1Algorithm::Loops(3) User Contributed Perl Documentation Algorithm::Loops(3)
2
6 Algorithm::Loops - Looping constructs: NestedLoops, MapCar*, Filter,
7 and NextPermute*
8
10 use Algorithm::Loops qw(
11 Filter
12 MapCar MapCarU MapCarE MapCarMin
13 NextPermute NextPermuteNum
14 NestedLoops
15 );
16 my @copy= Filter {tr/A-Z'.,"()/a-z/d} @list;
18 my $string= Filter {s/\s*$/ /} @lines;
19 my @transposed= MapCarU {[@_]} @matrix;
21 my @list= sort getList();
23 do {
24 usePermutation( @list );
25 } while( NextPermute( @list ) );
26 my $len= @ARGV ? $ARGV[0] : 3;
28 my @list= NestedLoops(
29 [ ( [ 1..$len ] ) x $len ],
30 sub { "@_" },
31 );
32 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
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 Filter
45 Similar to "map" but designed for use with s/// and other reflexive
46 operations. Returns a modified copy of a list.
47 MapCar, MapCarU, MapCarE, and MapCarMin
49 All similar to "map" but loop over multiple lists at the same time.
50 NextPermute and NextPermuteNum
52 Efficiently find all (unique) permutations of a list, even if it
53 contains duplicate values.
54 NestedLoops
56 Simulate "foreach" loops nested arbitrarily deep.
57 Filter(\&@)
59 Overview
60 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 For example:
66 use Algorithm::Loops qw( Filter );
68 @copy = Filter { s/\\(.)/$1/g } @list;
70 $text = Filter { s/^\s+// } @lines;
71 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 Usage
78 Filter has a prototype specification of (\&@).
80 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 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 If used in a scalar context, Filter returns a single string that is the
91 result of:
92 $string= join "", @results;
94 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 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 my @copy= Filter sub {s/\s/_/g}, @list;
103 # becomes: v^^^ v ^
104 my @copy= Filter {s/\s/_/g} @list;
105 Most of our examples will use this shorter syntax.
107 Note also that by importing Filter via the "use" statement:
109 use Algorithm::Loops qw( Filter );
111 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 my @copy= Filter( sub {s/\s/_/g}, @list );
117 Note on "Function BLOCK LIST" bugs
119 Note that in at least some versions of Perl, support for the "Filter
121 BLOCK ..." syntax is somewhat fragile. For example:
122 ... Filter( {y/aeiou/UAEIO/} @list );
124 may give you this error:
126 Array found where operator expected
128 which can be fixed by dropping the parentheses:
130 ... Filter {y/aeiou/UAEIO/} @list;
132 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 # v <--------- These ---------> v
137 ... Filter( sub {y/aeiou/UAEIO/}, @list );
138 # require ^^^ <--- these ---> ^ (sometimes)
139 so your code will be portable to more versions of Perl.
141 Examples
143 Good code ignores "invisible" characters. So instead of just
145 chomp()ing, consider removing all trailing whitespace:
146 my @lines= Filter { s/\s+$// } <IN>;
148 or
150 my $line= Filter { s/\s+$// } scalar <IN>;
152 [ 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 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 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 [ 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 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 because it will produce the following error:
180 Undefined subroutine in sort
182 in some versions of Perl. Some versions of Perl may even require you
184 to write it like this:
185 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 Which is how I wrote it in ex/NaturalSort.plx. ]
193 Need to sort names? Then you'll probably want to ignore letter case
195 and certain punctuation marks while still preserving both:
196 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 You can also roll your own simple HTML templating:
202 print Filter {
204 s/%(\w*)%/expand($1)/g
205 } $cgi->...,
206 ...
207 $cgi->...;
208 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 my $html= '';
214 ...
215 $html .= Filter {
216 s/%(\w*)%/expand($1)/g
217 } $cgi->...,
218 ...
219 $cgi->...;
220 Motivation
222 A reasonable use of map is:
224 @copy= map {lc} @list;
226 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 @copy= map {tr/A-Z/a-z/} @list; # Wrong
232 The reason why these aren't the same is similar to why we write:
234 $str= lc $str;
236 not
238 lc $str; # Useless use of 'lc' in void context
240 and we write:
242 $str =~ tr/A-Z/a-z/;
244 not
246 $new= ( $old =~ tr/A-Z/a-z/ ); # Wrong
248 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 This distinction is so common that we have several ways of switching
254 between the two forms. For example:
255 $two= $one + $other;
257 # vs.
258 $one += $other;
259 or
261 $two= substr($one,0,4);
263 # vs.
264 substr($one,4)= '';
265 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 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 You can write:
275 my $line= <STDIN>;
277 chomp( $line );
278 # or
279 chomp( my $line= <STDIN> );
280 but it somehow seems more natural to write:
282 my $line= chomp( <STDIN> ); # Wrong
284 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 my $line= Filter {chomp} ''.<STDIN>;
290 [ I used "''." to provide a scalar context so that only one line is
292 read from STDIN. ]
293 Or, for a better example, consider these valid alternatives:
295 my @lines= <STDIN>;
297 chomp( @lines );
298 # or
299 chomp( my @lines= <STDIN> );
300 And what you might expect to work (but doesn't):
302 my @lines= chomp( <STDIN> ); # Wrong
304 And what you can now use instead:
306 my @lines= Filter {chomp} <STDIN>;
308 Here are some examples of ways to use map/grep correctly to get
310 Filter's functionality:
311 Filter { CODE } @list
313 # vs
314 join "", map { local($_)= $_; CODE; $_ } @list
315 # vs
316 join "", grep { CODE; 1 } @{ [@list] }
317 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 Some (including me) would even consider the last form above to be an
323 abuse (or misuse) of "grep".
324 You can also use "for"/"foreach" to get the same results as Filter:
326 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 MapCar*
337 MapCar(\&@)
338 MapCarU(\&@)
339 MapCarE(\&@)
340 MapCarMin(\&@)
341 Usage
343 The MapCar* functions are all like "map" except they each loop over
345 more than one list at the same time.
346 [ 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 The MapCar* functions all have prototype specifications of (\&@).
354 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 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 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 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 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 [ 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 $sum=map{(1)x$_}@ints;
384 for adding up a list of natural numbers. q-: ]
386 Differences
388 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 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 In contrast, MapCar() will simply leave out values for short arrays
397 (just like I left the "U" out of its name).
398 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 Finally, MapCarMin() only calls your subroutine as many times as there
404 are elements in the shortest array.
405 In other words,
407 MapCarU \&MySub, [1,undef,3], [4,5], [6,7,8]
409 returns
411 ( MySub( 1, 4, 6 ),
413 MySub( undef, 5, 7 ),
414 MySub( 3, undef, 8 ),
415 )
416 While
418 MapCar \&MySub, [1,undef,3], [4,5], [6,7,8]
420 returns
422 ( MySub( 1, 4, 6 ),
424 MySub( undef, 5, 7 ),
425 MySub( 3, 8 ),
426 )
427 While
429 MapCarMin \&MySub, [1,undef,3], [4,5], [6,7,8]
431 returns
433 ( MySub( 1, 4, 6 ),
435 MySub( undef, 5, 7 ),
436 )
437 And
439 MapCarE \&MySub, [1,undef,3], [4,5], [6,7,8]
441 dies with
443 MapCarE: Arrays with different sizes (3 and 2)
445 Examples
447 Transposing a two-dimensional matrix:
449 my @transposed= MapCarE {[@_]} @matrix;
451 or, using references to the matrices and allowing for different row
453 lengths:
454 my $transposed= MapCarU {[@_]} @$matrix;
456 Formatting a date-time:
458 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 Same thing but not worrying about warnings for using undefined values:
466 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 Combine with "map" to do matrix multiplication:
474 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 Report the top winners:
498 MapCarMin {
500 print pop(), " place goes to ", pop(), ".\n";
501 } [qw( First Second Third Fourth )],
502 \@winners;
503 Same thing (scalar context):
505 my $report= MapCarMin {
507 pop(), " place goes to ", pop(), ".\n";
508 } [qw( First Second Third Fourth )],
509 \@winners;
510 Displaying a duration:
512 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 NextPermute*
529 NextPermute(\@)
530 NextPermuteNum(\@)
531 Introduction
533 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 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 Usage
542 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 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 So you would use NextPermute() like this:
555 my @list= sort GetValuesSomehow();
557 do {
558 DoSomethingWithPermutation( @list );
559 } while( NextPermute( @list ) );
560 or, if your list only contains numbers, you could use NextPermuteNum()
562 like this:
563 my @list= sort {$a<=>$b} GetNumbersSomehow();
565 do {
566 DoSomethingWithPermutation( @list );
567 } while( NextPermuteNum( @list ) );
568 Notes
570 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 If you instead have a reference to an array, you'll need to use "@{ }"
576 when calling a NextPermute* routine:
577 } while( NextPermute( @{$av} ) );
579 (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 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 } while( NextPermute( \@list ) ); # Wrong
590 because
592 · 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 · 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 However, I have decided to use a prototype here because:
603 · Several other functions from this module already use prototypes to
605 good advantage, enough advantage that I'd hate to lose it.
606 · 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 · The compile-time checking provided by the prototype can save
612 develop time over a run-time check by pointing out mistakes sooner.
613 Features
615 There are several features to NextPermute* that can be advantages over
617 other methods of finding permutations.
618 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 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 A programming object that gives you access to things one-at-a-time
630 is called an "iterator".
631 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 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 [ This also means you don't have to bother with creating an object
642 to do the iterating. ]
643 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 The following example:
650 my @list= ( 3, 3, 3, 3 );
652 do {
653 print "@list\n";
654 } while( NextPermute( @list ) );
655 will only print the one line, "3 3 3 3\n", because NextPermute()
657 quickly determines that there are no other unique permutations.
658 Try out the demonstration program included in the "ex" subdirectory
660 of the source distribution of this module:
661 > 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 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 > perl ex/Permute.plx noon
681 1: nnoo
682 2: nono
683 3: noon
684 4: onno
685 5: onon
686 6: oonn
687 Most permutation generators would have listed each of those four
689 times.
690 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 Generated in sorted order
697 If you were to run code like:
698 my @list= sort GetValuesSomehow();
700 do {
701 print join('',@lista, $/);
702 } while( NextPermute( @list ) );
703 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 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 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 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 Notes
729 Note that NextPermute() considers two values (say $x and $y) to be
731 duplicates if (and only if) "$x eq $y".
732 NextPermuteNum() considers $x and $y to be duplicates if "$x == $y".
734 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 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 > 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 NestedLoops
762 Introduction
763 Makes it easy to simulate loops nested to an arbitrary depth.
765 It is easy to write code like:
767 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 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 use Algorithm::Loops qw( NestedLoops );
780 my $depth= 3;
782 NestedLoops(
783 [ [ 0..$N ],
784 ( sub { [$_+1..$N] } ) x ($depth-1),
785 ],
786 \&Stuff,
787 );
788 Then you only have to change $depth to 4 to get the same results as:
790 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 Usage
802 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 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 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 So the possible ways to call NestedLoops are:
818 $iter= NestedLoops( \@Loops );
820 $iter= NestedLoops( \@Loops, \%Opts );
821 ... NestedLoops( \@Loops, \%Opts, \&Code );
822 ... NestedLoops( \@Loops, \&Code );
823 The "..."s above show that, when the final code reference is provided,
825 NestedLoops can return a few different types of information.
826 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 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 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 Note that \&Code is called in a list context no matter what context
842 NestedLoops was called in (in the current implementation).
843 In summary:
845 NestedLoops( \@loops, \%opts, \&code );
847 $count= NestedLoops( \@loops, \%opts, \&code );
848 @results= NestedLoops( \@loops, \%opts, \&code );
849 \@Loops
851 Each element of @Loops can be
853 an array refernce
855 which means the loop will iterate over the elements of that array,
856 a code refernce
858 to a subroutine that will return a reference to the array to loop
859 over.
860 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 \%Opts
867 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 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 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 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 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 If this key does not exist (or is specified with a false value),
892 then a default subroutine is used, like:
893 sub { return @_ == @Loops }
895 That is, only complete lists are used (by default). So:
897 my @list= NestedLoops(
899 [ ( [ 1..3 ] ) x 3 ],
900 { OnlyWhen => 0 },
901 sub { "@_" },
902 );
903 is similar to:
905 my @list= qw/ 111 112 113 121 122 123 131 132 133 211 212 ... /;
907 while
909 my @list= NestedLoops(
911 [ ( [ 1..3 ] ) x 3 ],
912 { OnlyWhen => 1 },
913 sub { "@_" },
914 );
915 is similar to:
917 my @list= qw/ 1 11 111 112 113 12 121 122 123
919 13 131 132 133 2 21 211 212 ... /;
920 Another example:
922 NestedLoops(
924 [ ( [ 1..3 ] ) x 3 ],
925 { OnlyWhen => 1 },
926 \&Stuff,
927 );
928 is similar to:
930 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 Last example:
942 NestedLoops(
944 [ ( [ 1..3 ] ) x 3 ],
945 { OnlyWhen => \&Test },
946 \&Stuff,
947 );
948 is similar to:
950 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 \&Code
963 The subroutine that gets called for each iteration.
965 Iterator
967 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 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 Examples
977 Finding non-repeating sequences of digits.
979 One way would be to loop over all digit combinations but only selecting
981 ones without repeats:
982 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 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 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 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 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 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 A third way is to construct the list of values to loop over by
1070 excluding values already selected:
1071 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 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 Future releases of this module may add features to makes these last two
1114 methods easier to write.
1115
1117 Hey! The above document had some coding errors, which are explained
1118 below:
1119 Around line 955:
1121 '=item' outside of any '=over'
1122perl v5.30.1 2020-01-29 Algorithm::Loops(3)