dideod.yang has asked for the wisdom of the Perl Monks concerning the following question:

HI monks. I have question about checking combination of sum. I want to check that array can generate pairs of sum. Please give me nice algorithm.. I could't make script..
my @input = qw/ 2 5 7 /; my $target = 15; my @want_output = ( (5 5 5) (2 2 2 2 7) .... ) my $target2 = 3 my @want_output = fail;

Replies are listed 'Best First'.
Re: check possible combination of sum using given array
by haukex (Archbishop) on Jul 07, 2019 at 15:03 UTC
Re: check possible combination of sum using given array
by tybalt89 (Monsignor) on Jul 07, 2019 at 16:23 UTC

    Here's one idea for an algorithm. Getting the output into the @want_output array is left up to you.

    #!/usr/bin/perl # https://perlmonks.org/?node_id=11102502 use strict; use warnings; my @input = qw/ 2 5 7 /; my $target = 15; print "\ntarget $target from @input\n"; find( 0, [], $target, @input ); print "That's all, folks\n"; $target = 3; print "\ntarget $target from @input\n"; find( 0, [], $target, @input ); print "That's all, folks\n"; $target = 35; print "\ntarget $target from @input\n"; find( 0, [], $target, @input ); print "That's all, folks\n"; sub find { my ($sum, $sofar, $want, @numbers ) = @_; if( $sum == $want ) { print "@$sofar\n"; } elsif( $sum < $want and @numbers and $numbers[0] > 0 ) { find( $sum + $numbers[0], [ @$sofar, $numbers[0] ], $want, @number +s ); find( $sum, $sofar, $want, @numbers[1..$#numbers] ); } }

    Outputs:

    target 15 from 2 5 7 2 2 2 2 2 5 2 2 2 2 7 5 5 5 That's all, folks target 3 from 2 5 7 That's all, folks target 35 from 2 5 7 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 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 5 5 5 2 2 2 2 2 2 2 2 2 5 5 7 2 2 2 2 2 2 2 2 5 7 7 2 2 2 2 2 2 2 7 7 7 2 2 2 2 2 5 5 5 5 5 2 2 2 2 5 5 5 5 7 2 2 2 5 5 5 7 7 2 2 5 5 7 7 7 2 5 7 7 7 7 5 5 5 5 5 5 5 7 7 7 7 7 That's all, folks
Re: check possible combination of sum using given array
by bliako (Abbot) on Jul 07, 2019 at 21:42 UTC

    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); } } }
    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

    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'} ); ...

    bw, bliako

        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'} ); ...

        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

      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) ...

      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

        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,

        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."

Re: check possible combination of sum using given array
by Don Coyote (Hermit) on Jul 15, 2019 at 16:42 UTC

    This question has kind of motivated me to try and write something worthwhile. I am making some progress but am not quite there. Still I think I have enough to give an idea where I'm heading

    I have posted the output to where im at currently, as getting namespaces and actually trying to figure out how the data types are going to go is well, some fun

    More than just solving the OP logic problem, the intention is perhaps more to write something that can be used as support for educational purposes. It is understandable that much of this has already been implemented in many math modules already. However, I maybe just entertaining my own sentiments, but there is something refreshing about getting down to the atomic structure of numbers. And just simply seeing the arithmetic in action. And any excuse to use Perl, for which I think this purpose is suited, is a good excuse.

    Hopefully I'll get the logic side of the OP shortly. Fifty quid on it. I did however figure out that I may not have supposed to have been getting negative denominators when row reducing. I guess thats what happens when you take the inverse of a negative fraction by turning it upside down. :p

    This looks like a problem that could be dealt with using prime factorisation. But, to get a prime factorisation you need to check the possible combinations of a sum.

    tentatively, problem restated: Given a number A, and a List B consisting of one or more numbers, which numbers from B:

    • are divisors of A
    • can be summed to any divisor of A
    • are divisors of any other number in B
    • can be summed to any divisor of any other number from B
    • are divisors of A
    • can be summed to any divisor of A
    • are divisors of any other number in B that is a divisor of A
    • can be summed with any other number in B to A or any B That is a Divisor of A.

    When all numbers in B satisfy (some or all?) of these conditions, supply the multiplicities of the numbers required for firstly the summations up to the divisors of both A and B, and secondly any reaminders of numbers that are not divisors but are used in the summation composition.

    note: restatement subject to re-interpretation using more appropriate terminology where required. That is, I may mean factor where I have stated divisor. I may mean composite summation. Also to be clarified - where remainders that are not divisors are used in the summation.

    Before moving on to a List of multiple numbers, understanding how the failing case works is probably key. With A being 3 and a B being a List or Set from 2.

    • A: Prim Nat '|||' (3)
    • B: List(2)

    where B contains only 1 item, B could be construed as a List or a Set. Right now, I am (attempting to be) keeping it simple as an argument list.

    Plan of action, is to match A with B. A is a number, B is a List. done. Ok, Let us use b to mean the number in the List.

    Plan of action, is to match A with b. Failure is a result of either

    • b not being a divisor of A
    • any multiple of b not being a divisor of A
    This case also highlights another aspect in that b itself is smaller than A, and its first multiple (2b) is larger than A. These conditions in relation to each other should form the basis of an appropriate algorithm for the problem if not solve it.

    No errrors found.

    getting there, I can now 'split' rather, substitute and count the substitutions, so to say, and test for a remainder, which is half the problem.

    output as it stands

    progress report Re: check possible combination of sum using given array. out by 5168!


    not 'A^2 + A^2' ne 'C'
