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

How to generate restricted partitions of an integer

by borisz (Canon)
on Nov 11, 2004 at 11:12 UTC ( #406984=perlquestion: print w/ replies, xml ) Need Help??
borisz has asked for the wisdom of the Perl Monks concerning the following question:

While watching tv I saw a quiz, suppose you have a 100 euro banknote, how often can you change that note into other notes ( including another 100e note )? In Europe we have 100, 50, 20, 10 and 5 euro notes. For example changing my 100e note to 2x50e or to 1x50e+5x10e or 2x20e + 1x10 + 10x5. Here is my try to solve the puzzle, but it is more a try and error than a solve.
my $cnt; for my $f ( 0 .. 20 ) { for my $z ( 0 .. 10 ) { for my $zw ( 0 .. 5 ) { for my $fu ( 0 .. 2 ) { for my $hu ( 0 .. 1 ) { $cnt++ if $f * 5 + $z * 10 + $zw * 20 + $fu * 50 + $hu * 100 + == 100; } } } } } print $cnt;
How would you do it?
Boris

2004-11-11 Edited by Arunbear: Changed title from 'How to solve this puzzle in a better way?', as per Monastery guidelines

Comment on How to generate restricted partitions of an integer
Download Code
Re: How to generate restricted partitions of an integer
by grinder (Bishop) on Nov 11, 2004 at 12:05 UTC
    Here is my try to [solve] the puzzle

    Heh, a fine example of Ken Thompson's adage "when in doubt, use brute force".

    Your code does have the merit of being very straightforward to understand. If I had the tuits I would code up an iterator solution using the closure-as-odometer idiom, but the code would not be as clear.

    A simple observation of your code is to note that many a time, the sum exceeds 100 way before you get down to the fifth inner loop. Therefore, exiting the loop early via last will save considerable amount of time:

    my $cnt = 0; for my $f ( 0 .. 20 ) { for my $z ( 0 .. 10 ) { last if $f*5 + $z*10 > 100; for my $zw ( 0 .. 5 ) { last if $f*5 + $z*10 + $zw*20 > 100; for my $fu ( 0 .. 2 ) { last if $f*5 + $z*10 + $zw*20 + $fu*50 > 100; for my $hu ( 0 .. 1 ) { $cnt++ if $f * 5 + $z * 10 + $zw * 20 + $fu * 50 + $hu * 100 + == 100; } } } } } print $cnt;

    You could unconditionally increment a counter in the inner loop inside this code and yours, and compare how many less times my inner loop gets called.

    - another intruder with the mooring of the heart of the Perl

      686 loops for yours. 8316 for the original. 197 for mine which uses a slightly more optimised fail fast.

        46 for mine :-)

        function calls, not loops though :-(

        Updated was 67 but I moved an if and reduced it to 46

Re: How to generate restricted partitions of an integer
by BrowserUk (Pope) on Nov 11, 2004 at 12:14 UTC

    Encode the knowledge of what substitions are possible as data instead of code and let the regex engine take the strain.

    #! perl -slw use strict; my %subs = ( 100 => '50 50', 50 => '20 20 10', 20 => '10 10', 10 => '5 5', 5 => '2 2 1', 2 => '1 1', ); my $re_conversion = '(' . join( '|', sort{ length $b <=> length $a } keys %subs ) . ')'; my $input ); do { printf 'Denomination to change[100|50|20|10|5|2]: '; chomp( $input = <STDIN> ); } until exists $subs{ $input }; print $input while $input =~ s[$re_conversion][$subs{ $1 }]; __END__ [11:58:38.32] P:\test>406984 Denomination to change[100|50|20|10|5|2]: 20 10 10 5 5 10 2 2 1 5 10 1 1 2 1 5 10 1 1 1 1 1 5 10 1 1 1 1 1 2 2 1 10 1 1 1 1 1 1 1 2 1 10 1 1 1 1 1 1 1 1 1 1 10 1 1 1 1 1 1 1 1 1 1 5 5 1 1 1 1 1 1 1 1 1 1 2 2 1 5 1 1 1 1 1 1 1 1 1 1 1 1 2 1 5 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 5 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1

    Examine what is said, not who speaks.
    "Efficiency is intelligent laziness." -David Dunham
    "Think for yourself!" - Abigail
    "Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon

      This will miss many conversions such as 10 => 2 2 2 2 2 (not catered for by %subs) and 20 => 5 5 5 5 (not catered for by the single iterative substitution approach).

      Hugo

        But...there isn't a 2 euro note, per the original OP (I wouldn't know...I'm a dumb American). The breaking of a 20 into 4 5's is valid, though.

        thor

        Feel the white light, the light within
        Be your own disciple, fan the sparks of will
        For all of us waiting, your kingdom will come

        Agreed. It's an idea that needs some work.


        Examine what is said, not who speaks.
        "Efficiency is intelligent laziness." -David Dunham
        "Think for yourself!" - Abigail
        "Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon
Re: How to generate restricted partitions of an integer
by tachyon (Chancellor) on Nov 11, 2004 at 13:08 UTC

    This reduces the 8316 loops your code requires to 197 which is almost 2 orders of magnitude faster tahn your original and 3.5x faster than grinders example that needs 686 loops. Only 4:1 wastage on the test is pretty good as semi brute force goes and certainly beats the original 166:1. All it does different is to limit the looping to the limited subset of possible cases....

    my ( $loops, $cnt ); printf "%4d %4d %4d %4d %4d\n", 100,50,20,10,5; for (my $e5=0; $e5<=100; $e5+=10 ) { for (my $e10=0; $e10<=100-$e5; $e10+=10 ) { for (my $e20=0; $e20<=100-$e10-$e5; $e20+=20 ) { for (my $e50=0; $e50<=100-$e20-$e10-$e5; $e50+=50 ) { for (my $e100=0; $e100<=100-$e50-$e20-$e10-$e5; $e100+=100 ) { $loops++; if ( $e5+$e10+$e20+$e50+$e100 == 100 ) { printf "%4d %4d %4d %4d %4d\n",$e100/100,$e50/50,$e20/20,$ +e10/10,$e5/5; $cnt++; } } } } } } print "\n$cnt possibilities in $loops loops\n"; __DATA__ 100 50 20 10 5 1 0 0 0 0 0 2 0 0 0 0 0 5 0 0 0 1 2 1 0 0 0 4 2 0 0 1 1 3 0 0 0 3 4 0 0 1 0 5 0 0 0 2 6 0 0 0 1 8 0 0 0 0 10 0 0 1 2 0 2 0 0 4 1 2 0 1 1 2 2 0 0 3 3 2 0 1 0 4 2 0 0 2 5 2 0 0 1 7 2 0 0 0 9 2 0 0 4 0 4 0 1 1 1 4 0 0 3 2 4 0 1 0 3 4 0 0 2 4 4 0 0 1 6 4 0 0 0 8 4 0 1 1 0 6 0 0 3 1 6 0 1 0 2 6 0 0 2 3 6 0 0 1 5 6 0 0 0 7 6 0 0 3 0 8 0 1 0 1 8 0 0 2 2 8 0 0 1 4 8 0 0 0 6 8 0 1 0 0 10 0 0 2 1 10 0 0 1 3 10 0 0 0 5 10 0 0 2 0 12 0 0 1 2 12 0 0 0 4 12 0 0 1 1 14 0 0 0 3 14 0 0 1 0 16 0 0 0 2 16 0 0 0 1 18 0 0 0 0 20 50 possibilities in 197 loops

    cheers

    tachyon

Re: How to generate restricted partitions of an integer
by thor (Priest) on Nov 11, 2004 at 13:24 UTC
    including another 100e note
    Woudn't the answer be "infinity"? I mean, if you can change the 100e note for another, couldn't you do that ad infinitum?

    thor

    Feel the white light, the light within
    Be your own disciple, fan the sparks of will
    For all of us waiting, your kingdom will come

      No, I search for distinct combinations only. So I can exchange 100e only one into another 100e.
      Boris
        Well, you did say "how often", which is probably a pretty stupid way of phrasing the problem. It certainly led me to think that the problem involved repeated changings, e.g. once I've broken it into two 50s, what can I do with the two 50s. It now seems that you meant to say "How many ways", rather than "How often". I mean, how often? Once per day? Twice per second?
Re: How to generate restricted partitions of an integer
by Roy Johnson (Monsignor) on Nov 11, 2004 at 16:02 UTC
    I would do it recursively:
    use warnings; @denoms = qw(2 5 10 20 50 100); sub change { my ($unchanged, $nothing_smaller_than) = (@_,0); my @results = (); for my $trybill (@denoms) { next if ($trybill < $nothing_smaller_than); if ($trybill < $unchanged) { my $remaining = $unchanged - $trybill; push @results, map {[$trybill, @$_]} change($remaining, $trybill +); } elsif ($trybill == $unchanged) { push @results, [$trybill]; } else { last } } return @results; } use Data::Dumper; print Dumper change(100);
    Try each denomination against what is to be changed. If the bill being tried ($trybill) is less than the amount to be changed ($unchanged), then make a result set out of $trybill mapped to each combination returned by change($unchanged-$trybill).

    The $nothing_smaller_than parameter ensures that the output doesn't result in multiple permutations of the same combination of bills: only the canonical order of smallest bill to largest bill will be returned.


    Caution: Contents may have been coded under pressure.
Re: How to generate restricted partitions of an integer
by fergal (Chaplain) on Nov 11, 2004 at 16:12 UTC
    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; }

      Interesting stuff ++

      cheers

      tachyon

