jgraeve has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks, I wish to create array @c from arrays @a and @b
@a = (1, 2, 3) @b = ("a", "b");
In @c I want all values of @a with all possible combinations of @b
@c = ( [ [1,"a"], [2,"a"], [3,"a"] ] , [ [1,"a"], [2,"a"], [3,"b"] ] , [ [1,"a"], [2,"b"], [3,"a"] ] , [ [1,"b"], [2,"a"], [3,"a"] ] , [ [1,"b"], [2,"b"], [3,"a"] ] , [ [1,"b"], [2,"b"], [3,"b"] ] )

What would we be the best way to accomplish this?

Thanks for helping out.

Johan

Replies are listed 'Best First'.
Re: combinations of multiple variables which can assume multiple values
by choroba (Cardinal) on Mar 16, 2018 at 16:21 UTC
    It's not clear what output you expect. Are you missing the following?
    [ [1,"a"], [2,"b"], [3,"b"] ], [ [1,"b"], [2,"a"], [3,"b"] ]

    If so, the following should work:

    #!/usr/bin/perl use warnings; use strict; my @a = (1, 2, 3); my @b = qw( a b ); my @expected = ( [ [1, "a"], [2, "a"], [3, "a"] ], [ [1, "a"], [2, "a"], [3, "b"] ], [ [1, "a"], [2, "b"], [3, "a"] ], [ [1, "b"], [2, "a"], [3, "a"] ], [ [1, "b"], [2, "b"], [3, "a"] ], [ [1, "b"], [2, "b"], [3, "b"] ], # [ [1, "a"], [2, "b"], [3, "b"] ], # [ [1, "b"], [2, "a"], [3, "b"] ], ); my %reverse_b; @reverse_b{@b} = 0 .. $#b; my @c = [ map [ $_, $b[0] ], @a ]; while (1) { my @indexes = map $reverse_b{ $_->[1] }, @{ $c[-1] }; my $r = $#indexes; while ($r >= 0) { if (++$indexes[$r] > $#b) { $indexes[$r--] = 0; } else { last } } last if $r < 0; push @c, [ map [ $a[$_], $b[ $indexes[$_] ]], 0 .. $#a ]; } use Test::More; use Test::Deep; cmp_deeply \@c, bag @expected; done_testing();

    Update: I forgot to mention: It works for any size of both the arrays.

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
      This is exactly what I needed. Thank you so much.
Re: combinations of multiple variables which can assume multiple values
by Cristoforo (Curate) on Mar 16, 2018 at 19:01 UTC
    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"]], ]

      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
      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; }
Re: combinations of multiple variables which can assume multiple values
by tybalt89 (Monsignor) on Mar 16, 2018 at 16:42 UTC

    Did you mean?

    #!/usr/bin/perl # http://perlmonks.org/?node_id=1211055 use strict; use warnings; use Data::Dump 'pp'; my @a = (1, 2, 3); my @b = ("a", "b"); my @bc = map [ split // ], glob +('{' . join(',', @b) . '}') x @a; my @c = map { my $t = $_; [ map [ $_, $t->[$_-1] ], 1..@a ] } @bc; pp @c;

    Outputs:

    ( [[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"]], )
Re: combinations of multiple variables which can assume multiple values
by LanX (Saint) on Mar 16, 2018 at 19:01 UTC
    straight forward,

    the solution for n columns constructed from n-1 columns successively.

    use strict; use warnings; use Data::Dump qw/pp dd/; my @a = 1 .. 3; my @b = "a".."b"; my @c =([]); # init one empty row for my $l (@a) { my @old = @c; @c =(); for my $r (@b) { for my $row (@old) { push @c, [ @$row , [$l,$r] ]; #push @c, [ (map [@$_], @$row) , [$l,$r] ]; # copy old-pairs +to new arrays } } #pp "old $l: ",@old; } warn "final:\n"; pp $_ for @c; pp \@c;
    [[1, "a"], [2, "a"], [3, "a"]] [[1, "b"], [2, "a"], [3, "a"]] [[1, "a"], [2, "b"], [3, "a"]] [[1, "b"], [2, "b"], [3, "a"]] [[1, "a"], [2, "a"], [3, "b"]] [[1, "b"], [2, "a"], [3, "b"]] [[1, "a"], [2, "b"], [3, "b"]] [[1, "b"], [2, "b"], [3, "b"]]

    NB: many subarray-refs repeat

    do { my $a = [ [[1, "a"], [2, "a"], [3, "a"]], [[1, "b"], [2, "a"], [3, "a"]], ['fix', [2, "b"], [3, "a"]], ['fix', [2, "b"], [3, "a"]], ['fix', 'fix', [3, "b"]], ['fix', 'fix', [3, "b"]], ['fix', 'fix', [3, "b"]], ['fix', 'fix', [3, "b"]], ]; $a->[2][0] = $a->[0][0]; $a->[3][0] = $a->[1][0]; $a->[4][0] = $a->[0][0]; $a->[4][1] = $a->[0][1]; $a->[5][0] = $a->[1][0]; $a->[5][1] = $a->[1][1]; $a->[6][0] = $a->[0][0]; $a->[6][1] = $a->[2][1]; $a->[7][0] = $a->[1][0]; $a->[7][1] = $a->[3][1]; $a; }

    if you want to avoid this, swap the comments in the push lines.

    update

    added version with tuple copy for non-shared refs

    update

    toggle the loops to have the order you (probably) wanted

    for my $row (@old) { for my $r (@b) {

    final: [[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"]]

    Cheers Rolf
    (addicted to the Perl Programming Language and ☆☆☆☆ :)
    Wikisyntax for the Monastery