Re: check possible combination of sum using given array
by Don Coyote (Hermit) on Apr 30, 2020 at 16:11 UTC

    some progress

    Clearly the issue for me is about the implementation of the data structures. However, returning to this SoPW. I have made some progress toward understanding how exactly the Array and Hash perl data structures do not work as I may have supposed they might.

    Having said that I am now drafting a Meditation that will go into a bit more detail about, what it is I think I'm doing versus what it is I think I am trying to do. I may get some more appropriate responses after I do such. I hope, and thanks for bearing with me.

    Essentially I am attempting to implement LOMS. This may already exist within the perl universe, and I may have bypassed that somewhere. Initially though, it would appear that the perl data structures Array and Hash, might be considered as Lists, and Sets respectively. And I am still debating that, they may be Osets and Multisets (they're not they're perl data structures), but the hands have to start getting dirty somewhere. The idea being that, treating either as a specific structure from another field, is most likely akin to mixing up system and software IO. Principally not a good idea, but maybe a starting point for headache inducing thoughts.

    In my previous study to the OP question Re: check possible combination of sum using given array I most definetely hinted towards this, but at the level of attempting to ascertain what data structure the natural numbers fitted into. Again with some difficulty. However in the mean time, I have been developing my understanding around the areas of comp sci and maths, as it relates or, as much as I percieve it relates to these ideas.

    A near answer

    #!/usr/bin/perl #re https://www.perlmonks.org/?node_id=11102502 use strict; use warnings; #my $abc = "abc-&#945;&#946;&#947;"; #handy greek letters #my $xyz = "&#967;&#968;&#950;-xyz"; my( $number, @components ) = grep s/\A([0-9]+)\Z/$1/, @ARGV; unless( $number and @components == ( @ARGV - 1 ) ){ exit q[Argument isn't numeric] } # removes duplicates prior to processing, to indicate to the user this + is known; my %not_quite_an_Oset_A; @not_quite_an_Oset_A{@components} = (undef) x @components; my $dup; if( keys %not_quite_an_Oset_A != @components){ print "Duplicated numbers will be removed in processing\n"; $dup = 1; }; @components = sort map { $_ + 0 } keys %not_quite_an_Oset_A; # understanding of LOMS implementations versus Perl Data Structures ma +y vary just now :} print "Interpreting [ $number ] as sums of [ @components ]\n"; my $allocated = compute_recursively( $number, \@components ); #use Data::Dumper; #print Dumper( $allocated ); unfurl_recursive( $allocated ); sub compute_recursively{ my ( $number, $components ) = @_; my $allocating = {}; foreach my $comp ( @$components ) { $allocating->{ $comp } = do { if( $comp == $number ){ if( defined $dup ){ $|++; print "removing dup comp"; sleep 1; prin +t " ."; sleep 1; print ".\n" }; undef }elsif( $comp > $number ){ 'X' }else{ compute_recursively( $number - $comp, $components ) } }; } return $allocating } sub unfurl_recursive{ # optimism unshift @_, 'Mset [', if @_ == 1; # reality #$_[0] =~ s!\AMset \[!Set {!; # hmmm..? $_[0] =~ s!\AMset \[!LOMS? {!; unshift @_, 'Mset [', if @_ == 1; my $Emulated_Numerical_Equivilation = shift; my $perlHash = shift; unless( defined $perlHash ){ print "$Emulated_Numerical_Equivilation }\n"; return } if( $perlHash eq 'X' ){ return ''; } foreach my $n ( keys %$perlHash ) { unfurl_recursive( "$Emulated_Numerical_Equivilation $n", $perlHash- +>{$n} ) } } __END__ >numsums.pl 15 3 5 7 OUTPUT Interpreting [ 15 ] as sums of [ 3 5 7 ] LOMS? { 3 3 3 3 3 } LOMS? { 3 7 5 } LOMS? { 3 5 7 } LOMS? { 7 3 5 } LOMS? { 7 5 3 } LOMS? { 5 3 7 } LOMS? { 5 7 3 } LOMS? { 5 5 5 } Interpreting [ 2 ] as sums of [ 3 ] Interpreting [ 55 ] as sums of [ 3 5 7 ] 86000ish Interpreting [ 105 ] as sums of [ 3 5 7 ] Out of Memory!

    The OP asked for a check of combinations, the program returns combinations that sum to teh required number. I would argue that these are not permutations, as there would be multiples of the permutation of the Multiplicities of only 3 or 5. but there are only 1 of each.

    In the printout what we see is actually a mixing of types, there are 2 Multisets, and 6 Osets, or 2 Multisets, and 6 Perms of 1 Set.

    What the OP does not get from, my response anyway, is an Array containg the combinations if any exist, or an Array conataining 'fail' should any not exist. I thought I'd just add that in about 4 hours ago, needless to say I just reverted to giving a response. Think I see how recursiveness can be a pain now.

    The point being that the OP was actually rather vague about what they were after, so the answer they recieved was/is rather vague.

    When perl dwim I think it is looking to translate some text from one place to another, when someone would like to start playing around with number theory, perl is not really bothered. Perl likes transcribing clay tablets, over evaluating them.


    Meditation coming soon to a perlmonks webpage near you.