Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Challenge: Number of unique ways to reach target sum

by Limbic~Region (Chancellor)
on Feb 14, 2006 at 13:35 UTC ( #530112=perlquestion: print w/ replies, xml ) Need Help??
Limbic~Region has asked for the wisdom of the Perl Monks concerning the following question:

All,
In the spirit of Project Euler, I pose the following problem:

How many unique ways are there to select 10 different numbers from 1-100 so that the sum of the numbers is 667?

In other words:
  • Each number in a set of 10 must be distinct
  • Two sets that have the same 10 numbers but in a different order are not valid (not unique)
  • Some numbers in 2 different sets may repeat as long as all 10 do not repeat
A straight forward brute force implementation will require checking 17,310,309,456,440 different sets of numbers, so that is where the challenge comes in.

The only hints that I will give on how I solved the problem is that I used C and constructed my loops dynamically. I will also say that there are over a billion solutions. Unlike Project Euler, I ask that you also post your code so that everyone may learn from our collective ingenuity. I will post my code by this Friday.

Cheers - L~R

Clarified acceptable solution criteria

Comment on Challenge: Number of unique ways to reach target sum
Re: Challenge: Number of unique ways to reach target sum
by Roy Johnson (Monsignor) on Feb 14, 2006 at 15:09 UTC
    Having discussed the general form of this program with you and written code for it, I have something of an advantage over others. The code to iterate through all solutions is below, and is running on my PC as I type this, at something between 10000 and 20000 iterations/second.

    I will be pondering whether there isn't a way to determine how many ways to get the result without actually generating them. I know that you can save one order of magnitude by knowing that your last dial will always have only one acceptable value, so you can just count the number of elements on the next-to-last dial, then iterate to the next incarnation of it.


    Caution: Contents may have been coded under pressure.
      Roy Johnson,
      I had discussed this problem along with my own meditation Arbitrarily Nested Loops with several monks, so don't feel bad about having an advantage. I do not know for a fact, my solution is correct since some of the shortcuts I took may be invalid. Since the answer itself doesn't have any tangible real-world value, I am interested in any and all responses. Some of the more astute mathematically inclined monks may come up with an answer without any code at all - that's fine too.

      Cheers - L~R

Re: Challenge: Number of unique ways to reach target sum
by blokhead (Monsignor) on Feb 14, 2006 at 15:21 UTC
    The answer I got is:

    Here's the code I used:

    use List::Util 'min'; use POSIX 'ceil'; sub num_ways { my ($N, $S, $T) = @_; return 1 if $S == 0 and $T == 0; return 0 if $N < 1 or $S < 1 or $T < 1; my $min = (2*$T-$S+$S**2)/(2*$S); ## more correctly, ceil() of thi +s my $max = min( $T-(($S-1)*$S/2), $N ); my $sum = 0; for my $K ($min .. $max) { $sum += num_ways( $K-1, $S-1, $T-$K ); } return $sum; } use Memoize; memoize 'num_ways'; print num_ways(100, 10, 667), $/;
    num_ways($N,$S,$T) computes the number of ways to pick a S (distinct) elements from the range {1..N} whose sum is T. Here's how I compute it recursively:

    The code can be made to not only count the solutions, but to iterate over them as well (using a callback & accumulation of the solution):

    blokhead

      blokhead,
      This answer agrees with mine. The difference is that I actually iterate over the solutions which I am not sure your code could do in the 72 minutes it takes mine to run :P

      Cheers - L~R

      Update: This node was updated several times to address an implicit casting bug in my C code which truncated my answer.

        Is that Perl code to generate them all in 72 minutes? I can't see it posted anywhere.
      The code can be made to not only count the solutions, but to iterate over them as well (using a callback & accumulation of the solution): ... But this takes a lot longer, as memoizing does you no good.

      No need to abandon Memoize. First generate all the answers (takes about 6 seconds on my computer, your original takes about a second less just to count them), then print them out (this can take considerably longer depending on the format.

      The key is to not generate strings in the first stage but to generate a tree (a very lispish tree). So say our target is 197 and we can use 2 coins. We would generate

      $VAR1 = [ [ '99', [ '98' ] ], [ '100', [ '97' ] ] ];

      You can see that there are 2 possibilities, 100+97 and 99+98. Slightly more complex 3 coins and a target of 295 the result is

      $VAR1 = [ [ '100', [ [ '98', [ '97' ] ], [ '99', [ '96' ] ] ] ] ];

      This you can think of this as 100 + (98+97 or 99+96).

      In some ways you can say that just dumping out this stucture answers the question. Recursing over it and printing out x+y+...+z for each solution goes at a bit more than 100,000 results per second on my computer (which is slower than I'd expected).

      Memory-wise, this is very efficient because when the same subtree appears in 2 places, you don't get 2 copies, you just get a reference to the same subtree.

      It is possible to use memoization for the printing process too but the problem is that you can't memoize the whole thing or you'll run out of memory. I've written something that starts to use memoized data after a certain level and it's doing > 1 million per second (and it's accelerating as it benefits more and more from the cache). I reckon it should take about 3 hours but I don't know how much acceleration there is so I'm going for a bath :)

      Code for the simpler version is below (based on blokhead's original)

      use List::Util 'min'; use POSIX 'ceil'; use strict; use warnings; sub make_ways { my ($N, $S, $T) = @_; # one coin left can we do it? if ($S == 1) { if ($T <= $N) { return ["$T"]; } else { return 0; } } my $min = (2*$T-$S+$S**2)/(2*$S); ## more correctly, ceil() of thi +s my $max = min( $T-(($S-1)*$S/2), $N ); my @all_ways; for my $K ($min .. $max) { my $ways = make_ways( $K-1, $S-1, $T-$K ); if ($ways) { push(@all_ways, ["$K", $ways]); } } if (@all_ways) { return \@all_ways; } else { return 0 } } use Memoize; memoize 'make_ways'; #useful for printing out details of a sane set use Data::Dumper; my $ways = make_ways(100, 10, 667); #my $ways = make_ways(20, 5, 30); #print Dumper($ways); print_ways($ways, "", 3); my $printed = 0; sub print_ways { my ($ways, $base) = @_; for my $way (@$ways) { if (ref $way) { my ($coin, $more_ways) = @$way; my $new_base = length($base) ? "$coin+$base" : $coin; print_ways($more_ways, $new_base); } else { print STDERR "printed $printed\n" unless (++$printed % 1000000); print "$base+$way\n"; } } }

        When I came back it was using 500M of memory (growing very very slowly) and was clocking 1.9M answers per second which puts it at a total time between 2 and 3 hours. Which isn't bad.

        I'm leaving it running overnight on a machine to verfiy that.

        By the way, to store the answers would require > 400GB of space!

        The code below has functions. string_ways() generates an array of strings from a tree of ways of summing things, it's memoized. nasty_print_ways() is like print_ways() but it also takes a depth. When it reaches that depth it starts making calls to string_ways() to get lists of strings to finish off the current way. This avoids recomputing a lot of stuff. You can adjust the depth if you have more or less memory but I think a change of 1 results in about a 100-fold difference in memory usage.

        This dumps out performance other stats every million lines. You get how many have been printed, how many times string_ways was called, how many times it was really called (that is the memoization didn't help us) and a rate of lines/CPU second

        nasty_print_ways($ways, "", 6); # do my own memoizing as I couldn't get Memoize to work, possibly # to do with the arguments being array refs my %strings; my $real_stringed = 0; sub string_ways { my $ways = $_[0]; if (my $strings = $strings{$ways}) { #die "already $strings"; return $strings } $real_stringed++; my @strings; for my $way (@$ways) { if (ref $way) { my ($coin, $more_ways) = @$way; # print STDERR "coin is $coin, making ".@{$more_ways}." ways\n"; push(@strings, map {"$_+$coin"} (@{string_ways($more_ways)})); } else { push(@strings, $way); } } return $strings{$ways} = \@strings; } my $stringed = 0; sub nasty_print_ways { my ($ways, $base, $depth) = @_; if ($depth == 0) { $stringed++; my $strings = string_ways($ways); for my $string (@$strings) { $printed++; print STDERR "p/s/r $printed / $stringed / $real_stringed r +ate = ".($printed/(times())[0])."\n" unless ($printed % 1000000); print "$string+$base\n"; } } else { $depth--; for my $way (@$ways) { if (ref $way) { my ($coin, $more_ways) = @$way; my $new_base = length($base) ? "$coin+$base" : $coin; nasty_print_ways($more_ways, $new_base, $depth); } else { print STDERR "printed $printed\n" unless (++$printed % 100000) +; print "way+$base\n"; } } } }
Re: Challenge: Number of unique ways to reach target sum
by thor (Priest) on Feb 14, 2006 at 15:24 UTC
    I have to wonder: is there something special about the target of 667? For the solution that you came up with, does it generalize to other targets?

    thor

    The only easy day was yesterday

      thor,
      It is a somewhat arbitrary number chosen to reduce the search space. I had 10 numbers with a max of 100 and got 10 * 100 = 1000. I took 2/3 of that and got 667. My solution involves creating an upper and lower boundary through the search space to walk through and I wanted to make it narrow enough to complete this century.

      Cheers - L~R

Re: Challenge: Number of unique ways to reach target sum
by Anonymous Monk on Feb 14, 2006 at 18:48 UTC
    To all the mathematicians in the house: does partition theory have anything to say on this subject (especially Q)?
Re: Challenge: Number of unique ways to reach target sum
by ambrus (Abbot) on Feb 14, 2006 at 22:20 UTC
Re: Challenge: Number of unique ways to reach target sum
by ambrus (Abbot) on Feb 15, 2006 at 14:18 UTC
Re: Challenge: Number of unique ways to reach target sum
by Limbic~Region (Chancellor) on Feb 15, 2006 at 15:37 UTC
    All,
    As this thread has apparently lost interest, I am posting my code today instead of waiting until Friday. Note that you will have to uncomment one of the printf() to see the solutions.

    Cheers - L~R

    Update: Fixed format of printf() that was causing type problems
      As this thread has apparently lost interest, I am posting my code today instead of waiting until Friday.
      Patience, dear Limbic~Region. You had a solution already in the can when you posted this. Not everybody had that advantage. Just because nobody has posted in a while doesn't make it any less intersting...

      thor

      The only easy day was yesterday

Re: Challenge: Number of unique ways to reach target sum
by tall_man (Parson) on Sep 26, 2006 at 21:12 UTC
    Here is a very late, but very fast solution to your challenge. It can find the count in less than two seconds. The trick is to use a result from partition theory and compute the counts using a "Pascal's triangle"-like approach.
      tall_man,
      Quite impressive. It does not come near to being what I had hoped for but that is my fault. I was so close to the problem that I could not see the forest through the trees. I naively assumed that counting the ways would mean generating them and as you and others have shown - this is a very poor assumption.

      I am very happy that you have contributed though because not only do I know a little bit more about math theory, I have a new way of looking at problems.

      Cheers - L~R

        My second script can be used to generate all the partitions, just by running it for each index up to the count. You could even wrap it in an iterator, just like that Partitions::Unrestricted package you wrote a while ago.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://530112]
Approved by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (5)
As of 2014-08-23 10:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (173 votes), past polls