mapping to a subroutine that accepts multiple argument - perl

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

Related

Perl hash, array and references

I have this 3 lines of code in a sub and I'm trying to write them together on one line only.. but I'm quite lost
my %p = #_;
my $arr = $p{name};
my #a = #$arr;
what's the correct way of doing this?
thank you!
my %p = #_;
#_ is assumed to contain key-value pairs which are then used to construct the hash %p.
my $arr = $p{name};
The argument list is assumed to have contained something along the lines of name, [1, 2, 3,] so that $p{name} is an reference to an array.
my #a = #$arr;
Dereference that array reference to get the array #.
Here is an invocation that might work with this prelude in a sub:
func(this => 'that', name => [1, 2, 3]);
If you want to reduce the whole prelude to a single statement, you can use:
my #a = #{ { #_ }->{name} };
as in:
#!/usr/bin/env perl
use strict;
use warnings;
use YAML::XS;
func(this => 'that', name => [1, 2, 3]);
sub func {
my #a = #{ { #_ }->{name} };
print Dump \#a;
}
Output:
---
- 1
- 2
- 3
If the array pointed to by name is large, and if you do not need a shallow copy, however, it may be better to just stick with references:
my $aref = { #_ }->{ name };
OK so what you're doing is:
Assign a list of elements passed to the sub, to a hash.
extract a value from that hash (that appears to be an array reference)
dereference that into a standalone array.
Now, I'm going to have to make some guesses as to what you're putting in:
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
sub test {
my %p = #_;
my $arr = $p{name};
my #a = #$arr;
print Dumper \#a;
}
my %input = ( fish => [ "value", "another value" ],
name => [ "more", "less" ], );
test ( %input );
So with that in mind:
sub test {
print join "\n", #{{#_}->{name}},"\n";
}
But actually, I'd suggest what you probably want to do is pass in the hashref in the first place:
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
sub test {
my ( $input_hashref ) = #_;
print Dumper \#{$input_hashref -> {name}};
}
my %input = ( fish => [ "value", "another value" ],
name => [ "more", "less" ], );
test ( \%input );
Also:
Don't use single letter variable names. It's bad style.
that goes double for a and b because $a and $b are for sorting. (And using #a is confusing as a result).

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

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.

Is there a compact Perl operation to slice alternate elements from an array?

If I have an array myarray in Python, I can use the slice notation
myarray[0::2]
to select only the even-indexed elements. For example:
>>> ar = [ "zero", "one", "two", "three", "four", "five", "six" ]
>>> ar [ 0 : : 2 ]
['zero', 'two', 'four', 'six']
Is there a similar facility in Perl?
Thanks.
A Perl array slice is the # in front of the array name, then the list of indices you want:
#array[#indices];
There's not a built-in syntax to select multiples, but it's not so hard. Use grep to produce a list of indices that you want:
my #array = qw( zero one two three four five six );
my #evens = #array[ grep { ! ($_ % 2) } 0 .. $#array ];
If you are using PDL, there are lots of nice slicing options.
There's array slices:
my #slice = #array[1,42,23,0];
There's a way to to generate lists between $x and $y:
my #list = $x .. $y
There's a way to build new lists from lists:
my #new = map { $_ * 2 } #list;
And there's a way to get the length of an array:
my $len = $#array;
Put together:
my #even_indexed_elements = #array[map { $_ * 2 } 0 .. int($#array / 2)];
Granted, not quite as nice as the python equivalent, but it does the same job, and you can of course put that in a subroutine if you're using it a lot and want to save yourself from some writing.
Also there's quite possibly something that'd allow writing this in a more natural way in List::AllUtils.
I've written the module List::Gen on CPAN that provides an alternative way to do this:
use List::Gen qw/by/;
my #array = qw/zero one two three four five six/;
my #slice = map {$$_[0]} by 2 => #array;
by partitions #array into groups of two elements and returns an array of array references. map then gets this list, so each $_ in the map will be an array reference. $$_[0] (which could also be written $_->[0]) then grabs the first element of each group that by created.
Or, using the mapn function which by uses internally:
use List::Gen qw/mapn/;
my #slice = mapn {$_[0]} 2 => #array;
Or, if your source list is huge and you may only need certain elements, you can use List::Gen's lazy lists:
use List::Gen qw/by gen/;
my $slicer = gen {$$_[0]} by 2 => #array;
$slicer is now a lazy list (an array ref) that will generate it's slices on demand without processing anything that you didn't ask for. $slicer also has a bunch of accessor methods if you don't want to use it as an array ref.
I'll do this in a two-step process: first generate the desired indices, and then use a slice operation to extract them:
#indices = map { $_ * 2 } (0 .. int($#array / 2));
my #extracted = #array[#indices];
Step-by-step, thats:
generate a list of integers from 0 to the last element of the array divided by two
multiply each integer by two: now we have even numbers from zero to the index of the last element
extract those elements from the original array
Perl 6 will improve things dramatically, but (so far?) Perl 5 has pretty limited slicing capability: you have to explicitly specify the indexes you want, and it can't be open-ended.
So you'd have to do:
#ar = ( "zero", "one", "two", "three", "four", "five", "six" );
print #ar[ grep $_ % 2 == 0, 0..$#ar ]
One way to make this prettier is to wrap it in something like autobox.
For example using autobox::Core:
use autobox::Core;
my #ar = qw/zero one two three four five six/;
# you could do this
#ar->slice_while( sub{ not $_ % 2 } );
# and this
#ar->slice_by(2);
# or even this
#ar->evens;
This is how you can define these autobox methods:
sub autobox::Core::ARRAY::slice_while {
my ($self, $code) = #_;
my #array;
for (my $i = 0; $i <= $#{ $self }; $i++) {
local $_ = $i;
push #array, $self->[ $i ] if $code->();
}
return wantarray ? #array : \#array;
}
sub autobox::Core::ARRAY::slice_by {
my ($self, $by) = #_;
my #array = #$self[ map { $_ * $by } 0 .. int( $#{$self} / $by )];
return wantarray ? #array : \#array;
}
sub autobox::Core::ARRAY::evens {
my $self = shift;
my #array = $self->slice_by(2);
return wantarray ? #array : \#array;
}
/I3az/
If you don't care about the order, and if the odd-numbered elements of the list are unique, you can concisely convert the array to a hash and take the values:
#even_elements = values %{{#array}};
#odd_elements = keys %{{#array}};
(No, this is not a serious answer)
Another way would be by using grep:
my #array = qw( zero one two three four five six );
print map { "$_ " } #array[grep { !($_ & 1) } 0 .. $#array]; #even
Output:zero two four six
print map { "$_ " } #array[grep { ($_ & 1) } 0 .. $#array]; #odd
Output:one three five
If you don't mind using an obscure feature of $| you can do this:
{
local $|; # don't mess with global $|
#ar = ( "zero", "one", "two", "three", "four", "five", "six" );
$| = 0;
#even = grep --$|, #ar;
$| = 1;
#odd = grep --$|, #ar;
print "even: #even\\n";
# even: zero two four six
print "odd: #odd\\n";
# odd: one three five
}
or, as a 1 liner:
{ local $|=0; #even = grep --$|, #ar; }
Basically, --$| flip flops between a 0 and 1 value (despite the -- which normally decrements a numeric value), so grep sees a "true" value every other time, thus causing it to return every other item starting with the initial value of $|. Note that you must start with 0 or 1, not some arbitrary index.
Here is the simplest code without creating any index arrays:
sub even { my $f=0; return grep {++$f%2} #_; }
sub odd { my $f=1; return grep {++$f%2} #_; }

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.