For example
From this:
UserA|Single|Girly|200|500
UserA|Single|Boyish|200|200
UserA|Double|Girly|100|200
UserA|Multiple|Boyish|200|400
UserA|Double|Girly|250|150
UserA|Single|Boyish|150|150
To this:
UserA|Single|Girly|200|500
UserA|Single|Boyish|350|350
UserA|Double|Girly|350|350
UserA|Multiple|Boyish|200|400
How should I code this in order to get the sum of the line by their same keys.
You get the basic idea from my example.
Thanks!
use strict;
use warnings;
my %hash;
while(my $line = <DATA>)
{
chomp $line;
if ($line =~ /(.*\|.*\|.*)\|(\d*)\|(\d*)/)
{
# you want to group them by the first 3 attributes, therefore:
# 1 will hold UserA|Single|Girly
# 2 will hold the first value
# 3 will hold the second value
$hash{$1}{'first_value'} += $2;
$hash{$1}{'second_value'} += $3;
}
}
use Data::Dumper;
print Dumper %hash;
__DATA__
UserA|Single|Girly|200|500
UserA|Single|Boyish|200|200
UserA|Double|Girly|100|200
UserA|Multiple|Boyish|200|400
UserA|Double|Girly|250|150
UserA|Single|Boyish|150|150
The result looks like this :
$VAR1 = 'UserA|Multiple|Boyish';
$VAR2 = {
'first' => '200',
'second' => '400'
};
$VAR3 = 'UserA|Double|Girly';
$VAR4 = {
'first' => '350',
'second' => '350'
};
$VAR5 = 'UserA|Single|Boyish';
$VAR6 = {
'first' => '350',
'second' => '350'
};
$VAR7 = 'UserA|Single|Girly';
$VAR8 = {
'first' => '200',
'second' => '500'
};
Related
I have a series of strings for example
my #strings;
$strings[1] = 'foo/bar/some/more';
$strings[2] = 'also/some/stuff';
$strings[3] = 'this/can/have/way/too/many/substrings';
What I would like to do is to split these strings and store them in a hash as keys like this
my %hash;
$hash{foo}{bar}{some}{more} = 1;
$hash{also}{some}{stuff} = 1;
$hash{this}{can}{have}{way}{too}{many}{substrings} = 1;
I could go on and list my failed attempts, but I don't think they add to the value to the question, but I will mention one. Lets say I converted 'foo/bar/some/more' to '{foo}{bar}{some}{more}'. Could I somehow store that in a variable and do something like the following?
my $var = '{foo}{bar}{some}{more}';
$hash$var = 1;
NOTE: THIS DOESN'T WORK, but I hope it only doesn't due to a syntax error.
All help appreciated.
Identical logic to Shawn's answer. But I've hidden the clever hash-walking bit in a subroutine. And I've set the final value to 1 rather than an empty hash reference.
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
use Data::Dumper;
my #keys = qw(
foo/bar/some/more
also/some/stuff
this/can/have/way/too/many/substrings
);
my %hash;
for (#keys) {
multilevel(\%hash, $_);
}
say Dumper \%hash;
sub multilevel {
my ($hashref, $string) = #_;
my $curr_ref = $hashref;
my #strings = split m[/], $string;
for (#strings[0 .. $#strings - 1]) {
$curr_ref->{$_} //= {};
$curr_ref = $curr_ref->{$_};
}
$curr_ref->{#strings[-1]} = 1;
}
You have to use hash references to walk down thru the list of keys.
use Data::Dumper;
my %hash = ();
while( my $string = <DATA> ){
chomp $string;
my #keys = split /\//, $string;
my $hash_ref = \%hash;
for my $key ( #keys ){
$hash_ref->{$key} = {};
$hash_ref = $hash_ref->{$key};
}
}
say Dumper \%hash;
__DATA__
foo/bar/some/more
also/some/stuff
this/can/have/way/too/many/substrings
Just use a library.
use Data::Diver qw(DiveVal);
my #strings = (
undef,
'foo/bar/some/more',
'also/some/stuff',
'this/can/have/way/too/many/substrings',
);
my %hash;
for my $index (1..3) {
my $root = {};
DiveVal($root, split '/', $strings[$index]) = 1;
%hash = (%hash, %$root);
}
__END__
(
also => {some => {stuff => 1}},
foo => {bar => {some => {more => 1}}},
this => {can => {have => {way => {too => {many => {substrings => 1}}}}}},
)
I took the easy way out w/'eval':
use Data::Dumper;
%hash = ();
#strings = ( 'this/is/a/path', 'and/another/path', 'and/one/final/path' );
foreach ( #strings ) {
s/\//\}\{/g;
$str = '{' . $_ . '}'; # version 2: remove this line, and then
eval( "\$hash$str = 1;" ); # eval( "\$hash{$_} = 1;" );
}
print Dumper( %hash )."\n";
the original perl array is sorted and looks like this:
Original ARRARY:
ccc-->2
ccc-->5
abc-->3
abc-->7
cb-->6
and i like to have the following result:
FINAL ARRARY:
ccc-->7
abc-->10
cb-->6
Question:
can you please create a subroutine for that ?
this was the orig. subroutine that i used:
sub read_final_dev_file {
$dfcnt=0;
$DEVICE_ANZSUMZW=0;
$DEVICE_ANZSUM=0;
open(DATA,"$log_dir1/ALLDEVSORT.$log_file_ext1") || die ("Cannot Open Logfile: $log_dir1/$log_DEV_name.$log_file_ext1 !!!!");
#lines = <DATA>;
close(DATA);
chomp(#lines); # erase the last sign from a string
foreach $logline (#lines) {
if ($logline =~ /(.*)-->(.*)/) {
$DEVICE_CODE[$dfcnt] = $1;
$DEVICE_ANZAHL[$dfcnt] = $2;
print "DEVICE_final = $DEVICE_CODE[$dfcnt], D_ANZAHL_final = $DEVICE_ANZAHL[$dfcnt]\n";
if ($dfcnt > 0 ) {
if ( $DEVICE_CODE[$dfcnt] eq $DEVICE_CODE[$dfcnt-1] ) {
$DEVICE_ANZSUM = $DEVICE_ANZAHL[$dfcnt] + $DEVICE_ANZAHL[$dfcnt-1];
$DEVICE_ANZSUMZW = $DEVICE_ANZSUM++;
#$DEVICE_ANZSUM = $DEVICE_ANZAHL[$dfcnt]++;
#print "DEVICE_ANZAHL = $DEVICE_ANZAHL[$dfcnt],DEVICE_ANZAHL -1 = $DEVICE_ANZAHL[$dfcnt-1]\n";
print "DEVICE_eq = $DEVICE_CODE[$dfcnt], D_ANZAHL_eq = $DEVICE_ANZAHL[$dfcnt],DEVANZSUM = $DEVICE_ANZSUM,COUNT = $dfcnt\n";
}#end if
if ( $DEVICE_CODE[$dfcnt] ne $DEVICE_CODE[$dfcnt-1] ) {
#$DEVICE_ANZSUM=0;
#splice(#data3,$dfcnt+2,1) if ($DEVICE_ANZSUM > 1);
push (#data3,$DEVICE_ANZSUMZW) if ($DEVICE_ANZSUM > 1);
push (#data3,$DEVICE_ANZAHL[$dfcnt]) if ($DEVICE_ANZSUM == 0);
if ( $DEVICE_CODE[$dfcnt] ne $DEVICE_CODE[$dfcnt-1] ) {
$DEVICE_ANZSUM=0;
}
print "DEVICE_ne = $DEVICE_CODE[$dfcnt], D_ANZAHL_ne = $DEVICE_ANZAHL[$dfcnt], DEVANZSUM = $DEVICE_ANZSUM\n";
}#end if
}#end if $dfcnt
$dfcnt++;
}#end if logline
}#end for
print "#labels3\n";
print "#data3\n";
}#end sub read_final_dev_file
Probably not the best way, but this is what came to mind after seeing LeoNerd answer, since I don't have CPAN access in production and never have modules lying around:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my #input = (
[ ccc => 2 ],
[ ccc => 5 ],
[ abc => 3 ],
[ abc => 7 ],
[ cb => 6 ],
);
my %output;
$output{$_->[0]} += $_->[1] for #input;
print Dumper \%output;
my #output = map { [ $_ => $output{$_} ] } keys(%output);
print Dumper \#output;
Output:
$VAR1 = {
'abc' => 10,
'cb' => 6,
'ccc' => 7
};
$VAR1 = [
['abc', 10],
['cb', 6],
['ccc', 7],
];
You could use List::UtilsBy::partition_by to group the original list into partitions, by the first string:
use List::UtilsBy qw( partition_by );
my #input = (
[ ccc => 2 ],
[ ccc => 5 ],
[ abc => 3 ],
[ abc => 7 ],
[ cb => 6 ],
);
my %sets = partition_by { $_->[0] } #input;
Now you have a hash, keyed by the leading strings, whose values are all the ARRAY refs with that key first. You can now sum the values within them, by mapping over $_->[1] which contains the numbers:
use List::Util qw( sum );
my %totals;
foreach my $key ( keys %sets ) {
$totals{$key} = sum map { $_->[1] } #{ $sets{$key} };
}
If you're inclined towards code of a more compact and functional-looking nature, you could instead use the new pairmap here; making the whole thing expressible in one line:
use List::UtilsBy qw( partition_by );
use List::Util qw( pairmap sum );
my %totals = pairmap { $a => sum map { $_->[1] } #$b }
partition_by { $_->[0] } #input;
Edit: I should add that even though you stated in your original question that the array was sorted, this solution doesn't require it sorted. It will happily take the input in any order.
You can simplify your subroutine a lot by using a hash to track the counts instead of an array. The following uses an array #devices to track the order and a hash %device_counts to track the counts:
my #devices;
my %device_counts;
while (<DATA>) { # Read one line at a time from DATA
if (/(.*)-->(.*)/) { # This won't extract newlines so no need to chomp
if (!exists $device_counts{$1}) {
push #devices, $1; # Add to the array the first time we encounter a device
}
$device_counts{$1} += $2; # Add to the count for this device
}
}
for my $device (#devices) {
printf "%s-->%s\n", $device, $device_counts{$device};
}
Using Perl, I have a HoH similar to this:
%HoH = (
'A' => {
'a' => 4,
'b' => 18,
'c' => 2
},
'B' => {
'a' => 1,
'b' => 2
},
'C' => {
'a' => 1
},
'D' => {
'a' => 1,
'b' => 2,
'c' => 5,
'd' => 9
},
#........ on and on and on .....
);
For each of the capital keys, I want to print the one lower-case key that has the largest value associated with it.
example output:
b,b,a,d...
Any direction at this point would be appreciated, new to the game.
use List::Util qw(reduce);
for my $k1 (sort keys %HoH) {
my $h = $HoH{$k1};
my $k2 = reduce { $h->{$a} > $h->{$b} ?$a :$b } keys %$h;
print "$k1, $k2\n";
}
For example:
for my $k (sort keys %HoH) {
my $h = $HoH{$k};
my $g= (sort {$h->{$b} <=> $h->{$a}} keys %$h)[0];
print "$k: $g \n";
}
(Your original output does not much sense, because the order of the keys of %HoH is not fixed)
Using List::Util's reduce;
use List::Util qw(reduce);
use strict;
use warnings;
my %HoH = ...
for my $k (sort keys %HoH) {
my $h = $HoH{$k};
my $maxKey = reduce {$h->{$a} > $h->{$b} ? $a : $b} keys %$h;
print "$k -> $maxKey\n";
}
I have the following code
use strict;
use warnings;
use Data::Dumper;
my $s = "12 A P1
23 B P5
24 C P2
15 D P1
06 E P5 ";
my $hash = {};
my #a = split(/\n/, $s);
foreach (#a)
{
my $c = (split)[2];
my $d = (split)[1];
my $e = (split)[0];
push(#{$hash->{$c}}, $d);
}
print Dumper($hash );
I am getting the output
$VAR1 = {
'P5' => [
'B',
'E'
],
'P2' => [
'C'
],
'P1' => [
'A',
'D'
]
};
But I want the output like
$VAR1 = {
'P5' => {
'E' => '06',
'B' => '23'
},
'P2' => {
'C' => '24'
},
'P1' => {
'A' => '12',
'D' => '15'
}
};
Please help.
You need to use a hash if you want a hash as output.
No need to split three times and use postscripts, just split once and assign all variables. Also no need to initialize a scalar as an empty hash, perl will take care of that for you.
I renamed the variables for increased readability.
my $string = "12 A P1
23 B P5
24 C P2
15 D P1
06 E P5 ";
my $hash;
my #lines = split(/\n/, $string);
foreach (#lines)
{
my ($value, $key2, $key) = split;
$hash->{$key}{$key2} = $value;
}
print Dumper($hash );
Be aware that if you have multiple values with the same keys, they will overwrite each other. In that case, you'd need to push the values onto an array instead:
push #{$hash->{$key}{$key2}}, $value;
Well it's not that different from what you have. Just replace the push with a hash-assign (thank you auto-vivification):
foreach (#a)
{
my ($e, $d, $c) = split;
$hash->{$c}->{$d} = $e;
}
Additionally I have re-arranged the "split" so that it's just called once per line.
How can I preserve the order in which the hash elements were added
FOR THE SECOND VAR ?
( Hash of Hashes )
For example:
use Tie::IxHash;
my %hash;
tie %hash, "Tie::IxHash";
for my $num (0 .. 5){
$hash{"FirstVal$num"}++;
}
for my $num (0 .. 5){
$hash{"FirstValFIXED"}{"SecondVal$num"}++;
}
print Dumper(%hash);
When dumping out the result, $VAR14 didn't preserve the insertion order:
$VAR1 = 'FirstVal0';
$VAR2 = 1;
$VAR3 = 'FirstVal1';
$VAR4 = 1;
$VAR5 = 'FirstVal2';
$VAR6 = 1;
$VAR7 = 'FirstVal3';
$VAR8 = 1;
$VAR9 = 'FirstVal4';
$VAR10 = 1;
$VAR11 = 'FirstVal5';
$VAR12 = 1;
$VAR13 = 'FirstValFIXED';
$VAR14 = {
'SecondVal5' => 1,
'SecondVal4' => 1,
'SecondVal2' => 1,
'SecondVal1' => 1,
'SecondVal3' => 1,
'SecondVal0' => 1
};
I know I can trick that example with some sort operation but in my real problem the elements are not numbered or can't be ordered some how.
Is there any simple function/operation for hash multi level order insertion ?
Thanks,
Yodar.
Look at Tie::Autotie. It automatically ties new hashes created by autovivification. The perldoc page shows an example using Tie::IxHash.
You need an extra "\", as below.
print Dumper(\%hash);
Do you mean hash of hashes? You need to tie to Tie::IxHash every value of outer hash.
use strict;
use warnings;
use Tie::IxHash;
my $hash={};
my $t = tie(%$hash, 'Tie::IxHash', 'a' => 1, 'b' => 2);
%$hash = (first => 1, second => 2, third => 3);
$hash->{fourth} = 4;
print join(', ',keys %$hash),"\n";
my %new_hash=('test'=>$hash);
$new_hash{'test'}{fifth} = 5;
print join(', ',keys %{$new_hash{'test'}}),"\n";
$new_hash{'test'}{fifth}++;
print join(', ',values %{$new_hash{'test'}}),"\n";
foreach my $sortline (sort {$a<=>$b} keys %{$hash->{"first_field"}}){
my $name;
# Soultion to touch a Key with keys within it:
#---------------------------------------------
foreach my $subkey (keys %{$hash->{"first_field"}->{$sortline}})
{$name = $subkey;}
#---------------------------------------------
}
This useful answer helped me.