Do you know where your variables are? PerlMonks

### Find combination of numbers whose sum equals X

by harangzsolt33 (Chaplain)
 on Nov 20, 2020 at 07:15 UTC Need Help??

harangzsolt33 has asked for the wisdom of the Perl Monks concerning the following question:

Dear Monks,

This question is about an algorithm, which I am writing in Perl.

Recently I tried to write a simple script for an accountant friend of mine as a hobby, and when I sat down to put this thing together, then I realized that it's not as simple as I thought!

The problem is we have a long list of numbers. The accountant types in one big number which we call TARGET NUMBER. And my program immediately lists all possible combination of numbers from the list whose sum equals the TARGET NUMBER. So, if that number is 100 and our list is made up of the following numbers: 1 99 2 40 50 60 90 3 5 95 100, then the result should look like this:
100
1+99
2+3+95
5+95
2+3+5+90
2+3+5+40+50
40+60

Unfortunately, I don't know how to write the algorithm that finds all possible combinations. My program sorts the list of numbers first. Then it picks the smallest number from the list and adds it to the largest to see if it equals the TARGET NUMBER. If it's bigger, then it tries to add the smallest number to the second from the last and so forth until it finds a combination of two numbers that is equal or smaller than the TARGET NUMBER.

If the sum of two numbers is LESS than the TARGET NUMBER, then we try to add a third number to see if it equals and so forth... The problem is that this requires the numbers to occur in a certain order. If they occur in the wrong order, then we will miss some combinations! For example, we're looking to find combinations that equal 100. This is our list: 5 5 5 5 10 15 80 99

As you can see, in this scenario, we will find 5+15+80, because they occur in a specific order. But we will completely miss 5+5+5+5+80, because the algorithm has a bug. I don't know how to make this work. Can anyone suggest a fix or a different algorithm?

Replies are listed 'Best First'.
Re: Find combination of numbers whose sum equals X
by choroba (Cardinal) on Nov 20, 2020 at 09:47 UTC
#!/usr/bin/perl use warnings; use strict; sub _summands { my (\$target, @numbers) = @_; return [[]] if 0 == \$target; my @results; for my \$index (0 .. \$#numbers) { my \$number = \$numbers[\$index]; my @remaining = @numbers[ grep \$_ != \$index, 0 .. \$#numbers ]; next if \$target - \$number < 0; my \$result = _summands(\$target - \$number, @remaining); push @results, map [\$number, @\$_], grep ! @\$_ || \$number <= \$_->[0], @\$result; } return \@results } sub summands { my \$results = _summands(@_); my %unique; for my \$result (@\$results) { undef \$unique{"@\$result"}; } return [ map [split ' '], keys %unique ] } use Test::More tests => 2; use Test::Deep; cmp_deeply summands(100, 1, 99, 2, 40, 50, 60, 90, 3, 5, 95, 100), bag([100], [1, 99], [2, 3, 95], [5, 95], [2, 3, 5, 90], [2, 3, 5, +40, 50], [40, 60]); cmp_deeply summands(100, 5, 5, 5, 5, 10, 15, 80, 99), bag([5, 15, 80], [5, 5, 5, 5, 80], [5, 5, 10, 80]);

Update: Sorry, I'm kind of busy, so I don't have much time to explain it. It's a classical example of Dynamic Programming - the only complication is the numbers can be repeated, which I solved using the \$unique hash. It's probably possible to build the solutions in a unique way right away in the recursive function, so there won't be any postprocessing needed.

Update 2: For a speed-up, add

