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.
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.
| [reply] [d/l] |
|
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
| [reply] [d/l] [select] |
|
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.
| [reply] [d/l] [select] |
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!
| [reply] |
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; };
| [reply] [d/l] [select] |
|
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. | [reply] [d/l] [select] |
|
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
| [reply] [d/l] |
|
|
|
|