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] |
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] |
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] |
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] |
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] |
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] |
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] |