1Algorithm::Loops(3)   User Contributed Perl Documentation  Algorithm::Loops(3)
2
3
4

NAME

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

SYNOPSYS

10           use Algorithm::Loops qw(
11               Filter
12               MapCar MapCarU MapCarE MapCarMin
13               NextPermute NextPermuteNum
14               NestedLoops
15           );
16
17           my @copy= Filter {tr/A-Z'.,"()/a-z/d} @list;
18           my $string= Filter {s/\s*$/ /} @lines;
19
20           my @transposed= MapCarU {[@_]} @matrix;
21
22           my @list= sort getList();
23           do {
24               usePermutation( @list );
25           } while(  NextPermute( @list )  );
26
27           my $len= @ARGV ? $ARGV[0] : 3;
28           my @list= NestedLoops(
29               [  ( [ 1..$len ] ) x $len  ],
30               sub { "@_" },
31           );
32
33       If you want working sample code to try, see below in the section
34       specific to the function(s) you want to try.  The above samples only
35       give a feel for how the functions are typically used.
36

FUNCTIONS

38       Algorithm::Loops provides the functions listed below.  By default, no
39       functions are exported into your namespace (package / symbol table) in
40       order to encourage you to list any functions that you use in the "use
41       Algorithm::Loops" statement so that whoever ends up maintaining your
42       code can figure out which module you got these functions from.
43
44       Filter
45           Similar to "map" but designed for use with s/// and other reflexive
46           operations.  Returns a modified copy of a list.
47
48       MapCar, MapCarU, MapCarE, and MapCarMin
49           All similar to "map" but loop over multiple lists at the same time.
50
51       NextPermute and NextPermuteNum
52           Efficiently find all (unique) permutations of a list, even if it
53           contains duplicate values.
54
55       NestedLoops
56           Simulate "foreach" loops nested arbitrarily deep.
57
58   Filter(\&@)
59       Overview
60
61       Produces a modified copy of a list of values.  Ideal for use with s///.
62       If you find yourself trying to use s/// or tr/// inside of map (or
63       grep), then you should probably use Filter instead.
64
65       For example:
66
67           use Algorithm::Loops qw( Filter );
68
69           @copy = Filter { s/\\(.)/$1/g } @list;
70           $text = Filter { s/^\s+// } @lines;
71
72       The same process can be accomplished using a careful and more complex
73       invocation of map, grep, or foreach.  However, many incorrect ways to
74       attempt this seem rather seductively appropriate so this function helps
75       to discourage such (rather common) mistakes.
76
77       Usage
78
79       Filter has a prototype specification of (\&@).
80
81       This means that it demands that the first argument that you pass to it
82       be a CODE reference.  After that you can pass a list of as many or as
83       few values as you like.
84
85       For each value in the passed-in list, a copy of the value is placed
86       into $_ and then your CODE reference is called.  Your subroutine is
87       expected to modify $_ and this modified value is then placed into the
88       list of values to be returned by Filter.
89
90       If used in a scalar context, Filter returns a single string that is the
91       result of:
92
93           $string= join "", @results;
94
95       Note that no arguments are passed to your subroutine (so don't bother
96       with @_) and any value "return"ed by your subroutine is ignored.
97
98       Filter's prototype also means that you can use the "map BLOCK"-like
99       syntax by leaving off the "sub" keyword if you also leave off the comma
100       after the block that defines your anonymous subroutine:
101
102               my @copy= Filter sub {s/\s/_/g}, @list;
103         # becomes:            v^^^       v   ^
104               my @copy= Filter {s/\s/_/g} @list;
105
106       Most of our examples will use this shorter syntax.
107
108       Note also that by importing Filter via the "use" statement:
109
110           use Algorithm::Loops qw( Filter );
111
112       it gets declared before the rest of our code is compiled so we don't
113       have to use parentheses when calling it.  We can if we want to,
114       however:
115
116               my @copy= Filter( sub {s/\s/_/g}, @list );
117
118       Note on "Function BLOCK LIST" bugs
119
120       Note that in at least some versions of Perl, support for the "Filter
121       BLOCK ..." syntax is somewhat fragile.  For example:
122
123           ... Filter( {y/aeiou/UAEIO/} @list );
124
125       may give you this error:
126
127           Array found where operator expected
128
129       which can be fixed by dropping the parentheses:
130
131           ... Filter {y/aeiou/UAEIO/} @list;
132
133       So if you need or want to use parentheses when calling Filter, it is
134       best to also include the "sub" keyword and the comma:
135
136           #         v <--------- These ---------> v
137           ... Filter( sub {y/aeiou/UAEIO/}, @list );
138           # require   ^^^ <--- these ---> ^ (sometimes)
139
140       so your code will be portable to more versions of Perl.
141
142       Examples
143
144       Good code ignores "invisible" characters.  So instead of just
145       chomp()ing, consider removing all trailing whitespace:
146
147           my @lines= Filter { s/\s+$// } <IN>;
148
149       or
150
151           my $line= Filter { s/\s+$// } scalar <IN>;
152
153       [ Note that Filter can be used in a scalar context but always puts its
154       arguments in a list context.  So we need to use "scalar" or something
155       similar if we want to read only one line at a time from "IN" above. ]
156
157       Want to sort strings that contain mixtures of letters and natural
158       numbers (non-negative integers) both alphabetically and numerically at
159       the same time?  This simple way to do a "natural" sort is also one of
160       the fastest.  Great for sorting version numbers, file names, etc.:
161
162           my @sorted= Filter {
163               s#\d{2}(\d+)#\1#g
164           } sort Filter {
165               s#(\d+)# sprintf "%02d%s", length($1), $1 #g
166           } @data;
167
168       [ Note that at least some versions of Perl have a bug that breaks
169       "sort" if you write "sub {" as part of building the list of items to be
170       sorted but you don't provide a comparison routine.  This bug means we
171       can't write the previous code as:
172
173           my @sorted= Filter {
174               s#\d{2}(\d+)#\1#g
175           } sort Filter sub {
176               s#(\d+)# sprintf "%02d%s", length($1), $1 #g
177           }, @data;
178
179       because it will produce the following error:
180
181           Undefined subroutine in sort
182
183       in some versions of Perl.  Some versions of Perl may even require you
184       to write it like this:
185
186           my @sorted= Filter {
187               s#\d{2}(\d+)#\1#g
188           } sort &Filter( sub {
189               s#(\d+)# sprintf "%02d%s", length($1), $1 #g
190           }, @data );
191
192       Which is how I wrote it in ex/NaturalSort.plx. ]
193
194       Need to sort names?  Then you'll probably want to ignore letter case
195       and certain punctuation marks while still preserving both:
196
197           my @compare= Filter {tr/A-Z'.,"()/a-z/d} @names;
198           my @indices= sort {$compare[$a] cmp $compare[$b]} 0..$#names;
199           @names= @names[@indices];
200
201       You can also roll your own simple HTML templating:
202
203           print Filter {
204               s/%(\w*)%/expand($1)/g
205           }   $cgi->...,
206               ...
207               $cgi->...;
208
209       Note that it also also works correctly if you change how you output
210       your
211           HTML and accidentally switch from list to scalar context:
212
213           my $html= '';
214           ...
215           $html .= Filter {
216               s/%(\w*)%/expand($1)/g
217           }   $cgi->...,
218               ...
219               $cgi->...;
220
221       Motivation
222
223       A reasonable use of map is:
224
225           @copy= map {lc} @list;
226
227       which sets @copy to be a copy of @list but with all of the elements
228       converted to lower case.  But it is too easy to think that that could
229       also be done like this:
230
231           @copy= map {tr/A-Z/a-z/} @list;  # Wrong
232
233       The reason why these aren't the same is similar to why we write:
234
235           $str= lc $str;
236
237       not
238
239           lc $str;  # Useless use of 'lc' in void context
240
241       and we write:
242
243           $str =~ tr/A-Z/a-z/;
244
245       not
246
247           $new= ( $old =~ tr/A-Z/a-z/ );  # Wrong
248
249       That is, many things (such as lc) return a modified copy of what they
250       are given, but a few things (such as tr///, s///, chop, and chomp)
251       modify what they are given in-place.
252
253       This distinction is so common that we have several ways of switching
254       between the two forms.  For example:
255
256               $two= $one + $other;
257         # vs.
258               $one += $other;
259
260       or
261
262               $two= substr($one,0,4);
263         # vs.
264               substr($one,4)= '';
265
266       I've even heard talk of adding some syntax to Perl to allow you to make
267       things like "lc" become reflexive, similar to how += is the reflexive
268       form of +.
269
270       But while many non-reflexive Perl operations have reflexive
271       counterparts, there are a few reflexive Perl operations that don't
272       really have non-reflexive counterparts: s///, tr///, chop, chomp.
273
274       You can write:
275
276               my $line= <STDIN>;
277               chomp( $line );
278         # or
279               chomp( my $line= <STDIN> );
280
281       but it somehow seems more natural to write:
282
283               my $line= chomp( <STDIN> );  # Wrong
284
285       So, if you dislike hiding the variable declaration inside of a function
286       call or dislike using two lines and repeating the variable name, then
287       you can now use:
288
289               my $line= Filter {chomp} ''.<STDIN>;
290
291       [ I used "''." to provide a scalar context so that only one line is
292       read from STDIN. ]
293
294       Or, for a better example, consider these valid alternatives:
295
296               my @lines= <STDIN>;
297               chomp( @lines );
298         # or
299               chomp( my @lines= <STDIN> );
300
301       And what you might expect to work (but doesn't):
302
303               my @lines= chomp( <STDIN> );  # Wrong
304
305       And what you can now use instead:
306
307               my @lines= Filter {chomp} <STDIN>;
308
309       Here are some examples of ways to use map/grep correctly to get
310       Filter's functionality:
311
312               Filter { CODE } @list
313         # vs
314               join "", map { local($_)= $_; CODE; $_ } @list
315         # vs
316               join "", grep { CODE; 1 } @{ [@list] }
317
318       Not horribly complex, but enough that it is very easy to forget part of
319       the solution, making for easy mistakes.  I see mistakes related to this
320       quite frequently and have made such mistakes myself several times.
321
322       Some (including me) would even consider the last form above to be an
323       abuse (or misuse) of "grep".
324
325       You can also use "for"/"foreach" to get the same results as Filter:
326
327               my @copy= Filter { CODE } @list;
328         # vs
329               STATEMENT  foreach  my @copy= @list;
330         # or
331               my @copy= @list;
332               foreach(  @copy  ) {
333                   CODE;
334               }
335
336   MapCar*
337       MapCar(\&@)
338       MapCarU(\&@)
339       MapCarE(\&@)
340       MapCarMin(\&@)
341
342       Usage
343
344       The MapCar* functions are all like "map" except they each loop over
345       more than one list at the same time.
346
347       [ The name "mapcar" comes from LISP. As I understand it, 'car' comes
348       from the acronym for a register of the processor where LISP was first
349       developed, one of two registers used to implement lists in LISP.  I
350       only mention this so you won't waste too much time trying to figure out
351       what "mapcar" is supposed to mean. ]
352
353       The MapCar* functions all have prototype specifications of (\&@).
354
355       This means that they demand that the first argument that you pass be a
356       CODE reference.  After that you should pass zero or more array
357       references.
358
359       Your subroutine is called (in a list context) and is passed the first
360       element of each of the arrays whose references you passed in (in the
361       corresponding order).  Any value(s) returned by your subroutine are
362       pushed onto an array that will eventually be returned by MapCar*.
363
364       Next your subroutine is called and is passed the second element of each
365       of the arrays and any value(s) returned are pushed onto the results
366       array.  Then the process is repeated with the third elements.
367
368       This continues until your subroutine has been passed all elements
369       [except for some cases with MapCarMin()].  If the longest array whose
370       reference you passed to MapCar() or MapCarU() contained $N elements,
371       then your subroutine would get called $N times.
372
373       Finally, the MapCar* function returns the accumulated list of values.
374       If called in a scalar context, the MapCar* function returns a reference
375       to an array containing these values.
376
377       [ I feel that having "map" return a count when called in a scalar
378       context is quite simply a mistake that was made when this feature was
379       copied from "grep" without properly considering the consequences.
380       Although it does make for the impressive and very impractical golf
381       solution of:
382
383           $sum=map{(1)x$_}@ints;
384
385       for adding up a list of natural numbers. q-: ]
386
387       Differences
388
389       The different MapCar* functions are only different in how they deal
390       with being pqssed arrays that are not all of the same size.
391
392       If not all of your arrays are the same length, then MapCarU() will pass
393       in "undef" for any values corresponding to arrays that didn't have
394       enough values.  The "U" in "MapCarU" stands for "undef".
395
396       In contrast, MapCar() will simply leave out values for short arrays
397       (just like I left the "U" out of its name).
398
399       MapCarE() will croak without ever calling your subroutine unless all of
400       the arrays are the same length.  It considers it an Error if your
401       arrays are not of Equal length and so throws an Exception.
402
403       Finally, MapCarMin() only calls your subroutine as many times as there
404       are elements in the shortest array.
405
406       In other words,
407
408           MapCarU \&MySub, [1,undef,3], [4,5], [6,7,8]
409
410       returns
411
412           ( MySub( 1, 4, 6 ),
413             MySub( undef, 5, 7 ),
414             MySub( 3, undef, 8 ),
415           )
416
417       While
418
419           MapCar \&MySub, [1,undef,3], [4,5], [6,7,8]
420
421       returns
422
423           ( MySub( 1, 4, 6 ),
424             MySub( undef, 5, 7 ),
425             MySub( 3, 8 ),
426           )
427
428       While
429
430           MapCarMin \&MySub, [1,undef,3], [4,5], [6,7,8]
431
432       returns
433
434           ( MySub( 1, 4, 6 ),
435             MySub( undef, 5, 7 ),
436           )
437
438       And
439
440           MapCarE \&MySub, [1,undef,3], [4,5], [6,7,8]
441
442       dies with
443
444           MapCarE: Arrays with different sizes (3 and 2)
445
446       Examples
447
448       Transposing a two-dimensional matrix:
449
450           my @transposed= MapCarE {[@_]} @matrix;
451
452       or, using references to the matrices and allowing for different row
453       lengths:
454
455           my $transposed= MapCarU {[@_]} @$matrix;
456
457       Formatting a date-time:
458
459           my $dateTime= join '', MapCarE {
460               sprintf "%02d%s", pop()+pop(), pop()
461           } [ (localtime)[5,4,3,2,1,0] ],
462             [ 1900, 1, (0)x4 ],
463             [ '// ::' =~ /./g, '' ];
464
465       Same thing but not worrying about warnings for using undefined values:
466
467           my $dateTime= join '', MapCarU {
468               sprintf "%02d%s", pop()+pop(), pop()
469           } [ (localtime)[5,4,3,2,1,0] ],
470             [ 1900, 1 ],
471             [ '// ::' =~ /./g ];
472
473       Combine with "map" to do matrix multiplication:
474
475           my @X= (
476               [  1,  3 ],
477               [  4, -1 ],
478               [ -2,  2 ],
479           );
480           my @Y= (
481               [ -6,  2, 5, -3 ],
482               [  4, -1, 3,  1 ],
483           );
484           my @prod= map {
485               my $row= $_;
486               [
487                   map {
488                       my $sum= 0;
489                       $sum += $_   for  MapCarE {
490                           pop() * pop();
491                       } $row, $_;
492                       $sum;
493                   } MapCarE {\@_} @Y;
494               ]
495           } @X;
496
497       Report the top winners:
498
499           MapCarMin {
500               print pop(), " place goes to ", pop(), ".\n";
501           } [qw( First Second Third Fourth )],
502             \@winners;
503
504       Same thing (scalar context):
505
506           my $report= MapCarMin {
507               pop(), " place goes to ", pop(), ".\n";
508           } [qw( First Second Third Fourth )],
509             \@winners;
510
511       Displaying a duration:
512
513           my $ran= time() - $^T;
514           my $desc= join ', ', reverse MapCar {
515               my( $unit, $mult )= @_;
516               my $part= $ran;
517               if(  $mult  ) {
518                   $part %= $mult;
519                   $ran= int( $ran / $mult );
520               }
521               $unit .= 's'   if  1 != $part;
522               $part ? "$part $unit" : ();
523           } [ qw( sec min hour day week year ) ],
524             [     60, 60, 24,   7,  52 ];
525           $desc ||= '< 1 sec';
526           print "Script ran for $desc.\n";
527
528   NextPermute*
529       NextPermute(\@)
530       NextPermuteNum(\@)
531
532       Introduction
533
534       If you have a list of values, then a "permutation" of that list is the
535       same values but not (necessarily) in the same order.
536
537       NextPermute() and NextPermuteNum() each provide very efficient ways of
538       finding all of the (unique) permutations of a list (even if the list
539       contains duplicate values).
540
541       Usage
542
543       Each time you pass an array to a NextPermute* routine, the elements of
544       the array are shifted around to give you a new permutation.  If the
545       elements of the array are in reverse-sorted order, then the array is
546       reversed (in-place, making it sorted) and a false value is returned.
547       Otherwise a true value is returned.
548
549       So, if you start out with a sorted array, then you can use that as your
550       first permutation and then call NextPermute* to get the next
551       permutation to use, until NextPermute* returns a false value (at which
552       point your array has been returned to its original, sorted order).
553
554       So you would use NextPermute() like this:
555
556           my @list= sort GetValuesSomehow();
557           do {
558               DoSomethingWithPermutation( @list );
559           } while(  NextPermute( @list )  );
560
561       or, if your list only contains numbers, you could use NextPermuteNum()
562       like this:
563
564           my @list= sort {$a<=>$b} GetNumbersSomehow();
565           do {
566               DoSomethingWithPermutation( @list );
567           } while(  NextPermuteNum( @list )  );
568
569       Notes
570
571       The NextPermute* functions each have a prototype specifications of
572       (\@).  This means that they demand that you pass them a single array
573       which they will receive a reference to.
574
575       If you instead have a reference to an array, you'll need to use "@{ }"
576       when calling a NextPermute* routine:
577
578           } while(  NextPermute( @{$av} )  );
579
580       (or use one of several other techniques which I will leave the
581       consideration of as an "exercise" for the more advanced readers of this
582       manual).
583
584       Note that this particular use of a function prototype is one that I am
585       not completely comfortable with.  I am tempted to remove the prototype
586       and force you to create the reference yourself before/when calling
587       these functions:
588
589           } while(  NextPermute( \@list )  );   # Wrong
590
591       because
592
593       •   It makes it obvious to the reader of the code that a reference to
594           the array is what is being used by the routine.  This makes the
595           reader more likely to realize/suspect that the array is being
596           modified in-place.
597
598       •   Many/most uses of Perl function prototypes are more trouble than
599           they are worth.  This makes using even the less problematic cases
600           often not a good idea.
601
602       However, I have decided to use a prototype here because:
603
604       •   Several other functions from this module already use prototypes to
605           good advantage, enough advantage that I'd hate to lose it.
606
607       •   Removing the prototype would require the addition of argument-
608           checking code that would get run each time a permutation is
609           computed, somewhat slowing down what is currently quite fast.
610
611       •   The compile-time checking provided by the prototype can save
612           develop time over a run-time check by pointing out mistakes sooner.
613
614       Features
615
616       There are several features to NextPermute* that can be advantages over
617       other methods of finding permutations.
618
619       Iterators - No huge memory requirements
620           Some permutation generators return the full set of all permutations
621           (as a huge list of lists).  Your input list doesn't have to be very
622           big at all for the resulting set to be too large to fit in your
623           available memory.
624
625           So the NextPermute* routines return each permutation, one at a
626           time, so you can process them all (eventually) without the need for
627           lots of memory.
628
629           A programming object that gives you access to things one-at-a-time
630           is called an "iterator".
631
632       No context - Hardly any memory required
633           The NextPermute* routines require no extra memory in the way of
634           context or lists to keep track of while constructing the
635           permutations.
636
637           Each call to a NextPermute* routine shuffles the items in the list
638           in-place, never making copies of more than a couple of values at a
639           time (when it swaps them).
640
641           [ This also means you don't have to bother with creating an object
642           to do the iterating. ]
643
644       Handles duplicate values
645           Unlike most permutation generators you are likely to find in Perl,
646           both NextPermute* routines correctly deal with lists containing
647           duplicate values.
648
649           The following example:
650
651               my @list= ( 3, 3, 3, 3 );
652               do {
653                   print "@list\n";
654               } while(  NextPermute( @list )  );
655
656           will only print the one line, "3 3 3 3\n", because NextPermute()
657           quickly determines that there are no other unique permutations.
658
659           Try out the demonstration program included in the "ex" subdirectory
660           of the source distribution of this module:
661
662               > perl ex/Permute.plx tool
663               1: loot
664               2: loto
665               3: ltoo
666               4: olot
667               5: olto
668               6: oolt
669               7: ootl
670               8: otlo
671               9: otol
672               10: tloo
673               11: tolo
674               12: tool
675
676           Most permutation generators would have listed each of those twice
677           (thinking that swapping an "o" with another "o" made a new
678           permutation).  Or consider:
679
680               > perl ex/Permute.plx noon
681               1: nnoo
682               2: nono
683               3: noon
684               4: onno
685               5: onon
686               6: oonn
687
688           Most permutation generators would have listed each of those four
689           times.
690
691           Note that using a hash to eliminate duplicates would require a hash
692           table big enough to hold all of the (unique) permutations and so
693           would defeat the purpose of iterating.  NextPermute* does not use a
694           hash to avoid duplicates.
695
696       Generated in sorted order
697           If you were to run code like:
698
699               my @list= sort GetValuesSomehow();
700               do {
701                   print join('',@lista, $/);
702               } while(  NextPermute( @list )  );
703
704           then the lines output would be sorted (assuming none of the values
705           in @list contained newlines.  This may be convenient in some
706           corcumstances.
707
708           That is, the permutations are generated in sorted order.  The first
709           permutations have the lowest values at the front of the list.  As
710           you iterate, larger values are shifted to be in front of smaller
711           values, starting at the back of the list.  So the value at the very
712           front of the list will change the fewest times (once for each
713           unique value in the list), while the value at the very end of the
714           list changes between most iterations.
715
716       Fast
717           If you don't have to deal with duplicate values, then
718           Algorithm::Permute provides some routines written in C (which makes
719           them harder to install but about twice as fast to run as the
720           NextPermute* routines) that you can use.
721
722           Algorithm::Permute also includes some fun benchmarks comparing
723           different Perl ways of finding permutations.  I found NextPermute
724           to be faster than any of the routines included in those benchmarks
725           except for the ones written in C that I mentioned above.  Though
726           none of the benchmarked routines deal with duplicates.
727
728       Notes
729
730       Note that NextPermute() considers two values (say $x and $y) to be
731       duplicates if (and only if) "$x eq $y".
732
733       NextPermuteNum() considers $x and $y to be duplicates if "$x == $y".
734
735       If you have a list of floating point numbers to permute, you might want
736       to use NextPermute() [instead of NextPermuteNum()] as it is easy to end
737       up with $x and $y that both display the same (say as "0.1") but are
738       just barely not equal numerically.  Thus $x and $y would look equal and
739       it would be true that "$x eq $y" but also true that "$x != $y".  So
740       NextPermute() would consider them to be duplicates but NextPermuteNum()
741       would not.
742
743       For example, $x could be slightly more than 1/10, likely about
744       0.1000000000000000056, while $y is slightly more at about
745       0.0999999999999999917 (both of which will be displayed as "0.1" by Perl
746       and be considered "eq" (on most platforms):
747
748           > perl -w -Mstrict
749           my $x= 0.1000000000000000056;
750           my $y= 0.0999999999999999917;
751           print "x=$x\ny=$y\n";
752           print "are eq\n"   if  $x eq $y;
753           print "are ==\n"   if  $x == $y;
754           print "are !=\n"   if  $x != $y;
755           <EOF>
756           x=0.1
757           y=0.1
758           are eq
759           are !=
760
761   NestedLoops
762       Introduction
763
764       Makes it easy to simulate loops nested to an arbitrary depth.
765
766       It is easy to write code like:
767
768           for my $a (  0..$N  ) {
769            for my $b (  $a+1..$N  ) {
770             for my $c (  $b+1..$N  ) {
771                 Stuff( $a, $b, $c );
772             }
773            }
774           }
775
776       But what if you want the user to tell you how many loops to nest
777       together?  The above code can be replaced with:
778
779           use Algorithm::Loops qw( NestedLoops );
780
781           my $depth= 3;
782           NestedLoops(
783               [   [ 0..$N ],
784                   ( sub { [$_+1..$N] } ) x ($depth-1),
785               ],
786               \&Stuff,
787           );
788
789       Then you only have to change $depth to 4 to get the same results as:
790
791           for my $a (  0..$N  ) {
792            for my $b (  $a+1..$N  ) {
793             for my $c (  $b+1..$N  ) {
794              for my $d (  $c+1..$N  ) {
795                 Stuff( $a, $b, $c, $d );
796              }
797             }
798            }
799           }
800
801       Usage
802
803       The first argument to NestedLoops() is required and must be a reference
804       to an array.  Each element of the array specifies the values for a
805       single loop to iterate over.  The first element describes the outermost
806       loop.  The last element describes the innermost loop.
807
808       If the next argument to NestedLoops is a hash reference, then it
809       specifies more advanced options.  This argument can be omitted if you
810       don't need it.
811
812       If the last argument to NestedLoops is a code reference, then it will
813       be run inside the simulated loops.  If you don't pass in this code
814       reference, then NestedLoops returns an iterator (described later) so
815       you can iterate without the restrictions of using a call-back.
816
817       So the possible ways to call NestedLoops are:
818
819           $iter= NestedLoops( \@Loops );
820           $iter= NestedLoops( \@Loops, \%Opts );
821           ...    NestedLoops( \@Loops, \%Opts, \&Code );
822           ...    NestedLoops( \@Loops,         \&Code );
823
824       The "..."s above show that, when the final code reference is provided,
825       NestedLoops can return a few different types of information.
826
827       In a void context, NestedLoops simply iterates and calls the provided
828       code, discarding any values it returns.  (Calling NestedLoops in a void
829       context without passing a final code reference is a fatal error.)
830
831       In a list context, NestedLoops "push"es the values returned by each
832       call to \&Code onto an array and then returns (copies of the values
833       from) that array.
834
835       In a scalar contetx, NestedLoops keeps a running total of the number of
836       values returned by each call to \&Code and then returns this total.
837       The value is the same as if you had called NestedLoops in a list
838       context and counted the number of values returned (except for using
839       less memory).
840
841       Note that \&Code is called in a list context no matter what context
842       NestedLoops was called in (in the current implementation).
843
844       In summary:
845
846           NestedLoops( \@loops, \%opts, \&code );
847           $count= NestedLoops( \@loops, \%opts, \&code );
848           @results= NestedLoops( \@loops, \%opts, \&code );
849
850       \@Loops
851
852       Each element of @Loops can be
853
854       an array refernce
855           which means the loop will iterate over the elements of that array,
856
857       a code refernce
858           to a subroutine that will return a reference to the array to loop
859           over.
860
861       You don't have to use a reference to a named array.  You can, of
862       course, construct a reference to an anonymous array using "[...]", as
863       shown in most of the examples.  You can also use any other type of
864       expression that rerurns an array reference.
865
866       \%Opts
867
868       If %Opts is passed in, then it should only zero or more of the
869       following keys.  How NestedLoops interprets the values associated with
870       each key are described below.
871
872       OnlyWhen => $Boolean
873       OnlyWhen => \&Test
874           Value must either be a Boolean value or a reference to a subroutine
875           that will return a Boolean value.
876
877           Specifying a true value is the same as specifying a routine that
878           always returns a true value.  Specifying a false value gives you
879           the default behavior (as if you did not include the OnlyWhen key at
880           all).
881
882           If it is a code reference, then it is called each time a new item
883           is selected by any of the loops.  The list of selected items is
884           passed in.
885
886           The Boolean value returned says whether to use the list of selected
887           values.  That is, a true value causes either \&Code to be called
888           (if specified) or the list to be returned by the iterator (if
889           \&Code was not specified).
890
891           If this key does not exist (or is specified with a false value),
892           then a default subroutine is used, like:
893
894               sub { return @_ == @Loops }
895
896           That is, only complete lists are used (by default).  So:
897
898               my @list= NestedLoops(
899                   [  ( [ 1..3 ] ) x 3  ],
900                   {  OnlyWhen => 0  },
901                   sub { "@_" },
902               );
903
904           is similar to:
905
906               my @list= qw/ 111 112 113 121 122 123 131 132 133 211 212 ... /;
907
908           while
909
910               my @list= NestedLoops(
911                   [  ( [ 1..3 ] ) x 3  ],
912                   {  OnlyWhen => 1  },
913                   sub { "@_" },
914               );
915
916           is similar to:
917
918               my @list= qw/ 1 11 111 112 113 12 121 122 123
919                             13 131 132 133 2 21 211 212 ... /;
920
921           Another example:
922
923               NestedLoops(
924                   [  ( [ 1..3 ] ) x 3  ],
925                   { OnlyWhen => 1 },
926                   \&Stuff,
927               );
928
929           is similar to:
930
931               for my $a (  1..3  ) {
932                   Stuff( $a );
933                   for my $b (  1..3  ) {
934                       Stuff( $a, $b );
935                       for my $c (  1..3  ) {
936                           Stuff( $a, $b, $c );
937                       }
938                   }
939               }
940
941           Last example:
942
943               NestedLoops(
944                   [  ( [ 1..3 ] ) x 3  ],
945                   { OnlyWhen => \&Test },
946                   \&Stuff,
947               );
948
949           is similar to:
950
951               for my $a (  1..3  ) {
952                   Stuff( $a )   if  Test( $a );
953                   for my $b (  1..3  ) {
954                       Stuff( $a, $b )   if  Test( $a, $b );
955                       for my $c (  1..3  ) {
956                           Stuff( $a, $b, $c )
957                               if  Test( $a, $b, $c );
958                       }
959                   }
960               }
961
962       \&Code
963
964       The subroutine that gets called for each iteration.
965
966       Iterator
967
968       If you don't pass in a final code reference to NestedLoops, then
969       NestedLoops will return an iterator to you (without having performed
970       any iterations yet).
971
972       The iterator is a code reference.  Each time you call it, it returns
973       the next list of selected values.  Any arguments you pass in are
974       ignored (at least in this release).
975
976       Examples
977
978       Finding non-repeating sequences of digits.
979
980       One way would be to loop over all digit combinations but only selecting
981       ones without repeats:
982
983           use Algorithm::Loops qw/ NestedLoops /;
984           $|= 1;
985           my $len= 3;
986           my $verbose= 1;
987           my $count= NestedLoops(
988               [   ( [0..9] ) x $len  ],
989               {   OnlyWhen => sub {
990                           $len == @_
991                       &&  join('',@_) !~ /(.).*?\1/;
992                   #or &&  @_ == keys %{{@_,reverse@_}};
993                   }
994               },
995               sub {
996                   print "@_\n"   if  $verbose;
997                   return 1;
998               },
999           );
1000           print "$count non-repeating $len-digit sequences.\n";
1001
1002           0 1 2
1003           0 1 3
1004           0 1 4
1005           0 1 5
1006           0 1 6
1007           0 1 7
1008           0 1 8
1009           0 1 9
1010           0 2 1
1011           ...
1012           9 8 5
1013           9 8 6
1014           9 8 7
1015           720 non-repeating 3-digit sequences.
1016
1017       But it would be nice to not waste time looping over, for example
1018       (2,1,2,0,0) through (2,1,2,9,9).  That is, don't even pick 2 as the
1019       third value if we already picked 2 as the first.
1020
1021       A clever way to do that is to only iterate over lists where the digits
1022       increase from left to right.  That will give us all sets of non-
1023       repeating digits and then we find all permutations of each:
1024
1025           use Algorithm::Loops qw/ NestedLoops NextPermute /;
1026           $|= 1;
1027           my $len= 3;
1028           my $verbose= 1;
1029           my $iter= NestedLoops(
1030               [   [0..9],
1031                   ( sub { [$_+1..9] } ) x ($len-1),
1032               ],
1033           );
1034           my $count= 0;
1035           my @list;
1036           while(  @list= $iter->()  ) {
1037               do {
1038                   ++$count;
1039                   print "@list\n"   if  $verbose;
1040               } while( NextPermute(@list) );
1041           }
1042           print "$count non-repeating $len-digit sequences.\n";
1043
1044           0 1 2
1045           0 2 1
1046           1 0 2
1047           1 2 0
1048           2 0 1
1049           2 1 0
1050           0 1 3
1051           0 3 1
1052           1 0 3
1053           1 3 0
1054           3 0 1
1055           3 1 0
1056           0 1 4
1057           0 4 1
1058           ...
1059           9 6 8
1060           9 8 6
1061           7 8 9
1062           7 9 8
1063           8 7 9
1064           8 9 7
1065           9 7 8
1066           9 8 7
1067           720 non-repeating 3-digit sequences.
1068
1069       A third way is to construct the list of values to loop over by
1070       excluding values already selected:
1071
1072           use Algorithm::Loops qw/ NestedLoops /;
1073           $|= 1;
1074           my $len= 3;
1075           my $verbose= 1;
1076           my $count= NestedLoops(
1077               [   [0..9],
1078                   ( sub {
1079                       my %used;
1080                       @used{@_}= (1) x @_;
1081                       return [ grep !$used{$_}, 0..9 ];
1082                   } ) x ($len-1),
1083               ],
1084               sub {
1085                   print "@_\n"   if  $verbose;
1086                   return 1;
1087               },
1088           );
1089           print "$count non-repeating $len-digit sequences.\n";
1090
1091           0 1 2
1092           0 1 3
1093           0 1 4
1094           0 1 5
1095           0 1 6
1096           0 1 7
1097           0 1 8
1098           0 1 9
1099           0 2 1
1100           0 2 3
1101           ...
1102           9 7 8
1103           9 8 0
1104           9 8 1
1105           9 8 2
1106           9 8 3
1107           9 8 4
1108           9 8 5
1109           9 8 6
1110           9 8 7
1111           720 non-repeating 3-digit sequences.
1112
1113       Future releases of this module may add features to makes these last two
1114       methods easier to write.
1115

POD ERRORS

1117       Hey! The above document had some coding errors, which are explained
1118       below:
1119
1120       Around line 955:
1121           '=item' outside of any '=over'
1122
1123
1124
1125perl v5.34.0                      2021-07-22               Algorithm::Loops(3)
Impressum