Printing values of an array from an array of array references - perl

How can I print the values of an array. I have tried several ways but I am unable to get the required values out of the arrays:
#array;
Dumper output is as below :
$VAR1 = [
'a',
'b',
'c'
];
$VAR1 = [
'd',
'e',
'f'
];
$VAR1 = [
'g',
'h',
'i'
];
$VAR1 = [
'j',
'k',
'l'
];
for my $value (#array) {
my $ip = $value->[0];
DEBUG("DEBUG '$ip\n'");
}
I am getting output as below, which means foreach instance I am only getting the first value.
a
d
g
j
I have tried several approaches :
First option :
my $size = #array;
for ($n=0; $n < $size; $n++) {
my $value=$array[$n];
DEBUG( "DEBUG: Element is as $value" );
}
Second Option :
for my $value (#array) {
my $ip = $value->[$_];
DEBUG("DEBUG Element is '$ip\n'");
}
What is the best way to do this?

It is obvious that you have list of arrays. You only loop over top list and print first (0th) value in your first example. Barring any automatic dumpers, you need to loop over both levels.
for my $value (#array) {
for my $ip (#$value) {
DEBUG("DEBUG '$ip\n'");
}
}

You want to dereference here so you need to do something like:
my #array_of_arrays = ([qw/a b c/], [qw/d e f/ ], [qw/i j k/])
for my $anon_array (#array_of_arrays) { say for #{$anon_array} }
Or using your variable names:
use strict;
use warnings;
my #array = ([qw/a b c/], [qw/d e f/], [qw/i j k/]);
for my $ip (#array) {
print join "", #{$ip} , "\n"; # or "say"
}
Since there are anonymous arrays involved I have focused on dereferencing (using PPB style!) instead of nested loops, but print for is a loop in disguise really.
Cheers.

Related

Perl to sort words by user-defined alphabet sequence

I have an array of "words" (strings), which consist of letters from an "alphabet" with user-defined sequence. E.g my "alphabet" starts with "ʔ ʕ b g d", so a list of "words" (bʔd ʔbg ʕʔb bʕd) after sort by_my_alphabet should be ʔbd ʕʔb bʔd bʕd.
sort by_my_alphabet (bʔd ʔbg ʕʔb bʕd) # gives ʔbd ʕʔb bʔd bʕd
Is there a way to make a simple subroutine by_my_alphabet with $a and $b to solve this problem?
Simple, and very fast because it doesn't use a compare callback, but it needs to scan the entire string:
use utf8;
my #my_chr = split //, "ʔʕbgd";
my %my_ord = map { $my_chr[$_] => $_ } 0..$#my_chr;
my #sorted =
map { join '', #my_chr[ unpack 'W*', $_ ] } # "\x00\x01\x02\x03\x04" ⇒ "ʔʕbgd"
sort
map { pack 'W*', #my_ord{ split //, $_ } } # "ʔʕbgd" ⇒ "\x00\x01\x02\x03\x04"
#unsorted;
Optimized for long strings since it only scans a string up until a difference is found:
use utf8;
use List::Util qw( min );
my #my_chr = split //, "ʔʕbgd";
my %my_ord = map { $my_chr[$_] => $_ } 0..$#my_chr;
sub my_cmp($$) {
for ( 0 .. ( min map length($_), #_ ) - 1 ) {
my $cmp = $my_ord{substr($_[0], $_, 1)} <=> $my_ord{substr($_[1], $_, 1)};
return $cmp if $cmp;
}
return length($_[0]) <=> length($_[1]);
}
my #sorted = sort my_cmp #unsorted;
Both should be faster than Sobrique's. Theirs uses a compare callback, and it scans the entire strings being compared.
Yes.
sort can take any function that returns a relative sort position. All you need is a function that correctly looks up the 'sort value' of a string for comparing.
So all you need to do here is define a 'relative weight' of your extra letters, and then compare the two.
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
my #sort_order = qw ( B C A D );
my #array_to_sort = qw ( A B C D A B C D AB BB CCC ABC );
my $count = 0;
my %position_of;
$position_of{$_} = $count++ for #sort_order;
print Dumper \%position_of;
sub sort_by_pos {
my #a = split //, $a;
my #b = split //, $b;
#iterate one letter at a time, using 'shift' to take it off the front
#of the array.
while ( #a and #b ) {
my $result = $position_of{shift #a} <=> $position_of{shift #b};
#result is 'true' if it's "-1" or "1" which indicates relative position.
# 0 is false, and that'll cause the next loop iteration to test the next
#letter-pair
return $result if $result;
}
#return a value based on remaining length - longest 'string' will sort last;
#That's so "AAA" comparing with "AA" comparison actually work,
return scalar #a <=> scalar #b;
}
my #new = sort { sort_by_pos } #array_to_sort;
print Dumper \#new;
Bit of a simple case, but it sorts our array into:
$VAR1 = [
'B',
'B',
'BB',
'C',
'C',
'CCC',
'A',
'A',
'AB',
'ABC',
'D',
'D'
];

How to Sort 2D array Perl?

May be I am missing something. First It seemed too easy to me.I thought I can easily achieve it using map{}sort{}map{} ,but now it became complicated to me.
So, finally the problem is I have an array:
#array=(['b','e','d'],['s','a','f'],['g','i','h']);
and I want sorted array like
#sorted_array=(['a','f','s'],['b','d','e'],['g','h','i']);
I wrote
##sort based on columns########
my #sorted_array= map{my #sorted=sort{$a cmp $b}#$_;[#sorted]}#array;
###sort on rows####
my #sorted_array= map{$_->[0]}sort{$a->[1] cmp $b->[1]} map{[$_,"#$_"]}#array;
But I was not sure how to wrap it into one(for both rows and column). Can I achieve this using Schwartzian transform.
Yes, you can use it,
use strict;
use warnings;
my #array =( [qw(b e d)], [qw(s a f)], [qw(g i h)] );
my #sorted_array =
map { $_->[0] }
sort {
$a->[1] cmp $b->[1]
}
map {
my $r = [ sort #$_ ];
[$r, "#$r"];
}
#array;
use Data::Dumper;
print Dumper \#sorted_array;
output
$VAR1 = [
[
'a',
'f',
's'
],
[
'b',
'd',
'e'
],
[
'g',
'h',
'i'
]
];
This is two separate sorts. First you want to sort the inner arrays individually, then you can sort the outer array by, perhaps, the first element of each of the inner ones.
use List::UtilsBy qw( sort_by );
my #array =( [qw(b e d)], [qw(s a f)], [qw(g i h)] );
# sort the inner ones individually
#$_ = sort #$_ for #array;
# sort the whole by the first element of each
my #sorted_array = sort_by { $_->[0] } #array;
Or if you'd prefer doing it all in one go and avoiding the temporary mutation:
my #sorted_array = sort_by { $_->[0] }
map { [ sort #$_ ] } #array;

remove an array from AOA perl

I have an array of array that looks like this -
$VAR1 = [
'sid_R.ba',
'PS20TGB2YM13',
'SID_r.BA',
'ARS',
'XBUE'
]; $VAR2 = [
'sddff.pk',
'PQ10XD06K800',
'SDDFF.PK',
'USD',
'PINX'
]; $VAR3 = [
'NULL',
'NULL',
'NULL',
'.',
'XNAS'
]; $VAR4 = [
'NULL',
'NULL',
'NULL',
'.',
'XNAS'
]; $VAR5 = [
'NULL',
'NULL',
'NULL',
'EUR',
'OTCX'
]; $VAR6 = [
'sid.ba',
'PS20TGB1TN17',
'SID.BA',
'ARS',
'XBUE'
];
I want to remove the complete block (array ref) if any of its element is NULL
I have a code in which the array gets generated, so I tried a for loop to delete but then the index of the array is reduced on the inside the for loop.
So I dont know in which order the array will be or the length of array.
Please I need a generic solution.
Please help.
Thanks
You seem to have an array like
my #AoA = (
[1, 2, 3],
[4, 5, 6],
[7, 8, "NULL"],
[9, 10],
);
You want to select all child arrays that do not contain "NULL". Easy: Just use nested grep:
my #AoA_sans_NULL = grep {
not grep { $_ eq "NULL" } #$_
} #AoA;
The grep { CONDITION } #array selects all elements from #array where the CONDITION evaluates to true.
The grep { $_ eq "NULL" } #$_ counts the number of "NULL"s in the inner array. If this is zero, our condition is true, else, we don't want to keep that sub-array.
use List::MoreUtils qw(none);
my #filtered = grep {
none { $_ eq "NULL" } #$_;
} #array;
Does this do what you want?
my #new_array = grep { scalar(grep { $_ eq 'NULL' } #{$_}) == 0 } #old_array;
Old school:
my #filtered = ();
ARRAY_LOOP:
for my $array ( #AoA ){
ITEM_LOOP:
for my $item ( #$array ){
next ARRAY_LOOP if $item eq 'NULL';
} # end ITEM_LOOP
push #filtered, $array;
} # end ARRAY_LOOP
This code will be slower than the others, but an in-place solution might be useful if the data-set is very large.
use List::MoreUtils qw(any);
for(my $i = 0; $i < #AoA; $i ++) {
splice #AoA, $i --, 1
if any { $_ eq "NULL" } #{ $AoA[$i] };
}
A non-grep of a grep solution:
my #array = ...; #Array of Arrays
for my $array_index ( reverse 0 .. $#array ) {
my #inner_array = #{ $array[$array_index] };
if ( grep /^NULL$/, #inner_array ) {
splice #array, $array_index, 1;
}
}
say Dumper #array;
The splice command removes the entire subarray. I don't need to create #inner_array I could have used my dereferenced #{ $array[$array_index] } in the if statement, but I like going for clarity.
The only gotcha is that you have to go through your array of array backwards. If you go through your array from first element to last element, you'll remove element 2 which causes all the other elements to have their indexes decremented. If I first remove element 4, element 0 to 3 don't change their index.
It's not as elegant as the grep of a grep solutions, but it's a lot easier to maintain. Imagine someone who has to go through your program six months from now trying to figure out what:
grep { not grep { $_ eq "NULL" } #$_ } #array;
is doing.

Perl, convert numerically-keyed hash to array

If I have a hash in Perl that contains complete and sequential integer mappings (ie, all keys from from 0 to n are mapped to something, no keys outside of this), is there a means of converting this to an Array?
I know I could iterate over the key/value pairs and place them into a new array, but something tells me there should be a built-in means of doing this.
You can extract all the values from a hash with the values function:
my #vals = values %hash;
If you want them in a particular order, then you can put the keys in the desired order and then take a hash slice from that:
my #sorted_vals = #hash{sort { $a <=> $b } keys %hash};
If your original data source is a hash:
# first find the max key value, if you don't already know it:
use List::Util 'max';
my $maxkey = max keys %hash;
# get all the values, in order
my #array = #hash{0 .. $maxkey};
Or if your original data source is a hashref:
my $maxkey = max keys %$hashref;
my #array = #{$hashref}{0 .. $maxkey};
This is easy to test using this example:
my %hash;
#hash{0 .. 9} = ('a' .. 'j');
# insert code from above, and then print the result...
use Data::Dumper;
print Dumper(\%hash);
print Dumper(\#array);
$VAR1 = {
'6' => 'g',
'3' => 'd',
'7' => 'h',
'9' => 'j',
'2' => 'c',
'8' => 'i',
'1' => 'b',
'4' => 'e',
'0' => 'a',
'5' => 'f'
};
$VAR1 = [
'a',
'b',
'c',
'd',
'e',
'f',
'g',
'h',
'i',
'j'
];
OK, this is not very "built in" but works. It's also IMHO preferrable to any solution involving "sort" as it's faster.
map { $array[$_] = $hash{$_} } keys %hash; # Or use foreach instead of map
Otherwise, less efficient:
my #array = map { $hash{$_} } sort { $a<=>$b } keys %hash;
Perl does not provide a built-in to solve your problem.
If you know that the keys cover a particular range 0..N, you can leverage that fact:
my $n = keys(%hash) - 1;
my #keys_and_values = map { $_ => $hash{$_} } 0 .. $n;
my #just_values = #hash{0 .. $n};
This will leave keys not defined in %hashed_keys as undef:
# if we're being nitpicky about when and how much memory
# is allocated for the array (for run-time optimization):
my #keys_arr = (undef) x scalar %hashed_keys;
#keys_arr[(keys %hashed_keys)] =
#hashed_keys{(keys %hashed_keys)};
And, if you're using references:
#{$keys_arr}[(keys %{$hashed_keys})] =
#{$hashed_keys}{(keys %{$hashed_keys})};
Or, more dangerously, as it assumes what you said is true (it may not always be true … Just sayin'!):
#keys_arr = #hashed_keys{(sort {$a <=> $b} keys %hashed_keys)};
But this is sort of beside the point. If they were integer-indexed to begin with, why are they in a hash now?
As DVK said, there is no built in way, but this will do the trick:
my #array = map {$hash{$_}} sort {$a <=> $b} keys %hash;
or this:
my #array;
keys %hash;
while (my ($k, $v) = each %hash) {
$array[$k] = $v
}
benchmark to see which is faster, my guess would be the second.
#a = #h{sort { $a <=> $b } keys %h};
Combining FM's and Ether's answers allows one to avoid defining an otherwise unnecessary scalar:
my #array = #hash{ 0 .. $#{[ keys %hash ]} };
The neat thing is that unlike with the scalar approach, $# works above even in the unlikely event that the default index of the first element, $[, is non-zero.
Of course, that would mean writing something silly and obfuscated like so:
my #array = #hash{ $[ .. $#{[ keys %hash ]} }; # Not recommended
But then there is always the remote chance that someone needs it somewhere (wince)...
$Hash_value =
{
'54' => 'abc',
'55' => 'def',
'56' => 'test',
};
while (my ($key,$value) = each %{$Hash_value})
{
print "\n $key > $value";
}
We can write a while as below:
$j =0;
while(($a1,$b1)=each(%hash1)){
$arr[$j][0] = $a1;
($arr[$j][1],$arr[$j][2],$arr[$j][3],$arr[$j][4],$arr[$j][5],$arr[$j][6]) = values($b1);
$j++;
}
$a1 contains the key and
$b1 contains the values
In the above example i have Hash of array and the array contains 6 elements.
An easy way is to do #array = %hash
For example,
my %hash = (
"0" => "zero",
"1" => "one",
"2" => "two",
"3" => "three",
"4" => "four",
"5" => "five",
"6" => "six",
"7" => "seven",
"8" => "eight",
"9" => "nine",
"10" => "ten",
);
my #array = %hash;
print "#array"; would produce the following output,
3 three 9 nine 5 five 8 eight 2 two 4 four 1 one 10 ten 7 seven 0 zero
6 six

Perl: How to get all grouped patterns

I have the following code.
Here I am matching the vowels characters words:
if ( /(a)+/ and /(e)+/ and /(i)+/ and /(o)+/ and /(u)+/ )
{
print "$1#$2#$3#$4#$5\n";
$number++;
}
I am trying to get the all matched patterns using grouping, but I am getting only the last expression pattern, which means the fifth expression of the if condition. Here I know that it is giving only one pattern because last pattern matching in if condition. I want to get all matched patterns, however. Can anyone help me out of this problem?
It is not quite clear what you want to do. Here are some thoughts.
Are you trying to count the number of vowels? In which case, tr will do the job:
my $count = tr/aeiou// ;
printf("string:%-20s count:%d\n" , $_ , $count ) ;
output :
string:book count:2
string:stackoverflow count:4
Or extract the vowels
my #array = / ( [aeiou] ) /xg ;
print Dumper \#array ;
Output from "stackoverflow question"
$VAR1 = [
'a',
'o',
'e',
'o',
'u',
'e',
'i',
'o'
];
Or extract sequences of vowels
my #array = / ( [aeiou]+ ) /xg ;
print Dumper \#array ;
Output from "stackoverflow question"
$VAR1 = [
'a',
'o',
'e',
'o',
'ue',
'io'
];
You could use
sub match_all {
my($s,#patterns) = #_;
my #matches = grep #$_ >= 1,
map [$s =~ /$_/g] => #patterns;
wantarray ? #matches : \#matches;
}
to create an array of non-empty matches.
For example:
my $string = "aaa e iiii oo uuuuu aa";
my #matches = match_all $string, map qr/$_+/ => qw/ a e i o u /;
if (#matches == 5) {
print "[", join("][", #$_), "]\n"
for #matches;
}
else {
my $es = #matches == 1 ? "" : "es";
print scalar(#matches), " match$es\n";
}
Output:
[aaa][aa]
[e]
[iiii]
[oo]
[uuuuu]
An input of, say, "aaa iiii oo uuuuu aa" produces
4 matches
You have 5 patterns with one matching group () each. Not 1 pattern with 5 groups.
(a)+ looks for a string containing a, aa, aaa, aaaa etc. The match will be multiple a's, not the word containing the group of a-s.
Your if( ...) is true if $_ contains one or more of 'a','e','i','o','u'.