Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Re: combinations of multiple variables which can assume multiple values

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


in reply to combinations of multiple variables which can assume multiple values

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; }

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others avoiding work at the Monastery: (4)
As of 2024-03-28 22:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found