Related
I am trying to compare all the array values (complete array) with a hash's value(which is array) and if the match founds,then push the key of hash to new array.
The below code compare if the hash value is not array but how can I compare if its array?
%hash=(
storeA=>['milk','eggs'],
storeB=>['milk','fruits','eggs','vegetables'],
storeC=>['milk','fruits','eggs'],
);
#array = (
'fruits',
'milk',
'eggs'
);
Code to compare
use strict;
use warnings;
use Data::Dumper;
foreach my $thing (#array) {
foreach ((my $key, my $value) = each %hash) {
if ($value eq $thing) {
push #new_array, $key;
}
}
}
print Dumper(\#new_array);
Expected Output
#new_array = (
storeB,
storeC
);
You could also use a combination of all and any form List::Util :
while ((my $key, my $value) = each %hash) {
if ( all { my $temp = $_; any { $_ eq $temp } #$value } #array ) {
push #new_array, $key;
}
}
So here you are looking for the case where all the elements of #array exists in the given array from the hash.
I would build a hash out of each store's stock array. It's a wasteful method, but not egregiously so as long as the real data isn't enormous
Like this. The inner grep statement counts the number of items in #list that are available at this store and compares it to the number of items in the list, returning true if everything is in stock
If this is a real situation (I suspect it's homework) then for all practical purposes that I can think of, the %stocks hash should contain hashes of the items available at each store
use strict;
use warnings 'all';
my %stocks = (
storeA => [ qw/ milk eggs / ],
storeB => [ qw/ milk fruits eggs vegetables / ],
storeC => [ qw/ milk fruits eggs / ],
);
my #list = qw/ fruits milk eggs /;
my #stores = grep {
my %stock = map { $_ => 1 } #{ $stocks{$_} };
grep($stock{$_}, #list) == #list;
} keys %stocks;
use Data::Dump;
dd \#stores;
output
["storeB", "storeC"]
Find the intersection of the two sets, if the number of its elements is the number of the elements in the array, you want to store the key:
#!/usr/bin/perl
use warnings;
use strict;
sub intersect {
my ($arr1, $arr2) = #_;
my %intersection;
$intersection{$_}{0}++ for #$arr1;
$intersection{$_}{1}++ for #$arr2;
return grep 2 == keys %{ $intersection{$_} }, keys %intersection
}
my %hash = (
storeA => [qw[ milk eggs ]],
storeB => [qw[ milk fruits eggs vegetables ]],
storeC => [qw[ milk fruits eggs ]],
);
my #array = qw( fruits milk eggs );
my #new_array;
while (my ($store, $arr) = each %hash) { # while, not for!
push #new_array, $store if #array == intersect(\#array, $arr);
}
use Data::Dumper;
print Dumper(\#new_array);
Simply try this. One small trick i done here. grep was use to filter the element from an array.
I created the variable $joined_array which contain the | separated #array data. Then i pass the variable into the grep.
And the trick is, when the array is compare with a scalar data, the comparison is behave, the total number of an array element with scalar data.
my #array = qw(one two three);
if(#array == 3)
{
print "Hi\n";
}
Here condition is internally run as 3 == 3.
That the same logic i done here.
use warnings;
use strict;
my %hash=(
"storeA"=>['milk','eggs'],
"storeB"=>['milk','fruits','eggs','vegetables'],
"storeC"=>['milk','fruits','eggs'],
);
my #array = (
'fruits',
'milk',
'eggs'
);
my #new_array;
my $joined_array = join("|",#array);
foreach (keys %hash)
{
push(#new_array,$_) if ((grep{ /\b$joined_array\b/ } #{$hash{$_}}) >= scalar #array);
}
print "$_\n" for #new_array
Go through all stores (keys) and for each check whether all array elems are in the key's array-ref.
use strict;
use warnings;
my %inventory = (
storeA => ['milk','eggs'],
storeB => ['milk','fruits','eggs','vegetables'],
storeC => ['milk','fruits','eggs'],
);
my #items = ('fruits', 'milk', 'eggs');
my #found;
foreach my $store (keys %inventory) {
push #found, $store
if #items == grep { in_store($_, $inventory{$store}) } #items
}
sub in_store { for (#{$_[1]}) { return 1 if $_[0] eq $_ }; return 0; }
print "#found\n"; # prints: storeB storeC
The grep block checks for each item whether it is (available) in the store, and if the number of those that pass is equal to the number of items (array size) that store has all items and is added. Note that a subroutine returns the last value evaluated without an explicit return, so the final return is not needed. It was added for clarity.
Is it possible to assign two variables the same data from an array in a Perl foreach loop?
I am using Perl 5, I think I came across something in Perl 6.
Something like this:
my $var1;
my $var2;
foreach $var1,$var2 (#array){...}
It's not in the Perl 5 core language, but List::Util has a pairs function which should be close enough (and a number of other pair... functions which may be more convenient, depending on what you're doing inside the loop):
#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
use List::Util 'pairs';
my #list = qw(a 1 b 2 c 3);
for my $pair (pairs #list) {
my ($first, $second) = #$pair;
say "$first => $second";
}
Output:
a => 1
b => 2
c => 3
The easiest way to use this is with a while loop that calls splice on the first two elements of the array each time,
while (my($var1, $var2) = splice(#array, 0, 2)) {
...
}
However, unlike foreach, this continually does a double-shift on the original array, so when you’re done, the array is empty. Also, the variables assigned are copies, not aliases as with foreach.
If you don’t like that, you can use a C-style for loop:
for (my $i = 0; $i < #array; $i += 2) {
my($var1, $var2) = #array[$i, $i+1];
...
}
That leaves the array in place but does not allow you to update it the way foreach does. To do that, you need to address the array directly.
my #pairlist = (
fee => 1,
fie => 2,
foe => 3,
fum => 4,
);
for (my $i = 0; $i < #pairlist; $i += 2) {
$pairlist[ $i + 0 ] x= 2;
$pairlist[ $i + 1 ] *= 2;
}
print "Array is #pairlist\n";
That prints out:
Array is feefee 2 fiefie 4 foefoe 6 fumfum 8
You can get those into aliased variables if you try hard enough, but it’s probably not worth it:
my #kvlist = (
fee => 1,
fie => 2,
foe => 3,
fum => 4,
);
for (my $i = 0; $i < #kvlist; $i += 2) {
our ($key, $value);
local(*key, $value) = \#kvlist[ $i, $i + 1 ];
$key x= 2;
$value *= 2;
}
print "Array is #kvlist\n";
Which prints out the expected changed array:
Array is feefee 2 fiefie 4 foefoe 6 fumfum 8
Note that the pairs offered by the List::Pairwise module, which were but very recently added to the core List::Util module (and so you probably cannot use it), are still not giving you aliases:
use List::Util 1.29 qw(pairs);
my #pairlist = (
fee => 1,
fie => 2,
foe => 3,
fum => 4,
);
for my $pref (pairs(#pairlist)) {
$pref->[0] x= 2;
$pref->[1] *= 2;
}
print "Array is #pairlist\n";
That prints out only:
Array is fee 1 fie 2 foe 3 fum 4
So it didn’t change the array at all. Oops. :(
Of course, if this were a real hash, you could double the values trivially:
for my $value (values %hash) { $value *= 2 }
The reasons that works is because those are aliases into the actual hash values.
You cannot change the keys, since they’re immutable. However, you can make a new hash that’s an updated copy of the old one easily enough:
my %old_hash = (
fee => 1,
fie => 2,
foe => 3,
fum => 4,
);
my %new_hash;
#new_hash{ map { $_ x 2 } keys %old_hash } =
map { $_ * 2 } values %old_hash;
print "Old hash is: ", join(" " => %old_hash), "\n";
print "New hash is: ", join(" " => %new_hash), "\n";
That outputs
Old hash is: foe 3 fee 1 fum 4 fie 2
New hash is: foefoe 6 fiefie 4 fumfum 8 feefee 2
A general algorithm for more than 2 variables:
while( #array ){
my $var1 = shift #array;
my $var2 = shift #array;
my $var3 = shift #array;
# other variables from #array
# do things with $var1, $var2, $var3, ...
}
PS: Using a working copy of the array to that it is preserved for use later:
if( my #working_copy = #array ){
while( #working_copy ){
my $var1 = shift #working_copy;
my $var2 = shift #working_copy;
my $var3 = shift #working_copy;
# other variables from #working_copy
# do things with $var1, $var2, $var3, ...
}
}
PPS: another way is to use indexing. Of course, that is a sure sign that the data structure is wrong. It should be an array of arrays (AoA) or an array of hashes (AoH). See perldoc perldsc and perldoc perllol.
my $i = 0;
while( $i < #array ){
my $var1 = $array[ $i++ ];
my $var2 = $array[ $i++ ];
my $var3 = $array[ $i++ ];
# other variables from #array
# do things with $var1, $var2, $var3, ...
}
PPPS: I've been asked to clarify why the data structure is wrong. It is a flatten set of tuples (aka records aka datasets). The tuples are recreated by counting of the number of data for each. But what is the reader constructing the set has a bug and doesn't always get the number right? If, for a missing value, it just skips adding anything? Then all the remaining tuples are shifted by one, causing the following tuples to be grouped incorrectly and therefore, invalid. That is why an AoA is better; only the tuple with the missing data would be invalid.
But an better structure would be an AoH. Each datum would access by a key. Then new or optional data can be added without breaking the code downstream.
While I'm at it, I'll add some code examples:
# example code for AoA
for my $tuple ( #aoa ){
my $var1 = $tuple->[0];
my $var2 = $tuple->[1];
my $var3 = $tuple->[2];
# etc
}
# example code for AoH
for my $tuple ( #aoh ){
my $var1 = $tuple->{keyname1};
my $var2 = $tuple->{key_name_2};
my $var3 = $tuple->{'key name with spaces'};
my $var4 = $tuple->{$key_name_in_scalar_variable};
# etc
}
Here is a module-less way to "loop" by an arbitrary value ($by) and output the resulting group of elements using an array slice:
#!perl -l
#array = "1".."6";
$by = 3; $by--;
for (my $i = 0 ; $i < #array ; $i += $by ) {
print "#array[$i..$i+$by]";
$i++ ;
}
As a one-liner to test (cut and paste to a Unix shell):
perl -E '#array = "1".."6"; $by = 3; $by--;
for (my $i = 0 ; $i < #array ; $i += $by ) {
say "#array[$i..$i+$by]"; $i++ }'
Output:
1 2 3
4 5 6
If you make $by = 2; it will print pairs of numbers. To get at specific elements of the resulting slice access it as an anonymous array: (e.g. [#array[$i..$i+$by]]->[1]).
See also:
How do I read two items at a time in a Perl foreach loop?
Perl way of iterating over 2 arrays in parallel
Some good responses there, including reference to natatime which is quite easy to use. It's easy to implement too - it is essentially a wrapper around the splice solutions mentioned in the responses here.
The following is not the nicest example, but I've been using autobox::Core and made an #array->natatime() "method" ;-) like this:
use autobox::Core ;
sub autobox::Core::ARRAY::natatime {
my ($self, $by) = #_;
my #copy = #$self ;
my #array ;
push #array, [splice (#copy, 0, $by) ] while #copy ;
if ( not defined wantarray ) {
print "#{ $_ } \n" for #array ;
}
return wantarray ? #array : \#array;
}
The #copy array is spliced destructively, but $self (which is how the #array in front of the autobox method -> arrow gets passed to the function) is still there. So I can do:
my #dozen = "1" .. "12" ; # cakes to eat
#dozen->natatime(4) ; # eat 4 at time
my $arr_ref = #dozen->natatime(4) ; # make a reference
say "Group 3: #{ $arr_ref->[2] }" ; # prints a group of elements
say scalar #dozen , " cakes left" ; # eat cake; still have it
Output:
1 2 3 4
5 6 7 8
9 10 11 12
Group 3: 9 10 11 12
12 cakes left
One other approach that also uses a CPAN module (I gave this answer elsewhere but it is worth repeating). This can also be done non-destructively, with Eric Strom's excellent List::Gen module:
perl -MList::Gen=":all" -E '#n = "1".."6"; say "#$_" for every 2 => #n'
1 2
3 4
5 6
Each group of elements you grab is returned in an anonymous array so the individual values are in: $_->[0] $_->[1] ... etc.
You mentioned Perl6, which handles multiple looping values nicely:
my #qarr = 1 .. 6;
my ($x, $y, $z) ;
for #qarr -> $x , $y , $z { say $x/$y ; say "z = " ~ $z }
Output:
0.5
z = 3
0.8
z = 6
For more on the Perl6 approach see: Looping for Fun and Profit from the 2009 Perl6 Advent Calendar, or the Blocks and Statements Synopsis for details. Perhaps Perl 5 will have a similar "loop by multliple values" construct one day - à la perl5i's foreach :-)
I have a table like this
symbol length id
A 10 id_1
A 15 id_2
A 15 id_3
B 20 id_4
B 25 id_5
... ... ...
I want to print the following in a new table
symbol length id
A 15 id_2; id_3
B 25 id_5
... ... ...
So I want to loop through the symbol column. When there are duplicate values in this column, I want to print the line where the numeric length-value is the greatest (example: symbol B). When the greatest length values are equal, I want to merge the values in the idcolumn (example: symbol A) and print this new line.
How should I do this in perl?
The tool in perl for coalescing duplicates is a hash. Hashes are key-value pairs, but the useful part is - the value can be an array (reference).
I'd be suggesting something like this:
#!/usr/bin/perl
use strict;
use warnings;
my %length_of;
my %ids_of;
my $heading_row = <DATA>;
while (<DATA>) {
my ( $symbol, $length, $id ) = split;
if ( not defined $length_of{$symbol} or $length_of{$symbol} < $length ) {
$length_of{$symbol} = $length;
}
push( #{ $ids_of{$symbol}{$length} }, $id );
}
print join( "\t", "symbol", "length", "ids" ), "\n";
foreach my $symbol ( sort keys %ids_of ) {
my $length = $length_of{$symbol};
print join( "\t",
$symbol,
$length,
join( "; ", #{ $ids_of{$symbol}{$length} } ) ),
"\n";
}
__DATA__
symbol length id
A 10 id_1
A 15 id_2
A 15 id_3
B 20 id_4
B 25 id_5
What this is doing is - iterating your data, and saving the highest length value (in %length_of). It's also stashing each of the ids - by symbol and length (in %ids_of). It keeps them all, so this might not be very efficient if you've a lot of data.
Just remember the last symbol and length and accumulate the ids:
#! /usr/bin/perl
use warnings;
use strict;
my ($last_l, $last_s, #i);
sub out {
print "$last_s\t$last_l\t", join(";", #i), "\n"
}
while (<>) {
my ($s, $l, $i) = split;
out() if $last_s and $s ne $last_s;
undef #i if $last_l < $l;
push #i, $i;
$last_s = $s;
$last_l = $l;
}
out();
This approach builds a hash of hashes of arrays by using the values from the symbol and length columns as keys and adding the values from the id column as array references. For the simple dataset you provided such a complex data structure is not really needed, but the approach shown below might be more flexible in cases where data is not sorted.
I use the max function from (List::Util , which is part of the core distribution) to get the maximum length value for each symbol, and Data::Dumper to help visualize things.
use Data::Dumper ;
use List::Util 'max';
use v5.16;
my (%hash, #lines) ;
while ( <DATA>) {
chomp ;
next if $. == 1 ;
push #lines, [ split ] ;
}
for (#lines) {
push #{ $hash{ $_->[0] }{ $_->[1] } }, $_->[2] ;
}
say "This is your %hash:\n", Dumper \%hash;
for my $symbol ( keys %hash ) {
my $max = max ( keys $hash{$symbol} ) ;
say "$symbol \t", "$max \t", join "; ", #{ $hash{$symbol}{$max} };
}
__DATA__
symbol length id
A 10 id_1
A 15 id_2
A 15 id_3
B 20 id_4
B 25 id_5
Output:
This is your %hash:
$VAR1 = {
'A' => {
'10' => [
'id_1'
],
'15' => [
'id_2',
'id_3'
]
},
'B' => {
'25' => [
'id_5'
],
'20' => [
'id_4'
]
}
};
A 15 id_2; id_3
B 25 id_5
I have a set of CSV values like this:
device name, CPU value, frequency of CPU value, CPU in percentage
For example
router1,5,10,4
router1,5,1,5
router2,5,10,4
router2,5,2,5
router3,4,5,6
router3,7,6,5
I need to form a data structure like this:
array = {
router1 => [5,10,4],[5,1,5],
router2 => [5,10,4],[5,2,5],
router3 => [4,5,6],[7,6,5]
}
I need help in forming this data structure in Perl.
I have tried visualizing how to do this but am unable to do so. I would appreciate any help on this.
The end goal for me is to convert this into a JSON object.
This should get you started. It uses the DATA file handle so that I could embed the data in the program itself. I have used to_json from the JSON module to format the hash as JSON data. The statement $_ += 0 for #values converts the contents of #values from string to to numeric, to avoid quotation marks in the resultant JSON data.
use strict;
use warnings;
use JSON;
my %data;
while (<DATA>) {
chomp;
my ($device, #values) = split /,/;
$_ += 0 for #values;
push #{ $data{$device} }, \#values;
}
print to_json(\%data, { pretty => 1, canonical => 1 });
__DATA__
router1,5,10,4
router1,5,1,5
router2,5,10,4
router2,5,2,5
router3,4,5,6
router3,7,6,5
output
{
"router1" : [
[
5,
10,
4
],
[
5,
1,
5
]
],
"router2" : [
[
5,
10,
4
],
[
5,
2,
5
]
],
"router3" : [
[
4,
5,
6
],
[
7,
6,
5
]
]
}
Here is a simple solution which prints desired JSON object.
#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
my %hash;
while (my $line = <DATA>) {
chomp $line;
my ($device, #cpu_values) = split(/,/, $line);
my $cpu_token = join(",", #cpu_values);
$hash{$device} .= '[' . $cpu_token . '], ';
}
my #devices = keys %hash;
print "array = { \n";
foreach (sort #devices) {
print "$_ => [$hash{$_}]\n";
}
print "}\n";
__DATA__
router1,5,10,4
router1,5,1,5
router2,5,10,4
router2,5,2,5
router3,4,5,6
router3,7,6,5
In Perl you need to use references in the way of anonymous arrays and hashes to make multidimensional arrays, arrays of arrays, hashes containing hashes and anywhere in between. perlreftut should cover how to accomplish what you are trying to do. Here is an example I wrote the other day that could help explain as well:
print "\nFun with multidimensional arrays\n";
my #myMultiArray = ([1,2,3],[1,2,3],[1,2,3]);
for my $a (#myMultiArray){
for my $b (#{$a}){
print "$b\n";
}
}
print "\nFun with multidimensional arrays containing hashes\nwhich contains an anonymous array\n";
my #myArrayFullOfHashes = (
{'this-key'=>'this-value','that-key'=>'that-value'},
{'this-array'=>[1,2,3], 'this-sub' => sub {return 'hi'}},
);
for my $a (#myArrayFullOfHashes){
for my $b (keys %{$a}){
if (ref $a->{$b} eq 'ARRAY'){
for my $c (#{$a->{$b}}){
print "$b.$c => $c\n";
}
} elsif ($a->{$b} =~ /^CODE/){
print "$b => ". $a->{$b}() . "\n";
} else {
print "$b => $a->{$b}\n";
}
}
}
I have a hash whose values are arrays. I need to find the common elements of those arrays,
ie. the elements that are present in all the arrays. So I extracted the values of the hash into
a multidimensional array whose each row corresponds to an array in the hash. Then I took the first row
of this matrix into another array (#arr1) and iterated through it to find if there was any element
in arr1 that was also in the rest of the rows of the matrix. If such an element is found, it is
pushed onto another array that contains the final list of all the elements. The code is as follows
(I hope it is clear enough):
sub construct_arr(my %records) {
my $len = keys %records;
my #matrix;
my $i = 0;
# Extract the values of the hash into a matrix
foreach my $key (keys %records) {
$matrix[$i] = $records{$key};
$i++;
}
my #arr1 = $matrix[0];
my #final;
# Iterate through each element of arr1
for my $j (0..$#{$arr1[0]}) {
my $count = 1;
# Iterate through each row of the matrix, starting from the second
for ( my $i = 1; $i < $len ; $i++ ) {
my $flag = 0;
# Iterate through each element of the row
for my $k (0..$#{$matrix[$i]}) {
if ($arr1[0][$j] eq $matrix[$i][$k]) {
$flag = 1;
$count++;
}
}
# On finding the first instance of the element in a row, go to the next row
if (!$flag == 1) {
last;
}
}
# If element is in all the rows, push it on to the final array
if ($count == $len) {
push(#final, $arr1[0][$j]);
}
}
return #final;
}
I know that the above works, but I would like to know if there is any other (perlish) way to do this.
I am starting to learn perl and I am very interested in knowing things that could make my work easier
in perl as compared to other languages. If my code is the best that can be done, please let me know that
too. Any guidance would be appreciated. Thanks!
Take a look at Chris Charley's link for calculating the intersection of arrays.
Hashes are the clear way to go for problems like this. Together with map and grep a solution can be reduced to just a few lines.
This program uses sundar's data for want of anything better, and seems to do what you need.
use strict;
use warnings;
my %records = (
a => [ qw/ A B C / ],
b => [ qw/ C D E A / ],
c => [ qw/ A C E / ],
);
print "$_\n" for construct_arr(\%records);
sub construct_arr {
my $records = shift;
my %seen;
$seen{$_}++ for map #$_, values %$records;
grep $seen{$_} == keys %$records, keys %seen;
}
output
A
C
Edit
I thought it may help to see a more Perlish, tidied version of your own solution.
use strict;
use warnings;
my %records = (
a => [ qw/ A B C / ],
b => [ qw/ C D E A / ],
c => [ qw/ A C E / ],
);
print "$_\n" for construct_arr(\%records);
sub construct_arr {
my $records = shift;
my #matrix = values %$records;
my #final;
# iterate through each element the first row
for my $i ( 0 .. $#{$matrix[0]} ) {
my $count = 1;
# look for this value in all the rest of the rows, dropping
# out to the next row as soon as a match is found
ROW:
for my $j ( 1 .. $#matrix ) {
for my $k (0 .. $#{$matrix[$j]}) {
next unless $matrix[0][$i] eq $matrix[$j][$k];
$count++;
next ROW;
}
}
# If element is in all the rows, push it on to the final array
push #final, $matrix[0][$i] if $count == #matrix;
}
return #final;
}
The output is the same as for my own program, but the functionality is slightly different as mine assumes the values in each row are unique. If the sama value appears more than once my solution will break (the same applies to sundar's). Please let me know if that is acceptable.
Although the poster explained there aren't duplicates within a single array, here is my attempt which handles that case too (notice the slightly modified test data - "5" should not be printed):
#!/usr/bin/env perl
use warnings;
use strict;
my %records = (
a => [1, 2, 3],
b => [3, 4, 5, 1],
c => [1, 3, 5, 5]
);
my %seen;
while (my ($key, $vals) = each %records) {
$seen{$_}{$key} = 1 for #$vals;
}
print "$_\n" for grep { keys %{$seen{$_}} == keys %records } keys %seen;
You can find the size of the hash easily using scalar(keys %hash);
Here's an example code that does what you need:
#!/usr/bin/perl
use strict;
use warnings;
my %records = ( a => [1, 2, 3],
b => [3, 4, 5, 1],
c => [1, 3, 5]
);
my %count;
foreach my $arr_ref (values %records) {
foreach my $elem (#$arr_ref) {
$count{$elem}++;
}
}
my #intersection;
my $num_arrays = scalar(keys %records);
foreach my $elem (keys %count) {
#If all the arrays contained this element,
#allowing for multiple entries per array
if ($count{$elem} >= $num_arrays) {
push #intersection, $elem;
}
}
Feel free to comment if you need any clarification in this code. And the second foreach that constructs the #intersection array is written this way only for clarity - if you're learning Perl, I'd suggest you study and rewrite it using the map construct, since that's arguably more idiomatic Perl.