|
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?
#!/usr/bin/perl -w
use strict;
use warnings;
my @RESULT;
my $TARGET = 100;
my @LIST = qw(0 5 10 5 5 5 15 80 99);
#34 111.38 55 3.93 100 100 100 100 88 6.3 99 400 1020 -2.43
#73 39 3 12 -0.999 228 104 12377.31 390 399 212 315 5.8 405 4402 16252
#10 3600 18209 288.62 3384 12 450 902 151 396.07 44 88 52 107 244 1 52
+0);
print "\n This program finds a combination of numbers from a long li
+st";
print "\n whose sum equals the \"TARGET\" total number. Ideally, we
+want";
print "\n to find ALL possible combinations! For example:";
print "\n When Target = 5 and our list is 1, 3, 6, 3.38, -9.8, 4, 72
+, 2";
print "\n then the solution would be : 5 = 1 + 4 and 5 = 2 + 3.";
print "\n 1 + 2 + 2 will not appear in the list, because we only hav
+e one number 2.";
print "\n\n\n";
FindCombinations();
exit;
##################################################
#
# This is the main algorithm. First of all, it sorts
# all the numbers in ascending order. Then we get rid
# of all the numbers that are larger than the TARGET
# or if they're zero or smaller. Then it looks at
# the first number in the list and tries to add another
# number to it until it equals the TARGET. Then it takes
# the second number, and so forth, looking for pairs.
#
sub FindCombinations
{
# First, we get rid of all the numbers that are larger
# than the TARGET or ZERO or less than 0. We also remove
# numbers if number == TARGET record a number if it equals the targe
+t.
print "\nSTAGE 1\n>>>LIST=", join(' ', @LIST), "<<<\nRESULTS=|", joi
+n(' ', @RESULT), "|\n";
my $NUMBER;
for (my $i = 0; $i < @LIST; $i++)
{
$NUMBER = $LIST[$i];
if ($NUMBER <= 0 || $NUMBER >= $TARGET)
{
if ($NUMBER == $TARGET) { $RESULT[0] = ($TARGET); }
$LIST[$i] = '';
}
}
print "\nSTAGE 2\n>>>LIST=", join(' ', @LIST), "<<<\nRESULTS=|", joi
+n(' ', @RESULT), "|\n";
@LIST = RemoveBlankLines(@LIST);
@LIST = SortNumbers(@LIST);
print "\nSTAGE 3\n>>>LIST=", join(' ', @LIST), "<<<\nRESULTS=|", joi
+n(' ', @RESULT), "|\n";
############# SEARCH ALGORITHM BEGINS HERE #############
my @ADD_LIST;
my @SKIP_LIST;
for (my $j = 0; $j < @LIST; $j++)
{
my $Total = 0;
$Total = $LIST[$j] * 1;
@ADD_LIST = ($LIST[$j]); # Start here. Try adding numbers to thi
+s number.
for (my $i = @LIST - 1; $i >= 0; $i--)
{
if ($i == $j) { next; } # Skip this number, because it's alread
+y in ADD_LIST.
### Try to add numbers and see if the sum is exactly what we are
+ looking for.
$Total += $LIST[$i];
if ($Total > $TARGET)
{
$Total = $LIST[$j];
$i += @ADD_LIST - 1;
@ADD_LIST = ($LIST[$j]);
next;
}
push(@ADD_LIST, $LIST[$i]);
if ($Total == $TARGET)
{
@ADD_LIST = sort(@ADD_LIST);
push(@RESULT, join('+', @ADD_LIST));
last;
}
}
}
@RESULT = ExtractDuplicates(@RESULT);
print "\nSTAGE 4\n>>>LIST=", join(' ', @LIST), "<<<\nRESULTS=|", joi
+n(' ', @RESULT), "|\n";
}
##################################################
# v2020.11.19
# This function removes duplicate lines from an array
# by sorting it and comparing each line with case-sensitive
# comparison. Returns a new array.
#
# Usage: NEW_ARRAY = ExtractDuplicates(ARRAY)
#
sub ExtractDuplicates
{
my @A = @_;
@A > 1 or return @A;
@A = sort(@A);
my $i = 0;
my $j = 1;
while ($j < @A)
{
if ($A[$i] eq $A[$j])
{
splice(@A, $j, 1);
}
else
{
$i++; $j++;
}
}
return @A;
}
##################################################
# v2020.11.19
# This function trims each element of the input array
# and removes empty strings elements. This function
# shortens the original array.
#
# Usage: RemoveBlankLines(ARRAY)
#
sub RemoveBlankLines
{
@_ or return;
my @A = @_;
my ($j, $i, $LINE) = 0;
for ($i = 0; $i < @A; $i++)
{
$LINE = Trim($A[$i]);
if (length($LINE))
{
if ($j < $i) { $A[$j] = $LINE; }
$j++;
}
}
$#A = $j - 1;
return @A;
}
##################################################
# v2019.8.25
# Removes whitespace from before and after STRING.
# Whitespace is here defined as any byte whose
# ASCII value is less than 33. That includes
# tabs, esc, null, vertical tab, new lines, etc.
# Usage: STRING = Trim(STRING)
#
sub Trim
{
defined $_[0] or return '';
(my $L = length($_[0])) or return '';
my $P = 0;
while ($P <= $L && vec($_[0], $P++, 8) < 33) {}
for ($P--; $P <= $L && vec($_[0], $L--, 8) < 33;) {}
substr($_[0], $P, $L - $P + 2)
}
##################################################
sub SortNumbers { return sort {$a <=> $b} @_; }
##################################################
|
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]
| [reply]
[d/l]
[select] |
|
|
Wow, thank you very much for all your answers! These replies have been very enlightening! :-)
| [reply] |
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
| [reply]
[d/l] |
|
|
> 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.
°)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.
| [reply] |
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
| [reply]
[d/l]
[select] |
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
I hope this is helpful.
| [reply]
[d/l]
[select] |
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' => {}
}
}
}
};
| [reply]
[d/l]
[select] |
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!
| [reply] |
|
|
