#!/usr/bin/pugs

use v6;

sub NL2 (++@loop) {
    coro {
        given (@loop.elems) {
            when 0  { yield [] }
            when 1  { @loop[0].map:{ yield [$^first] }; yield undef }
            default {
                for @loop[0] -> $first {
                    my &rest = NL2(loop => @loop[1..Inf]);
                    my @rest;
                    while @rest = rest() {
                       yield [$first, @rest];
                    }
                }
                yield undef;
            }
        }
    }
}


my &iter = NL2(loop => ([0..2], [3..5], [6..8]));
my ($cnt, $item);

say "ITER {++$cnt}: {$item.perl}" while $item = iter;
[download]

This is nice, except I have one small quibble. You have used map in a void context, with side effects. I usually avoid doing this, as I think it adds nothing over an equivalent for loop, other than obfuscation. So, I'd change:

    when 1  { @loop[0].map:{ yield [$^first] }; yield undef }
[download]

To:

    when 1  { for @loop[0] { yield [$^first] } yield undef }
[download]

Much like similar circumstances in Perl 5, not only is the for loop shorter (update: shorter only due to the semicolon, but shorter nonetheless), I also think it's clearer. The less superfluous syntax we use, the better. :-)

Update: based on the replies, I perhaps should have added a disclaimer. This post is about style and based on my personal preferences. I was not arguing in terms of performance or functionality, merely in terms of style. My personal style preference is to favor alternatives with fewer syntax characters, all else being equal. That's the essence of what I was trying to convey.

Using map in void context is a popular topic on Perlmonks, somewhat of a religious war à la Emacs and vi. Some previous discussion of the topic includes is the use of map in a void context deprecated ? (42 comments). Remember also that Perl 5.8.1 contained an optimization for map in a void context. I believe the conclusion reached was that "we agree to disagree", in the sense that both sides agree not to impose their beliefs on the other side. Recall also Larry's quote on the matter:

The argument against using an operator for other than its primary purpose strikes me the same as the old argument that you shouldn't have sex for other than procreational purposes. Sometimes side effects are more enjoyable than the originally intended effect.

This isn't as bad as you might think. Because map is being used in Void context, we know we can throw away the return value, and hence not bother to compute it in many cases due to Lazy evaluation...

