"be consistent" PerlMonks

### Re: combinations of multiple variables which can assume multiple values

by Cristoforo (Curate)
 on Mar 16, 2018 at 19:01 UTC ( #1211068=note: print w/replies, xml ) Need Help??

Lacking the magic of solutions by LanX or choroba, this solution uses Algorithm::Combinatorics and List::MoreUtils.
```#!/usr/bin/perl
use strict;
use warnings;
use Algorithm::Combinatorics 'variations_with_repetition';
use List::MoreUtils 'pairwise';

my @a = 1 .. 3;
my @b = qw/a b/;

my @c;

my \$iter = variations_with_repetition (\@b, scalar @a);

while (my \$tuple = \$iter->next) {
no warnings 'once'; # silence warnings about \$a \$b only used once
my @temp = pairwise { [\$a,\$b] } @a, @\$tuple;
push @c, \@temp;
}

use Data::Dump; dd \@c;
Dump output:
```[
[[1, "a"], [2, "a"], [3, "a"]],
[[1, "a"], [2, "a"], [3, "b"]],
[[1, "a"], [2, "b"], [3, "a"]],
[[1, "a"], [2, "b"], [3, "b"]],
[[1, "b"], [2, "a"], [3, "a"]],
[[1, "b"], [2, "a"], [3, "b"]],
[[1, "b"], [2, "b"], [3, "a"]],
[[1, "b"], [2, "b"], [3, "b"]],
]

Replies are listed 'Best First'.
Re^2: combinations of multiple variables which can assume multiple values
by vr (Curate) on Mar 17, 2018 at 13:42 UTC

Cool. Here is generalization for "n dimensions", e.g. I want an exhaustive list of combinations to build Perl variable names according to some pattern (silly example):

```use strict;
use warnings;
use feature 'say';
use Algorithm::Combinatorics 'variations_with_repetition';
use List::MoreUtils 'pairwise';
use Data::Dump 'dd';

my @subsets = (
[ qw/ \$ @ % /],
[ qw/ p q r s /],
[ qw/ 0 1 /],
);

my \$base      = shift @subsets;
my \$var_len   = @\$base;
my @solutions = [ map [\$_], @\$base ];

for my \$subset ( @subsets ) {

my @variations = variations_with_repetition( \$subset, \$var_len );

@solutions = map {
my \$sol = \$_;
map [ pairwise { [ @\$a, \$b ] } @\$sol, @\$_ ], @variations
} @solutions;
}

dd \@solutions;

Output:

```  [["\\$", "p", 0], ["\@", "p", 0], ["%", "p", 0]],
[["\\$", "p", 0], ["\@", "p", 0], ["%", "p", 1]],
[["\\$", "p", 0], ["\@", "p", 1], ["%", "p", 0]],
[["\\$", "p", 0], ["\@", "p", 1], ["%", "p", 1]],
[["\\$", "p", 1], ["\@", "p", 0], ["%", "p", 0]],
[["\\$", "p", 1], ["\@", "p", 0], ["%", "p", 1]],
[["\\$", "p", 1], ["\@", "p", 1], ["%", "p", 0]],
[["\\$", "p", 1], ["\@", "p", 1], ["%", "p", 1]],
[["\\$", "p", 0], ["\@", "p", 0], ["%", "q", 0]],
[["\\$", "p", 0], ["\@", "p", 0], ["%", "q", 1]],
[["\\$", "p", 0], ["\@", "p", 1], ["%", "q", 0]],
[["\\$", "p", 0], ["\@", "p", 1], ["%", "q", 1]],
[["\\$", "p", 1], ["\@", "p", 0], ["%", "q", 0]],
[["\\$", "p", 1], ["\@", "p", 0], ["%", "q", 1]],
[["\\$", "p", 1], ["\@", "p", 1], ["%", "q", 0]],
[["\\$", "p", 1], ["\@", "p", 1], ["%", "q", 1]],
[["\\$", "p", 0], ["\@", "p", 0], ["%", "r", 0]],
...
... total 512 solutions
Re^2: combinations of multiple variables which can assume multiple values
by Cristoforo (Curate) on Apr 24, 2018 at 19:38 UTC
As an exercise related to this problem (not solving the whole problem), I wanted to find an algorithm for 'variations_with_repetitions', (algorithms not being my strong suit), and was able to find a solution. I wouldn't say it is pretty, but it works :-)

It doen't have an iterative solution. Instead it returns all the tuples.

```#!/usr/bin/perl
use strict;
use warnings;

my \$n = 3;
my @a = "a".."b";

my @b = vw_rep(\@a, \$n); # variations with repetition (Algorithm::Comb
+inatorics)

use Data::Dump; dd \@b;

sub vw_rep {
my (\$ref, \$n) = @_;
my @c;
for my \$k (0 .. \$n-1) {
my \$L = 0;
for (1 .. @\$ref**\$k) {
for my \$i (0 .. \$#\$ref) {
for (1 .. @\$ref**(\$n-1 - \$k)) {
push @{ \$c[\$L++] }, \$ref->[\$i];
}
}
}
}
return @c;
}

__END__
C:\Old_Data\perlp>perl var_w_rep.pl
[
["a", "a", "a"],
["a", "a", "b"],
["a", "b", "a"],
["a", "b", "b"],
["b", "a", "a"],
["b", "a", "b"],
["b", "b", "a"],
["b", "b", "b"],
]
Update: A better approach using choroba's solution in an iterative fashion could be:
```#!/usr/bin/perl
use warnings;
use strict;

# Pm node 1211055

my \$n = 3;
my @b = qw( a b );

my \$iter = variations_rep_iter(\@b, \$n);

while (my \$tuple = \$iter->()) {
print "@\$tuple\n";
}

sub variations_rep_iter {
my (\$bases, \$n) = @_;

my @indices = (0) x \$n;
my \$first = 1;

my \$iter = sub {
if (\$first) {
\$first = 0;
return [ @\$bases[ @indices ] ];
}

my \$r = \$#indices;
while (\$r >= 0) {
if (++\$indices[\$r] > \$#\$bases) {
\$indices[\$r--] = 0;
} else {
last
}
}
return if \$r < 0;

return [ @\$bases[ @indices ] ];
};
return \$iter;
}

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

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (7)
As of 2021-04-20 14:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?