Re^2: Perl6 Contest #2: P6 That Doesn't Look Like P5

[tall_man]

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;

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,
    );

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

[Roy Johnson]

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($_), @_;
}

[tall_man]

Roy, I tried your code on the documentation example:

my $N = 4;
my $depth = 3;
my $i2 = nested_for([   [ 0..$N ],
             ( sub { [$_+1..$N] } ) x ($depth-1),
         ]);
print "@args\n" while @args = $i2->();

There seems to be a problem when the range hits the top. The output is:

0 1 2
0 1 3
0 1 4
0 2 3
0 2 4
0 3 4
0 4
1 2 3
1 2 4
1 3 4
1 4
2 3 4
2 4
3 4
4

[Roy Johnson]

That makes sense: the range ends up being [5..4], which is a no-iteration loop. What do you think should be the output?

NB: my code does not run under 5.8.1 (on a Mac). I don't know why, and I can't get 5.8.6 to compile. Grrr. I hate it when my PC works better than my Mac.

Update: and to answer my own question, I looked at what NestedLoops does. Sensibly enough, it does no iterations when there's a no-iteration loop. You can get this behavior by making the last line of nest be return((@out and @in) ? (@out, @in) : ());

[Limbic~Region]

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!

[tall_man]

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; };

[tall_man]

I was looking for ways to pass out-of-band parameters to the loop subroutines (preferably without requiring the users to make messy changes), and this idea of using named parameters in combination with a splatted list occurred to me.

#!/usr/bin/pugs

use v6;
#use Test;
#plan 2;

sub oob(+$x = $CALLER::_, *@lst) {
   return ($x,@lst);
}

sub runner() {
   $_ = "qqq";
   oob("a","b","c");
}

my ($x, @lst) = runner();
say "x = *$x* lst = *",~@lst,"*";
#is($x, 'qqq', '... default named parameter with $CALLER_ and a list',
+ :todo<bug>);
#is(~@lst, 'a b c', '... list after default named parameter with $CALL
+ER_', :todo<bug>);

What I actually got was:

x = *a* lst = *b c*

and not:

x = *qqq* lst = *a b c*

This was unexpected after seeing examples in E06, so it could be a bug test (with the Test stuff uncommented). Or I may be completely misunderstanding positional parameters.

[eric256]

Couldn't you place named paramteres after the uhhh....splatted?... parameter?

Actualy a quick test shows that doesn't work. I think however it would be usefull to have a set of positional paramters (like your slurpy array) and then follow them with parameters that are meant to be set by named pairs. Then sub oob(*@lst,?$x = $CALLER::_) { would DWIM