NAME

Algorithm::Loops - Looping constructs: NestedLoops, MapCar*, Filter, and NextPermute*

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 feel for how the functions are typically used.

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 use Algorithm::Loops statement so that whoever ends up maintaining your code can figure out which module you got these functions from.

Filter: Similar to map but designed for use with s/// and other reflexive operations. Returns a modified copy of a list.
MapCar, MapCarU, MapCarE, and MapCarMin: All similar to map but loop over multiple lists at the same time.
NextPermute and NextPermuteNum: Efficiently find all (unique) permutations of a list, even if it contains duplicate values.
NestedLoops: Simulate foreach loops nested arbitrarily deep.

Filter(\&@)

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.

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.

For each value in the passed-in list, a copy of the value is placed into $_ and then your CODE reference is called. Your subroutine is expected to modify $_ and this modified value is then placed into the list of values to be returned by Filter.

If used in a scalar context, Filter returns a single string that is the result of:

$string= join "", @results;

Note that no arguments are passed to your subroutine (so don't bother with @_) and any value returned by your subroutine is ignored.

Filter's prototype also means that you can use the "map BLOCK"-like syntax by leaving off the sub keyword if you also leave off the comma after the block that defines your anonymous subroutine:

      my @copy= Filter sub {s/\s/_/g}, @list;
# becomes:            v^^^       v   ^
      my @copy= Filter {s/\s/_/g} @list;

Most of our examples will use this shorter syntax.

Note also that by importing Filter via the use statement:

use Algorithm::Loops qw( Filter );

it gets declared before the rest of our code is compiled so we don't have to use parentheses when calling it. We can if we want to, however:

my @copy= Filter( sub {s/\s/_/g}, @list );

Note on "Function BLOCK LIST" bugs

Note that in at least some versions of Perl, support for the "Filter BLOCK ..." syntax is somewhat fragile. For example:

... Filter( {y/aeiou/UAEIO/} @list );

may give you this error:

Array found where operator expected

which can be fixed by dropping the parentheses:

... Filter {y/aeiou/UAEIO/} @list;

So if you need or want to use parentheses when calling Filter, it is best to also include the sub keyword and the comma:

#         v <--------- These ---------> v
... Filter( sub {y/aeiou/UAEIO/}, @list );
# require   ^^^ <--- these ---> ^ (sometimes)

so your code will be portable to more versions of Perl.

Examples

Good code ignores "invisible" characters. So instead of just chomp()ing, consider removing all trailing whitespace:

my @lines= Filter { s/\s+$// } <IN>;

my $line= Filter { s/\s+$// } scalar <IN>;

[ Note that Filter can be used in a scalar context but always puts its arguments in a list context. So we need to use scalar or something similar if we want to read only one line at a time from IN above. ]

Want to sort strings that contain mixtures of letters and natural numbers (non-negative integers) both alphabetically and numerically at the same time? This simple way to do a "natural" sort is also one of the fastest. Great for sorting version numbers, file names, etc.:

my @sorted= Filter {
    s#\d{2}(\d+)#\1#g
} sort Filter {
    s#(\d+)# sprintf "%02d%s", length($1), $1 #g
} @data;

[ Note that at least some versions of Perl have a bug that breaks sort if you write sub { as part of building the list of items to be sorted but you don't provide a comparison routine. This bug means we can't write the previous code as:

my @sorted= Filter {
    s#\d{2}(\d+)#\1#g
} sort Filter sub {
    s#(\d+)# sprintf "%02d%s", length($1), $1 #g
}, @data;

because it will produce the following error:

Undefined subroutine in sort

in some versions of Perl. Some versions of Perl may even require you to write it like this:

my @sorted= Filter {
    s#\d{2}(\d+)#\1#g
} sort &Filter( sub {
    s#(\d+)# sprintf "%02d%s", length($1), $1 #g
}, @data );

Which is how I wrote it in ex/NaturalSort.plx. ]

Need to sort names? Then you'll probably want to ignore letter case and certain punctuation marks while still preserving both:

my @compare= Filter {tr/A-Z'.,"()/a-z/d} @names;
my @indices= sort {$compare[$a] cmp $compare[$b]} 0..$#names;
@names= @names[@indices];

You can also roll your own simple HTML templating:

print Filter {
    s/%(\w*)%/expand($1)/g
}   $cgi->...,
    ...
    $cgi->...;

Note that it also also works correctly if you change how you output your HTML and accidentally switch from list to scalar context:

my $html= '';
...
$html .= Filter {
    s/%(\w*)%/expand($1)/g
}   $cgi->...,
    ...
    $cgi->...;

Motivation

A reasonable use of map is:

@copy= map {lc} @list;

which sets @copy to be a copy of @list but with all of the elements converted to lower case. But it is too easy to think that that could also be done like this:

@copy= map {tr/A-Z/a-z/} @list;  # Wrong

The reason why these aren't the same is similar to why we write:

$str= lc $str;

not

lc $str;  # Useless use of 'lc' in void context

and we write:

$str =~ tr/A-Z/a-z/;

not

$new= ( $old =~ tr/A-Z/a-z/ );  # Wrong

That is, many things (such as lc) return a modified copy of what they are given, but a few things (such as tr///, s///, chop, and chomp) modify what they are given in-place.

This distinction is so common that we have several ways of switching between the two forms. For example:

      $two= $one + $other;
# vs.
      $one += $other;

      $two= substr($one,0,4);
# vs.
      substr($one,4)= '';

I've even heard talk of adding some syntax to Perl to allow you to make things like lc become reflexive, similar to how += is the reflexive form of +.

But while many non-reflexive Perl operations have reflexive counterparts, there are a few reflexive Perl operations that don't really have non-reflexive counterparts: s///, tr///, chop, chomp.

You can write:

      my $line= <STDIN>;
      chomp( $line );
# or
      chomp( my $line= <STDIN> );

but it somehow seems more natural to write:

my $line= chomp( <STDIN> );  # Wrong

So, if you dislike hiding the variable declaration inside of a function call or dislike using two lines and repeating the variable name, then you can now use:

my $line= Filter {chomp} ''.<STDIN>;

[ I used ''. to provide a scalar context so that only one line is read from STDIN. ]

Or, for a better example, consider these valid alternatives:

      my @lines= <STDIN>;
      chomp( @lines );
# or
      chomp( my @lines= <STDIN> );

And what you might expect to work (but doesn't):

my @lines= chomp( <STDIN> );  # Wrong

And what you can now use instead:

my @lines= Filter {chomp} <STDIN>;

Here are some examples of ways to use map/grep correctly to get Filter's functionality:

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

You can also use for/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;
      }

MapCar*

MapCar(\&@)
MapCarU(\&@)
MapCarE(\&@)
MapCarMin(\&@)

Usage

The MapCar* functions are all like 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 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 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 map return a count when called in a scalar context is quite simply a mistake that was made when this feature was copied from 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-: ]

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 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 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 ),
  MySub( 3, 8 ),
)

While

MapCarMin \&MySub, [1,undef,3], [4,5], [6,7,8]

returns

( MySub( 1, 4, 6 ),
  MySub( undef, 5, 7 ),
)

And

MapCarE \&MySub, [1,undef,3], [4,5], [6,7,8]

dies with

MapCarE: Arrays with different sizes (3 and 2)

Examples

Transposing a two-dimensional matrix:

my @transposed= MapCarE {[@_]} @matrix;

or, using references to the matrices and allowing for different row lengths:

my $transposed= MapCarU {[@_]} @$matrix;

Formatting a date-time:

my $dateTime= join '', MapCarE {
    sprintf "%02d%s", pop()+pop(), pop()
} [ (localtime)[5,4,3,2,1,0] ],
  [ 1900, 1, (0)x4 ],
  [ '// ::' =~ /./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 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";

NextPermute*

NextPermute(\@)
NextPermuteNum(\@)

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

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

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 @{ } when calling a NextPermute* routine:

} while(  NextPermute( @{$av} )  );

(or use one of several other techniques which I will leave the consideration of as an "exercise" for the more advanced readers of this manual).

Note that this particular use of a function prototype is one that I am not completely comfortable with. I am tempted to remove the prototype and force you to create the reference yourself before/when calling these functions:

} while(  NextPermute( \@list )  );   # Wrong

because

It makes it obvious to the reader of the code that a reference to the array is what is being used by the routine. This makes the reader more likely to realize/suspect that the array is being modified in-place.
Many/most uses of Perl function prototypes are more trouble than they are worth. This makes using even the less problematic cases often not a good idea.

However, I have decided to use a prototype here because:

Several other functions from this module already use prototypes to good advantage, enough advantage that I'd hate to lose it.
Removing the prototype would require the addition of argument-checking code that would get run each time a permutation is computed, somewhat slowing down what is currently quite fast.
The compile-time checking provided by the prototype can save develop time over a run-time check by pointing out mistakes sooner.

Features

There are several features to NextPermute* that can be advantages over other methods of finding permutations.

Iterators - No huge memory requirements

Some permutation generators return the full set of all permutations (as a huge list of lists). Your input list doesn't have to be very big at all for the resulting set to be too large to fit in your available memory.

So the NextPermute* routines return each permutation, one at a time, so you can process them all (eventually) without the need for lots of memory.

A programming object that gives you access to things one-at-a-time is called an "iterator".

No context - Hardly any memory required

The NextPermute* routines require no extra memory in the way of context or lists to keep track of while constructing the permutations.

Each call to a NextPermute* routine shuffles the items in the list in-place, never making copies of more than a couple of values at a time (when it swaps them).

[ This also means you don't have to bother with creating an object to do the iterating. ]

Handles duplicate values

Unlike most permutation generators you are likely to find in Perl, both NextPermute* routines correctly deal with lists containing duplicate values.

The following example:

my @list= ( 3, 3, 3, 3 );
do {
    print "@list\n";
} while(  NextPermute( @list )  );

will only print the one line, "3 3 3 3\n", because NextPermute() quickly determines that there are no other unique permutations.

Try out the demonstration program included in the "ex" subdirectory of the source distribution of this module:

> perl ex/Permute.plx tool
1: loot
2: loto
3: ltoo
4: olot
5: olto
6: oolt
7: ootl
8: otlo
9: otol
10: tloo
11: tolo
12: tool

Most permutation generators would have listed each of those twice (thinking that swapping an "o" with another "o" made a new permutation). Or consider:

> perl ex/Permute.plx noon
1: nnoo
2: nono
3: noon
4: onno
5: onon
6: oonn

Most permutation generators would have listed each of those four times.

Note that using a hash to eliminate duplicates would require a hash table big enough to hold all of the (unique) permutations and so would defeat the purpose of iterating. NextPermute* does not use a hash to avoid duplicates.

Generated in sorted order

If you were to run code like:

my @list= sort GetValuesSomehow();
do {
    print join('',@lista, $/);
} while(  NextPermute( @list )  );

then the lines output would be sorted (assuming none of the values in @list contained newlines. This may be convenient in some corcumstances.

That is, the permutations are generated in sorted order. The first permutations have the lowest values at the front of the list. As you iterate, larger values are shifted to be in front of smaller values, starting at the back of the list. So the value at the very front of the list will change the fewest times (once for each unique value in the list), while the value at the very end of the list changes between most iterations.

Fast

If you don't have to deal with duplicate values, then Algorithm::Permute provides some routines written in C (which makes them harder to install but about twice as fast to run as the NextPermute* routines) that you can use.

Algorithm::Permute also includes some fun benchmarks comparing different Perl ways of finding permutations. I found NextPermute to be faster than any of the routines included in those benchmarks except for the ones written in C that I mentioned above. Though none of the benchmarked routines deal with duplicates.

Notes

Note that NextPermute() considers two values (say $x and $y) to be duplicates if (and only if) $x eq $y.

NextPermuteNum() considers $x and $y to be duplicates if $x == $y.

If you have a list of floating point numbers to permute, you might want to use NextPermute() [instead of NextPermuteNum()] as it is easy to end up with $x and $y that both display the same (say as "0.1") but are just barely not equal numerically. Thus $x and $y would look equal and it would be true that $x eq $y but also true that $x != $y. So NextPermute() would consider them to be duplicates but NextPermuteNum() would not.

For example, $x could be slightly more than 1/10, likely about 0.1000000000000000056, while $y is slightly more at about 0.0999999999999999917 (both of which will be displayed as "0.1" by Perl and be considered eq (on most platforms):

> perl -w -Mstrict
my $x= 0.1000000000000000056;
my $y= 0.0999999999999999917;
print "x=$x\ny=$y\n";
print "are eq\n"   if  $x eq $y;
print "are ==\n"   if  $x == $y;
print "are !=\n"   if  $x != $y;
<EOF>
x=0.1
y=0.1
are eq
are !=

NestedLoops

Introduction

Makes it easy to simulate loops nested to an arbitrary depth.

It is easy to write code like:

for my $a (  0..$N  ) {
 for my $b (  $a+1..$N  ) {
  for my $c (  $b+1..$N  ) {
      Stuff( $a, $b, $c );
  }
 }
}

But what if you want the user to tell you how many loops to nest together? The above code can be replaced with:

use Algorithm::Loops qw( NestedLoops );

my $depth= 3;
NestedLoops(
    [   [ 0..$N ],
        ( sub { [$_+1..$N] } ) x ($depth-1),
    ],
    \&Stuff,
);

Then you only have to change $depth to 4 to get the same results as:

for my $a (  0..$N  ) {
 for my $b (  $a+1..$N  ) {
  for my $c (  $b+1..$N  ) {
   for my $d (  $c+1..$N  ) {
      Stuff( $a, $b, $c, $d );
   }
  }
 }
}

Usage

The first argument to NestedLoops() is required and must be a reference to an array. Each element of the array specifies the values for a single loop to iterate over. The first element describes the outermost loop. The last element describes the innermost loop.

If the next argument to NestedLoops is a hash reference, then it specifies more advanced options. This argument can be omitted if you don't need it.

If the last argument to NestedLoops is a code reference, then it will be run inside the simulated loops. If you don't pass in this code reference, then NestedLoops returns an iterator (described later) so you can iterate without the restrictions of using a call-back.

So the possible ways to call NestedLoops are:

$iter= NestedLoops( \@Loops );
$iter= NestedLoops( \@Loops, \%Opts );
...    NestedLoops( \@Loops, \%Opts, \&Code );
...    NestedLoops( \@Loops,         \&Code );

The "..."s above show that, when the final code reference is provided, NestedLoops can return a few different types of information.

In a void context, NestedLoops simply iterates and calls the provided code, discarding any values it returns. (Calling NestedLoops in a void context without passing a final code reference is a fatal error.)

In a list context, NestedLoops pushes the values returned by each call to \&Code onto an array and then returns (copies of the values from) that array.

In a scalar contetx, NestedLoops keeps a running total of the number of values returned by each call to \&Code and then returns this total. The value is the same as if you had called NestedLoops in a list context and counted the number of values returned (except for using less memory).

Note that \&Code is called in a list context no matter what context NestedLoops was called in (in the current implementation).

In summary:

NestedLoops( \@loops, \%opts, \&code );
$count= NestedLoops( \@loops, \%opts, \&code );
@results= NestedLoops( \@loops, \%opts, \&code );

\@Loops

Each element of @Loops can be

an array refernce: which means the loop will iterate over the elements of that array,
a code refernce: to a subroutine that will return a reference to the array to loop over.

You don't have to use a reference to a named array. You can, of course, construct a reference to an anonymous array using [...], as shown in most of the examples. You can also use any other type of expression that rerurns an array reference.

\%Opts

If %Opts is passed in, then it should only zero or more of the following keys. How NestedLoops interprets the values associated with each key are described below.

OnlyWhen => $Boolean

OnlyWhen => \&Test

Value must either be a Boolean value or a reference to a subroutine that will return a Boolean value.

Specifying a true value is the same as specifying a routine that always returns a true value. Specifying a false value gives you the default behavior (as if you did not include the OnlyWhen key at all).

If it is a code reference, then it is called each time a new item is selected by any of the loops. The list of selected items is passed in.

The Boolean value returned says whether to use the list of selected values. That is, a true value causes either \&Code to be called (if specified) or the list to be returned by the iterator (if \&Code was not specified).

If this key does not exist (or is specified with a false value), then a default subroutine is used, like:

sub { return @_ == @Loops }

That is, only complete lists are used (by default). So:

my @list= NestedLoops(
    [  ( [ 1..3 ] ) x 3  ],
    {  OnlyWhen => 0  },
    sub { "@_" },
);

is similar to:

my @list= qw/ 111 112 113 121 122 123 131 132 133 211 212 ... /;

while

my @list= NestedLoops(
    [  ( [ 1..3 ] ) x 3  ],
    {  OnlyWhen => 1  },
    sub { "@_" },
);

is similar to:

my @list= qw/ 1 11 111 112 113 12 121 122 123
              13 131 132 133 2 21 211 212 ... /;

Another example:

NestedLoops(
    [  ( [ 1..3 ] ) x 3  ],
    { OnlyWhen => 1 },
    \&Stuff,
);

is similar to:

for my $a (  1..3  ) {
    Stuff( $a );
    for my $b (  1..3  ) {
        Stuff( $a, $b );
        for my $c (  1..3  ) {
            Stuff( $a, $b, $c );
        }
    }
}

Last example:

NestedLoops(
    [  ( [ 1..3 ] ) x 3  ],
    { OnlyWhen => \&Test },
    \&Stuff,
);

is similar to:

for my $a (  1..3  ) {
    Stuff( $a )   if  Test( $a );
    for my $b (  1..3  ) {
        Stuff( $a, $b )   if  Test( $a, $b );
        for my $c (  1..3  ) {
            Stuff( $a, $b, $c )
                if  Test( $a, $b, $c );
        }
    }
}

\&Code

The subroutine that gets called for each iteration.

Iterator

If you don't pass in a final code reference to NestedLoops, then NestedLoops will return an iterator to you (without having performed any iterations yet).

The iterator is a code reference. Each time you call it, it returns the next list of selected values. Any arguments you pass in are ignored (at least in this release).

Examples

Finding non-repeating sequences of digits.

One way would be to loop over all digit combinations but only selecting ones without repeats:

use Algorithm::Loops qw/ NestedLoops /;
$|= 1;
my $len= 3;
my $verbose= 1;
my $count= NestedLoops(
    [   ( [0..9] ) x $len  ],
    {   OnlyWhen => sub {
                $len == @_
            &&  join('',@_) !~ /(.).*?\1/;
        #or &&  @_ == keys %{{@_,reverse@_}};
        }
    },
    sub {
        print "@_\n"   if  $verbose;
        return 1;
    },
);
print "$count non-repeating $len-digit sequences.\n";

0 1 2
0 1 3
0 1 4
0 1 5
0 1 6
0 1 7
0 1 8
0 1 9
0 2 1
...
9 8 5
9 8 6
9 8 7
720 non-repeating 3-digit sequences.

But it would be nice to not waste time looping over, for example (2,1,2,0,0) through (2,1,2,9,9). That is, don't even pick 2 as the third value if we already picked 2 as the first.

A clever way to do that is to only iterate over lists where the digits increase from left to right. That will give us all sets of non-repeating digits and then we find all permutations of each:

use Algorithm::Loops qw/ NestedLoops NextPermute /;
$|= 1;
my $len= 3;
my $verbose= 1;
my $iter= NestedLoops(
    [   [0..9],
        ( sub { [$_+1..9] } ) x ($len-1),
    ],
);
my $count= 0;
my @list;
while(  @list= $iter->()  ) {
    do {
        ++$count;
        print "@list\n"   if  $verbose;
    } while( NextPermute(@list) );
}
print "$count non-repeating $len-digit sequences.\n";

0 1 2
0 2 1
1 0 2
1 2 0
2 0 1
2 1 0
0 1 3
0 3 1
1 0 3
1 3 0
3 0 1
3 1 0
0 1 4
0 4 1
...
9 6 8
9 8 6
7 8 9
7 9 8
8 7 9
8 9 7
9 7 8
9 8 7
720 non-repeating 3-digit sequences.

A third way is to construct the list of values to loop over by excluding values already selected:

use Algorithm::Loops qw/ NestedLoops /;
$|= 1;
my $len= 3;
my $verbose= 1;
my $count= NestedLoops(
    [   [0..9],
        ( sub {
            my %used;
            @used{@_}= (1) x @_;
            return [ grep !$used{$_}, 0..9 ];
        } ) x ($len-1),
    ],
    sub {
        print "@_\n"   if  $verbose;
        return 1;
    },
);
print "$count non-repeating $len-digit sequences.\n";

0 1 2
0 1 3
0 1 4
0 1 5
0 1 6
0 1 7
0 1 8
0 1 9
0 2 1
0 2 3
...
9 7 8
9 8 0
9 8 1
9 8 2
9 8 3
9 8 4
9 8 5
9 8 6
9 8 7
720 non-repeating 3-digit sequences.

Future releases of this module may add features to makes these last two methods easier to write.

1 POD Error

The following errors were encountered while parsing the POD:

Around line 955:: '=item' outside of any '=over'

To install Algorithm::Loops, copy and paste the appropriate command in to your terminal.

cpanm

cpanm Algorithm::Loops

CPAN shell

perl -MCPAN -e shell
install Algorithm::Loops

For more information on module installation, please visit the detailed CPAN module installation guide.

	Global
`s`	Focus search bar
`?`	Bring up this help dialog

	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)

	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse

	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)

NAME

SYNOPSYS

FUNCTIONS

Filter(\&@)

Overview

Usage

Note on "Function BLOCK LIST" bugs

Examples

Motivation

MapCar*

Usage

Differences

Examples

NextPermute*

Introduction

Usage

Notes

Features

Notes

NestedLoops

Introduction

Usage

\@Loops

\%Opts

\&Code

Iterator

Examples

Finding non-repeating sequences of digits.

Module Install Instructions