Correct way to compare array elements - arrays

I'm writing a piece of code that extracts some numbers from an input file, which holds information for two conditions. The code therefore extracts two numbers for each line, and compares them against each other. The snippet below works fine, but I'm having trouble understanding which of the below approaches is 'correct', and why:
Input:
gi|63100484|gb|BC094950.1|_Xenopus_tropicalis_cDNA_clone_IMAGE:7022272 C1:XLOC_017431_0.110169:4.99086,_Change:5.5015,_p:0.00265,_q:0.847141 [95.08] C2:XLOC_020690_0.050681:9.12527,_Change:7.49228,_p:0.0196,_q:0.967194 [95.08]
gi|6572468|emb|AJ251750.1|_Xenopus_laevis_mRNA_for_frizzled_4_protein_(fz4_gene) C1:XLOC_027664_1.61212:4.37413,_Change:1.44003,_p:0.00515,_q:0.999592 [99.40] C2:XLOC_032999_2.94775:14.2322,_Change:2.27147,_p:5e-05,_q:0.0438548 [99.40]
gi|68533737|gb|BC098974.1|_Xenopus_laevis_RDC1_like_protein,_mRNA_(cDNA_clone_MGC:114801_IMAGE:4632706),_complete_cds C1:XLOC_036220_0.565861:6.52476,_Change:3.52741,_p:0.00015,_q:0.21728 [99.95] C2:XLOC_043165_0.157752:2.52129,_Change:3.99843,_p:0.02115,_q:0.99976 [99.95]
gi|70672087|gb|DQ096846.1|_Xenopus_laevis_degr03_mRNA,_complete_sequence C1:XLOC_031048_0.998437:4.20942,_Change:2.07588,_p:0.01365,_q:0.999592 [99.87] C2:XLOC_037051_1.1335:4.36819,_Change:1.94624,_p:0.01905,_q:0.9452 [99.87]
gi|70672102|gb|DQ096861.1|_Xenopus_laevis_rexp44_mRNA,_complete_sequence C1:XLOC_049520_12.3353:6.30193,_Change:-0.968926,_p:0.04935,_q:0.999592 [92.90] C2:XLOC_058958_13.0419:5.10275,_Change:-1.35381,_p:0.0373,_q:0.99976 [92.90]
gi|7110523|gb|AF231711.1|_Xenopus_laevis_7-transmembrane_receptor_frizzled-1_mRNA,_complete_cds C1:XLOC_038309_0.784476:2.37536,_Change:1.59835,_p:0.0079,_q:0.999592 [99.94] C2:XLOC_045678_0.692883:3.52599,_Change:2.34735,_p:0.00125,_q:0.341583 [99.94]
#!/usr/bin/perl
use strict;
use warnings;
use File::Slurp;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
my #intersect = read_file('text.txt');
my (#q1, #q2, #change_q, #q_values, #q_value1, #q_value2);
foreach (#intersect) {
chomp;
#q_value1 = ($_ =~ /C1:.*?q:(\d+\.\d+)/);
#q_value2 = ($_ =~ /C2:.*?q:(\d+\.\d+)/);
push #q_values, "C1:#q_value1\tC2:#q_value2";
if (abs $q_value1[#_] < abs $q_value2[#_]) {
push #change_q, $q_value1[#_];
}
elsif (abs $q_value2[#_] < abs $q_value1[#_]) {
push #change_q, $q_value2[#_];
}
}
print Dumper (\#q_values);
print Dumper (\#change_q);
Output:
$VAR1 = [
'C1:0.847141 C2:0.967194',
'C1:0.999592 C2:0.0438548',
'C1:0.21728 C2:0.99976',
'C1:0.999592 C2:0.9452',
'C1:0.999592 C2:0.99976',
'C1:0.999592 C2:0.341583'
];
$VAR1 = [
'0.847141',
'0.0438548',
'0.21728',
'0.9452',
'0.999592',
'0.341583'
];
This works perfectly, outputting the smaller 'q-value' for each condition. However replacing #_ with $#_ also works.
As does this approach:
foreach (#intersect) {
chomp;
#q_value1 = ($_ =~ /C1:.*?q:(\d+\.\d+)/);
#q_value2 = ($_ =~ /C2:.*?q:(\d+\.\d+)/);
push #q_values, "C1:#q_value1\tC2:#q_value2";
my $q_value1 = $q_value1[0] // $q_value1[1];
my $q_value2 = $q_value2[0] // $q_value2[1];
if (abs $q_value1 < abs $q_value2) {
push #change_q, $q_value1;
}
elsif (abs $q_value2 < abs $q_value1) {
push #change_q, $q_value2;
}
}
print Dumper (\#q_values);
print Dumper (\#change_q);
Output:
$VAR1 = [
'C1:0.847141 C2:0.967194',
'C1:0.999592 C2:0.0438548',
'C1:0.21728 C2:0.99976',
'C1:0.999592 C2:0.9452',
'C1:0.999592 C2:0.99976',
'C1:0.999592 C2:0.341583'
];
$VAR1 = [
'0.847141',
'0.0438548',
'0.21728',
'0.9452',
'0.999592',
'0.341583'

"This works perfectly" is putting it a bit strong. It works coincidentally would be a better description. You are using the #_ array, its highest index $#_ and the number zero, getting the same result every time. What you are not realizing is that #_ is actually empty, because it is only used when passing arguments to subroutines. So when you say
$foo[#_]
You are really saying
$foo[0]
And when you are saying
$foo[$#_]
You are really saying
$foo[-1]
For extra fun, -1 is also a valid array element, meaning the last element in the array, so for an array of size 1 or 2, it probably seems to work fine.
Because in scalar context, an array #_ will return its size, which in this case is 0. $#_ will return -1 when #_ is empty, because there is no highest index.
So, to answer your question: Because using #_ is wrong and only works on accident, using fixed numbers 0 and 1 is the better solution.

Related

For Loop Issues in creating nested array

Creating a matrix of products for three element arrays. I understand Perl does not have multi-dimensional arrays and are flattened. I have been using refs but I can't seem to get past the for loop issue in getting three products into a single array and pushing that array into a different single array. And I could be way off too. Be nice, but I've spent too many hours on this.
I have moved values inside and out of various places i.e. { }, printed out variables until I'm blue and used $last all over for debugging. I'm likely fried at this point.
use strict;
use warnings;
my #array1 = (1, 2, 3);
my #array2 = (2, 4, 6);
my #matrixArray = ();
my $matrixArray;
my #row;
my #finalArray = maths(\#array1, \#array2);
print #finalArray;
sub maths{
my $array1ref = shift;
my $array2ref = shift;
my $value1;
my $value2;
my $maths;
my #row = ();
my #array1 = #{$array1ref};
my #array2 = #{$array2ref};
my $len1 = #array1;
my $len2 = #array2;
for my $x (0 ..($len1 -1)){
#iterate through first array at each value
$value1 = $array1[$x];
#print $value1, " value1 \n";
for my $y (0 .. ($len2 -1)){
#iterate through second array at each value
$value2 = $array2[$y];
#print $value2, " value2 \n";
#calculate new values
$maths = $value1 * $value2;
#exactly right here
#print $maths, " maths \n" ;
push #row, $maths;
}
}
#and exactly right here but not set of arrays
#print #row, "\n";
return #row;
}
Currently I'm able to get this: 246481261218. Which is the correct dumb math but...
it should appear as a matrix:
2 4 6
4 8 12
6 12 18
I am not passing three arrays so it seems my issue is up in the sub routine before I can get on with anything else. This seems to be a theme that I often miss. So sorry if I sound inept.
EDIT***
This was working but I couldn't unpack it
use strict;
use warnings;
my #array1 = (1, 2, 3);
my #array2 = (2, 4, 6);
my #matrixArray = ();
maths(\#array1, \#array2);
foreach my $x (#matrixArray){
print "$x \n";
}
sub maths{
my $array1ref = shift;
my $array2ref = shift;
my $value1;
my $value2;
my $maths;
my #row = ();
my $row;
my #array1 = #{$array1ref};
my #array2 = #{$array2ref};
my $len1 = #array1;
my $len2 = #array2;
for my $x (0 ..($len1 -1)){
#iterate through first array at each value
$value1 = $array1[$x];
for my $y (0 .. ($len2 -1)){
#iterate through second array at each value
$value2 = $array2[$y];
#calculate new values
$maths = $value1 * $value2;
push #row, $maths;
$row = \#row;
}
push #matrixArray, $row;
}
return #matrixArray;
}
The output right after the function call is this:
ARRAY(0x55bbe2c667b0)
ARRAY(0x55bbe2c667b0)
ARRAY(0x55bbe2c667b0)
which would be the (line 10) print of $x.
****EDIT
This Works (almost):
print join(" ", #{$_}), "\n" for #matrixArray;
Output is a bit wrong...
2 4 6 4 8 12 6 12 18
2 4 6 4 8 12 6 12 18
2 4 6 4 8 12 6 12 18
And of note: I knew $x was an array but I seemed to run into trouble trying to unpack it correctly. And I'm no longer a fan of Perl. I'm pining for the fjords of Python.
And *****EDIT
This is working great and I get three arrays out of it:
sub maths{
my ($array1, $array2) = #_;
my #res;
for my $x (#$array1) {
my #row;
for my $y (#$array2) {
push #row, $x * $y;
}
push #res, \#row;
}
#This is the correct structure on print #res!
return #res;
}
But, though it's putting it together correctly, I have no output after the call
maths(\#array1, \#array2);
NOTHING HERE...
print #res;
print join(" ", #{$_}), "\n" for #res;
foreach my $x (#res){
print join(" ", #{$x}), "\n";
}
And of course a million thanks! I regret taking this stupid course and fear my grade will eventually do me in. Still pining for Python!
It appears that you need a matrix with rows obtained by multiplying an array by elements of another.
One way
use warnings;
use strict;
use Data::Dump qw(dd);
my #ary = (2, 4, 6);
my #factors = (1, 2, 3);
my #matrix = map {
my $factor = $_;
[ map { $_ * $factor } #ary ]
} #factors;
dd #matrix;
The array #matrix, formed by the outer map, has array references for each element and is thus (at least) a two-dimensional structure (a "matrix"). Those arrayrefs are built with [ ], which creates an anonymous array out of a list inside. That list is generated by map over the #ary.
I use Data::Dump to nicely print complex data. In the core there is Data::Dumper.
With a lot of work like this, and with large data, efficiency may matter. The common wisdom would have it that direct iteration should be a bit faster than map, but here is a benchmark. This also serves to show more basic ways as well.
use warnings;
use strict;
use feature 'say';
use Benchmark qw(cmpthese);
my $runfor = shift // 5; # run each case for these many seconds
sub outer_map {
my ($ary, $fact) = #_;
my #matrix = map {
my $factor = $_;
[ map { $_ * $factor } #$ary ]
} #$fact;
return \#matrix;
}
sub outer {
my ($ary, $fact) = #_;
my #matrix;
foreach my $factor (#$fact) {
push #matrix, [];
foreach my $elem (#$ary) {
push #{$matrix[-1]}, $elem * $factor;
}
}
return \#matrix;
}
sub outer_tmp {
my ($ary, $fact) = #_;
my #matrix;
foreach my $factor (#$fact) {
my #tmp;
foreach my $elem (#$ary) {
push #tmp, $elem * $factor;
}
push #matrix, \#tmp;
}
return \#matrix;
}
my #a1 = map { 2*$_ } 1..1_000; # worth comparing only for large data
my #f1 = 1..1_000;
cmpthese( -$runfor, {
direct => sub { my $r1 = outer(\#a1, \#f1) },
w_tmp => sub { my $r2 = outer_tmp(\#a1, \#f1) },
w_map => sub { my $r3 = outer_map(\#a1, \#f1) },
});
On a nice machine with v5.16 this prints
Rate direct w_map w_tmp
direct 11.0/s -- -3% -20%
w_map 11.4/s 3% -- -17%
w_tmp 13.8/s 25% 21% --
The results are rather similar on v5.29.2, and on an oldish laptop.
So map is a touch faster than building a matrix directly, and 15-20% slower than the method using a temporary array for rows, which I'd also consider clearest. The explicit loops can be improved a little by avoiding scopes and scalars, and the "direct" method can perhaps be sped up some by using indices. But these are dreaded micro-optimizations, and for fringe benefits at best.
Note that timings such as these make sense only with truly large amounts of data, what the above isn't. (I did test with both dimensions ten times as large, with very similar results.)
The second program is mostly correct.
The problem is that you didn't unpack the second level of the array.
foreach my $x (#matrixArray){
print "$x \n";
}
should be something like:
foreach my $x (#matrixArray) {
print join(" ", #{$x}), "\n";
}
# or just:
print join(" ", #{$_}), "\n" for #matrixArray;
Your maths function can be made shorter without losing legibility (it may actually make it more legible) by cutting out unnecessary temporary variables and indexing. For example:
sub maths {
my #array1 = #{ $_[0] };
my #array2 = #{ $_[1] }; # or: ... = #{ (shift) };
my #res = ();
for my $x (#array1) {
my #row = (); # <-- bugfix of original code
for my $y (#array2) {
my $maths = $x * $y;
push #row, $maths;
}
push #res, \#row;
}
return #res;
}

Getting indices of matching parentheses

Hi I am trying to print indices of the following pattern of brackets:
((((((...)))(((...))))))
as follows:
0 23
1 22
2 21
3 11
4 10
5 9
12 20
13 19
14 18
I tried to achieve this using this perl code as given below:
#!/usr/bin/perl
use strict;
use warnings;
my $string = '((((((...)))(((...))))))';
my #myarray = split('', $string);
my #stack;
my #stack1;
while (my ($index, $element) = each(#myarray))
{
if ($element eq '(')
{
push(#stack, $index);
}
if ($element eq ')')
{
push(#stack1, $index);
}
}
print "$stack[$_]-$stack1[$_]\n" for (0 .. $#stack);
But the above code is giving me following output which is not the required output:
0-9
1-10
2-11
3-18
4-19
5-20
12-21
13-22
14-23
Is there any way I can achieve this?
Push to the stack on the left hand side parenthesis, pop on the right hand side.
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
my $string = '((((((...)))(((...))))))';
my #output;
my #stack;
my $pos = 0;
for my $char (split //, $string) {
if ($char eq '(') {
push #stack, $pos;
} elsif ($char eq ')') {
push #output, [ pop #stack, $pos ];
}
++$pos;
}
say "#$_" for sort { $a->[0] <=> $b->[0] } #output;
Fun question! The accepted answer is fine, but here's another way to do it, because it's always educational to see another solution.
#!/usr/bin/perl
use strict;
use warnings;
my $string = '((((((...)))(((...))))))';
my (#out, #match);
while ($string =~ m/([()])/g) {
my $p = pos($string) - 1;
if ($1 eq '(') {
push #out, [$p];
push #match, $#out;
}
else {
die "mismatched paren at char $p\n"
unless #match;
$out[pop #match][1] = $p;
}
}
for (#out) { print "#$_\n" }
exit(0);
Output is exactly as per your desired output. Dies on mismatched parentheses (which choroba's code could also do with an appropriate test in the elsif block). Unmatched parentheses result in lines with no second number, and they will also be residual in #match after the while loop.
I've opted to use Perl's pattern matching a little instead of breaking the string into individual characters and iterating over them all. Instead, I match on each open or close parenthesis in turn, using the "g" modifier. Thus, the loop only iterates over characters of interest. The pos() function on $string returns the point after the last match, so I need to subtract one to get zero-based output.
The other key difference is that I accumulate in #out, and track the corresponding close by noting the last index of #out, pushing it on #match. I then pop off #match as I find closing parentheses, and add the second element to the sub-array in #out at that position. This eliminates the need for sorting the final result, as #out is already in order of opening parentheses.

Is it possible to assign two variables in Perl foreach loop?

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 :-)

An elegant way of returning the index of the last non-zero element in Perl?

I find myself wanting to find the index of the last non-zero element in an array. So, given:
my #array = (0,0,5,9,0,0,0,7,0,3,0,0);
my $indexLastNonZero = insertElegantMethodHere(#array);
# expect $indexLastNonZero to be equal to 9;
I've done this:
for my $i (0 .. $#array) {
$indexLastNonZero = $i if $array[$i] != 0;
};
I works but somehow I can't help feel there must be a super elegant (smarter? nice? more efficient?) way of doing this in perl. I've looked into List::Utils but not found a nice way there and would like a non-core-module independent method.
Any thoughts?
Cheers
Use List::MoreUtils for such tasks:
use warnings;
use strict;
use List::MoreUtils;
my #array = (0,0,5,9,0,0,0,7,0,3,0,0);
print List::MoreUtils::lastidx { $_ } #array
Start at the end of the array and work backwards until you find a non-zero element:
my #array = (0,0,5,9,0,0,0,7,0,3,0,0);
my $i = $#array;
$i-- while $i >= 0 && $array[$i] == 0;
print "The last non-zero element is at index $i\n";
The $i >= 0 test is to guard against the edge case where all elements are zero. In that case the resulting value of $i is -1.
my #array = (0,0,5,9,0,0,0,7,0,3,0,0);
my ($indexLastNonZero) = grep $array[$_], reverse 0 .. $#array;
You could use List::Util, which is in core:
use strict;
use warnings;
use List::Util qw(first);
my #array = (0,0,5,9,0,0,0,7,0,3,0,0);
my $index = #array;
first { $index-- && $_ } reverse #array;
print "Last index that is non-zero: $index\n";
Destructive approach so take a copy of the array first:
my #array2 = #array;
while (!pop #array2) {} # Remove up to and including the last non-zero
print scalar #array2; # Size of remaining elements is index of last non-zero
sub last_true {
pop and return scalar #_ while #_;
undef;
}
my $index = last_true(#foo);

Perl splitting array based on condition using grep

I have some perl code that looks something like this:
my #array = map { rand } ( 1..100 );
my #matching = grep { $_ == $condition } #array;
#array = grep { $_ != $condition } #array;
This works ok, but what I would like to do is split the original array into two based on a single operation...I think I'm carrying out twice as many operations as strictly necessary.
Help appreciated!! Thanks.
This is where part from List::MoreUtils comes in handy.
use List::MoreUtils qw'part';
my($even,$odd) = part { $_ % 2 } #array;
This works great if you want each element of input in exactly one array of the output.
If you want to possibly put them in more than one of the arrays, you have to loop over them yourself.
The best way to do that is with a foreach loop.
my(#div2,#div3);
for my $elem (#array){
push #div2, $elem unless $elem % 2;
push #div3, $elem unless $elem % 3;
}
If there are a lot of similar checks you have to do, perhaps you should loop on what your testing against as-well.
my %div;
for my $elem (#array){
for my $div (2,3,5,7,11,13){
push #{ $out{$div} }, $elem unless $elem % $div;
}
}
By far the easiest method is to iterate your array and push values to either of the two arrays depending on the condition, as in the below example.
for (#array) {
if ($_ % 2) {push #odd, $_}
else {push #even, $_}
}
If you'd like to modify the source array:
for (my $i =0; $i < #array; ++$i) {
if ($array[$i] % 2) {
push #odd, splice (#array, $i--, 1);
}
}
Why didn't you recommend List::MoreUtils::part?
The module in question might not exists on the target system, which is always an annoying thing.
Also on the system I ran tests on I found that List::MoreUtils::part was twice as slow as first snippet in this post, though with different implementations of part it might be the opposite actually.
I love the simplicity of List::MoreUtils' part function:
sub part (&#) {
my ($code, #list) = #_;
my #parts;
push #{ $parts[ $code->($_) ] }, $_ foreach #list;
return #parts;
}
The resulting #parts array is an array of arrayrefs. #$parts[0] is the array of elements that returned false. #$parts[1] returned true.

Resources