Anonymous user
Subset sum problem: Difference between revisions
Add Perl
(Add Perl) |
|||
Line 817:
let res = aux [] d in
List.iter (fun (n,w) -> Printf.printf " %4d\t%s\n" w n) res</lang>
=={{header|Perl}}==
{{libheader|ntheory}}
<lang perl>use ntheory qw/:all/;
my $print_all_combinations = 0;
my %pairs = (
alliance => -624, archbishop => -915, balm => 397, bonnet => 452,
brute => 870, centipede => -658, cobol => 362, covariate => 590,
departure => 952, deploy => 44, diophantine => 645, efferent => 54,
elysee => -326, eradicate => 376, escritoire => 856, exorcism => -983,
fiat => 170, filmy => -874, flatworm => 503, gestapo => 915,
infra => -847, isis => -982, lindholm => 999, markham => 475,
mincemeat => -880, moresby => 756, mycenae => 183, plugging => -266,
smokescreen => 423, speakeasy => -745, vein => 813 );
my @names = keys(%pairs);
my @weights = values(%pairs);
if ($print_all_combinations) {
foreach my $n (1 .. @names) {
forcomb {
print "Length $n: @names[@_]\n" unless vecsum(@weights[@_]);
} @names, $n;
}
} else {
foreach my $n (1 .. @names) {
eval {
forcomb {
if (vecsum(@weights[@_]) == 0) {
print "Length $n: @names[@_]\n";
die;
}
} @names, $n;
};
}
}</lang>
Printing just the first one found for each number of elements:
{{out}}
<pre>
Length 2: archbishop gestapo
Length 3: exorcism fiat vein
Length 4: efferent plugging brute centipede
Length 5: efferent exorcism cobol fiat balm
Length 6: efferent exorcism isis vein gestapo mycenae
Length 7: efferent exorcism isis cobol covariate gestapo deploy
Length 8: efferent exorcism isis speakeasy covariate vein escritoire balm
Length 9: efferent exorcism isis speakeasy cobol markham smokescreen lindholm balm
... to length 27 ...
</pre>
We can also use different modules. Assuming the same pairs/names/weights variables set and first combination only, this iterator style is a little cleaner when wanting to exit early:
<lang perl>use List::Util qw/sum/;
use Algorithm::Combinatorics qw/combinations/;
foreach my $n (1 .. @names) {
my $iter = combinations([0..$#weights], $n);
while (my $c = $iter->next) {
next if sum(@weights[@$c]);
print "Length $n: @names[@$c]\n";
last;
}
}</lang>
=={{header|Perl 6}}==
<lang perl6>my @pairs =
| |||