This question already has answers here:
Difference of Two Arrays Using Perl
(10 answers)
Closed 8 years ago.
I have two arrays ,so i want to get the similar values from both the arrays in a array.
This is array :
my #a = qw( a e c d );
my #b = qw( c d e f );
Please help me how could i get the similar values in Perl.I am new in Perl
try this easy code:
my #a = qw( a e c d );
my #b = qw( c d e f );
foreach $my(#a){
print "$my\n";
if ((grep(/$my/,#b))){
push #new,$my;
}
}
print "new----#new";
Try something like below:
use strict;
use Data::Dumper;
my #a1 = qw( a e c d );
my #b1 = qw( c d e f );
my %seen;
my #final;
#seen{#a1} = (); # hash slice
foreach my $new ( #b1 ) {
push (#final, $new ) if exists $seen{$new};
}
print Dumper(\#final);
Output:
$VAR1 = [
'c',
'd',
'e'
];
A common pattern is to map a hash for seen elements and search the other array using grep.
my #a = qw( a e c d );
my #b = qw( c d e f );
my %seen = map { $_ => 1 } #a;
my #intersection = grep { $seen{$_} } #b;
print #intersection;
Assuming the end result contains elements which are present in both the arrays:
#!/usr/bin/perl -w
use strict;
my #a = qw( a e c d );
my #b = qw( c d e f );
my #c;
foreach my $x (#a)
{
foreach my $y (#b)
{
push #c, $x if ($x eq $y);
}
}
foreach (#c) {print $_."\n"};
Output:
e
c
d
You can also try http://vti.github.io/underscore-perl a clone of underscore-js. You can do an intersection of 2 arrays -> http://vti.github.io/underscore-perl/#intersection
use Underscore;
_->intersection([1, 2, 3], [101, 2, 1, 10], [2, 1]);
# [1, 2]
Related
I use Data::Dumper to catch uniqe number in each element.
#!perl
use warnings;
use strict;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
my #names = qw(A A A A B B B C D);
my %counts;
$counts{$_}++ for #names;
print Dumper (\%counts);
exit;
This is output.
$VAR1 = {
'A' => 4,
'B' => 3,
'C' => 1,
'D' => 1
};
How can I remove the title name of each unique number to get output like this format?
$VAR1 = { 4 ,3 ,1 ,1 }
Presuming you want the counts in descending order, you could use the following:
printf "\$VAR1 = { %s};\n",
join ',',
map "$_ ",
sort { $b <=> $a }
values(%counts);
If instead you want the counts sorted by key,
printf "\$VAR1 = { %s};\n",
join ',',
map "$counts{$_} ",
sort
keys(%counts);
Either way, that's a really weird format. Square brackets would make more sense than curly ones.
One of many ways to get desired result
use strict;
use warnings;
use feature 'say';
my #names = qw( A A A A B B B C D );
my %counts;
$counts{$_}++ for #names;
my #values = map { $counts{$_} } sort keys %counts;
say join(',', #values);
output
4,3,1,1
I made a subroutine that I want to pass a string and an array into:
sub pass_in {
my ($str, $array) = #_;
for my $e (#$array) {
print "I see str $str and list elem: $e\n";
}
return 0;
}
my #temp_arr = qw(A B C D E);
my $str = "hello";
pass_in( $str, \#temp_arr );
This works fine, but I don't want to have to create a temp_arr. Is it possible to do?
Doesn't work:
pass_in( $str, qw(A B C D E));
Also doesn't work:
pass_in( $str, \qw(A B C D E));
I don't want to create a temporary variable.
You can use square brackets to create a reference to an array:
pass_in( $str, [qw(A B C D E)]);
perldoc perlref
In order to pass an in array, you have must an array to pass!
qw() does not create an array. It just puts a bunch of scalars on the stack. That for which you are looking is [ ]. It conveniently creates an array, initializes the array using the expression within, and returns a reference to the array.
pass_in( $str, [qw( A B C D E )] );
Alternatively, you could rewrite your subroutine to accept a list of values.
sub pass_in {
my $str = shift;
for my $e (#_) {
print "I see str $str and list elem: $e\n";
}
return 0;
}
pass_in( "hello", qw( A B C D E ) );
How can I print a hash in Perl, such that 3 key value pairs are printed on each line?
print %hash;
This will print key value pairs each in a line.
To display the hash, so "that 3[n] key value pairs are printed on each line", you can use a counter ($n) and % (modulo op) to determine when to print a "\n". Demo:
use Modern::Perl;
my %h = ();
for (0..7) {
$h{$_} = chr(65 + $_);
}
print %h, "\n";
my $cols = +$ARGV[0] || 5;
my $n = -$cols;
for my $key (keys %h) {
print $key, ' => ', $h{$key}, 0 == ++$n % $cols ? "\n" : "\t\t";
}
print $n % $cols ? "\n------" : "------";
output:
perl -w 31444449.pl 1
6G4E1B3D0A7H2C5F
6 => G
4 => E
1 => B
3 => D
0 => A
7 => H
2 => C
5 => F
------
perl -w 31444449.pl
6G4E1B3D0A7H2C5F
6 => G 4 => E 1 => B 3 => D 0 => A
7 => H 2 => C 5 => F
------
perl -w 31444449.pl 3
6G4E1B3D0A7H2C5F
6 => G 4 => E 1 => B
3 => D 0 => A 7 => H
2 => C 5 => F
------
Borodin's solutions, however, is simpler.
See mpapec answer for a much improved version.
A very simple way to do this is to copy all the keys and values to an array, and then print six (three pairs) of those at a time
use strict;
use warnings;
my %h = map { $_ => 1 } 'A' .. 'H';
my #kv = %h;
while ( my #row = splice #kv, 0, 6 ) {
print "#row\n";
}
output
B 1 C 1 A 1
D 1 E 1 G 1
F 1 H 1
You can use natatime from List::MoreUtils:
use List::MoreUtils qw/natatime/;
my $it = natatime 6, %ENV;
while (my #vals = $it->()) {
print "#vals\n";
}
List::MoreUtils isn't in core modules, you need to install it.
Thanks All. I tried this and it worked.
my #keylist=sort keys %hash;
my $counter=0;
foreach(#keylist){
#printing the key value pairs
printf "%-15s :%3d ",$_,$hash{$_};
$counter++;
if($counter==3){
$counter=0;
print "\n";
}
}
print "\n";
If you really just want to print hash and check the values for debugging or for analysing then use
use Data::Dumper;
print Dumper(\%hash);
This print hash keys and values at any n number of levels
How to count the each element of same index number?
my #a = qw"A B C D E F";
my #b = qw"A B C C";
my $count = 0;
for($i = 0; $i<=scalar #a; $i++){
for($j = 0; $j <= scalar #b; $j++){
if($a[$i] eq $b[$j]){
$count++;
}
}
}
print "Total: $count";
I expect the output is:
Total:3
The output is done by count only the same element of the index key? How can i do it?
There are two potential interpretations to your problem:
1. How does one count the intersection of two arrays?
A hash is an ideal data structure to test for existance:
use strict;
use warnings;
my #a = qw"A B C D E F";
my #b = qw"A B C C";
my %b = map {$_ => 1} #b;
my $count = scalar grep {$b{$_}} #a;
print "Total: $count";
Outputs:
Total: 3
Additional perldoc reference: How do I compute the difference of two arrays? How do I compute the intersection of two arrays?
2. How does one test element equality between two arrays, index to index?
If this is your question, then you do not need two loops, just a single iterator.
use strict;
use warnings;
use List::Util qw(min);
my #a = qw"A B C D E F";
my #b = qw"A B C C";
my $count = scalar grep {$a[$_] eq $b[$_]} (0..min($#a, $#b));
print "Total: $count";
Outputs:
Total: 3
I recently "needed" a zip function in Perl 5 (while I was thinking about How do I calculate relative time?), i.e. a function that takes two lists and "zips" them together to one list, interleaving the elements.
(Pseudo)example:
#a=(1, 2, 3);
#b=('apple', 'orange', 'grape');
zip #a, #b; # (1, 'apple', 2, 'orange', 3, 'grape');
Haskell has zip in the Prelude and Perl 6 has a zip operator built in, but how do you do it in an elegant way in Perl 5?
Assuming you have exactly two lists and they are exactly the same length, here is a solution originally by merlyn (Randal Schwartz), who called it perversely perlish:
sub zip2 {
my $p = #_ / 2;
return #_[ map { $_, $_ + $p } 0 .. $p - 1 ];
}
What happens here is that for a 10-element list, first, we find the pivot point in the middle, in this case 5, and save it in $p. Then we make a list of indices up to that point, in this case 0 1 2 3 4. Next we use map to pair each index with another index that’s at the same distance from the pivot point as the first index is from the start, giving us (in this case) 0 5 1 6 2 7 3 8 4 9. Then we take a slice from #_ using that as the list of indices. This means that if 'a', 'b', 'c', 1, 2, 3 is passed to zip2, it will return that list rearranged into 'a', 1, 'b', 2, 'c', 3.
This can be written in a single expression along ysth’s lines like so:
sub zip2 { #_[map { $_, $_ + #_/2 } 0..(#_/2 - 1)] }
Whether you’d want to use either variation depends on whether you can see yourself remembering how they work, but for me, it was a mind expander.
The List::MoreUtils module has a zip/mesh function that should do the trick:
use List::MoreUtils qw(zip);
my #numbers = (1, 2, 3);
my #fruit = ('apple', 'orange', 'grape');
my #zipped = zip #numbers, #fruit;
Here is the source of the mesh function:
sub mesh (\#\#;\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#) {
my $max = -1;
$max < $#$_ && ($max = $#$_) for #_;
map { my $ix = $_; map $_->[$ix], #_; } 0..$max;
}
I find the following solution straightforward and easy to read:
#a = (1, 2, 3);
#b = ('apple', 'orange', 'grape');
#zipped = map {($a[$_], $b[$_])} (0 .. $#a);
I believe it's also faster than solutions that create the array in a wrong order first and then use slice to reorder, or solutions that modify #a and #b.
For arrays of the same length:
my #zipped = ( #a, #b )[ map { $_, $_ + #a } ( 0 .. $#a ) ];
my #l1 = qw/1 2 3/;
my #l2 = qw/7 8 9/;
my #out;
push #out, shift #l1, shift #l2 while ( #l1 || #l2 );
If the lists are a different length, this will put 'undef' in the extra slots but you can easily remedy this if you don't wish to do this. Something like ( #l1[0] && shift #l1 ) would do it.
Hope this helps!
Algorithm::Loops is really nice if you do much of this kind of thing.
My own code:
sub zip { #_[map $_&1 ? $_>>1 : ($_>>1)+($#_>>1), 1..#_] }
This is totally not an elegant solution, nor is it the best solution by any stretch of the imagination. But it's fun!
package zip;
sub TIEARRAY {
my ($class, #self) = #_;
bless \#self, $class;
}
sub FETCH {
my ($self, $index) = #_;
$self->[$index % #$self][$index / #$self];
}
sub STORE {
my ($self, $index, $value) = #_;
$self->[$index % #$self][$index / #$self] = $value;
}
sub FETCHSIZE {
my ($self) = #_;
my $size = 0;
#$_ > $size and $size = #$_ for #$self;
$size * #$self;
}
sub CLEAR {
my ($self) = #_;
#$_ = () for #$self;
}
package main;
my #a = qw(a b c d e f g);
my #b = 1 .. 7;
tie my #c, zip => \#a, \#b;
print "#c\n"; # ==> a 1 b 2 c 3 d 4 e 5 f 6 g 7
How to handle STORESIZE/PUSH/POP/SHIFT/UNSHIFT/SPLICE is an exercise left to the reader.