Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer

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

by tall_man (Parson)
on Jun 06, 2005 at 18:32 UTC ( #464022=note: print w/replies, xml ) Need Help??

in reply to Re: Perl6 Contest #2: P6 That Doesn't Look Like P5
in thread Perl6 Contest #2: P6 That Doesn't Look Like P5

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.

Replies are listed 'Best First'.
Re^3: Perl6 Contest #2: P6 That Doesn't Look Like P5
by Roy Johnson (Monsignor) on Jun 06, 2005 at 19:36 UTC
    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($_), @_; }

    Caution: Contents may have been coded under pressure.
      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
        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) : ());

        Caution: Contents may have been coded under pressure.
Re^3: Perl6 Contest #2: P6 That Doesn't Look Like P5
by Limbic~Region (Chancellor) on Jun 06, 2005 at 19:02 UTC
    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

Re^3: Perl6 Contest #2: P6 That Doesn't Look Like P5
by tall_man (Parson) on Jun 07, 2005 at 16:37 UTC
    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; };
      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.

        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

        Eric Hodges

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://464022]
[Discipulus]: who make the invitation? the program?!?
[choroba]: it's historical
[erix]: pull requests
[choroba]: originally, you sent a pull request to someone by email, i.e. you asked them to pull from your repo
[Discipulus]: if is the author of a patch, is more like a 'request to push' into rather than a pull request..
[choroba]: as it's considered unpolite to push to someone else's repo
[choroba]: and in fact, you don't push into the target repo, you push into your branch of your fork
[choroba]: the maintainer of the upstream repo than "merges" the pull request, i.e. they pull from your fork into the upstream
[Discipulus]: ' i.e. you asked them to pull from your repo' =~ I (subj) want to push
[Discipulus]: chorobayour words are reasonable

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (6)
As of 2017-05-27 20:12 GMT
Find Nodes?
    Voting Booth?