I wanted to share with you guys a function I had created to see how I could optimize it, or if there was a better way to do this.
sub flatten{
my($ref,$delim,$item_delim,$array,$str) = #_;
die("Required Hash Reference") unless isHash($ref);
$delim = $delim ? $delim :'_';
#dump into array hash vals #simplified
if(!$item_delim){
#{$array} = %{$ref};
}else{
my($keys,$values);
$keys = getKeys($ref);
$values = getValues($ref);
#item strings
if($#$keys > 0 && $#$values > 0){
#fix for issue where value[n] is empty
#{$array}= map{ (defined $$values[ $_ ]) ? $$keys[ $_ ].$item_delim.$$values[ $_ ] : $$keys[ $_ ].$item_delim } 0 .. int($#$keys);
}else{
log "No Values to flatten";
return '';
}
}
$str = join($delim,#{$array});
return $str;
}
Are there any optimization points I should be aware of here?
Basically I want to go from
$HASH => {
key1 => 'val1',
key2 => 'val2',
key3 => 'val3',
}
to $STRING= key1=val1&key2=val2 ...
UPDATED
a solution without Modules is preferred I really just want to know how to effectively flatten a hash!.
Note that some of the functions here are simply wrapper functions that do what they say. isHash getKeys... pay no attention to those!
One convenient way is to use URI's query_form facility.
use URI;
my $uri = URI->new("", "http"); # We don't actually care about the path...
$uri->query_form(%params);
my $query_string = $uri->query;
Another, more manual way, is to just use URI::Escape, map, and join.
Without modules:
my $hashref = {
key1 => 'val1',
key2 => 'val2',
key3 => 'val3',
};
sub encode {
my $str = shift;
$str =~ s/([^A-Za-z0-9\.\/\_\-])/sprintf("%%%02X", ord($1))/seg;
return $str;
}
my $str = join '&' => map { encode($_).'='.encode($hashref->{$_}) } grep { defined $hashref->{$_} } keys %$hashref;
result:
key2=val2&key1=val1&key3=val3
I can't see anything in your question which means that your subroutine needs to be any more complex than:
sub flatten {
my ($hash, $delim, $item_delim) = #_;
$delim //= '&',
$item_delim //= '=';
return join $delim, map { "$_$item_delim$hash->{$_}" } keys %$hash;
}
Update: Getting a few downvotes here. I assume that people object to the fact that I'm not URI-encoding anything. I'll just point out that there's nothing in the original question saying that we're building URIs. If I knew that we were, then I'd certainly use the appropriate module.
This is why I said "I can't see anything in your question...".
use URI::Escape;
my $str=join '&',map {uri_escape($_).'='.uri_escape($QUERY_STRING->{$_})} grep {defined $QUERY_STRING->{$_}} keys %$QUERY_STRING;
I think this should work!
Related
I am trying to sort out defined parameters from a complex hash, using hash slices. Hash slices are great because they avoid lots of foreach and if defined so they simplify syntax greatly.
However, I'm clearly not doing this correctly:
use DDP;
my %hash = (
'a' => # first patient
{
'age' => 9,
'BMI' => 20
},
'b' =>
{
'age' => 8
}
);
my %defined_patients = grep {defined $hash{$_}{'age', 'BMI'}} keys %hash;
p %defined_patients;
The above code gives an empty hash, when I want it to return just patient a.
This question is similar to "no autovivication" pragma fails with grep in Perl and I've based my code on it.
I've also tried
my #defined_patients = grep {defined $hash{$_}{'age', 'BMI'}} keys %hash;
but that doesn't work either.
How can I use hash slices to grep patients with the defined keys?
If you want to check that none of the target keys are undefined, you have to check separately. This greps for undefined values:
grep { ! defined } #{ $hash{$_} }{ qw(age BMI) }
Notice that the hash slice
#{ $hash{$_} }{ qw(age BMI) }
In v5.24, you can use postfix dereferencing instead:
$hash{$_}->#{ qw(age BMI) }
But that grep has to fit in another one. Since you want the cases where all values are defined, you have to negate the result of the inner grep:
my #patients =
grep { ! grep { ! defined } $hash{$_}->#{ qw(age BMI) } }
keys %hash;
That's pretty ugly though. I'd probably do something simpler in a subroutine. This way you can handle any number of keys easily:
sub some_patients {
my( $hash, $keys ) = #_;
my #patient_keys;
foreach my $key ( keys %$hash ) {
next unless grep { ! defined } $hash{$key}->#{ #$keys };
push $key, #patient_keys;
}
return #patient_keys;
}
Now I simply call a subroutine instead of grokking multilevel greps:
my #patient_keys = some_patients( \%patients, [ qw(age BMI) ] );
Or, for something more targeted, maybe something like this that tests a particular sub-hash instead of the whole data structure:
sub has_defined_keys {
my( $hash, $keys ) = #_;
! grep { ! defined } $hash->#{#$keys}
}
my #target-keys = ...;
my #keys = grep {
has_defined_keys( $patients{$_}, \#target-keys )
} keys %patients;
Either way, when things start getting a bit too complex, use a subroutine to give those things names so you can hide the code in favor of something short.
I have a string as input, say apple.mango.orange = 100
I also have a hash reference:
$inst = {
'banana' => 2,
'guava' => 3,
'apple' => {
'mango' => {
'orange' => 80
}
}
};
I want to modify the value of orange using the input string. Can someone please help me how I could do this?
I tried splitting the string into (key, value) pair. I then did the following on the key string:
my $key2 = "\$inst->{".$key."}";
$key2 =~ s/\./}->{/g;
$$key2 = $value;
This does not work as intended. Can someone help me out here? I have read the Perl FAQ about not using a variable value as variable but I am unable to think of an alternative.
You are building string that consists of (buggy) Perl code, but you never ask Perl to execute it. ...but that's not the right approach.
sub dive_val :lvalue {
my $p = \shift;
$p = \($$p->{$_}) for #_;
$$p
}
my #key = split /\./, "apple.mango.orange";
dive_val($inst, #key) = $value;
or
use Data::Diver qw( DiveVal );
my #key = split /\./, "apple.mango.orange";
DiveVal($inst, map \$_, #key) = $value;
Not only is a symbolic reference a very bad idea here, it doesn't even solve your problem. You're building an expression in $key2, and just jamming another dollar sign in front of its name won't make perl execute that code. For that you would need eval, which is another bad idea
You can install and use the Data::Diver module, which does exactly this sort of thing, or you can simply loop over the list of hash keys, picking up a new hash reference each time and assigning the value to the element with the last key
The biggest issue is actually parsing the incoming string into a list of keys and a value. This code implements a subroutine apply which applies the implied operation in the string to a nested hash. Unless you are confident of your data, it needs some error checking addingto make sure each of the keys in the list exists. The Data:;Dumper output is just to demonstrate the validity of the result
use strict;
use warnings 'all';
use Data::Dumper;
my $inst = { 'banana' => 2, 'guava' => 3, 'apple' => { 'mango' => { 'orange' => 80 } } };
my $s = 'apple.mango.orange = 100';
apply($s, $inst);
print Dumper $inst;
sub apply {
my ($operation, $data) = #_;
my ($keys, $val) = $operation =~ /([\w.]+)\s*=\s*(\d+)/;
my #keys = split /\./, $keys;
my $last = pop #keys;
my $hash = $data;
$hash = $hash->{$_} for #keys;
$hash->{$last} = $val;
}
output
$VAR1 = {
'banana' => 2,
'apple' => {
'mango' => {
'orange' => '100'
}
},
'guava' => 3
};
The issue is when I try to compare the input to the output file, i am unable to handle the nesting of the parenthesis, and the complexity needs to be very low. is there a parsing module for this? compatible to 5.8.4. I found modules but they needed at least 5.10.:(
Input
(K1=V1,K2=V2,K3=V3(K2=V2.K5=V5)K6=V6(K7=V7,K8=V8(K9=V9,K10=V10)K11=V11)K12=V12,K13=V13)
OUTPUT FILE
(K0=V0,K1=V1,K2=V2,K3=V3(K1=V1,K2=V2,K4=V4,K5=V5,K14=V14),K15=V15,K6=V6(K18=V18,K7=V7,K19=V19,K8=V8(K20=V20,K9=V9,K16=V16,K10=V10,K21=V21)K11=V11)K12=V12,K13=V13,K22=V22)
I need to pick up each key value pair from input and one by one verify from the output file that the value is the same. if not
I need to store the key with the existing value.( The issue is with the nesting )
INPUT
K3=V3(K2=V2,K5=V5)
OUTPUT
K3=V3(K1=V1,K2=V2,K4=V4,K5=V5,K14=V14)
The issue is that "K2=V2" inside the V3 value is to be checked inside the V3 value in the output file. So I cannot just use a regular expression to do that as K2=V2 may appear outside the V3 parenthesis too.
I was trying to create a hash of a hash of a hash but failed. could someone suggest a way I could achieve this?
The following code builds the hash of hashes. Note that values (V3) are lost if they contain an inner hash.
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
sub to_hash {
my $string = shift;
$string =~ s/^\( | \)$//gx; # Remove the outer parentheses.
my #stack = {};
my #keys;
while (length $string) {
$string =~ s/^([^,=()]+) = ([^(),]*)//x or die $string;
my ($key, $value) = ($1, $2);
$stack[-1]{$key} = $value;
next if $string =~ s/^,//;
if ($string =~ s/^\(//) {
push #stack, {};
push #keys, $key;
} elsif ($string =~ s/^\),?//) {
my $last = pop #stack;
$stack[-1]{ pop #keys } = $last;
}
}
return $stack[0]
}
my $input = '(K1=V1,K2=V2,K3=V3(K2=V2,K5=V5)K6=V6(K7=V7,K8=V8(K9=V9,K10=V10)K11=V11)K12=V12,K13=V13)';
print Dumper to_hash($input);
Output
$VAR1 = {
'K2' => 'V2',
'K13' => 'V13',
'K6' => {
'K7' => 'V7',
'K8' => {
'K9' => 'V9',
'K10' => 'V10'
},
'K11' => 'V11'
},
'K3' => {
'K2' => 'V2',
'K5' => 'V5'
},
'K12' => 'V12',
'K1' => 'V1'
};
Nested parens either suggests an application of Text::Balanced and its extract_bracketed function, or building yourself a little parser subclass on Parser::MGC. Using the latter to build a little "convert string into data structure" parser is usually pretty straightforward for simple examples like this.
Assume a nested hash structure %old_hash ..
my %old_hash;
$old_hash{"foo"}{"bar"}{"zonk"} = "hello";
.. which we want to "flatten" (sorry if that's the wrong terminology!) to a non-nested hash using the sub &flatten(...) so that ..
my %h = &flatten(\%old_hash);
die unless($h{"zonk"} eq "hello");
The following definition of &flatten(...) does the trick:
sub flatten {
my $hashref = shift;
my %hash;
my %i = %{$hashref};
foreach my $ii (keys(%i)) {
my %j = %{$i{$ii}};
foreach my $jj (keys(%j)) {
my %k = %{$j{$jj}};
foreach my $kk (keys(%k)) {
my $value = $k{$kk};
$hash{$kk} = $value;
}
}
}
return %hash;
}
While the code given works it is not very readable or clean.
My question is two-fold:
In what ways does the given code not correspond to modern Perl best practices? Be harsh! :-)
How would you clean it up?
Your method is not best practices because it doesn't scale. What if the nested hash is six, ten levels deep? The repetition should tell you that a recursive routine is probably what you need.
sub flatten {
my ($in, $out) = #_;
for my $key (keys %$in) {
my $value = $in->{$key};
if ( defined $value && ref $value eq 'HASH' ) {
flatten($value, $out);
}
else {
$out->{$key} = $value;
}
}
}
Alternatively, good modern Perl style is to use CPAN wherever possible. Data::Traverse would do what you need:
use Data::Traverse;
sub flatten {
my %hash = #_;
my %flattened;
traverse { $flattened{$a} = $b } \%hash;
return %flattened;
}
As a final note, it is usually more efficient to pass hashes by reference to avoid them being expanded out into lists and then turned into hashes again.
First, I would use perl -c to make sure it compiles cleanly, which it does not. So, I'd add a trailing } to make it compile.
Then, I'd run it through perltidy to improve the code layout (indentation, etc.).
Then, I'd run perlcritic (in "harsh" mode) to automatically tell me what it thinks are bad practices. It complains that:
Subroutine does not end with "return"
Update: the OP essentially changed every line of code after I posted my Answer above, but I believe it still applies. It's not easy shooting at a moving target :)
There are a few problems with your approach that you need to figure out. First off, what happens in the event that there are two leaf nodes with the same key? Does the second clobber the first, is the second ignored, should the output contain a list of them? Here is one approach. First we construct a flat list of key value pairs using a recursive function to deal with other hash depths:
my %data = (
foo => {bar => {baz => 'hello'}},
fizz => {buzz => {bing => 'world'}},
fad => {bad => {baz => 'clobber'}},
);
sub flatten {
my $hash = shift;
map {
my $value = $$hash{$_};
ref $value eq 'HASH'
? flatten($value)
: ($_ => $value)
} keys %$hash
}
print join( ", " => flatten \%data), "\n";
# baz, clobber, bing, world, baz, hello
my %flat = flatten \%data;
print join( ", " => %flat ), "\n";
# baz, hello, bing, world # lost (baz => clobber)
A fix could be something like this, which will create a hash of array refs containing all the values:
sub merge {
my %out;
while (#_) {
my ($key, $value) = splice #_, 0, 2;
push #{ $out{$key} }, $value
}
%out
}
my %better_flat = merge flatten \%data;
In production code, it would be faster to pass references between the functions, but I have omitted that here for clarity.
Is it your intent to end up with a copy of the original hash or just a reordered result?
Your code starts with one hash (the original hash that is used by reference) and makes two copies %i and %hash.
The statement my %i=%{hashref} is not necessary. You are copying the entire hash to a new hash. In either case (whether you want a copy of not) you can use references to the original hash.
You are also losing data if your hash in the hash has the same value as the parent hash. Is this intended?
If you have a hash (or reference to a hash) in perl with many dimensions and you want to iterate across all values, what's the best way to do it. In other words, if we have
$f->{$x}{$y}, I want something like
foreach ($x, $y) (deep_keys %{$f})
{
}
instead of
foreach $x (keys %f)
{
foreach $y (keys %{$f->{$x})
{
}
}
Stage one: don't reinvent the wheel :)
A quick search on CPAN throws up the incredibly useful Data::Walk. Define a subroutine to process each node, and you're sorted
use Data::Walk;
my $data = { # some complex hash/array mess };
sub process {
print "current node $_\n";
}
walk \&process, $data;
And Bob's your uncle. Note that if you want to pass it a hash to walk, you'll need to pass a reference to it (see perldoc perlref), as follows (otherwise it'll try and process your hash keys as well!):
walk \&process, \%hash;
For a more comprehensive solution (but harder to find at first glance in CPAN), use Data::Visitor::Callback or its parent module - this has the advantage of giving you finer control of what you do, and (just for extra street cred) is written using Moose.
Here's an option. This works for arbitrarily deep hashes:
sub deep_keys_foreach
{
my ($hashref, $code, $args) = #_;
while (my ($k, $v) = each(%$hashref)) {
my #newargs = defined($args) ? #$args : ();
push(#newargs, $k);
if (ref($v) eq 'HASH') {
deep_keys_foreach($v, $code, \#newargs);
}
else {
$code->(#newargs);
}
}
}
deep_keys_foreach($f, sub {
my ($k1, $k2) = #_;
print "inside deep_keys, k1=$k1, k2=$k2\n";
});
This sounds to me as if Data::Diver or Data::Visitor are good approaches for you.
Keep in mind that Perl lists and hashes do not have dimensions and so cannot be multidimensional. What you can have is a hash item that is set to reference another hash or list. This can be used to create fake multidimensional structures.
Once you realize this, things become easy. For example:
sub f($) {
my $x = shift;
if( ref $x eq 'HASH' ) {
foreach( values %$x ) {
f($_);
}
} elsif( ref $x eq 'ARRAY' ) {
foreach( #$x ) {
f($_);
}
}
}
Add whatever else needs to be done besides traversing the structure, of course.
One nifty way to do what you need is to pass a code reference to be called from inside f. By using sub prototyping you could even make the calls look like Perl's grep and map functions.
You can also fudge multi-dimensional arrays if you always have all of the key values, or you just don't need to access the individual levels as separate arrays:
$arr{"foo",1} = "one";
$arr{"bar",2} = "two";
while(($key, $value) = each(%arr))
{
#keyValues = split($;, $key);
print "key = [", join(",", #keyValues), "] : value = [", $value, "]\n";
}
This uses the subscript separator "$;" as the separator for multiple values in the key.
There's no way to get the semantics you describe because foreach iterates over a list one element at a time. You'd have to have deep_keys return a LoL (list of lists) instead. Even that doesn't work in the general case of an arbitrary data structure. There could be varying levels of sub-hashes, some of the levels could be ARRAY refs, etc.
The Perlish way of doing this would be to write a function that can walk an arbitrary data structure and apply a callback at each "leaf" (that is, non-reference value). bmdhacks' answer is a starting point. The exact function would vary depending one what you wanted to do at each level. It's pretty straightforward if all you care about is the leaf values. Things get more complicated if you care about the keys, indices, etc. that got you to the leaf.
It's easy enough if all you want to do is operate on values, but if you want to operate on keys, you need specifications of how levels will be recoverable.
a. For instance, you could specify keys as "$level1_key.$level2_key.$level3_key"--or any separator, representing the levels.
b. Or you could have a list of keys.
I recommend the latter.
Level can be understood by #$key_stack
and the most local key is $key_stack->[-1].
The path can be reconstructed by: join( '.', #$key\_stack )
Code:
use constant EMPTY_ARRAY => [];
use strict;
use Scalar::Util qw<reftype>;
sub deep_keys (\%) {
sub deeper_keys {
my ( $key_ref, $hash_ref ) = #_;
return [ $key_ref, $hash_ref ] if reftype( $hash_ref ) ne 'HASH';
my #results;
while ( my ( $key, $value ) = each %$hash_ref ) {
my $k = [ #{ $key_ref || EMPTY_ARRAY }, $key ];
push #results, deeper_keys( $k, $value );
}
return #results;
}
return deeper_keys( undef, shift );
}
foreach my $kv_pair ( deep_keys %$f ) {
my ( $key_stack, $value ) = #_;
...
}
This has been tested in Perl 5.10.
If you are working with tree data going more than two levels deep, and you find yourself wanting to walk that tree, you should first consider that you are going to make a lot of extra work for yourself if you plan on reimplementing everything you need to do manually on hashes of hashes of hashes when there are a lot of good alternatives available (search CPAN for "Tree").
Not knowing what your data requirements actually are, I'm going to blindly point you at a tutorial for Tree::DAG_Node to get you started.
That said, Axeman is correct, a hashwalk is most easily done with recursion. Here's an example to get you started if you feel you absolutely must solve your problem with hashes of hashes of hashes:
#!/usr/bin/perl
use strict;
use warnings;
my %hash = (
"toplevel-1" =>
{
"sublevel1a" => "value-1a",
"sublevel1b" => "value-1b"
},
"toplevel-2" =>
{
"sublevel1c" =>
{
"value-1c.1" => "replacement-1c.1",
"value-1c.2" => "replacement-1c.2"
},
"sublevel1d" => "value-1d"
}
);
hashwalk( \%hash );
sub hashwalk
{
my ($element) = #_;
if( ref($element) =~ /HASH/ )
{
foreach my $key (keys %$element)
{
print $key," => \n";
hashwalk($$element{$key});
}
}
else
{
print $element,"\n";
}
}
It will output:
toplevel-2 =>
sublevel1d =>
value-1d
sublevel1c =>
value-1c.2 =>
replacement-1c.2
value-1c.1 =>
replacement-1c.1
toplevel-1 =>
sublevel1a =>
value-1a
sublevel1b =>
value-1b
Note that you CAN NOT predict in what order the hash elements will be traversed unless you tie the hash via Tie::IxHash or similar — again, if you're going to go through that much work, I recommend a tree module.