Assignment of multiple array subroutine parameters in Perl doesn't work - perl

I'm confused about perl subroutine parameters in this example
when i use references in subroutine parameters it works:
#a = ( 1, 2 );
#b = ( 5, 8 );
#c = add_vecpair( \#a, \#b );
print "#c\n";
print $a[0];
sub add_vecpair { # assumes both vectors the same length
my ( $x, $y ) = #_; # copy in the array references
my #result;
#$x[0] = 2;
for ( my $i = 0; $i < #$x; $i++ ) {
$result[$i] = $x->[$i] + $y->[$i];
}
return #result;
}
but when i don't use references as parameters like this:
#a = ( 1, 2 );
#b = ( 5, 8 );
#c = add_vecpair( #a, #b );
print "#c\n";
print $a[0];
sub add_vecpair { # assumes both vectors the same length
my ( #x, #y ) = #_; # copy in the array references
my #result;
print #y;
for ( my $i = 0; $i < #x; $i++ ) {
$result[$i] = $x[$i] + $y[$i];
}
return #result;
}
..it doesn't work. When do i need to use references as subroutine parameters?

Short version: The issue is this line:
my (#x, #y) = #_;
Assignments are greedy. #x is treated first, and is given as many values from #_ as it can handle. And as it can handle all of them, it ends up getting all of the contents of #_, and #y get none.
The result is the same as this:
my #x = #_; # Gets all of the arguements
my #y; # Gets nothing, and is therefore declared but uninitialized.
This is why using references is recommended when subroutines take more than one value as arguement, and at least one of those values are arrays or hashes.
Longer version:
#_ is a composite of all of the arguements passed to the subroutine, so the original container doesn't matter. Consider the code snippets below. The first one is yours, the second one does the exact same thing, but more clearly displays what is happening.
#a = (1, 2);
#b = (5, 8);
add_vecpair(#a,#b);
....is the same as:
add_vecpair(1, 2, 5, 8);
To further hilight the problem, hashes get really messy if treated this way:
%a = ('a' => 1,
'b' => 2);
%b = ('c' => 3,
'd' => 4);
somefunction(%a, %b);
...is the same as:
somefunction('a', 1, 'b', 2, 'c', 3, 'd', 4);

When you call Perl subroutines with array or hash parameters, they are flattened out to a single list. Therefore in the second case your two array parameters loose their identities and #_ becomes a single array with the elements of both #a and #b.

Related

mapping to a subroutine that accepts multiple argument

am trying to map an array to a subroutine that accept 2 argument, i tried using php array_map concept but didn't work out:
sub m {
my ($n, $m) = #_;
return("The number $n is called $m in Spanish");
}
sub new_map {
my (#argument) = #_;
my #arg = #argument;
#array = map(m($_, $_), #{ $arg[0] }, #{ $arg[1]});
}
my #arr1 = (1, 2, 3);
my #arr2 = ("uno", "dos");
new_map(\#arr1, \#arr2);
#outputs
#The number 1 is called 1 in Spanish INSTEAD OF 'The number 1 is called uno in Spanish'
#The number 2 is called 2 in Spanish INSTEAD OF 'The number 1 is called dos in Spanish'
Is there a way to accomplish this.
Your updated code that uses new_map could be done like so:
use Algorithm::Loops 'MapCarMin';
my #arr1 = (1, 2, 3);
my #arr2 = ("uno", "dos");
#array = MapCarMin \&m, \#arr1, \#arr2;
or
sub call_m_over_pair_of_arrays {
my ($arrayref1, $arrayref2) = #_;
map &m($arrayref1->[$_], $arrayref2->[$_]), 0..( $#$arrayref1 < $#$arrayref2 ? $#$arrayref1 : $#$arrayref2 );
}
#array = call_m_over_pair_of_arrays( \#arr1, \#arr2 );
Answer to original question:
Parentheses don't create lists or arrays in perl; nested parentheses just flatten out into a single list; you would need to do this:
#array = map( &m(#$_), [ 1, 'uno' ], [ 2, 'dos' ] );
Or this:
use List::Util 1.29 'pairmap';
#array = pairmap { &m($a, $b) } (1, 'uno', 2, 'dos');
Don't name subroutines m; that conflicts when the m match operator. (Though you can still call such a subroutine using &, it is better not to.)

Perl Passing arguments to subroutine not working

I'm trying to pass parameters to a perl subroutine and for whatever reason inside the subroutine the parameters are coming out empty.
...
...
...
print "Passing arguments $a, $b, $c, $d \n";
beforeEnd($a, %b, $c, $d);
sub beforeEnd() {
my ($a, %b, $c, $d) = #_;
print "a is $a, b is $b, c is $c, d is $d \n";
}
The output of the print statements give me an idea that something is wrong. The weird part? The first 2 parameters are passing properly.
> Passing arguments 1, (1,2,3), 2, 3
> a is 1, b is (1,2,3), c is , d is
Any help would be greatly appreciated.
Because when you pass arguments into or out of a subroutine, any hashes and arrays are smashed flat.
You are assigning into %b which will gobble up any arguments.
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
sub test1 {
my ( $first, #rest, $last ) = #_;
print Dumper \#rest;
print "First = $first, last = $last, rest = #rest\n";
}
sub test2 {
my ( $first, $second ) = #_;
print "#$first ; #$second";
}
test1 ( 1, 2, 3, 4 );
test2 ( [1,2], [ 3,4] );
my #list1 = ( 1,2,3,4 );
my #list2 = ( 5,6,7,8 );
test1 ( #list1, #list2 );
test2 ( \#list1, \#list2 );
If you want to keep arrays or hashes intact, you need to either pass them by reference or as the last argument.
You would also probably get a warning if you turned on strict and warnings here - which is one of the reasons it's strongly recommended - because $b and %b are not the same. You'd also get a warning about an odd number of assignments:
Odd number of elements in hash assignment at line 5.
Use of uninitialized value $b in print
When arguments are passed to a Perl subroutine, they are flattened into a single List represented by #_. Conceptually, this means that if you are not passing references to arrays or hashes, you will "lose" some data. "Lose" is not exactly correct, because all of the data is still there; it is just not in the variable you expect. An example of this could be:
sub f {
my (#a, #b) = #_;
say 'a: ' . join(', ', #a);
say 'b: ' . join(', ', #b);
}
f( qw(1 2 3), qw(a b c) );
You will get the following output:
a: 1, 2, 3, a, b, c
b:
This is happening because the first array #a consumes all of the values from #_ and there a no more left to be stored in #b. The same thing is happening with the hash in your beforeEnd subroutine. The values of $c and $d are getting stored inside of %b. As an example since I can't see the variables values, if you passed
beforeEnd(1, ( a => 1, b => 2 ), 'c', 3);
inside your sub, you get something like this:
$a = 1
%b = ( a => 1, b => 2, c => 3 )
$c = undef
$d = undef
You can solve this by passing a reference to your hash %b:
beforeEnd($a, \%b, $c, $d);
Subroutines accept a list of scalar as arguments. If you pass an array or a hash, the contents of the array or hash is passed instead. That means that
f($a, %b, $c, $d)
is the same as
f($a, $b_key_1, $b_val_1, $b_key_2, $b_val_2, $b_key_3, $b_val_3, $c, $d);
How many of the scalars in #_ should be assigned to %b? Perl keeps it simple and assigns all remaining scalars, so
my ($a, %b, $c, $d) = #_;
is really no different than
my $a = $_[0]; # The first argument
my %b = #_[1..$#_]; # All but the first argument
my $c;
my $d;
It's best if you pass a reference to the hash. That avoids the problem, and it's far more efficient.
use Data::Dumper qw( Dumper );
sub beforeEnd {
my ($a, $b, $c, $d) = #_;
local $Data::Dumper::Terse = 1;
print "a is $a, b is ".Dumper($b).", c is $c, d is $d \n";
}
beforeEnd($a, \%b, $c, $d);
Off-topic comments about your code:
You had a prototype indicating no arguments are expected (), but you expect four. Rid yourself of that prototype.
You should avoid using $a and $b as variables as it can issues with sort.
The arguments can be passed in subroutine only as list of scalar variables.
We need to pass the reference of the hash (or an array, object) whenever passing the arguments to subroutine.
...
...
...
print "Passing arguments $a, $b, $c, $d \n";
beforeEnd($a, \%b, $c, $d);
sub beforeEnd() {
my ($a, $b, $c, $d) = #_;
print "a is $a, b is %$b, c is $c, d is $d \n";
}

Print array multiple variables

Kindly advice I am unable to print value of a ,b &c
my #array = qw($a,$b,$c);
push(#new_array ,#array);
for my $x (#new_array)
{
DEBUG(" DEBUG : $x);
}
It showing me $a,$b,$c instead of there values.
Thanks,
The qw operator creates a list of strings. It quotes words, so it's "qw".
my #array = qw( x y z );
is exactly the same as
my #array = ( 'x', 'y', 'z' );
Your line:
my #array = qw($a,$b,$c);
is saying
my #array = ( '$a,$b,$c' );
What you want is to drop the qw.
my #array = ( $a, $b, $c );

How can I partition a Perl array into equal sized chunks?

I have a fixed-sized array where the size of the array is always in factor of 3.
my #array = ('foo', 'bar', 'qux', 'foo1', 'bar', 'qux2', 3, 4, 5);
How can I cluster the member of array such that we can get
an array of array group by 3:
$VAR = [ ['foo','bar','qux'],
['foo1','bar','qux2'],
[3, 4, 5] ];
my #VAR;
push #VAR, [ splice #array, 0, 3 ] while #array;
or you could use natatime from List::MoreUtils
use List::MoreUtils qw(natatime);
my #VAR;
{
my $iter = natatime 3, #array;
while( my #tmp = $iter->() ){
push #VAR, \#tmp;
}
}
I really like List::MoreUtils and use it frequently. However, I have never liked the natatime function. It doesn't produce output that can be used with a for loop or map or grep.
I like to chain map/grep/apply operations in my code. Once you understand how these functions work, they can be very expressive and very powerful.
But it is easy to make a function to work like natatime that returns a list of array refs.
sub group_by ($#) {
my $n = shift;
my #array = #_;
croak "group_by count argument must be a non-zero positive integer"
unless $n > 0 and int($n) == $n;
my #groups;
push #groups, [ splice #array, 0, $n ] while #array;
return #groups;
}
Now you can do things like this:
my #grouped = map [ reverse #$_ ],
group_by 3, #array;
** Update re Chris Lutz's suggestions **
Chris, I can see merit in your suggested addition of a code ref to the interface. That way a map-like behavior is built in.
# equivalent to my map/group_by above
group_by { [ reverse #_ ] } 3, #array;
This is nice and concise. But to keep the nice {} code ref semantics, we have put the count argument 3 in a hard to see spot.
I think I like things better as I wrote it originally.
A chained map isn't that much more verbose than what we get with the extended API.
With the original approach a grep or other similar function can be used without having to reimplement it.
For example, if the code ref is added to the API, then you have to do:
my #result = group_by { $_[0] =~ /foo/ ? [#_] : () } 3, #array;
to get the equivalent of:
my #result = grep $_->[0] =~ /foo/,
group_by 3, #array;
Since I suggested this for the sake of easy chaining, I like the original better.
Of course, it would be easy to allow either form:
sub _copy_to_ref { [ #_ ] }
sub group_by ($#) {
my $code = \&_copy_to_ref;
my $n = shift;
if( reftype $n eq 'CODE' ) {
$code = $n;
$n = shift;
}
my #array = #_;
croak "group_by count argument must be a non-zero positive integer"
unless $n > 0 and int($n) == $n;
my #groups;
push #groups, $code->(splice #array, 0, $n) while #array;
return #groups;
}
Now either form should work (untested). I'm not sure whether I like the original API, or this one with the built in map capabilities better.
Thoughts anyone?
** Updated again **
Chris is correct to point out that the optional code ref version would force users to do:
group_by sub { foo }, 3, #array;
Which is not so nice, and violates expectations. Since there is no way to have a flexible prototype (that I know of), that puts the kibosh on the extended API, and I'd stick with the original.
On a side note, I started with an anonymous sub in the alternate API, but I changed it to a named sub because I was subtly bothered by how the code looked. No real good reason, just an intuitive reaction. I don't know if it matters either way.
Or this:
my $VAR;
while( my #list = splice( #array, 0, 3 ) ) {
push #$VAR, \#list;
}
Another answer (a variation on Tore's, using splice but avoiding the while loop in favor of more Perl-y map)
my $result = [ map { [splice(#array, 0, 3)] } (1 .. (scalar(#array) + 2) % 3) ];
Try this:
$VAR = [map $_ % 3 == 0 ? ([ $array[$_], $array[$_ + 1], $array[$_ + 2] ])
: (),
0..$#array];
Another generic solution, non-destructive to the original array:
use Data::Dumper;
sub partition {
my ($arr, $N) = #_;
my #res;
my $i = 0;
while ($i + $N-1 <= $#$arr) {
push #res, [#$arr[$i .. $i+$N-1]];
$i += $N;
}
if ($i <= $#$arr) {
push #res, [#$arr[$i .. $#$arr]];
}
return \#res;
}
print Dumper partition(
['foo', 'bar', 'qux', 'foo1', 'bar', 'qux2', 3, 4, 5],
3
);
The output:
$VAR1 = [
[
'foo',
'bar',
'qux'
],
[
'foo1',
'bar',
'qux2'
],
[
3,
4,
5
]
];
As a learning experience I decided to do this in Perl6
The first, perhaps most simplest way I tried was to use map.
my #output := #array.map: -> $a, $b?, $c? { [ $a, $b // Nil, $c // Nil ] };
.say for #output;
foo bar qux
foo1 bar qux2
3 4 5
That didn't seem very scalable. What if I wanted to take the items from the list 10 at a time, that would get very annoying to write. ... Hmmm I did just mention "take" and there is a keyword named take lets try that in a subroutine to make it more generally useful.
sub at-a-time ( Iterable \sequence, Int $n where $_ > 0 = 1 ){
my $is-lazy = sequence.is-lazy;
my \iterator = sequence.iterator;
# gather is used with take
gather loop {
my Mu #current;
my \result = iterator.push-exactly(#current,$n);
# put it into the sequence, and yield
take #current.List;
last if result =:= IterationEnd;
}.lazy-if($is-lazy)
}
For kicks let's try it against an infinite list of the fibonacci sequence
my $fib = (1, 1, *+* ... *);
my #output = at-a-time( $fib, 3 );
.say for #output[^5]; # just print out the first 5
(1 1 2)
(3 5 8)
(13 21 34)
(55 89 144)
(233 377 610)
Notice that I used $fib instead of #fib. It was to prevent Perl6 from caching the elements of the Fibonacci sequence.
It might be a good idea to put it into a subroutine to create a new sequence everytime you need one, so that the values can get garbage collected when you are done with them.
I also used .is-lazy and .lazy-if to mark the output sequence lazy if the input sequence is. Since it was going into an array #output it would have tried to generate all of the elements from an infinite list before continuing onto the next line.
Wait a minute, I just remembered .rotor.
my #output = $fib.rotor(3);
.say for #output[^5]; # just print out the first 5
(1 1 2)
(3 5 8)
(13 21 34)
(55 89 144)
(233 377 610)
.rotor is actually far more powerful than I've demonstrated.
If you want it to return a partial match at the end you will need to add a :partial to the arguments of .rotor.
Use the spart function from the List::NSect package on CPAN.
perl -e '
use List::NSect qw{spart};
use Data::Dumper qw{Dumper};
my #array = ("foo", "bar", "qux", "foo1", "bar", "qux2", 3, 4, 5);
my $var = spart(3, #array);
print Dumper $var;
'
$VAR1 = [
[
'foo',
'bar',
'qux'
],
[
'foo1',
'bar',
'qux2'
],
[
3,
4,
5
]
];
Below a more generic solution to the problem:
my #array = ('foo', 'bar', 1, 2);
my $n = 3;
my #VAR = map { [] } 1..$n;
my #idx = sort map { $_ % $n } 0..$#array;
for my $i ( 0..$#array ){
push #VAR[ $idx[ $i ] ], #array[ $i ];
}
This also works when the number of items in the array is not a factor of 3.
In the above example, the other solutions with e.g. splice would produce two arrays of length 2 and one of length 0.

Is there an elegant zip to interleave two lists in Perl 5?

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.