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
Re: Combinations of an array of arrays...?
by hv (Prior) on Oct 08, 2004 at 15:37 UTC
|
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 | [reply] [d/l] [select] |
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;
}
| [reply] [d/l] [select] |
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.
| [reply] |
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
| [reply] [d/l] |
Re: Combinations of an array of arrays...?
by ccn (Vicar) on Oct 08, 2004 at 17:13 UTC
|
#!/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();
| [reply] [d/l] |
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
| [reply] [d/l] [select] |
|
|