Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Re: How to generate restricted partitions of an integer

by fergal (Chaplain)
on Nov 11, 2004 at 16:12 UTC ( #407087=note: print w/replies, xml ) Need Help??


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

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (6)
As of 2020-10-20 21:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favourite web site is:












    Results (210 votes). Check out past polls.

    Notices?