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
Related
I'm writing a piece of code that creates a HoAs and loops through for each key. The snippet below shows a basic example of the problem I'm having.
#!/usr/bin/perl
use strict;
use warnings;
my #array1 = qw (1 1 3 4 5); # Note that '1' appears twice
my #array2 = qw (a b c d e);
my #array3 = qw (6 7 8 9 10);
my #array4 = qw (f g h i j);
my %hash;
push #{$hash{$array1[$_]}}, [ $array2[$_], $array3[$_], $array4[$_] ] for 0 .. $#array1;
for my $key (sort keys %hash) {
my ($array2, $array3, $array4) = #{$hash{$key}[-1]};
print "[$key] $array2\t$array3\t$array4\n";
}
Output:
[1] b 7 g
[3] c 8 h
[4] d 9 i
[5] e 10 j
For the data I'm actually using (as opposed to this example) I have been using a key that I've just realised isn't unique, so, as above I end up overriding non-uniqe keys. I'm mainly using these values as keys in order to sort by them later.
My question is either:
A) I can perform the above task for each key unless (exists $hash{$array1}) in which case I can modify it
or
B) Is there a way to sort by those values, in which case I could use another, non-redundant key.
Thanks!
so, as above I end up overriding non-uniqe keys
You aren't. Let's print out the whole contents of that hash:
for my $key (sort { $a <=> $b } keys %hash) { # sort numerically!
for my $array (#{ $hash{$key} }) { # loop over all instead of $hash{$key}[-1] only
say "[$key] " . join "\t", #$array;
}
}
Output:
[1] a 6 f
[1] b 7 g
[3] c 8 h
[4] d 9 i
[5] e 10 j
You would be overriding the values if you were building the hash like
$hash{$array1[$_]} = [ $array2[$_], $array3[$_], $array4[$_] ] for 0 .. $#array1;
(And printing it as)
for my $key ( ... ) {
say "[$key] " . join "\t", #{ $hash{$key} };
}
That is, assigning instead of pushing.
If you want to keep the first value assigned to each key, use the //= operator (assign if undef).
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]
I am new to Perl. I have an input file such as:
a 7 5
b 8 2
a 3 2
b 4 1
c 6 1
How can I get output like
column_1_val, number_occurrence_column_1, sum_of_column_2, sum_of_column_3
For example
a 2 10 7
b 2 12 3
c 1 6 1
The program below is a possible solution. I have used the DATA file handle whereas you will presumably need to open an external file and use the handle from that.
use strict;
use warnings;
use feature 'say';
my %data;
while (<DATA>) {
my ($key, #vals) = split;
$data{$key}[0]++;
my $i;
$data{$key}[++$i] += $_ for #vals;
}
say join ' ', $_, #{$data{$_}} for sort keys %data;
__DATA__
a 7 5
b 8 2
a 3 2
b 4 1
c 6 1
output
a 2 10 7
b 2 12 3
c 1 6 1
That would be something like (untested):
while (<>) {
if (m/(\w+)\s+(\d+)\s+(\d+)/) {
($n, $r1, $r2) = ($1, $2, $3);
$nr{$n}++;
$r1{$n} += $r1;
$r2{$n} += $r2;
}
}
for $n (sort keys %nr) {
print "$n $nr{$n} $r1{$n} $r2{$n}\n";
}
This is a very quick-and-dirty way of doing what you described, but it should get you on your way.
Even i am not aware of perl.But in case you are concerned with the result.the below is the solution in awk.It might /might not help you.but in case u need it :
awk '{c[$1]++;a[$1]=a[$1]+$2;b[$1]+=$3}END{for(i in a)print i,c[i],a[i],b[i]}' file3
A slightly different take:
my %records;
while ( <> ) {
my #cols = split ' ';
my $rec = $records{ $cols[0] } ||= {};
$rec->{number_occurrence_column_1}++;
$rec->{sum_of_column_2} += $cols[1];
$rec->{sum_of_column_3} += $cols[2];
}
foreach my $rec ( map { { col1 => $_, %{ $records{ $_ } } }
sort keys %records
) {
print join( "\t"
, #$rec{ qw<col1 number_occurrence_column_1
sum_of_column_2 sum_of_column_3
>
}
), "\n"
;
}
I like to turn an array into a hash. However, the values are of unequal length for each key.
Lets say I have
my #array = qw( A 0 B 1 2 3 4 c 5 d 6 7);
Now I like to use the letters as keys and for each such letter/key the following number(s) as their values. So #array should be transformed into %hash as follows
my %hash = ( A => [0],
B => [1, 2, 3, 4],
c => [5],
d => [6, 7]
);
The difficulty for me is the unequal length of each keys' value.
Here is a way to do it:
#!/usr/local/bin/perl
use Data::Dump qw(dump);
use strict;
use warnings;
my #array = qw( A 0 B 1 2 3 4 c 5 d 6 7);
my %hash;
my $key;
foreach (#array) {
if (/^\D+$/) {
$key = $_;
$hash{$key} = [];
} else {
push #{$hash{$key}}, $_;
}
}
dump %hash;
Output:
("A", [0], "c", [5], "d", [6, 7], "B", [1 .. 4])
Firs the answer for this specific example then some comments
my $hash = {};
my #array = qw( A 0 B 1 2 3 4 c 5 d 6 7);
my $key;
foreach (#array) {
if (/\D/) {
$key = $_;
next;
} else {
push #{$hash->{$key}}, $_;
}
}
And if you want to play in the debugger:
$ perl -de 0
DB<18> #array = qw( A 0 B 1 2 3 4 c 5 d 6 7);
DB<19> $hash={}
DB<20> foreach(#array){if(/\D/){$key=$_;next}else{push #{$hash->{$key}},$_}}
DB<21> x $hash
0 HASH(0x347e568)
'A' => ARRAY(0x348fee8)
0 0
'B' => ARRAY(0x346f188)
0 1
1 2
2 3
3 4
'c' => ARRAY(0x34cefb0)
0 5
'd' => ARRAY(0x346f1e8)
0 6
1 7
Comments: unless your keys are giving information about if the value is scalar or array ref, is better to have all the values of the same type (in this case arrayref)
You would like to check if the last key has a value and decide if you want to initialize to undef or not.
Or using map:
my #a = qw{a 1 2 3 b 4 5 6 C 7 8 9};
my ($key, %h);
map { /^[a-z]$/i and $key = $_ or push(#{$h{$key}}, $_) } #a;
Isn't Perl fun?
Slightly simpler than previously provided solutions:
my #array = qw( A 0 B 1 2 3 4 c 5 d 6 7);
my %hash;
my $values;
for (#array) {
if (/\D/) {
$values = $hash{$_} = [];
} else {
push #$values, $_;
}
}
I have an array in Perl I want to print with space delimiters between each element, except every 10th element which should be newline delimited. There aren't any spaces in the elements if that matters.
I've written a function to do it with for and a counter, but I wondered if there's a better/shorter/canonical Perl way, perhaps a special join syntax or similar.
My function to illustrate:
sub PrintArrayWithNewlines
{
my $counter = 0;
my $newlineIndex = shift #_;
foreach my $item (#_)
{
++$counter;
print "$item";
if($counter == $newlineIndex)
{
$counter = 0;
print "\n";
}
else
{
print " ";
}
}
}
I like splice for a job like this:
sub PrintArrayWithNewlines {
my $n = 10;
my $delim = " ";
while (my #x = splice #_, 0, $n) {
print join($delim, #x), "\n";
}
}
You can use List::MoreUtils::natatime:
use warnings; use strict;
use List::MoreUtils qw( natatime );
my #x = (1 .. 35);
my $it = natatime 10, #x;
while ( my #v = $it->() ) {
print "#v\n"
}
Output:
C:\Temp> x
1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20
21 22 23 24 25 26 27 28 29 30
31 32 33 34 35
If you do not want to use any external modules, you can use array slices:
use warnings; use strict;
my #x = (1 .. 95);
my $n = 10;
for my $i ( 0 .. int #x/$n ) {
no warnings 'uninitialized';
print "#x[$n * $i .. $n * ($i + 1) - 1]\n";
}
The functions by and every in my module List::Gen can solve this problem:
use List::Gen;
for (every 10 => 'a' .. 'z') {
print "#$_\n"
}
# a b c d e f g h i j
# k l m n o p q r s t
# u v w x y z
it can also be written
foreach (by 10 => 'a' .. 'z') {
print "#$_\n"
}
or using the functional form:
mapn {print "#_\n"} 10 => 'a' .. 'z'; # #_ not #$_ here
or an iterator if that's your style:
my $letters = by 10 => 'a' .. 'z';
while (my $line = $letters->next) {
print "#$line\n";
}
You can also use map with a modification to PrintArrayWithNewlines:
#!/usr/bin/perl -w
use strict;
sub PrintArrayWithNewlines
{
my #array = #_;
my $newlineIndex = 10;
foreach my $item (#array) {
++$globalCounter;
print "$item";
if ($globalCounter == $newlineIndex) {
$globalCounter = 0;
print "\n";
}
else {
print " ";
}
}
}
my $globalCounter = 0;
my #myArray = 'a' .. 'z'
map { PrintArrayWithNewlines($_) } #myArray;
print "\n";
The output would be:
$ ./test.pl
a b c d e f g h i j
k l m n o p q r s t
u v x y z