#! perl -slw use strict; use Algorithm::Loops qw[ NestedLoops ]; use Time::HiRes qw[ time ]; sub nFor(&@) { my \$code = shift; my @indices = map { 0 } @_; # First set of indices is all zeroes my @sizes = map { scalar @\$_ } @_; # Cache array sizes (optional) my \$k; do { # Determine the array elements corresponding to the current set # of indices, and pass them to the closure: \$code->( map { \$_[\$_][\$indices[\$_]] } 0..\$#_ ); # Determine the next set of indices: for (\$k = \$#_; \$k >= 0; \$k--) { \$indices[\$k]++; if (\$indices[\$k] < \$sizes[\$k]) { last; } else { \$indices[\$k] = 0; } } # If \$k went out-of-bounds, it means we're finished: } while (\$k >= 0); } sub nForX(&@) { my \$code = shift; my \$n = shift; return \$code->( @_ ) unless \$n; for my \$i ( @{ shift() } ) { &nForX( \$code, \$n-1, @_, \$i ); } } my %stuff = ( A => [ 1..1000 ], B => [ 'a'..'z', 'A'..'Z' ], C => [ map chr, 33..47, 58..64, 92..96 ], ); my \$start; for my \$pat ( qw[ A::B A::C B::C A::B::C ] ) { print "\nProcessing \$pat"; my @keys = split '::', \$pat; \$start = time; nForX { my @set = @_; } scalar @keys, @stuff{ @keys }; printf "\tRecursive: %f seconds\n", time - \$start; \$start = time; nFor { my @set = @_; } @stuff{ @keys }; printf "\tIterative: %f seconds\n", time - \$start; \$start = time; NestedLoops [ @stuff{ @keys } ], sub { my @set = @_; }; printf "\tNestedLoops %f seconds\n", time - \$start; } __END__ C:\test>nforx Processing A::B Recursive: 0.107126 seconds Iterative: 0.227112 seconds NestedLoops 0.474461 seconds Processing A::C Recursive: 0.049802 seconds Iterative: 0.117263 seconds NestedLoops 0.235748 seconds Processing B::C Recursive: 0.002990 seconds Iterative: 0.006834 seconds NestedLoops 0.014829 seconds Processing A::B::C Recursive: 3.072954 seconds Iterative: 7.725672 seconds NestedLoops 15.938471 seconds