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

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.

Imagine one of those combination locks on a briefcase or a suitcase where there are a series of wheels and you need to get the correct numbers lined up for the lock to open. Each one of the wheels represents a level in our nested for loop with the left most being the outer and the right most being the inner. Unlike real combination locks though, our wheels have different number of values since the arrays may too.

The idea is to start with each wheel on the first setting and incriment the right most wheel (most inner loop) one turn each time. The positions of all the wheels correspond to positions in different arrays. We collect the values, try to open the lock, and continue. When we have tried all the values of the right most wheel, we set it back to the initial position and try the one just to its left. We repeat this process until all combinations have been tried.

The code is a bit trickier because we added in a few options:

# This says that I will be taking 3 named parameters
# that can appear in any order, but 1 is required (++)
sub NestedLoop (++@loop, +$OnlyWhen, +$code) returns Ref {

    # We start with all 0s (arrays) except the last wheel
    # This is so the first turn is in the correct position
    my @pos = 0 xx (@loop.elems - 1), -1;

    # We are creating an iterator so we return a code ref
    return sub {

        # We need to collect the values of the arrays
        # Since we are counting in indices
        my @group;
        
        # We added support for $OnlyWhen so each iteration
        # May actually be an unknown number of turns
        # So we loop until the condition is satisfied        
        loop {

            # If in the process of turning the right most
            # wheel, we exceed the end - we turn a new wheel 
            if ++@pos[-1] > @loop[-1].end {

                # We start at the nearest wheel to the right
                # and work to the left looking for 1 that
                # can be turned without exceeding the end
                for reverse 0 .. @pos.end - 1 -> $i {
                    next if @pos[$i] == @loop[$i].end;

                    # We turn that wheel and reset all the
                    # wheels to the right to their star pos
                    ++@pos[$i];
                    @pos = (@pos[0..$i], 0 xx (@pos.end - $i)) and las
+t;
                }
            }

            # If we were not able to reset the right most
            # Wheel we must have not been able to move the
            # Left most wheel, which means we are done
            return () if @pos[-1] > @loop[-1].end;

            # We populate the @group with the actual values
            # Since we were just keeping track of indices
            @group = map -> $i { @loop[$i][@pos[$i]] } 0 .. @pos.end;

            # Since $OnlyWhen is optional, see if it is a
            # code ref execute it and loop if it doesn't
            # return a true value
            if $OnlyWhen.does(Code) { $OnlyWhen(@group) or next }

            # Execute the optional $code ref if it was defined
            $code(@group) if $code.does(Code);

            # End the infinite loop
            last;
        }

        # Return the values for this iteration of the loop
        return @group;
    };
};
[download]

Cheers - L~R

Comment on Re^3: Perl6 Contest #2: P6 That Doesn't Look Like P5 Download Code

Replies are listed 'Best First'.
Re^4: Perl6 Contest #2: P6 That Doesn't Look Like P5 by eric256 (Parson) on Jun 03, 2005 at 16:25 UTC
I took a rather different approach to the code. I love OO so i went that route. #!/usr/bin/pugs use v6; class MultiCounter { has @.positions is rw; has @.lengths is rw; submethod BUILD() { @.positions = (0) xx (@.lengths.end + 1); } method inc () returns Bool { @.positions[-1]++; for reverse (0..@.lengths.end - 1) -> $i { if (@.positions[$i + 1] > @.lengths[$i + 1]) { @.positions[$i]++; @.positions[$i + 1] = 0; } } return (@.positions[0] > @.lengths[0]) ?? 0 :: 1; } } class NestedLoops { has @.loops is rw; has MultiCounter $.counter is r; submethod BUILD() { $.counter = MultiCounter.new( :lengths( @.loops.map:{.end } +) ); } method inc () returns Bool { $.counter.inc; } method data () { my @data; for (0..@.loops.end) -> $i { push @data, @.loops[ $i ][$.counter.positions[$i]]; } return @data; }; } my $counter = NestedLoops.new( :loops(['a','b'],[0..2], ['one',2,3]) ) +; while ($counter.inc) { $counter.data.join(" ").say; } [download] Some refinements and added features would probably be good but this is my start. ___________ Eric Hodges	[reply] [d/l]
Re^5: Perl6 Contest #2: P6 That Doesn't Look Like P5 by eric256 (Parson) on Jun 03, 2005 at 18:04 UTC
Some changes. Using invocants, and method dispatching based on signatures and a better data method. #!/usr/bin/pugs use v6; class MultiCounter { has @.positions is rw; has @.lengths is rw; submethod BUILD() { @.positions = (0) xx (@.lengths.end + 1); } method inc () returns Bool { @.positions[-1]++; for reverse (0..@.lengths.end - 1) -> $i { if (@.positions[$i + 1] > @.lengths[$i + 1]) { @.positions[$i]++; @.positions[$i + 1] = 0; } } return (@.positions[0] > @.lengths[0]) ?? 0 :: 1; } } class NestedLoops { has @.loops is rw; has MultiCounter $.counter is r; submethod BUILD($self:) { $self.reset; } method reset () { $.counter = MultiCounter.new( :lengths( @.loops.map:{.end } +) ); } method iter () returns Bool { $.counter.inc; } method iter ($self: Code $code) { while ($self.iter) { $code($self.data) }; $self.reset; } method data () { return map -> $i { @.loops[$i][ $.counter.positions[$i] ] } +0 .. @.loops.end; }; } my $counter = NestedLoops.new( :loops(['a','b'],[0..2], ['one',2,3]) ) +; $counter.iter( sub { say "HERE " ~ @_ } ); while ($counter.iter) { $counter.data.join(" ").say; } [download] ___________ Eric Hodges	[reply] [d/l]


more useful options
	PerlMonks