Let's say I have an array my #arr which is of hypothetical length 240 (but this length is variable). How could I go about running a function on each N elements of that array at a time?
For example, if N = 100, the function would first run on #arr[0..99], then #arr[100..199], and finally #arr[200..239].
My idea was to have some sort of loop which creates a temporary array of length N by joining N elements together, but these seems overly complicated.
while (#arr) {
f(splice(#arr, 0, 100));
}
Non-destructive version:
use List::Util qw( min );
for (my $i=0; $i<#a; $i+=100) {
f(#arr[$i .. min($i+99, $#arr)]);
}
You could also avoid destroying the original array cheaply by creating an array of aliases:
my $shadow = sub { \#_ }->(#arr);
while (#$shadow) {
f(splice(#$shadow, 0, 100));
}
You can use splice:
sub apply_f_to_n_elements {
my ($f, $n, #elements) = #_;
my #results;
while ( #elements ) {
my #batch = splice(#elements, 0, $n)
push #results,
$f->(#batch);
}
return #results;
}
Usage:
apply_f_to_n_elements(\&f, 100, #arr);
or
my #results = apply_f_to_n_elements(\&f, 100, #arr);
The following is optimized to avoid making two copies of every input (while still remaining non-destructive), and optimized to avoid collecting the results of the callback if they're going to be discarded anyway:
sub apply_f_to_n_elements {
my $f = shift;
my $n = shift;
if (wantarray) {
my #results;
while (#_) {
push #results, $f->(splice(#_, 0, $n));
}
return #results;
} else {
while (#_) {
$f->(splice(#_, 0, $n));
}
}
}
Using List::Util qw(min) works well.
However, if you want a more semantic solution, you can use List::MoreUtils qw(natatime).
use List::MoreUtils qw(natatime);
my $iter = natatime 100, #arr;
while (my #vals = $iter->()) {
f(#vals);
}
Related
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;
}
I need to create multidimensional hashes with varying depth using array elements as keys. Pseudocode attempt:
Example line:
Statement Coverage for instance Hierarchical/path/with/block/and/module ...
if (/Statement Coverage for instance (.&?) /)
{
#array = split /\//, $1;
}
for (my $eye = 1; $eye <= $#array; $eye++)
{
A miracle happens to %hash!
}
$hash{"path"}{"with"}{"block"}{"and"} now has a value of "module". Remember, the number of keys can vary. Any ideas?
That's what Data::Diver does for you:
my #array = split /\//, $1;
DiveVal(\ my %hash, #array[ 0 .. $#array - 1 ]) = $array[-1];
print Dumper(\%hash);
See my code below. It builds the desired hash recursively.
But I think that you are taking a wrong approach. I obviously don't know what exactly you are trying to achieve, but seems to me, that you should use tree data structure instead of the multidimensional hash.
use strict;
use warnings;
use v5.10;
use Data::Dumper;
my #data = (
'some/path/test',
'some/path/deeper/test',
'another/deeper/path/test',
);
my $resultHr = {};
foreach my $path (#data) {
my #elems = split /\//, $path;
buildHash($resultHr, #elems);
}
say Dumper($resultHr);
sub buildValue {
my $n = shift;
if (#_) {
return {$n => buildValue(#_)};
}
else {
return $n;
}
}
sub buildHash {
my $hr = shift;
my $k = shift;
return unless $k;
if (exists $hr->{$k} && ref $hr->{$k}) {
buildHash($hr->{$k}, #_);
}
else {
$hr->{$k} = buildValue(#_);
}
}
I have an array of numbers and wish to remove all the nonpositive (that is, zero or negative) numbers at the start of the array. Here's what I have:
shiftlbl:
$shift = shift #ary;
if (0 >= $shift) {goto shiftlbl;}
else {unshift #ary, $shift;}
Is there a way that works better (faster), or that works approximately equally well but is more Perlish or easier to read?
Without using any module, you can use
shift #ary while #ary && $ary[0] <= 0;
Not only is it much more readable; it's also much faster.
Or, you can try change the array just once, which could speed up the process if the portion to delete is very long:
use List::Util qw{ first };
my $i = first { $ary[$_] > 0 } 0 .. $#ary;
splice #ary, 0, $i;
For -1000 .. 200, I'm getting
Rate old new splice
old 2782/s -- -62% -69%
new 7371/s 165% -- -17%
splice 8886/s 219% 21% --
Here is the whole code:
#!/usr/bin/perl
use warnings;
use strict;
use List::Util qw{ first };
use Test::More;
use Benchmark qw{ cmpthese };
sub old {
my #ary = #_;
shiftlbl:
my $shift = shift #ary;
if (0 >= $shift) {goto shiftlbl;}
else {unshift #ary, $shift;}
return #ary
}
sub new {
my #ary = #_;
shift #ary while #ary && $ary[0] <= 0;
return #ary
}
sub sp {
my #ary = #_;
my $i = first { $ary[$_] > 0 } 0 .. $#ary;
splice #ary, 0, $i;
return #ary
}
my #ar = (-1000 .. 200);
is_deeply([old(#ar)], [new(#ar)], 'old - new');
is_deeply([old(#ar)], [sp(#ar)], 'old - splice');
cmpthese(-5,
{
old => sub { old(#ar) },
new => sub { new(#ar) },
splice => sub { sp(#ar) },
# Also tried with similar results:
# old => 'old( -1000 .. 200)',
# new => 'new( -1000 .. 200)',
# splice => 'sp( -1000 .. 200)',
});
done_testing();
You can use after_incl from List::MoreUtils:
use strict;
use warnings;
use Data::Dump;
use List::MoreUtils qw(after_incl);
my #numbers = (-2, -17, 2, -1, 5, 0);
my #starts_positive = after_incl { $_ > 0 } #numbers;
dd \#starts_positive;
Output:
[2, -1, 5, 0]
after_incl takes a list, applies a block to it until the block returns true, and returns a list of values from that point to the end of the original list.
I need an infinite loop into finite array...
Example:
#name = ('John', 'Helen', 'Dave');
1=John
2=Helen
3=Dave
4=John
5=Helen
6=Dave
7=John
8=Helen
9=Dave
...etc
Is it possible?
Thanks
It sounds as if you need to index the finite array with the index number modulo the size of the array:
foreach my $i (1..100) { printf "%d=%s\n", $i, $name[$i % scalar(#name)]; }
my #dow = ( 'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat' );
print $dow[7 % scalar(#dow)], "\n";
print $dow[125 % scalar(#dow)], "\n";
Etc.
I don't know why anyone would want to do that, but this will do what you want:
my $i=0;
my $cnt=1;
my #name = ('John', 'Helen', 'Dave');
while($i<scalar (#name )){
print $cnt."".$name[$i];
$i++;
$cnt++;
$i=$i==scalar(#name)?0:$i;
}
For fun, this presents an "infinitely" large array of repeating values (while only storing one copy of each value).
use InfinitelyLoopingArray qw( );
tie my #dow_lookup, InfinitelyLoopingArray::,
qw( Sun Mon Tue Wed Thu Fri Sat );
printf "%3d %s\n", $_, $dow_lookup[$_]
for 0..9, 125;
Where InfinitelyLoopingArray.pm contains:
package InfinitelyLoopingArray;
use strict;
use warnings;
use Carp qw( croak );
sub TIEARRAY {
my $class = shift;
return bless([ #_ ], $class);
}
sub FETCHSIZE {
# Largest supported array index.
# Currently 2**31-1 or 2**63-1 depending on the build.
return unpack('J', pack('j', -1)) >> 1;
}
sub FETCH {
my ($self, $idx) = #_;
croak "Negative indexes not supported" if $idx < 0;
return $self->[$idx % #$self];
}
sub new {
tie my #array, #_;
return \#array;
}
1;
many answers - so one more
my(#names) = ('John', 'Helen', 'Dave');
my $cnt;
while(1) {
print ++$cnt, "=$_\n" for (#names);
}
hope, this is enough infinite... :) /at least while the $cnt is overlfow/
I'm trying to iterate over a 2D array that is structured in this specific way. Whether or not this is a good way to structure the array is another question - I still need to be able to iterate over it (if it is possible).
#row1 = ( "Current Scan", "Last Month");
#row2 = ( "240", "0");
#row3 = ( "226", "209");
#row4 = ( "215", "207");
#array = (\#row1, \#row2, \#row3, \#row4);
print Dumper(#array);
printarray(#array);
Dumper gives me the following output:
$VAR1 = [
'Current Scan',
'Last Month'
];
$VAR2 = [
'240',
'0'
];
$VAR3 = [
'226',
'209'
];
$VAR4 = [
'215',
'207'
];
I've tried several for loops with no success. Each only prints the first row ($VAR1) and quits. Here is my most recent attempt:
sub printarray {
#array = shift;
$rowi = 0;
foreach my $row (#array) {
for (my $coli = 0; $coli <= #$row; $coli++) {
print "$array[$rowi][$coli]\n";
}
$rowi++;
}
}
I'm obviously overlooking something simple. What am I doing wrong? Thanks in advance!
If you want just print the array, try following code:
foreach my $row (#array) {
foreach my $elem (#$row) {
print $elem; ## print elements without separator
}
print "\n"; ## new line after row
}
If you need indexes for some purpose, here we go:
for(my $row_i = 0; $row_i < #array; $row_i++) {
for(my $column_i = 0; $column_i < #{ $array[$row_i] }; $column_i++) {
print $array[$row_i][$column_i];
}
}
The idea is that #array in scalar context returns number of elements in array. And #{ $array[$row_i] } is a little more tricky. It dereference array stored in $array[$row_i].
Update for subroutine:
In perl you can pass array by reference:
printarray(\#array); ## pass reference
sub printarray {
my $array_ref = shift; ## no copy created
foreach my $row (#$array_ref) { ## now we need to dereference
...
}
}
You can also pass a copy of array:
printarray(#array);
sub printarray {
my #array_copy = #_; ## store local copy of array
...
}
For more details take a look at How can I pass/return a {Function, FileHandle, Array, Hash, Method, Regex}? manual page.
And please add use strict; at the begining of programm. It'll force you to declare all variables, but will save bunch of time if you type something incorrectly.
When you pass the array into the subroutine, you're essentially passing in eight scalars. Then, when you do
sub printarray {
#array = shift;
... you're popping off only the first element in the list. Try:
sub printarray {
#array = #_;
#!/usr/bin/perl
use warnings;
use strict;
my #row1 = ( "Current Scan", "Last Month");
my #row2 = ( "240", "0");
my #row3 = ( "226", "209");
my #row4 = ( "215", "207");
my #array = (\#row1, \#row2, \#row3, \#row4);
foreach my $row (#array) {
foreach my $value (#$row) {
print "$value\n";
}
}
This will print
Current Scan
Last Month
240
0
226
209
215
207
Not sure if that's what you wanted.
Yes, the problem is in the way you're passing the array to the subroutine. Perl flattens arrays in parameter lists. Basically, printarray(#array) is (in this example) equivalent to printarray($array[0], $array[1], $array[2], $array[3]). The shift at the beginning of printarray takes the first parameter and assigns it to #array. So no matter how big the array is, printarray only sees the first element.
Are you looking for something like this:
#!/usr/bin/perl
use warnings;
use strict;
use Algorithm::Loops 'MapCar';
my #row1 = ( "Current Scan", "Last Month");
my #row2 = ( "240", "0");
my #row3 = ( "226", "209");
my #row4 = ( "215", "207");
my #array = (\#row1, \#row2, \#row3, \#row4);
MapCar { print "Scan: $_[0]: $_[1], $_[2], $_[3]\n" } #array;