Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Combinations of an array of arrays...?

by doowah2004 (Monk)
on Oct 08, 2004 at 15:19 UTC ( #397671=perlquestion: print w/replies, xml ) Need Help??

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

Hi All,

I have been racking my brain on this, and I am sure that it is probably simple. What I have is 7 arrays with arbitrary number of elements in each. I would like to create a new array that contains combinations of the other seven in this manner:

1. Only one element from each of the 7 arrays.
2. minimum of 4 elements per element in final array


For example if I had the data:
array1 = (a,b,c), array2 = (d,e), array3 = (f,g,h), array4 = (i), array5 = (j,k) array6 = (l) array7 = (m) Then the result should be an array that contained: adfijlm adfiklm adgijlm adgiklm . . adfijl . . adfij . . cehi . . iklm


Does anyone have any pointers?

Thanks in advance,

Cameron

Replies are listed 'Best First'.
Re: Combinations of an array of arrays...?
by hv (Parson) on Oct 08, 2004 at 15:37 UTC

    Here's one way to do it, using the Algorithm::Loops module:

    use strict; use Algorithm::Loops qw/ NestedLoops /; my @arrays = ( [qw/ a b c /], [qw/ d e /], [qw/ f g h /], [qw/ i /], [qw/ j k /], [qw/ l /], [qw/ m /], ); NestedLoops( [ map [ undef, @$_ ], @arrays ], sub { my $count = 0; my $string = join '', grep { defined && ++$count } @_; print $string if $count >= 4; }, );

    First, this combines the 7 individually named arrays into a single array of arrays to make it easier to handle them as a set.

    The first parameter to NestedLoops() constructs the sets over which to loop by taking each of the 7 arrays and including undef to represent "nothing chosen from this array".

    The second parameter is the code executed for each selection, which counts the number of defined values (to make sure we have at least 4), joins those defined values into a single string, and prints them.

    Note that some slight rearrangement would allow you to use this to construct an iterator which would return the next valid combination each time you call it; that would probably be the more useful approach if you want to do something other than simply print them.

    Hugo

Re: Combinations of an array of arrays...?
by kvale (Monsignor) on Oct 08, 2004 at 15:55 UTC
    It is probably easiest to break this down into three problems:
    • choose number of arrays x to draw from
    • for each number of arrays, create the (7 choose x) combinations of arrays to use
    • for each combination of arrays, iterate over all the elements in each array

    The first two tasks could be combined by assigning an array to each bit of a binary number, and iterating over (15..127) and only accepting binary numbers with at least 4 ones in it. But this sort of strategy is not efficient for large numbers of arrays.

    To iterate over the elements on each array, you can again use a counting scheme. For the selected arrays @a1,..@ak (k = 4,..,7), form the number N = @a1*...*@ak. Then count from z = 0 to N-1. This number z represents a unique combination of the element positions in your array.

    • int (z/(@a2*...*@ak)) mod @a1 is the ele position in @a1
    • int (z/(@a3*...*@ak)) mod @a2 is the ele position in @a2
    • ...
    • z mod @ak is the ele position in @ak
    Sorry, don't have time to code it up.

    -Mark

Re: Combinations of an array of arrays...?
by thospel (Hermit) on Oct 08, 2004 at 16:23 UTC
    Here is a quick and dirty version that doesn't generate all combinations and then filter, but only does the strictly needed work (I assume the array elements have length 1):
    #!/usr/bin/perl -wl use strict; print for generate(4, [qw(a b c)], [qw(d e)], [qw(f g h)], ["i"], [qw(j k)], ["l"], ["m"]); sub generate { my $min = shift; my @non_empty = grep @$_, @_; return if $min > @non_empty; work($min, @non_empty); } sub work { my $min = shift; return "" if !@_; my $first = shift; return map { my $n = $_; length() < $min ? () : $_, map $_.$n, @$first; } work($min-1, @_); }
    update: A purely iterative version of the above:
    sub generate { my $min = shift; my @arrays = grep @$_, @_; $min -= @arrays; return if $min > 0; my @current = (""); for my $array (@arrays) { $min++; @current = map { my $n = $_; length() < $min ? () : $_, map $n.$_, @$array; } @current; } return @current; }
Re: Combinations of an array of arrays...?
by dimar (Curate) on Oct 08, 2004 at 15:45 UTC

    Here is a simple example from some preexisting code. It uses the built-in 'glob' function. It does not check against requirement 2, but it should be enough to get you started.

    ### <region-file_info> ### main: ### - name : trySimpleCombinations000.pl ### sbty : perl ### desc : generate simple combinations from separate arra +ys ### </region-file_info> ### begin_: init perl use strict; use warnings; ### begin_: init vars my @aColor = qw(Red White Blue); my @aAnimal = qw(Cat Rat Dog Mouse); my @aLetter = qw(Alpha Bravo Charlie); my @aDigit = qw(0 1 2 3 4); my @aResult = (); ### begin_: generate combis @aResult = glob ( "{@{[join',',@aColor]}}" ."{@{[join',',@aAnimal]}}" ."{@{[join',',@aLetter]}}" ."{@{[join',',@aDigit]}}" ); ### begin_: show the results print join "\n", @aResult; print ("\n-----------------------------------\n"); 1; __END__ RedCatAlpha0 RedCatAlpha1 RedCatAlpha2 RedCatAlpha3 RedCatAlpha4 RedCatBravo0 . . . BlueMouseCharlie0 BlueMouseCharlie1 BlueMouseCharlie2 BlueMouseCharlie3 BlueMouseCharlie4
Re: Combinations of an array of arrays...?
by tmoertel (Chaplain) on Oct 08, 2004 at 16:17 UTC
    Just for kicks, here's what the solution looks like in the Haskell programming language:
    combos n ls = filter ((>= n) . length) . map concat . sequence . map (([]:) . map return) $ ls
    (This is analogous to the Perl solution provided by hv earlier.)

    Examples:

    > combos 1 ["abc", "def"] ["d","e","f","a","ad","ae","af","b","bd","be","bf","c","cd","ce","cf"]

    Here's the (elided) answer to your example question:

    > combos 4 ["abc", "de", "fgh", "i", "jk", "l", "m"] ["ijlm","iklm","fjlm","fklm","film","fijm", ... "cehijlm","cehik","cehikm","cehikl","cehiklm"]

    Cheers,
    Tom

Re: Combinations of an array of arrays...?
by ccn (Vicar) on Oct 08, 2004 at 17:13 UTC

    Update: make code more readable

    #!/usr/bin/perl -wl use strict; my @data = ( [qw(a b c)], [qw(d e)], [qw(f g h)], [qw(i)], [qw(j k)], [qw(l)], [qw(m)], ); my @pos = (0) x @data; sub iterator { my $i = @pos; while ($i--) { $pos[$i] = ($pos[$i] + 1) % @{$data[$i]} and last; } return scalar grep $_, @pos; } sub items { my ($n, $str) = @_; return if length $str < $n; return substr($str, 0, 1) if $n == 1; return $str if $n == length $str; my @items = items($n, substr($str, 1)); for my $i (1 .. length($str) - 1) { push @items, map { substr($str, 0, 1) . $_ } items($n - 1, substr($str, $i)); } return @items; } do { for (4 .. @data) { print for items($_, join '', map { $data[$_]->[$pos[$_]] } 0 .. $#data ); } } while iterator();

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://397671]
Approved by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (5)
As of 2019-10-18 00:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?