in reply to check possible combination of sum using given array

Obviously there are quite a few ways to do this including El Bruto (brute force).

In a similar problem, optimization problem, the aim is to find a combination of weights to reach a certain total. With the difference that you have integers and any combination is acceptable. I have suggested using genetic algorithms and there is code there to do that.

Another way, possibly inefficient, is to use a tree.

#!/usr/bin/env perl

# depth-first search on a tree of combinations
# aim is to use @input numbers to make the target sum.
# by bliako
# for https://perlmonks.org/?node_id=11102502
# 08/07/2019

use strict;
use warnings;

# from https://github.com/hadjiprocopis/Tree-Nary-Tiny
# or any other nary-tree implementation, e.g.
# https://metacpan.org/pod/Tree::Simple
use Tree::Nary::Tiny;

#for deep recursion try this:
#my @input = map { 2+int(rand(20)) } 0..100;
#my $target = 15783;

my @input = qw/ 2 5 7 /;
my $target = 15;

my $T = Tree::Nary::Tiny->new(
    undef, # parent
    "root",
    undef, # data
    sub { return $_[0] }
);
my @solutions;
find($T, \@input, $target, \@solutions);

print "$0 : here are all the solutions:\n";
my $i = 1;
foreach (@solutions){
    my $sum = 0;
    $sum += $_ foreach (@$_);
    if( $sum != $target ){ die "wrong solution, this should not be hap
+pening." }
    print $i . ")". join(",", @$_)."\n";
    $i++;
}

sub    find {
    my $n = $_[0];
    my $input = $_[1];
    my $target = $_[2];
    my $solutions = $_[3];
    my $v = $n->value();

    if( defined $v && $v->{'sum'} == $target ){
        my @asol = ();
        while( defined $n->parent() ){
            push @asol, $n->value()->{'number'};
            $n = $n->parent();
        }
        push @$solutions, \@asol;
        print "found solution: ".join(",",@asol)."\n";
        return
    }

    my $sum = defined($v) ? $v->{'sum'} : 0;
    foreach(@$input){
                # added this to make sure that we have combinations ra
+ther than permutations:
                # see haukex's comment below
                next if( defined($v) && $_ < $v->{'number'} );
        if( $sum + $_ <= $target ){
            my $nn = Tree::Nary::Tiny->new(
                $n, # parent
                $_, # an id, nothing important
                {
                    'sum' => $sum + $_,
                    'number' => $_
                }, # the data to hold
            );
            find($nn, $input, $target, $solutions);
        }
    }
}

[download]
tr.pl : here are all the solutions:
1)5,2,2,2,2,2
2)2,5,2,2,2,2
3)7,2,2,2,2
4)2,2,5,2,2,2
5)2,7,2,2,2
6)2,2,2,5,2,2
7)2,2,7,2,2
8)2,2,2,2,5,2
9)2,2,2,7,2
10)2,2,2,2,2,5
11)5,5,5
12)2,2,2,2,7

[download]

EDIT after soonix's comment below: I have added the next if ... statement to my code above like so (so above code now is corrected to give combinations rather than permutations (=order matters)): 

        foreach(@$input){
                # added this to make sure that we have combinations ra
+ther than permutations:
                # see haukex's comment below
                next if( defined($v) && $_ < $v->{'number'} );
                ...

[download]

bw, bliako

Replies are listed 'Best First'.
Re^2: check possible combination of sum using given array
by soonix (Chancellor) on Jul 08, 2019 at 06:08 UTC
[reply]

      good point! Converting my program to combinations is trivial. Make sure that children are added to any tree node only if their number is >= than current.

      foreach(@$input){
  # add this to make sure that we have combinations rather than permut
+ations:
  next if( defined($v) && $_ < $v->{'number'} );
  ...

      [download]

      for target 35 it yields:

      tr_strictly_perms.pl : here are all the solutions:
1)5,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
2)7,2,2,2,2,2,2,2,2,2,2,2,2,2,2
3)5,5,5,2,2,2,2,2,2,2,2,2,2
4)7,5,5,2,2,2,2,2,2,2,2,2
5)7,7,5,2,2,2,2,2,2,2,2
6)7,7,7,2,2,2,2,2,2,2
7)5,5,5,5,5,2,2,2,2,2
8)7,5,5,5,5,2,2,2,2
9)7,7,5,5,5,2,2,2
10)7,7,7,5,5,2,2
11)7,7,7,7,5,2
12)5,5,5,5,5,5,5
13)7,7,7,7,7

      [download]
[reply]
[d/l]
[select]
Re^2: check possible combination of sum using given array
by bliako (Abbot) on Jul 08, 2019 at 22:14 UTC

    A tree is "efficient" in the sense that it stops investigating branches as soon as it finds they contain an impossible/inconsistent solution (no point to keep checking). I initially said "tree may be inefficient" (see previous comment) because of past experience compared to other algorithms for given problem. To be fair,comparing to other methods mentioned here, I say it is quite efficient stricly as far as the number of times recursive find() is called. Still there may be something faster. Easily checcked via incrementing a global variable upon entry. Nice subject for a competition, in case monks get rasty rusty (oxidised, reacting with oxygen) ...

[reply]
[d/l]
Re^2: check possible combination of sum using given array
by karlgoethebier (Abbot) on Jul 08, 2019 at 18:48 UTC

    O.K. Just some nitpicking: I just wondered if your sub find {# bla ...; return} compiles. Regards, Karl

    «The Crux of the Biscuit is the Apostrophe»

    perl -MCrypt::CBC -E 'say Crypt::CBC->new(-key=>'kgb',-cipher=>"Blowfish")->decrypt_hex($ENV{KARL});'Help

[reply]
[d/l]
[select]

      Hello karlgoethebier,

      I just wondered if your sub find {# bla ...; return} compiles.

      Are you thinking of the missing semicolon? From perlsyn#Simple-Statements:

      Every simple statement must be terminated with a semicolon, unless it is the final statement in a block, in which case the semicolon is optional.

      Or were you worried about having a return without an explicit return value? From return:

      If no EXPR is given, returns an empty list in list context, the undefined value in scalar context, and (of course) nothing at all in void context.

      The only call to find in bliako’s script is find($T, \@input, $target, \@solutions);, which is a call in void context. So the bare return simply causes find() to exit immediately, by-passing the rest of the code in the subroutine.

      Hope that helps,

      Athanasius <°(((>< contra mundum Iustus alius egestas vitae, eros Piratica,

[reply]
[d/l]
[select]

        Thanks for the explanation. I forgot that a sub is a block. Or can be regarded as a block. I didn’t worry about the "plain" return. Best regards, Karl

        «The Crux of the Biscuit is the Apostrophe»

        perl -MCrypt::CBC -E 'say Crypt::CBC->new(-key=>'kgb',-cipher=>"Blowfish")->decrypt_hex($ENV{KARL});'Help

[reply]
[d/l]

      Do you mean returning from sub without any explicit return value? e.g. sub { return; }

      obviously it did run but whether it's a faux-pas I have no idea! After all "It's your language. I'm just trying to use it.". Victor Borge via a very dear friend who was paraphrasing it as "It's your language. I am only using it."

[reply]
[d/l]

        Sorry for the wisenheimerei. See my reply to Athanasius below. Best regards, Karl

        «The Crux of the Biscuit is the Apostrophe»

        perl -MCrypt::CBC -E 'say Crypt::CBC->new(-key=>'kgb',-cipher=>"Blowfish")->decrypt_hex($ENV{KARL});'Help

[reply]
[d/l]

In Section Seekers of Perl Wisdom