use Memoize; memoize('_summands');
and, as found by haukex in Fastest way to "pick without replacement", replace
my \$number = \$numbers[\$index]; my @remaining = @numbers[ grep \$_ != \$index, 0 .. \$#numbers ];
by
my @remaining = @numbers; my (\$number) = splice @remaining, \$index, 1;

map{substr\$_->[0],\$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
Wow, thank you very much for all your answers! These replies have been very enlightening! :-)
Re: Find combination of numbers whose sum equals X
by QM (Parson) on Nov 20, 2020 at 10:20 UTC
I think this is known as the Subset Sum Problem.

-QM
--
Quantum Mechanics: The dreams stuff is made of

> I think this is known as the Subset Sum Problem.

Well ... almost.

The Subset Sum Problem asks if there is one solution.

But the OP asks to "list all possible combination of numbers"

Algorithm wise that's a huge difference, because one can often optimize searching for a single solution, while happily ignoring the rest. °

And that's also why I'm hesitant solving this, you can easily show that the solution space of all possible combinations will explode quickly, in a way that already the time needed to print them out will take an eternity.

I.O.W. such problems don't make much sense, unless you are singling out a single (or a few) solution which are optimal regarding a second value-function.

Cheers Rolf
(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery

°)The Knapsack Problem will also demand to optimize a second "value" function and only require the "weight" to be less or equal the "target". It's a generalization of Subset Sum b/c if you choose the weight as value, the equal case - if it exists - will be maximal.

Re: Find combination of numbers whose sum equals X
by tybalt89 (Monsignor) on Nov 20, 2020 at 12:44 UTC
#!/usr/bin/perl use strict; # https://perlmonks.org/?node_id=11123870 use warnings; use List::Util qw( uniq ); print "\$_\n" for find( 100, '1 99 2 40 50 60 90 3 5 95 100' ); print "\n"; print "\$_\n" for find( 100, '5 5 5 5 10 15 80 99' ); sub find { my (\$target, \$from, \$have) = @_; \$have //= ''; \$target == 0 and return \$have =~ s/.//r; \$target > 0 && \$from =~ s/\d+// or return (); uniq find( \$target - \$&, \$from, "\$have+\$&"), find( \$target, \$from, +\$have ); }

Outputs:

1+99 2+40+50+3+5 2+90+3+5 2+3+95 40+60 5+95 100 5+5+5+5+80 5+5+10+80 5+15+80
Re: Find combination of numbers whose sum equals X
by johngg (Canon) on Nov 20, 2020 at 17:38 UTC

The word "combination" in the title brought Algorithm::Combinatorics to mind. I'm not sure if duplicate sums, e.g. the several 5+5+10+80 combinations in the third example, should all be shown but I have eliminated them. This code

use strict; use warnings; use feature qw{ say }; use Algorithm::Combinatorics qw{ combinations }; use List::Util qw{ sum }; my @tests = ( { target => 100, values => [ 1, 99, 2, 40, 50, 100, 60, 90, 3, 5, 95, 100 ], }, { target => 10, values => [ 1, 3, 2, 4 ], }, { target => 100, values => [ 5, 5, 5, 5, 10, 15, 80, 99 ], }, ); foreach my \$rhTest ( @tests ) { say qq{\nFind sums from }, join( q{, }, @{ \$rhTest->{ values } } ), qq{ making \$rhTest->{ target }}; say for do { my %seen; grep { ! \$seen{ \$_ } ++ } grep { \$_ == \$rhTest->{ target } } @{ \$rhTest->{ values } }; }; for my \$sumsOf ( 2 .. scalar @{ \$rhTest->{ values } } ) { my \$combIter = combinations( \$rhTest->{ values }, \$sumsOf ); my %seen; while ( my \$raComb = \$combIter->next() ) { next if \$seen{ join q{+}, sort { \$a <=> \$b } @{ \$raComb } +} ++; say join q{+}, @{ \$raComb } if \$rhTest->{ target } == sum @{ \$raComb }; } } }

produces

Find sums from 1, 99, 2, 40, 50, 100, 60, 90, 3, 5, 95, 100 making 100 100 1+99 40+60 5+95 2+3+95 2+90+3+5 2+40+50+3+5 Find sums from 1, 3, 2, 4 making 10 1+3+2+4 Find sums from 5, 5, 5, 5, 10, 15, 80, 99 making 100 5+15+80 5+5+10+80 5+5+5+5+80

Cheers,

JohnGG

Re: Find combination of numbers whose sum equals X
by LanX (Saint) on Nov 22, 2020 at 00:35 UTC
here another approach, it calculates the possible partial sums in %step with increasing possible \$delta.

the solutions are than printed by walking back from \$target to zero.

NB: it creates two kind of outputs, a tree with partial solutions and a result hash.

unfortunately this only works efficiently for unique deltas, I'll probably try to fix it tomorrow.

(or better leave it open for the interested reader ;)

use strict; use warnings; use Data::Dump qw/pp dd/; use Data::Dumper; # --- input my @input = (1,99,2,40,50,60,90,3,5,95,100); my \$target = 100; my %steps = ( 0 => []); # --- processing my @deltas = sort { \$a <=> \$b } @input ; for my \$delta ( @deltas ) { for my \$last (keys %steps) { my \$next = \$last + \$delta; unshift @{\$steps{\$next}},\$last if \$next <= \$target-\$delta # \$delta grows! or \$next == \$target; # goal } # pp \$delta, \%steps; } pp \%steps; # --- output my %free; \$free{\$_}++ for @deltas; our \$level = -1; sub walk_back { my (\$target,\$h_path)=@_; local \$level = \$level +1; for my \$last (@{\$steps{\$target}}) { my \$delta = \$target-\$last; next unless \$free{\$delta}; local \$free{\$delta} = \$free{\$delta}-1; print "\t" x \$level , "+\$delta\n"; my \$sub_path = \$h_path->{\$delta} = {}; if ( \$last>0 ) { walk_back(\$last,\$sub_path) } else { print "\n\n"; } } } my %path; walk_back(\$target,\%path); pp \@deltas; print Dumper \%path;

{ "0" => [], "1" => [0], "2" => [0], "3" => [0, 1], "4" => [1], "5" => [0, 2], "6" => [1, 3], "7" => [2], "8" => [3], "9" => [4], "10" => [5], "11" => [6], "40" => [0], "41" => [1], "42" => [2], "43" => [3], "44" => [4], "45" => [5], "46" => [6], "47" => [7], "48" => [8], "49" => [9], "50" => [0, 10], "51" => [11], "100" => [0, 1, 5, 10, 40, 50], } [1, 2, 3, 5, 40, 50, 60, 90, 95, 99, 100] +100 +99 +1 +95 +5 +3 +2 +90 +5 +3 +2 +60 +40 +50 +40 +5 +3 +2 \$VAR1 = { '99' => { '1' => {} }, '50' => { '40' => { '5' => { '3' => { '2' => {} } } } }, '95' => { '5' => {}, '3' => { '2' => {} } }, '100' => {}, '60' => { '40' => {} }, '90' => { '5' => { '3' => { '2' => {} } } } };

Cheers Rolf
(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery

Re: Find combination of numbers whose sum equals X
by Leudwinus (Scribe) on Nov 23, 2020 at 19:25 UTC

I don't really have anything of substance to add in helping you solve your problem but it did remind me of this blog post from a few years back describing how someone solved a similar accounting problem using Python!

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11123870]
Approved by Corion
Front-paged by choroba
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others avoiding work at the Monastery: (4)
As of 2024-06-21 02:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?
 • erzuuli ‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.