Yary has asked for the wisdom of the Perl Monks concerning the following question:
There are a few modules on CPAN for generating combinations. For example given the lists
[ 'a','b','c' ] , [ 1, 2 ]
they produce
a 1
a 2
b 1 # two changes this iteration
b 2
c 1 # two changes this iteration
c 2
There's another ordering, where only one position at a time changes. And there's a name for that ordering which I've forgotten, so I haven't been able to search CPAN for it. It would produce the tuples in an order like so:
a 1
a 2
b 2
b 1
c 1
c 2
Can anyone refresh my memory as to what that ordering is called, and as a bonus, find me a module on CPAN that already produces combinations that way?
... I have tried the the obvious keywords "permute" and "combination" on metacpan but suspect I'm missing the right word... yes I could implement it from scratch, or take the output of one of the CPAN modules and reverse some records to get the desired ordering. But why re-invent a wheel, if it's already been invented.
Re: Minimally changing combinations
by Eily (Monsignor) on Jun 28, 2017 at 09:06 UTC
|
That sounds Gray-ish. Except this article deals pretty well with cases where all subsets have the same number of elements, which does not seem to be your case according to your example.
If I'm not wrong, when you have @right, a list where your ordering is respected, and @left, a list of elements you can use the following algorithm:
Take the first element of @left, combine it with all elements of @righ
+t
Take the second element of @left, combine it with all elements of reve
+rse @right
Take the third element of @left, combine it with all elements of @righ
+t
...
Because you reverse the right part each time you change the left element, you are sure that only one element changes (the left part), because you'll either be using the last or first element of @right twice in a row. This lets you scale up your N-uples recursively. Which in perl gives:
use v5.20;
use strict;
use warnings;
use Data::Dump qw( pp );
sub combine
{
my ($left, $right) = @_;
my @out;
my $reverse = 0;
for my $el (@$left)
{
push @out, map { [ $el, ref $_ ? @$_ : $_ ] } ($reverse ? reverse
+@$right : @$right);
$reverse = !$reverse;
}
return \@out;
}
pp combine ['A' .. 'F'], combine ['a'..'d'], [1..8];
pp combine [1..3], combine [1..4], [1..3];
I've just tested those sets and looked if I could find somewhere where the rule was not respected, my advice would be to test it properly though. And haukex's proposed solution might be better, the python page does mention gray coding so that's promising.
Edit: and actually implementing that as a recursive sub is left as an exercise to the reader ;-) | [reply] [d/l] [select] |
Re: Minimally changing combinations (updated!)
by haukex (Bishop) on Jun 28, 2017 at 07:40 UTC
|
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]
| [reply] [d/l] |
|
| [reply] |
Re: Minimally changing combinations
by tybalt89 (Prior) on Jun 28, 2017 at 13:54 UTC
|
#!/usr/bin/perl -l
# http://perlmonks.org/?node_id=1193761
use strict;
use warnings;
my @list1 = qw( a b c );
my @list2 = qw( 1 2 );
my $reverse = 0;
my @combinations = map { my $left = $_;
map "$left $_", $reverse++ % 2 ? reverse @list2 : @list2 } @list1;
print for @combinations;
| [reply] [d/l] |
|
Good point. The OP says "combination", but it appears that what he actually wants is the Cartesian product.
| [reply] |
Re: Minimally changing combinations
by Yary (Pilgrim) on Jun 28, 2017 at 16:15 UTC
|
Thanks haukex for your code that generates an iterator, and it's efficient. It keeps track of the direction (1 or -1) for each position in the array @o and runs without needing a stack. I renamed the variables to help me understand it better-
sub mixedgray_iterator {
my @domains = @_;
my @sizes = map { scalar @$_ } @domains;
die "all items must have at least two positions"
if grep {$_<2} @sizes;
my @cur_indices = (0) x @domains;
my @pos_to_loop_next = 0 .. @domains;
my @dir = (1) x @domains;
my $done;
return sub {
return undef if $done;
my $rv = [map {$domains[$_][$cur_indices[$_]]} 0..$#domains];
if ($pos_to_loop_next[0]==@domains) { $done=1; return $rv }
(my $domain,$pos_to_loop_next[0]) = ($pos_to_loop_next[0], 0);
$cur_indices[$domain] += $dir[$domain];
if ($cur_indices[$domain]==0 || $cur_indices[$domain]==$sizes[
+$domain]-1) {
$dir[$domain] = -$dir[$domain];
$pos_to_loop_next[$domain] = $pos_to_loop_next[$domain+1];
$pos_to_loop_next[$domain+1] = $domain+1;
}
return $rv;
}
}
thanos1983's references include Algorithm::Loops, its NestedLoots could be wrangled into producing what I'm looking for.
Thanks Eily "Gray code" was the term I'd forgotten (and "Hamming Distance" too) and nice compact code there!
Turns out my post was an "XY" problem. Like the authors of some combination modules, I'm running tests with all combinations of options. In these tests, each time an option changes, there's expensive setup to run first. My thought was to take the Gray-code-like sequence, and then compare each iteration with the values from the previous to see which setup code to run.
Or in other words, I want a sequence of "change option K to value V". Working on it! | [reply] [d/l] |
|
It was easy once I figured out that it's just like counting... hope to have time this weekend to make it more feature-ful and put it on CPAN!
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dump;
sub single_change_iterator {
my @domains = @_;
my $it = 0;
my @dir = (1) x @domains;
my @pos = (0) x @domains;
$it = sub {
# Initializion. Next call, use the real iterator.
$it = sub {
my $cur_dom;
for ($cur_dom = 0;
$cur_dom < @domains or return; # No more changes!
++$cur_dom) {
# Are we at end position of this domain?
my $upward = $dir[$cur_dom]==1;
if ($pos[$cur_dom] == ($upward ? $#{$domains[$cur_dom]
+} : 0)) {
# flip domain's direction, let loop continue
$dir[$cur_dom] *= -1;
}
else {
# Move current domain to next position
$pos[$cur_dom] += $dir[$cur_dom];
last;
}
}
return [$cur_dom, $domains[$cur_dom][$pos[$cur_dom]]];
};
# End first call by initializing all domains
return map [$_, $domains[$_][0]], 0 .. $#domains
};
return \$it;
}
my $combo_it = single_change_iterator(['X','Y'], [qw(a b c)], [44,55])
+;
my @changes;
dd @changes while @changes = &$$combo_it;
=head1 NAME
single_change_itertor - Help build Cartesian product, by changing one
+value at a time
=head1 SYNOPSIS
use Data::Dump;
my $it = single_change_itertor(['X','Y'], [qw(a b c)], [1,2]);
dd $_ while $_ = &$$it;
prints
([0, "X"], [1, "a"], [2, 44])
[0, "Y"]
[1, "b"]
[0, "X"]
[1, "c"]
[0, "Y"]
[2, 55]
[0, "X"]
[1, "b"]
[0, "Y"]
[1, "a"]
[0, "X"]
=head1 DESCRIPTION
This finds a way to cycle through all possible combinations of the
given sets- their Cartesian Product- by changing a single element at a
time. Given a set of domains, returns a handle to an iterator showing
which position changes, and what to. Similar to a Gray code, which
cycles through a set of numbers while only changing one digit.
Each call returns a list of array references. The inner array
reference is a pair,
[ index of domain that has a change , new value ]
The first iteration returns a pair for each domain so as to initialize
all the domains. Each subsequent call returns a single pair.
| [reply] [d/l] |
Re: Minimally changing combinations
by thanos1983 (Parson) on Jun 28, 2017 at 08:14 UTC
|
| [reply] [d/l] [select] |
|
|