Re: How to generate restricted partitions of an integer
by tye (Cardinal) on Nov 12, 2004 at 09:11 UTC

    This one takes the desired total and/or the list of denominations on the command line and shows all possible combinations:

    #!/usr/bin/perl -w use strict; use Algorithm::Loops qw( NestedLoops MapCarMin ); my @sum= shift || 100; my @size= ( 100, 50, 20, 10, 5 ); @size= @ARGV if @ARGV; my $tries= 0; my $iter= NestedLoops( [ ( sub { my $n= $sum[@_]/$size[@_]; ! $n ? [] : @_ < $#size ? [ 0 .. $n ] : [ $n .. int $n ]; } ) x @size ], { OnlyWhen => sub { $tries++; not $sum[@_]= $sum[$#_] - $_[-1]*$size[$#_]; }, }, ); my @cnt; my $seq= 0; while( @cnt= $iter->() ) { printf "%d) %s\n", ++$seq, join ' + ', MapCarMin { !$_[0] ? () : join '*', @_ } \@cnt, \@size; } print "($tries tries)\n";

    And here's a sample run:

    > perl change.pl 103 100 33 10 3 | more 1) 1*10 + 31*3 2) 4*10 + 21*3 3) 7*10 + 11*3 4) 10*10 + 1*3 5) 1*33 + 1*10 + 20*3 6) 1*33 + 4*10 + 10*3 7) 1*33 + 7*10 8) 2*33 + 1*10 + 9*3 9) 1*100 + 1*3 (56 tries) >

    - tye        

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (7)
As of 2014-07-10 23:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (217 votes), past polls