Your skill will accomplishwhat the force of many cannot PerlMonks

### Re: Minimally changing combinations (updated!)

by haukex (Chancellor)
 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 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.

Create A New User
Node Status?
node history
Node Type: note [id://1193767]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (5)
As of 2019-06-17 22:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Is there a future for codeless software?

Results (80 votes). Check out past polls.

Notices?