Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

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

by Limbic~Region (Chancellor)
on Jun 02, 2005 at 18:29 UTC ( #462987=perlquestion: print w/replies, xml ) Need Help??
Limbic~Region has asked for the wisdom of the Perl Monks concerning the following question:

All,
I was rather disappointed at the turnout of Perl6 Contest: Test your Skills. After reading Why aren't you using Perl 6 yet?, I realize there are a lot of good reasons. OTOH, silly exercises to demonstrate skill have never been frowned upon here, so I will continue to poke and prod people to show off their Perl6 knowledge.

I finally figured out how to do arbitrarily nested loops, something tye figured out a long time ago. My problem is that I think in p5 so my p6 code as a result doesn't look very p6ish. The challenge is to achieve the same functionality as clearly and concisely as possible with an emphasis on p6 features.

use v6; sub NestedLoop (++@loop, +%opt, +$code) returns Ref{ my @pos = 0 xx (@loop.elems - 1), -1; return sub { 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 last; } } return () if @pos[-1] > @loop[-1].end; return map -> $i { @loop[$i][@pos[$i]] } 0 .. @pos.end; }; }; my $next = NestedLoop(loop => ([0..2], [0..2], [0..2])); my @group; while @group = $next() { say ~@group; }

Cheers - L~R

Note: This code is functional but is currently lacking support for the optional parameters. They may be added later in a reply.

Update: See Pugs Examples for the latest

Replies are listed 'Best First'.
Re: Perl6 Contest #2: P6 That Doesn't Look Like P5
by geoffb (Novice) on Jun 02, 2005 at 22:00 UTC
    OK, here's a version that just does the iteration, but it uses coroutines (which I just taught myself for this puzzle, so bear with me):
    #!/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;
    Now to add the other params . . .

      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 }

      To:

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

      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";
        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);
      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;
        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]);
      I know p6 will DWYM, but I think it is clearer that way.

      Cheers - L~R

Re: Perl6 Contest #2: P6 That Doesn't Look Like P5
by Limbic~Region (Chancellor) on Jun 02, 2005 at 19:48 UTC
    All,
    I hacked in support for OnlyWhen and \&Code from Algorithm::Loops.
    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; }
    If anyone is having a hard time following my logic in order to come up with alternatives, ask and I will provide an explanation. The basic idea is counting where each position relates to an anonymous array and the base to count in for that position is dependent on that array.

    Cheers - L~R

      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. The code is a bit trickier because we added in a few options:

        Cheers - L~R

Re: Perl6 Contest #2: P6 That Doesn't Look Like P5
by blokhead (Monsignor) on Jun 03, 2005 at 02:16 UTC
    Here's what I believe to be a "correct" implementation although it doesn't work with my copy of pugs.

    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; }
    From what I can tell, there are two things currently holding back pugs:
    • 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.
    You can fix that by just substituting Limbic~Region's map statement for the line containing zip. I was hoping there would be an even easier way to write this line. Something like:
    @loops >>.[]<< @pos
    But pugs didn't like that..

    blokhead

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

      gather { for @loop Y @pos -> $arr, $i { take $a[ $i ]; } }
      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

        --Ingo

      If you have your trusty zipwith available:

      sub zipwith ( Code $with, *@lists ) { gather { while any( @lists ) { take $with.( @lists>>.shift ); } } }
      then you can change that zip line to:
      zipwith( { $^a[ $^i ] }, @loop, @pos );

Re: Perl6 Contest #2: P6 That Doesn't Look Like P5
by iblech (Friar) on Jun 03, 2005 at 19:18 UTC

    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

    --Ingo

      my &helper = -> @prev, @rest { ... }
      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) { ... }
      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 } }
      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)

        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

Re: Perl6 Contest #2: P6 That Doesn't Look Like P5
by Limbic~Region (Chancellor) on Jun 04, 2005 at 00:22 UTC
    All,
    Roy Johnson gave me the following p5 code and indicated it would be nice if it was ported to p6:
    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; } }
    Here is my attempt:
    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]; }; }; }

    Cheers - L~R

      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.

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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://462987]
Approved by Joost
Front-paged by K_M_McMahon
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (5)
As of 2018-07-22 20:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?















    Results (455 votes). Check out past polls.

    Notices?