Subset sum problem: Difference between revisions
Content added Content deleted
(Add Perl) |
|||
Line 817: | Line 817: | ||
let res = aux [] d in |
let res = aux [] d in |
||
List.iter (fun (n,w) -> Printf.printf " %4d\t%s\n" w n) res</lang> |
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}}== |
=={{header|Perl 6}}== |
||
<lang perl6>my @pairs = |
<lang perl6>my @pairs = |