Algorithm-Loops
view release on metacpan or search on metacpan
lib/Algorithm/Loops.pm view on Meta::CPAN
{
my( $loops, $code, $when )= _NL_Args( @_ );
my $iter= _NL_Iter( $loops, $code, $when );
if( ! $code ) {
if( ! defined wantarray ) {
_Croak( "Useless in void context",
" when no code given" );
}
return $iter;
}
my @ret;
my @list;
while( @list= $iter->() ) {
@list= $code->( @list );
if( wantarray ) {
push @ret, @list;
} else {
$ret[0] += @list;
}
}
return wantarray ? @ret : ( $ret[0] || 0 );
}
"Filtering should not be straining";
__END__
=head1 NAME
Algorithm::Loops - Looping constructs:
NestedLoops, MapCar*, Filter, and NextPermute*
=head1 SYNOPSYS
use Algorithm::Loops qw(
Filter
MapCar MapCarU MapCarE MapCarMin
NextPermute NextPermuteNum
NestedLoops
);
my @copy= Filter {tr/A-Z'.,"()/a-z/d} @list;
my $string= Filter {s/\s*$/ /} @lines;
my @transposed= MapCarU {[@_]} @matrix;
my @list= sort getList();
do {
usePermutation( @list );
} while( NextPermute( @list ) );
my $len= @ARGV ? $ARGV[0] : 3;
my @list= NestedLoops(
[ ( [ 1..$len ] ) x $len ],
sub { "@_" },
);
If you want working sample code to try, see below in the section specific
to the function(s) you want to try. The above samples only give a
I<feel> for how the functions are typically used.
=head1 FUNCTIONS
Algorithm::Loops provides the functions listed below. By default, no
functions are exported into your namespace (package / symbol table) in
order to encourage you to list any functions that you use in the C<use
Algorithm::Loops> statement so that whoever ends up maintaining your code
can figure out which module you got these functions from.
=over 4
=item Filter
Similar to C<map> but designed for use with s/// and other reflexive
operations. Returns a modified copy of a list.
=item MapCar, MapCarU, MapCarE, and MapCarMin
All similar to C<map> but loop over multiple lists at the same time.
=item NextPermute and NextPermuteNum
Efficiently find all (unique) permutations of a list, even if it contains
duplicate values.
=item NestedLoops
Simulate C<foreach> loops nested arbitrarily deep.
=back
=head2 Filter(\&@)
=head3 Overview
Produces a modified copy of a list of values. Ideal for use with s///.
If you find yourself trying to use s/// or tr/// inside of map (or grep),
then you should probably use Filter instead.
For example:
use Algorithm::Loops qw( Filter );
@copy = Filter { s/\\(.)/$1/g } @list;
$text = Filter { s/^\s+// } @lines;
The same process can be accomplished using a careful and more complex
invocation of map, grep, or foreach. However, many incorrect ways to
attempt this seem rather seductively appropriate so this function helps
to discourage such (rather common) mistakes.
=head3 Usage
Filter has a prototype specification of (\&@).
This means that it demands that the first argument that you pass to it be
a CODE reference. After that you can pass a list of as many or as few
values as you like.
lib/Algorithm/Loops.pm view on Meta::CPAN
Filter { CODE } @list
# vs
join "", map { local($_)= $_; CODE; $_ } @list
# vs
join "", grep { CODE; 1 } @{ [@list] }
Not horribly complex, but enough that it is very easy to forget part of
the solution, making for easy mistakes. I see mistakes related to this
quite frequently and have made such mistakes myself several times.
Some (including me) would even consider the last form above to be an
abuse (or misuse) of C<grep>.
You can also use C<for>/C<foreach> to get the same results as Filter:
my @copy= Filter { CODE } @list;
# vs
STATEMENT foreach my @copy= @list;
# or
my @copy= @list;
foreach( @copy ) {
CODE;
}
=head2 MapCar*
=over 4
=item MapCar(\&@)
=item MapCarU(\&@)
=item MapCarE(\&@)
=item MapCarMin(\&@)
=back
=head3 Usage
The MapCar* functions are all like C<map> except they each loop over more
than one list at the same time.
[ The name "mapcar" comes from LISP. As I understand it, 'car' comes from
the acronym for a register of the processor where LISP was first
developed, one of two registers used to implement lists in LISP. I only
mention this so you won't waste too much time trying to figure out what
"mapcar" is supposed to mean. ]
The MapCar* functions all have prototype specifications of (\&@).
This means that they demand that the first argument that you pass be a
CODE reference. After that you should pass zero or more array references.
Your subroutine is called (in a list context) and is passed the first
element of each of the arrays whose references you passed in (in the
corresponding order). Any value(s) returned by your subroutine are
pushed onto an array that will eventually be returned by MapCar*.
Next your subroutine is called and is passed the B<second> element of
each of the arrays and any value(s) returned are pushed onto the results
array. Then the process is repeated with the B<third> elements.
This continues until your subroutine has been passed all elements [except
for some cases with MapCarMin()]. If the longest array whose reference
you passed to MapCar() or MapCarU() contained $N elements, then your
subroutine would get called $N times.
Finally, the MapCar* function returns the accumulated list of values. If
called in a scalar context, the MapCar* function returns a reference to
an array containing these values.
[ I feel that having C<map> return a count when called in a scalar
context is quite simply a mistake that was made when this feature was
copied from C<grep> without properly considering the consequences.
Although it does make for the impressive and very impractical golf
solution of:
$sum=map{(1)x$_}@ints;
for adding up a list of natural numbers. q-: ]
=head3 Differences
The different MapCar* functions are only different in how they deal with
being pqssed arrays that are not all of the same size.
If not all of your arrays are the same length, then MapCarU() will pass
in C<undef> for any values corresponding to arrays that didn't have
enough values. The "U" in "MapCarU" stands for "undef".
In contrast, MapCar() will simply leave out values for short arrays (just
like I left the "U" out of its name).
MapCarE() will croak without ever calling your subroutine unless all of
the arrays are the same length. It considers it an Error if your arrays
are not of Equal length and so throws an Exception.
Finally, MapCarMin() only calls your subroutine as many times as there
are elements in the B<shortest> array.
In other words,
MapCarU \&MySub, [1,undef,3], [4,5], [6,7,8]
returns
( MySub( 1, 4, 6 ),
MySub( undef, 5, 7 ),
MySub( 3, undef, 8 ),
)
While
MapCar \&MySub, [1,undef,3], [4,5], [6,7,8]
returns
( MySub( 1, 4, 6 ),
MySub( undef, 5, 7 ),
lib/Algorithm/Loops.pm view on Meta::CPAN
[ '// ::' =~ /./g, '' ];
Same thing but not worrying about warnings for using undefined values:
my $dateTime= join '', MapCarU {
sprintf "%02d%s", pop()+pop(), pop()
} [ (localtime)[5,4,3,2,1,0] ],
[ 1900, 1 ],
[ '// ::' =~ /./g ];
Combine with C<map> to do matrix multiplication:
my @X= (
[ 1, 3 ],
[ 4, -1 ],
[ -2, 2 ],
);
my @Y= (
[ -6, 2, 5, -3 ],
[ 4, -1, 3, 1 ],
);
my @prod= map {
my $row= $_;
[
map {
my $sum= 0;
$sum += $_ for MapCarE {
pop() * pop();
} $row, $_;
$sum;
} MapCarE {\@_} @Y;
]
} @X;
Report the top winners:
MapCarMin {
print pop(), " place goes to ", pop(), ".\n";
} [qw( First Second Third Fourth )],
\@winners;
Same thing (scalar context):
my $report= MapCarMin {
pop(), " place goes to ", pop(), ".\n";
} [qw( First Second Third Fourth )],
\@winners;
Displaying a duration:
my $ran= time() - $^T;
my $desc= join ', ', reverse MapCar {
my( $unit, $mult )= @_;
my $part= $ran;
if( $mult ) {
$part %= $mult;
$ran= int( $ran / $mult );
}
$unit .= 's' if 1 != $part;
$part ? "$part $unit" : ();
} [ qw( sec min hour day week year ) ],
[ 60, 60, 24, 7, 52 ];
$desc ||= '< 1 sec';
print "Script ran for $desc.\n";
=head2 NextPermute*
=over 4
=item NextPermute(\@)
=item NextPermuteNum(\@)
=back
=head3 Introduction
If you have a list of values, then a "permutation" of that list is the
same values but not (necessarily) in the same order.
NextPermute() and NextPermuteNum() each provide very efficient ways of
finding all of the (unique) permutations of a list (even if the list
contains duplicate values).
=head3 Usage
Each time you pass an array to a NextPermute* routine, the elements of
the array are shifted around to give you a new permutation. If the
elements of the array are in reverse-sorted order, then the array is
reversed (in-place, making it sorted) and a false value is returned.
Otherwise a true value is returned.
So, if you start out with a sorted array, then you can use that as your
first permutation and then call NextPermute* to get the next permutation
to use, until NextPermute* returns a false value (at which point your
array has been returned to its original, sorted order).
So you would use NextPermute() like this:
my @list= sort GetValuesSomehow();
do {
DoSomethingWithPermutation( @list );
} while( NextPermute( @list ) );
or, if your list only contains numbers, you could use NextPermuteNum()
like this:
my @list= sort {$a<=>$b} GetNumbersSomehow();
do {
DoSomethingWithPermutation( @list );
} while( NextPermuteNum( @list ) );
=head3 Notes
The NextPermute* functions each have a prototype specifications of (\@).
This means that they demand that you pass them a single array which they
will receive a reference to.
If you instead have a reference to an array, you'll need to use C<@{ }>
when calling a NextPermute* routine:
} while( NextPermute( @{$av} ) );
( run in 0.692 second using v1.01-cache-2.11-cpan-39bf76dae61 )