|
Basilides has asked for the wisdom of the Perl Monks concerning the following question:
not strictly a perl-specific query, i'm afraid, but can anyone help me with an algorithm:
i've got a variable length array of numbers, and i need to mark which combinations of them add up to zero
eg say the array (which is zero-based) is
-25,
14,
50,
20,
-7,
-8,
-10
then elements 0, 2, 4, 5 & 6 add up to zero, but no other combinations do (except the same thing in a different order, which i don't want to count again).
how do i structure my loops so that it tests every possible permutation? |
Re: permuation algorithm
by japhy (Canon) on Jul 11, 2002 at 15:52 UTC
|
my @n = (-25, 14, 50, 20, -7, -8, -10);
my $max = 2**@n;
for (my $i = 0; $i < $max; ++$i) {
my $sum = 0;
$sum += $n[$_] for grep $i & 2**$_, 0 .. $#n;
if ($sum == 0) {
my ($bits, @used) = $i;
while ($bits) {
my $high_bit = int(log($bits)/log(2));
push @used, $n[$high_bit];
$bits &= ~(2**$high_bit);
}
print "[@used] = 0\n";
}
}
Another approach to the end is thus:
my ($bits, $j, @used) = ($i, 0);
while ($bits) {
push @used, $n[$j] if $bits & 1;
$bits >>= 1, ++$j;
}
which could also be written as a for loop:
for (
my ($bits, $j, @used) = ($i, 0);
$bits;
$bits >>= 1, ++$j
) {
push @used, $n[$j] if $bits & 1;
}
_____________________________________________________
Jeff[japhy]Pinyan:
Perl,
regex,
and perl
hacker, who'd like a job (NYC-area)
s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??; | [reply]
[d/l]
[select] |
Re: permuation algorithm
by Abigail-II (Bishop) on Jul 11, 2002 at 16:21 UTC
|
Use backtracking, aka the Perl regex machine.
Give your set of number as command line arguments
to the following program:
#!/usr/bin/perl
use strict;
use warnings 'all';
use re 'eval';
use vars '%seen';
my $regex = <<'--';
(?{ local $x = 0 })
(?{ local @x = (-1) x @ARGV })
--
my $i = 0;
foreach my $number (@ARGV) {
$regex .= "(?:(?{ local \$x = \$x + $number; local \$x [$i] = $i }
+)|)\n";
$i ++
}
$regex .= <<'--';
(?(?{ $x }) fail | )
(?(?{ grep {$_ >= 0} @x }) | fail)
(?{ local $str = join " + " => @ARGV [grep {$_ >= 0} @x] })
(?(?{ $seen {$str} ++ }) fail | )
(?(?{ print "$str = 0\n" }) fail | )
--
"" =~ /$regex/x;
Abigail
| [reply]
[d/l] |
|
|
| [reply] |
Re: permuation algorithm
by FoxtrotUniform (Prior) on Jul 11, 2002 at 15:40 UTC
|
You're looking for combinations, not permutations, and
Knuth
recently wrote a rather complete paper on the subject
(about halfway down the page).
--
The hell with paco, vote for Erudil!
:wq
| [reply] |
Re: permuation algorithm
by broquaint (Abbot) on Jul 11, 2002 at 15:42 UTC
|
I'm no expert on the matter of permutations but there are plenty of resources on The Monastery about the subject of permutations and there's even a module on CPAN under the name of Algorithm::Permute which might do the job for you, or failing that the source should be a good reference.
HTH
_________
broquaint | [reply] |
Re: permutation algorithm
by runrig (Abbot) on Jul 11, 2002 at 20:33 UTC
|
There's a node on this sort of thing here from a monk who is gone but not forgotten. All you have to do is add up the numbers for every iteration of the iterator, and, if you want, skip any combinations which contain duplicates. | [reply] |
Re: permutation algorithm
by fglock (Vicar) on Jul 11, 2002 at 22:50 UTC
|
use strict;
my @list = (1,2,3);
my @result = ();
for my $elem (@list) {
push @result, [ @$_, $elem ] for @{ [ @result ] };
push @result, [ $elem ];
}
use Data::Dumper;
print Dumper @result;
Got:
$VAR1 = [
1
];
$VAR2 = [
1,
2
];
$VAR3 = [
2
];
$VAR4 = [
1,
3
];
$VAR5 = [
1,
2,
3
];
$VAR6 = [
2,
3
];
$VAR7 = [
3
];
| [reply]
[d/l]
[select] |
Re: permutation algorithm
by fglock (Vicar) on Jul 12, 2002 at 13:01 UTC
|
use strict;
my @list = (-25, 14, 50, 20, -7, -8, -10);
my @result = ();
my $sum;
for my $elem (@list) {
for (@{[@result]}) {
push @result, [ @$_, $elem ];
$sum = eval join '+' => @{$result[-1]};
print join(',', @{$result[-1]}), "\n" unless $sum;
}
push @result, [ $elem ];
print $elem, "\n" unless $elem;
}
Result:
-25,50,-7,-8,-10
You will need some additional work in
order to obtain array indexes
instead of values.
How it works:
In first pass, it will ignore the inner for and it will push [ -25 ]
into @result. Result is [ [-25] ]
In second pass, it will push 14 into a
copy of what it already has, and then it will push
[ 14 ]. Result is: [ [-25], [-25,14], [14] ]
In second pass, it will push 50 into a
copy of what it already has, and then it will push
[ 50 ]. Result is: [ [-25], [-25,14], [14], [-25,50], [-25,14,50], [14,50], [50] ]
While it does that, it will print whatever combinations that sum zero.
That's it!
| [reply]
[d/l]
[select] |
|
|
| [reply] |
|
|
| [reply] |
|
|
