Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

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.


Comment on Re^2: Perl6 Contest #2: P6 That Doesn't Look Like P5
Select or Download Code
Re^3: Perl6 Contest #2: P6 That Doesn't Look Like P5
by Limbic~Region (Chancellor) on Jun 06, 2005 at 19:02 UTC
    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

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 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?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (4)
As of 2015-07-04 11:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (59 votes), past polls