Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Variable number of foreach loops

by abhay180 (Acolyte)
on Nov 27, 2013 at 13:02 UTC ( #1064607=perlquestion: print w/ replies, xml ) Need Help??
abhay180 has asked for the wisdom of the Perl Monks concerning the following question:

I have a variable $count (range=1 to N), and arrays a_1,a_2,a_3...a_N. My requirement is: if $count==1:

foreach $i1 (@ a_1) { print $i1; }
if $count==2:
foreach $i1 (@ a_1) { foreach $i2 (@ a_2) { print $i1,$i2; } }
if $count==3:
foreach $i1 (@ a_1) { foreach $i2 (@ a_2) { foreach $i3 (@ a_3) { print $i1,$i2,$i3; } } }
So on... In short i need "variable" number of foreach loops based on variable "$count" Is this possible in PERL?

Comment on Variable number of foreach loops
Select or Download Code
Re: Variable number of foreach loops
by BrowserUk (Pope) on Nov 27, 2013 at 13:15 UTC
    Is this possible in PERL?

    Yes:

    #! perl -slw use strict; sub nFor { my $n = shift; if( $n ) { for my $i ( @{ shift() } ) { nFor( $n-1, @_, $i ); } } else { print join ' ', @_; } } my @a = 1..10; my @b = 'a'..'z'; my @c = map chr, 33 .. 47; nFor( 3, \@a, \@b, \@c ); __END__ C:\test>junk90 1 a ! 1 a " 1 a # 1 a $ 1 a % 1 a & 1 a ' 1 a ( 1 a ) 1 a * 1 a + 1 a , 1 a - 1 a . 1 a / 1 b ! 1 b " ... 10 y - 10 y . 10 y / 10 z ! 10 z " 10 z # 10 z $ 10 z % 10 z & 10 z ' 10 z ( 10 z ) 10 z * 10 z + 10 z , 10 z - 10 z . 10 z /

    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
      Thanks a lot. BTW what is the third argument($i) nFor( $n-1, @_, $i ) doing here?
        BTW what is the third argument($i) nFor( $n-1, @_, $i ) doing here?

        As the sub recurses, one of the array references is remove from the front of @_ at each level, and the current value being iterated by the for loop at that level is added to the end.

        Once $n == 0, all the array references have been removed and $n has been shifted off, all that is left in @_, is the set of elements to be printed.

        BTW. Here is a cleaner implementation that takes a callback to which the results sets are passed:

        #! perl -slw use strict; sub nForX(&@) { my $code = shift; my $n = shift; return $code->( @_ ) unless $n; for my $i ( @{ shift() } ) { &nForX( $code, $n-1, @_, $i ); } } my @a = 1..10; my @b = 'a'..'z'; my @c = map chr, 33 .. 47; nForX { print join ' ', @_; } 3, \( @a, @b, @c );

        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.
Re: Variable number of foreach loops
by choroba (Abbot) on Nov 27, 2013 at 13:25 UTC
    See NestedLoops in Algorithm::Loops.
    لսႽ ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
Re: Variable number of foreach loops
by tobyink (Abbot) on Nov 27, 2013 at 14:34 UTC

    List::MapMulti should do the trick.

    mapm { my ($i1, $i2, $i3) = @_; ...; } \(@_a_1, @_a_2, @_a_3);
    use Moops; class Cow :rw { has name => (default => 'Ermintrude') }; say Cow->new->name
Re: Variable number of foreach loops
by Anonymous Monk on Nov 27, 2013 at 15:17 UTC
    Generally speaking, you use recursion for this, as BrowserUK did, often calling a separate subroutine (this is where you would put the print-statement) from the innermost iteration. A Perl subroutine can call itself any (reasonable) number of times.
      Thanks
Re: Variable number of foreach loops (non-recursive solution)
by smls (Friar) on Nov 28, 2013 at 17:44 UTC

    Non-recursive solution

    For completeness, here's a solution that does not use a recursive subroutine:

    sub nested_foreach(&@) { 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, there are no more valid iterations: } while ($k >= 0); } my @a = ...; my @b = ...; my @c = ...; nested_foreach { say join ' ', @_ } \@a, \@b, \@c;

    The "Determine the next set of indices" step may seem a little complicated at first sight, but it becomes more intuitive if you think of the @indices array as an integer number (with each element representing a digit), and imagine that we want to "increment" that "number" by 1. It's not a decimal (i.e. base-10) number, but rather one where each digit can have a different base (i.e. the sizes of the input arrays) - but that doesn't really change anything.

    Incrementing the "number" by 1 works just like the integer addition (here with an addend of 1) that you were taught back in primary school: Start with the right-most digit; increment it; if it's still within the valid range of digits then you're done; if instead it went above the limit then wrap it around to zero, "carry the one", and repeat the same steps with the next digit to the left.


    Update:

    Performance comparison

    Interestingly, my iterative solution seems to be significantly slower than BrowserUK's recursive solution, at least when running on my PC and with various different numbers/sizes of input arrays I tried:

    sub nested_foreach(&@) { ... # see above } sub nForX(&@) { ... # see BrowserUK's post } # my @size = (500, 900); # my @size = (5, 5, 5, 5, 5, 5, 5, 5); my @size = (100, 4, 75, 23); my @AoA = map { [map { chr($_+64) x int(rand(10)) } 1 .. $_] } @size; cmpthese -10, { iterative => sub { nested_foreach { join("", @_) } @AoA }, recursive => sub { nForX { join("", @_) } scalar @AoA, @AoA }, };
    s/iter iterative recursive iterative 1.86 -- -71% recursive 0.532 249% --
      Thanks a lot. That helps.

        Just in case performance is a consideration:

        #! 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 se +t # 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

        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.
Re: Variable number of foreach loops
by ikegami (Pope) on Nov 28, 2013 at 18:47 UTC

    I have ... arrays a_1,a_2,a_3...a_N

    That's oh-so-wrong. Always use use strict;, which specifically forbids this (among other things). You should use an array of arrays instead.

    i need "variable" number of foreach loops based on variable "$count" Is this possible in PERL?

    If you mean "Perl" and you fixed the error mentioned above,

    use Algorithm::Loops qw( NestedLoops ); splice(@aoa, $count); NestedLoops(\@aoa, sub { print(@_); });

    Or if $count == @aoa,

    use Algorithm::Loops qw( NestedLoops ); NestedLoops(\@aoa, sub { print(@_); });

    Algorithm::Loops

Re: Variable number of foreach loops (improving performance)
by smls (Friar) on Dec 11, 2013 at 11:35 UTC

    Here are some attempts at improving performance, compared to the solutions already posted (of which BrowserUK's recursive solution was the fastest):

    Branching solution

    A trivial (but non-elegant) way to gain performance is to directly implement the nested loops for a few (presumably common) values of n, using if/elsif/else to branch between them, and only fall back to the general-case recursive implementation for higher values of n:

    sub multi_foreach(&@) { my $code = shift; if (@_ == 1) { for my $i (@{ shift() }) { $code->( $i ); } } elsif (@_ == 2) { my ($a0, $a1) = @_; for my $i0 (@$a0) { for my $i1 (@$a1) { $code->( $i0, $i1 ); } } } elsif (@_ > 2) { my ($a0, $a1, $a2, @rest) = @_; for my $i0 (@$a0) { for my $i1 (@$a1) { for my $i2 (@$a2) { if (@rest) { &multi_foreach_recursive( $code, scalar @rest, @rest, $i0, $i1, $i2 ); } else { $code->( $i0, $i1, $i2 ); } } } } } } multi_foreach { say join ' ', @_ } \( @a, @b, @c );

    eval solution

    The logical generalization of the branching solution, would be to dynamically generate the nested foreach loops for arbitrary levels of nesting. This incurs an overhead for code-generation each time the algorithm is called (PS: caching could help), but once generated the actual looping code will run very fast. Thus this solution tends to be slower than the recursive solution for small inputs, but faster for large inputs (i.e. many big arrays):

    sub multi_foreach(&@) { my $code = shift; my ($head, $inside, $tail) = ('', '$code->(', ')'); foreach (0..$#_) { $head .= "for my \$i$_ (\@{\$_[$_]}) { "; $inside .= "\$i$_, "; $tail .= ' }'; } eval( $head . $inside . $tail ); } multi_foreach { say join ' ', @_ } \( @a, @b, @c );

      You'll gain a lot more speed rewriting it in XS and using the multicall interface to call $code.


      use Moops; class Cow :rw { has name => (default => 'Ermintrude') }; say Cow->new->name

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1064607]
Approved by BrowserUk
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (15)
As of 2014-11-24 17:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (144 votes), past polls