http://www.perlmonks.org?node_id=407087


in reply to How to generate restricted partitions of an integer

Here's a kinda lispish solution. It's recursive and to generate the solution it calls the breakup function 46 times (thanks to the magic of Memoize).

The basic idea is that breakup is called with a target and a list of usable notes it then subtracts the biggest usable note from the target and calls breakup with the new target and the list of usable notes. When it's got all the possible solutions it can get it crosses the largest note off the list and tries again.

The cleverness comes in where instead of passing in the array of available notes, I just pass in a number that indicates how many notes have been crossed off so far. So in breakup(100, 0) the 0 indicates that all of [100,50,20,10,5] are available, whereas a 2 would mean that only [20,10,5] are available.

breakup being a function of 2 scalars makes it ideal for Memoize. This basically means it caches the results of the function calls so that for example when we are calculating

100 = 50 + 10 + 10 + 10 + 10 + 10
the 10s will come from a call to breakup(50, 3) but we'll also call breakup(50,3) when we're calculating
100 = 10 + 10 + 10 + 10 + 10 + 10 + 10 + 10 + 10 + 10
Memoize means the second time we call it, we get the result for free. Without Memoize it require 411 calls, almost 10 times as many.

Here's the output (in case I missed a solution)

100 50, 50 50, 20, 20, 10 50, 20, 20, 5, 5 50, 20, 10, 10, 10 50, 20, 10, 10, 5, 5 50, 20, 10, 5, 5, 5, 5 50, 20, 5, 5, 5, 5, 5, 5 50, 10, 10, 10, 10, 10 50, 10, 10, 10, 10, 5, 5 50, 10, 10, 10, 5, 5, 5, 5 50, 10, 10, 5, 5, 5, 5, 5, 5 50, 10, 5, 5, 5, 5, 5, 5, 5, 5 50, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 20, 20, 20, 20, 20 20, 20, 20, 20, 10, 10 20, 20, 20, 20, 10, 5, 5 20, 20, 20, 20, 5, 5, 5, 5 20, 20, 20, 10, 10, 10, 10 20, 20, 20, 10, 10, 10, 5, 5 20, 20, 20, 10, 10, 5, 5, 5, 5 20, 20, 20, 10, 5, 5, 5, 5, 5, 5 20, 20, 20, 5, 5, 5, 5, 5, 5, 5, 5 20, 20, 10, 10, 10, 10, 10, 10 20, 20, 10, 10, 10, 10, 10, 5, 5 20, 20, 10, 10, 10, 10, 5, 5, 5, 5 20, 20, 10, 10, 10, 5, 5, 5, 5, 5, 5 20, 20, 10, 10, 5, 5, 5, 5, 5, 5, 5, 5 20, 20, 10, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 20, 20, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 20, 10, 10, 10, 10, 10, 10, 10, 10 20, 10, 10, 10, 10, 10, 10, 10, 5, 5 20, 10, 10, 10, 10, 10, 10, 5, 5, 5, 5 20, 10, 10, 10, 10, 10, 5, 5, 5, 5, 5, 5 20, 10, 10, 10, 10, 5, 5, 5, 5, 5, 5, 5, 5 20, 10, 10, 10, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 20, 10, 10, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 20, 10, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 20, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 10, 10, 10, 10, 10, 10, 10, 10, 10, 10 10, 10, 10, 10, 10, 10, 10, 10, 10, 5, 5 10, 10, 10, 10, 10, 10, 10, 10, 5, 5, 5, 5 10, 10, 10, 10, 10, 10, 10, 5, 5, 5, 5, 5, 5 10, 10, 10, 10, 10, 10, 5, 5, 5, 5, 5, 5, 5, 5 10, 10, 10, 10, 10, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 10, 10, 10, 10, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 10, 10, 10, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 10, 10, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 10, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 count = 46
I like the pattern it makes :-)
use strict; use warnings; my @all = (100, 50, 20, 10, 5); use Memoize; memoize('breakup'); my $count = 0; sub nice { my ($target, $sub) = @_; my @solns = breakup($target, $sub); foreach my $sol (@solns) { print join(", ", @$sol)."\n"; } } nice(100, 0); print "count = $count\n"; sub breakup { my ($target, $sub) = @_; $count++; my $cur = $all[$sub]; my @solns; if ($target == $cur) { push(@solns, [$cur]); } if ($target >= $cur) { push(@solns, map {[$cur, @$_]} (breakup($target - $cur, $sub))); } push(@solns, breakup($target, $sub + 1)) unless ($sub == $#all); return @solns; }

Replies are listed 'Best First'.
Re^2: How to generate restricted partitions of an integer
by tachyon (Chancellor) on Nov 11, 2004 at 21:13 UTC

    Interesting stuff ++

    cheers

    tachyon