snippet
tye
<b>Update:</b> Now available in several flavors as part of [cpan://Algorithm::Loops].
<p>
[runrig] was complaining about no mapcar in Perl so I wrote one in the chatterbox but it scrolled off. So here are two better versions.<p>
mapcar is from lisp. It is like [map] but works on more than one list. While [map] loops setting $_ to successive elements of a list, mapcar loops setting @_ to successive elements of several lists (but since you can only pass one list to a subroutine, mapcar expects a list of references to one or more arrays). Both [map] and mapcar collect the values returned by the code block or subroutine and then return the collected values.<p>
<code>
# Sample usage:
my @array= ( [ 'a'..'c',undef ], [ 1..7 ], [ 'A'..'E' ] );
my @trans= mapcar { [@_] } @array;
# @transpose is now ( ['a',1,'A'],['b',2,'B'],['c',3,'C'],
# [undef,4,'D'],[5,'E'],[6] )
my @transpose= mapcaru { [@_] } @array;
# @trans is now ( ['a',1,'A'],['b',2,'B'],['c',3,'C'],
# [undef,4,'D'],[undef,5,'E'],[undef,6,undef] )
</code>
So mapcaru puts [undef]s into @_ when one of the lists is shorter than any of the others while mapcar just leaves values out of @_. Both versions are provided since the output of either cannot be easily converted into the other.
<p>
If you find yourself wishing for a special Perl variable that tracks which element of a list you are currently iterating over (in [map] or [for]), then you might find that mapcar is useful to you.
<code>
#!/usr/bin/perl -w
package mapcar;
use strict;
require Exporter;
use vars qw( $VERSION @EXPORT @ISA );
BEGIN {
$VERSION= 1.01;
@EXPORT= qw( mapcar mapcaru );
@ISA= qw( Exporter );
}
sub mapcaru (&@)
{
my $sub= shift;
if( ! @_ ) {
require Carp;
Carp::croak( "mapcaru: Nothing to map" );
}
my $max= 0;
for my $av ( @_ ) {
if( ! UNIVERSAL::isa( $av, "ARRAY" ) ) {
require Carp;
Carp::croak( "mapcaru: Not an array reference (",
ref($av) ? ref($av) : $av, ")" );
}
$max= @$av if $max < @$av;
}
my @ret;
for( my $i= 0; $i < $max; $i++ ) {
push @ret, &$sub( map { $_->[$i] } @_ );
}
return wantarray ? @ret : \@ret;
}
sub mapcar (&@)
{
my $sub= shift;
if( ! @_ ) {
require Carp;
Carp::croak( "mapcar: Nothing to map" );
}
my $max= 0;
for my $av ( @_ ) {
if( ! UNIVERSAL::isa( $av, "ARRAY" ) ) {
require Carp;
Carp::croak( "mapcar: Not an array reference (",
ref($av) ? ref($av) : $av, ")" );
}
$max= @$av if $max < @$av;
}
my @ret;
for( my $i= 0; $i < $max; $i++ ) {
push @ret, &$sub( map { $i < @$_ ? $_->[$i] : () } @_ );
}
return wantarray ? @ret : \@ret;
}
1;
</code>