in reply to
Re^2: Finding all Combinations

in thread Finding all Combinations

Limbic~Region:

I've finally *got* it! Thanks for the help you posted on your scratchpad. After a few hours of study, it finally paid off. I've commented it to describe how it works, and made a few changes to fix a minor bug, and remove some code that is never executed, and removed a state variable:

`#------------------------------------------------------------
# Return an iterator of all possible combinations (of all
# lengths) of a set of symbols with the constraint that each
# symbol in each result is less than the symbol to its right.
#
sub combo {
# The symbols we draw our results from:
my @list = @_;
# The trivial case
return sub { ( ) } if ! @_;
# Persistent state for the closure
my (@position, # Last set of symbol indices generated
@stop); # Last set possible for $by symbols
# Start by telling iterator that it just finished
# (next=1) all results of 0 digits.
my ($by, $next) = (0, 1);
return sub {
`

` # We're done after we've returned a list of all symbols
return () if @position == @list;
`

` if ( $next ) {
# We finished all combos of size $by, now do $by+1
$by++;
`

` # If new size is larger than list, we're done!
return () if $by > @list;
`

`
# Start with leftmost $by symbols (except last,
# which is preincremented before use)
@position = (0 .. $by - 2, $by - 2);
# Our stop condition is when we've returned the
# rightmost $by symbols
@stop = @list - $by .. $#list;
$next = undef;
}
# Start by trying to advance the rightmost digit
my $cur = $#position;
{ # **** redo comes back here! ****
# Advance current digit to next symbol
if ( ++$position[ $cur ] > $stop[ $cur ] ) {
# Keep trying next-most rightmost digit
# until we find one that's not 'stopped'
$position[ --$cur ]++;
redo if $position[ $cur ] > $stop[ $cur ];
# Reset digits to right of current digit to
# the leftmost possible positions
my $new_pos = $position[ $cur ];
@position[$cur .. $#position] = $new_pos .. $new_pos+$
+by;
}
}
# Advance to next result size when we return last
# possible result of this size
$next = $position[0]==$stop[0];
return @list[ @position ];
}
}
`

Thanks again! I learned a

*lot* from this exercise.

**UPDATE:** I just tweaked the code a bit to make it check for done less frequently so it'll run a bit quicker. It munges up the code listing a bit though. Is there a better way to edit the code so it's obvious without interspersing download links?

--roboticus