Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

finding values in an array that add up to a specific number

by Forsaken (Friar)
on Jul 26, 2005 at 22:32 UTC ( [id://478387]=perlquestion: print w/replies, xml ) Need Help??

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

Dear Monks,

this is something I've been cracking my brain over but can't seem to find a decent solution for. I've done a number of searches but can't seem to come up with anything useful either. Here's the situation: I have an array of integer numbers. I need to add up a number of those integers to match a specific value. So, say for example that I have the following array: my @array = (6, 18, 12, 2, 49); I'd need some sort of method to add up x of the elements to make up number y. So for example if I were to need 2 of the integers to add up to 30, I'd need it to return that elements 1 and 2 match the description. Normally if I knew in advance that I'd only need 2 integers I'd use 2 nested foreach loops, but in this case both the x amount of integers that need to be added up as well as the final number y that needs to result from the search are variable, so I'm definitely lost here. Is there a module that could work this black magic for me? On a sidenote I also need to mention that I require all matches.


UPDATE

After checking each of the replies and browsing through the various pieces of information available on the whole knapsack problem, first allow me to express my earnest gratitude for all the great advice everyone has spent their time giving me. Keeping in mind the specifics of my particular situation I decided to take little bits and pieces from everywhere and came up with the following:

package Algorithm::Knapsack::Fixed; use strict; use warnings; use Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw(calculate); sub calculate { my($target, $number, $arrayref) = @_; my @counters = (0..($number - 1)); my @array = @{$arrayref}; my @results; my $endpoint = $#array - $#counters; #sort the array in descending order but remember what the original o +rder was so we can reverse the sort # before we give back the results. If for example we find that items + 123 and 456 of the sorted array # match, we'd return $order[123] and $order[456] my @order = sort { $array[$b] <=> $array[$a] } @0 .. $#array; @array = @array[@order]; while(1) { my $sum = 0; $sum += $array[$counters[0]]; for(1..$#counters) { $sum += $array[$counters[$_]]; if(($sum > $target) && ($_ < $#counters)) { &_increment($_, \@counters, \@array); last; } } if($sum == $target) { #we've got a matching combination! push(@results, [@order[@counters]]); } if(($counters[0] == $endpoint) || (($array[$counters[0]] * ($#coun +ters + 1)) < $target)) { return @results; } if($sum < $target) { &_increment(($#counters - 1), \@counters, \@array); next; } &_increment($#counters, \@counters, \@array); } } sub _increment { my($counter, $countersref, $arrayref) = @_; $countersref->[$counter]++; while(($countersref->[$counter] > $#$arrayref - ($#$countersref - $c +ounter)) && ($counter > 0)) { $counter--; $countersref->[$counter]++; } if($counter < $#$countersref) { foreach my $counter2 (($counter + 1)..$#$countersref) { $countersref->[$counter2] = $countersref->[$counter] + $counte +r2 - $counter; } } } 1;

And it actually works, oh joy, oh joy. Perhaps this would be a good time to mention that the actual array I'm searching through contains a few thousand integers. Making a match of 2 integers can be done in less than 20 seconds. Making a match of 3....well, you're all smart people, do the math, so any advice you might wish to give me on optimizing would indeed be greatly appreciated ;-) I do intend to implement some sort of shortcircuit procedure, so that when for example searching for a combination of 6 numbers, and the first 4 already add up to more than the target value, the 4th counter would increment, cancelling out counter5 * counter6 combination checks, which might help speed things up a bit, especially if the numbers vary wildly.
minor update: fixed the while condition in _increment.
Yet another update: did a complete overhaul, steered away from OO, implemented "shortcircuit". Once again, any comments on optimization are more than welcome. Doing the same match of 2 numbers I mentioned earlier already went down from 20 seconds to 12...
Yet yet another update: made some optimizations to the calculate routine(thanks bart :-)) shaving off a lot more time.


Remember rule one...

Replies are listed 'Best First'.
Re: finding values in an array that add up to a specific number
by dave_the_m (Monsignor) on Jul 26, 2005 at 23:25 UTC
    Note that you are trying to solve what is known as a knapsack problem. In general this can only be solved by an exhaustive search, and so the execution time increases exponentially with the size of the array.

    As to your question, I'd do it with a recursive routine; in outline:

    sub find { my ($want, $n, $elems) = @_; return if $n == 0; return if $want <= 0; for (0..$#$elems) { my $e = $elems->[$_]; if ($n == 1) { return $e if $e == $want; } else { my @f = find($want-$e, $n-1, [@$elems less $e]); return ($e, @f) if @f; } } return; } # get 57 from 2 numbers in the set @answer = find(57, 2, [1,3,7,11]);

    Dave.

Re: finding values in an array that add up to a specific number
by halley (Prior) on Jul 26, 2005 at 23:15 UTC
Re: finding values in an array that add up to a specific number
by dynamo (Chaplain) on Jul 26, 2005 at 22:54 UTC
    interesting. I don't know about an existing module, but here are some ideas for your search algorithm:
    Assuming you want x number of elements in array that add up to y
    sub searchLoop { - pass in: - target number (y) - number of elements desired (x) - the array (array) - y offset number (offset, starts at 0) - sort array in descending numerical order and store that into a tempo +rary array that you can mess with. - remove entries in the temp array that are larger than y - foreach ( unshift a value off temp array into z) remaining entry: - if z = y, print z+offset as a solution (or return it if you only n +eed one solution) - run searchLoop(y-z, x-1, temp (with the z element removed), offset ++z) }

    This is a very rough sketch, but it should get you started.
    - paul
Re: finding values in an array that add up to a specific number
by tomazos (Deacon) on Jul 27, 2005 at 00:42 UTC
Re: finding values in an array that add up to a specific number
by Solo (Deacon) on Jul 26, 2005 at 23:10 UTC
    See Algorithm::Loops::NestedLoops.

    --Solo

    --
    You said you wanted to be around when I made a mistake; well, this could be it, sweetheart.
Re: finding values in an array that add up to a specific number
by GrandFather (Saint) on Jul 27, 2005 at 00:22 UTC
Re: finding values in an array that add up to a specific number
by Anonymous Monk on Jul 27, 2005 at 09:17 UTC
    Call this with the number of integers the sum, the desired sum, and the list of integers to pick from. Returns a list of arrays whose sum is the desired sum:
    sub _{@_>2&&$_[0]>0?(($_[2]==$_[1]&&$_[0]==1?[$_[2]]:()),&_($_[0],$_[1 +],@_[3..$#_]),map[$_[2],@$_],&_($_[0]-1,$_[1]-$_[2],@_[3..$#_])):()}
Re: finding values in an array that add up to a specific number
by TedPride (Priest) on Jul 27, 2005 at 07:46 UTC
    The following works, though it can definitely be made more efficient by using @_ instead of creating private variables in each instance of the sub, and by returning sets of matches instead of passing a potential set to each successive instance of the sub. Of course, this means you can only view the results once they're all in, instead of while they're being generated. Note that I'm passing the number array by reference rather than individual numbers, which should increase efficiency assuming the array starts out fairly big.
    use strict; use warnings; my @array = (6, 18, 12, 2, 49); addup(2, 30, 0, [sort {$b <=> $a} @array]); sub addup { my ($num, $val, $offset, $p, @set) = @_; if ($num == 1) { for ($offset..$#{$p}) { last if @$p[$_] < $val; print join ' ', @set, $val, "\n" if @$p[$_] == $val; } } else { for ($offset..($#{$p}-$num+1)) { next if @$p[$_] > $val - $num + 1; last if @$p[$_] < int ($val / $num); addup($num-1, $val-@$p[$_], $_+1, $p, @set, @$p[$_]); } } }

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://478387]
Approved by kwaping
Front-paged by dynamo
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (4)
As of 2024-03-29 02:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found