Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid

Re: Minimally changing combinations (updated!)

by haukex (Bishop)
on Jun 28, 2017 at 07:40 UTC ( #1193767=note: print w/replies, xml ) Need Help??

in reply to Minimally changing combinations

I think you're looking for Heap's algorithm, although a quick search on CPAN and a look on Rosettacode doesn't yet show me an existing Perl implementation. Update: Sorry, that was permutations, you're looking for combinations.

Update 2019-10-05: I've just released this as Algorithm::Odometer::Gray!

Update 2: Knuth's "The Art of Computer Programming", "Generating all n-tuples", Algorithm H, "Loopless reflected mixed-radix Gray generation". Best I can do at the moment is an implementation in Python from the Sage project, here. Update 3: The exact same algorithm appears to be described in this freely available paper: Loopless Functional Algorithms as "Algorithm C" in the section "9.5. Non-binary Gray codes".

Final Update: I think I've implemented the algorithm as described:

sub mixedgray_it { my @w = @_; my @m = map { 0+@$_ } @w; die "all items must have at least two positions" if grep {$_<2} @m; my @a = (0) x @m; my @f = 0 .. @m; my @o = (1) x @m; my $done; return sub { return undef if $done; my $rv = [map {$w[$_][$a[$_]]} 0..$#w]; if ($f[0]==@w) { $done=1; return $rv } my $j = $f[0]; $f[0] = 0; $a[$j] += $o[$j]; if ($a[$j]==0 || $a[$j]==$m[$j]-1) { $o[$j] = -$o[$j]; $f[$j] = $f[$j+1]; $f[$j+1] = $j+1; } return $rv; } } use Data::Dump; my $it = mixedgray_it(['a','b','c'],[1,2]); while (defined( my $c = $it->() )) { dd $c } __END__ ["a", 1] ["b", 1] ["c", 1] ["c", 2] ["b", 2] ["a", 2]

Replies are listed 'Best First'.
Re^2: Minimally changing combinations (updated!)
by Laurent_R (Canon) on Jun 28, 2017 at 17:03 UTC
    This is slightly off-topic, but just for your information, there is a description of the heap algorithm in the book Mastering Algorithms with Perl (O'Reilly, by Jon Orwant, Jarkko Hietaniemi, and John Macdonald). I think that the authors wrote a module (probably aimed at pedagogical purposes more than production) going with the book; but I'm not at home and can't check the book's content today, and I don't know if that particular algorithm is in this module.

    My book on Perl 6 also has something on heaps, but this is getting even more OT.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1193767]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (8)
As of 2020-07-03 09:20 GMT
Find Nodes?
    Voting Booth?

    No recent polls found