http://www.perlmonks.org?node_id=557196


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