$h=$ENV{HOME};my@q=split/\n\n/,`cat $h/.quotes`;$s="$h/."
."signature";$t=`cat $s`;print$t,"\n",$q[rand($#q)],"\n";
[download]

Good point. That was actually a holdover from when I did the non-coroutine recursive version -- the map wasn't void in that one. :-) Fixed in my working version.

Here's a version that has the $only_when and $code functionality. It's not quite what I originally aimed at because I came across at least one (and possibly more than one) Pugs bug. In particular, my next task is to write up a test case for the bug that causes the one line version of the following test from NestedLoop to die with a casting error in pugs if $only_when happens to be undef:

return &?SUB() if $only_when and not $only_when(@next);
[download]

Here's the code as it currently stands:

#!/usr/bin/pugs

use v6;

sub NestedLoop (++@loop, +$only_when, +$code) {
    my &iter = NL2(loop => @loop);

    sub {
        my @next = iter;
        return @next unless defined @next[0];

        if $only_when {
            return &?SUB() unless $only_when(@next);
        }

        $code(@next) if $code;
        return @next;
    }
}

sub NL2 (++@loop) {
    coro {
        given (@loop.elems) {
            when 0  { yield [] }
            when 1  { for @loop[0] { yield [$^first] } yield undef whi
+le 1 }
            default {
                for @loop[0] -> $first {
                    my &rest = NL2(loop => @loop[1..Inf]);
                    my @rest;
                    while @rest = rest() {
                       yield [$first, @rest];
                    }
                }
                yield undef while 1;
            }
        }
    }
}


my ($cnt, $item);

my &iter = NestedLoop(loop      => ([0..2], [3..5], [6..8]),
                      only_when => sub { ++$cnt % 2 },
                      code      => sub {say "reversed: {reverse @^grou
+p}"});

say "ITER {$cnt}: {$item.perl}" while $item = iter;
[download]

I just added a test to pugs for the undef cast fail bug above (my first commit!), so hopefully this will be a non-issue soon.

geoffb,
Very cool - especially considering you just got Pugs running yesterday. I do want to point out that I believe the coroutine syntax is still unspecced as S17 hasn't been written yet. Additionally, I probably would change:

my &rest = NL2(loop => @loop[1..Inf]);
# to
my &rest = NL2(loop => @loop[1..@loop.end]);
[download]

I know p6 will DWYM, but I think it is clearer that way.

Cheers - L~R

use v6;

sub NestedLoop (++@loop, +$OnlyWhen, +$code) returns Ref{
    my @pos = 0 xx (@loop.elems - 1), -1;
    return sub {
        my @group;
        loop {
            if ++@pos[-1] > @loop[-1].end {
                for reverse 0 .. @pos.end - 1 -> $i {
                    next if @pos[$i] == @loop[$i].end;
                    ++@pos[$i];
                    @pos = (@pos[0..$i], 0 xx (@pos.end - $i)) and las
+t;
                }
            }
            return () if @pos[-1] > @loop[-1].end;
            @group = map -> $i { @loop[$i][@pos[$i]] } 0 .. @pos.end;
            if $OnlyWhen.does(Code) { $OnlyWhen(@group) or next }
            $code(@group) if $code.does(Code);
            last;
        }
        return @group;
    };
};
my $next = NestedLoop(loop => ([0..2], [0..2], [0..2]));
my @group;
while @group = $next() { say ~@group; }
[download]

Could you run throught the logic of that code? I see some changes i wanted to make but then i get lost in the code. ;) Thanks.


___________
Eric Hodges

eric256,
Sure! First I will give an explanation of how the logic works and then a blow by blow of how the code accomplishes that logic.
Read more... (912 Bytes)
The code is a bit trickier because we added in a few options:
Read more... (3 kB)

Cheers - L~R

It's a slightly functional way of doing it. (Assuming my understanding of lexically-scoped subs is correct) I set up a recursive "incrementer" function which increments one position of @pos and "carries over" via a recursive call. It's tail-recursive, so if the compiler is smart, we don't lose a lot by making it recursive instead of iterative.

sub NestedLoops (*@loop) returns Ref {
    my @pos = 0 xx (@loop.elems - 1), -1;

    my sub incr($i) {
        if ( ++@pos[$i] == @loop[$i].elems ) {
            @pos[$i] = 0;
            return $i ?? incr($i - 1) :: 0;
        }
        return 1;
    };

    return sub {
       incr(@loop.end) or return;
       zip(@loop, @pos) ==> map -> $a, $i { $a[$i] };
    };
};

my $iter = NestedLoops( [0..2], [0..2] );
my @group;

while ( @group = $iter() ) {
     say ~@group;
}
[download]

• Doesn't appear to be support for the ==> operator yet. But I wasn't able to get zip().map to work correctly either.
• map -> $a, $i doesn't take two at a time.

  @loops >>.[]<< @pos
[download]

You can always simulate your own n-ary map using gather:

gather {
  for @loop Y @pos -> $arr, $i {
    take $a[ $i ];
  }
}
[download]

Although allowing map to take multiple items from the list at once would be nicer, and it's something I've wanted rather often.

Although allowing map to take multiple items from the list at once would be nicer, and it's something I've wanted rather often.

Sure, works in current Pugs! :)

  @result = map { $^a + $^b } 1,2,3,4;
  # 3,7

  @result = map -> $a, $b { $a + $^b } 1,2,3,4;
  # 3,7

  # And:
  $result = reduce { $^a + $^b * $^c } 1,2,3,4,5;
  # same as
  $result = (1 + 2 * 3) + 4 * 5;
  # i.e.
  # 27
[download]

--Ingo

If you have your trusty zipwith available:

sub zipwith ( Code $with, *@lists ) {
  gather {
    while any( @lists ) {
      take $with.( @lists>>.shift );
    }
  }
}
[download]

then you can change that zip line to:

zipwith( { $^a[ $^i ] }, @loop, @pos );
[download]

What you're searching for is the outer product. Following code should do it, and works in current Pugs :)

  use v6;

  sub outer(*@vals) {
    my &helper = -> @prev, @rest {
      if @rest {
        # We've still got a rest to interate over.
        # We add all items of @rest[0] to the new @prev
        # in our sub-helper, and use @rest[1...] as new
        # rest, i.e. all elements of @rest except the
        # first one.
        helper [ *@prev, $_ ], @rest[1...] for @rest[0];
      } else {
        # We don't have to recurse further, so we
        # simply "return" @prev.
        take @prev;
      }
    };

    # @prev: Empty array
    # @rest: @vals
    gather { helper [], @vals };
  }

  my @a = outer [1,2,3],[4,5,6],[7,8,9];
  say join "\n", @a;
  # 1 4 7
  # 1 4 8
  # [...]
  # 3 6 8
  # 3 6 9
[download]

--Ingo

    my &helper = -> @prev, @rest { ... }
[download]

Too much syntax! You can use lexically scoped subs in P6 -- you don't have to use pointy-blocks for everything:

    my sub helper (@prev, @rest) { ... }
[download]

Now I'm wondering if its possible to get rid of the "if" statment using multi-subs; And after that if its possible to get rid of the indexing into @rest. Something like

sub outer(*@vals)
{
   my multi sub helper (@prev) {
      take @prev
   }
   my multi sub helper (@prev, $current, *@rest) {
      $current.map: { helper [@prev, $_], *@rest }
   }
   gather { helper [], *@vals }
}
[download]

This is totally untested -- I haven't been able to install pugs yet.

--Dave.

iblech,
Call it what you want, what I am trying to replicate is NestedLoops from Algorithm::Loops. That is, the ability to loop over an arbitrary number of lists iteratively with a relatively small memory footprint. Your solution certainly produces the same output but not 1 at a time and has everything in memory at once. That aside, it certainly helps me learn more Perl6 and exposes others as well.

Cheers - L~R

That is, the ability to loop over an arbitrary number of lists iteratively with a relatively small memory footprint.

Sure, my outer does that, unless I've misunderstood something. It does not return a Code, though, but a lazy list, and it hasn't the same API as NestedLoops, as I was concentrating on the algorithm.

Your solution certainly produces the same output but not 1 at a time and appears to hold everything in memory at once.

Yep, this is as to get even only one item, the helper sub has to be executed recursively several times. I.e., in general:

  {
    ...;
    recurse ...;
    take ...;
    ...;
  } # not so good

  {
    ...;
    take ...;
    recurse ...;
    ...;
  } # better (items are yielded ASAP)
[download]

Therefore my solution should probably not be included in a library, as the other solutions presented scale much better. I do think that my solution is rather elegant though (no for, few lines of code).

--Ingo

sub ret_iter4 {
    my @ranges = @_;
    my $last=1;
    $last *= @$_ for @ranges;
    my $iteration=0;
    return sub {
        return if $iteration >= $last;
        my $i = $iteration++;
        my $possibilities = $last;
        map {
            $possibilities /= @$_;
            my $this_iter_i = $i / $possibilities;
            $i %= $possibilities;
            $_->[$this_iter_i];
        } @ranges;
    }
}
[download]

sub ret_iter4 (@loops is copy) returns Ref {
    my $last = [*] @loops.map:{ $_.elems };
    my $iter = -1;
    return sub {
        my $i = ++$iter;
        return () if $iter >= $last;
        my $possible = $last;
        return @loops.map:{
            $possible /= $_.elems;
            my $this_iter_i = $i / $possible;
            $i %= $possible;
            $_[$this_iter_i];
        };
    };
}
[download]

There is an off-by-one error in your translation, Limbic~Region. The P6 version is missing the first group because you used pre-increment rather than post-increment on $iter. This will correct the problem:

    my $iter = -1;
[download]

I'm hoping to create a version soon that can handle this example from the NestedLoops documentation:

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

In other words, a full implementation should allow code refs for the ranges, not just fixed ranges.

Here's a P5 version. It's broken down into very simple pieces, because I couldn't wrap my mind around this approach any other way. Conceptually, I think it's very straightforward (and I like how the main routine is just a reduce of a map -- very functional-flavored).

use warnings;
use strict;

nested_for(
          [[1..2], ['a'..'c'], ['A'..'D']],
           sub {print "Printing! [@_]\n";}
);

my $i = nested_for([[qw(r o y)],sub{[$_]}, [qw(b i v)]]);
my @args;
print "@args\n" while @args = $i->();

# Handles the coderef arg, if any
sub nested_for {
    my @loops = @{shift()};
    if (@_) {
        my $fn = shift;
        my @args;
        my $i = ret_iter(@loops);
        $fn->(@args) while @args = $i->();
    }
    else {
        return ret_iter(@loops);
    }
}

# Turns a list into a self-resetting iterator
# (upon completing iterations, it returns empty-list, then
# the next iteration is back at the beginning)
sub mk_iter {
    my $ref = $_[0];
    my $i = 0;
    return sub {
        my @items;
        @items = @{(ref $ref eq 'CODE') ? $ref->() : $ref}
          unless @items;
        if ($i > $#items) {
            $i = 0;
            @items = @{$ref->()} if ref $ref eq 'CODE';
            return ();
        } else {
            return $items[$i++];
        }
    }
}

# Like map for two iterators, returning an iterator
sub nest {
    my ($outer, $inner) = @_;
    my @out = $outer->();
    return sub {
        local $_ = $out[$#out];
        my @in = $inner->();
        unless (@in) {
            return unless @out = $outer->();
            $_ = $out[$#out];
            @in = $inner->();
        }
        return (@out, @in);
    };
}


use List::Util 'reduce';
sub ret_iter {
    reduce {nest($a, $b)} map mk_iter($_), @_;
}
[download]

---

Caution: Contents may have been coded under pressure.

tall_man,
Nice catch. I actually did see the fence post error but must not have posted the corrected copy. I will update the example in Pugs as well. WRT allowing code refs, I had to figure out where to draw a line. I suspect that my first challenge didn't go over so well because it was a fairly complicated problem. I was trying the KISS approach here to get more of a response, which seemed to work. OTOH, please provide a feature complete solution!

Cheers - L~R

On the principle that ugly working code is better than elegant nonworking code, I did a brute-force conversion of part of Algorithms:Loop. It supports a last-in-the list-parameter the hard way, by copying it as the first parameter instead of in $_,

use v6;

sub _NL_Iter(@loops, $when) returns Ref {
    my @list;
    my $i = -1;
    my @idx;

    return  sub { return }
        if  ! @loops;

    my @vals = @loops;

    return  sub {
        while 1 {
            # Prepare to append one more value:
            if  $i < @loops.end {
                @idx[++$i]= -1;
                if @loops[$i].does(Code) {
                    @vals[$i]= @loops[$i](@list[-1], @list);
                 }
            }
            ## return   if  $i < 0;
            # Increment furthest value, chopping if done there.
            while  @vals[$i].elems <= ++@idx[$i] {
                pop @list;
                return   if  --$i < 0;
            }
            @list[$i]= @vals[$i][@idx[$i]];

            if $when.does(Code) {
               return @list if $when(@list[-1], @list);
            } else {
               return @list;
            }
        }
     };
}

sub NestedLoop(++@loops, +$code, +$when) {
   my $onlywhen = $when;
   my $count_elems = @loops.elems + 1;
   $onlywhen //= sub { @_ == $count_elems }; # Default case - when we 
+have a full count.

    my $iter= _NL_Iter(@loops, $onlywhen );

    if ! $code {
        # There seeems to be no way to check for void context, since
        # want.count is not working.  I wanted to test want.count == 0
+.
        return $iter;
    }

    my @ret;
    my @list;
    while @list = $iter() {
        @list = $code( @list );
        if want.List {
            push @ret, @list;
        } else {
            @ret[0] += @list;
        }
    }
    return want.List ?? @ret :: ( $ret[0] // 0 );
}

my $next = NestedLoop(loops => ([0..2], [0..2], [0..2]));
my @group;
while @group = $next() { say ~@group; };

say "\nsecond case:";
my $N = 4;
my $depth = 3;
my $i2 = NestedLoop(loops => ( [ 0..$N ],
                                 ( sub { [@_[0]+1..$N] } ) xx ($depth-
+1),
                              ) );
while @group = $i2() { say ~@group; };
[download]