Re: puzzle: how many ways to make $100
by GrandFather (Saint) on Apr 29, 2006 at 00:44 UTC
|
use strict;
use warnings;
my @values = (100, 50, 20, 10, 5, 2, 1);
my $total = 100;
my $count = 0;
my @results;
@values = map {[$_, 0]} @values; # Generate counters and init to 0
findSubSums ($total, 0);
print "$_\n" for @results;
print scalar @results, " combinations found\n";
sub findSubSums {
my ($remaining, $index) = @_;
return if $remaining <= 0;
my $value = $values[$index][0];
my $counter = \$values[$index][1];
if ($index == $#values) {
#Special case for last element
$$counter = int ($remaining / $value);
dumpResult ($index) if $value * $$counter == $remaining;
return;
}
while ($remaining >= $value * $$counter) {
dumpResult ($index), last if $value * $$counter == $remaining;
findSubSums ($remaining - $value * $$counter, $index + 1);
++$$counter;
}
$$counter = 0; # Reset counter
}
sub dumpResult {
my @denoms = grep {$values[$_][1]} (0..shift);
push @results, join ' ', map {"\$$values[$_][0] x $values[$_][1]"}
+ @denoms;
return;
}
Partial output
$1 x 100
$2 x 1 $1 x 98
$2 x 2 $1 x 96
$2 x 3 $1 x 94
...
$2 x 50
$5 x 1 $1 x 95
$5 x 1 $2 x 1 $1 x 93
$5 x 1 $2 x 2 $1 x 91
...
$5 x 19 $1 x 5
$5 x 19 $2 x 1 $1 x 3
$5 x 19 $2 x 2 $1 x 1
$5 x 20
$10 x 1 $1 x 90
$10 x 1 $2 x 1 $1 x 88
$10 x 1 $2 x 2 $1 x 86
...
$20 x 5
$50 x 1 $1 x 50
$50 x 1 $2 x 1 $1 x 48
$50 x 1 $2 x 2 $1 x 46
$50 x 1 $2 x 3 $1 x 44
$50 x 1 $2 x 4 $1 x 42
...
$50 x 1 $20 x 2 $5 x 2
$50 x 1 $20 x 2 $10 x 1
$50 x 2
$100 x 1
4563 combinations found
DWIM is Perl's answer to Gödel
| [reply] [d/l] [select] |
Re: puzzle: how many ways to make $100 (with Prolog!)
by Ovid (Cardinal) on Apr 29, 2006 at 04:00 UTC
|
Well, if you're serious about teaching her logic skills ;) (I've ignored two dollar bills for simplicity. It should be trivial to add it)
#!/usr/bin/perl
use strict;
use warnings;
use AI::Prolog;
my @bills = qw(Fifties Twenties Tens Fives Ones);
my $bills = join ',', @bills; # don't use $prolog->list because these
+are vars
my $program = <<"END_PROLOG";
change([ $bills ]) :-
member(Fifties,[0,1,2]),
member(Twenties,[0,1,2,3,4,5]),
member(Tens,[0,1,2,3,4,5,6,7,8,9,10]),
member(Fives,[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20
+]),
Total is 50*Fifties + 20*Twenties +10*Tens + 5*Fives,
Total <= 100,
Ones is 100 - Total.
member(X, [X|_]).
member(X, [_|Tail]) :-
member(X, Tail).
END_PROLOG
my $prolog = AI::Prolog->new($program);
$prolog->query("change([ $bills ]).");
while (my $result = $prolog->results) {
for my $i ( 0 .. $#bills ) {
print "$result->[1][$i] $bills[$i]";
print ", " unless $i == $#bills;
}
print "\n";
}
__END__
# Beginning of output:
0 Fifties, 0 Twenties, 0 Tens, 0 Fives, 100 Ones
0 Fifties, 0 Twenties, 0 Tens, 1 Fives, 95 Ones
0 Fifties, 0 Twenties, 0 Tens, 2 Fives, 90 Ones
0 Fifties, 0 Twenties, 0 Tens, 3 Fives, 85 Ones
0 Fifties, 0 Twenties, 0 Tens, 4 Fives, 80 Ones
0 Fifties, 0 Twenties, 0 Tens, 5 Fives, 75 Ones
0 Fifties, 0 Twenties, 0 Tens, 6 Fives, 70 Ones
0 Fifties, 0 Twenties, 0 Tens, 7 Fives, 65 Ones
0 Fifties, 0 Twenties, 0 Tens, 8 Fives, 60 Ones
...
| [reply] [d/l] |
Re: puzzle: how many ways to make $100
by rhesa (Vicar) on Apr 29, 2006 at 00:21 UTC
|
You're looking for the Greedy Algorithm. It's basically the reverse from your approach: you start out with the highest denomination, then decrease that and spread the difference among the lower denominations.
Here's one link: http://www.personal.kent.edu/~rmuhamma/Algorithms/MyAlgorithms/Greedy/greedyIntro.htm
I dug up my solution to problem 31 on Project Euler.
It could use some refactoring, but I was in a hurry and I didn't write it for public consumption ;)
Update: Oh right, yes, output... I get Total found: 4563. | [reply] [d/l] [select] |
Re: puzzle: how many ways to make $100
by jdalbec (Deacon) on Apr 29, 2006 at 00:07 UTC
|
This is just a variation on partitions where the size of the parts is restricted to a finite set of values. I've adapted some partition code that I had lying around:
#! /usr/bin/perl -w
use strict;
my @parts = (100, 50, 20, 10, 5, 1);
sub partitions { my $n = shift; return partmax($n, $n) };
sub partmax {
my ($n, $maxpart) = @_;
return [] if $n < 0;
return [[]] if $n == 0;
my $partitions = [];
foreach my $part (grep {$_<=$maxpart} @parts) {
my $subpartitions = partmax($n - $part, $part);
foreach (@$subpartitions) {
unshift @$_, $part;
}
push @$partitions, @$subpartitions;
}
return $partitions;
}
my $example = partitions shift;
print "count: ", scalar @$example, "\n";
foreach my $partition (@$example) {
print join(" ", @$partition), "\n";
}
| [reply] [d/l] |
|
count: 344
100
50 50
50 20 20 10
50 20 20 5 5
50 20 20 5 1 1 1 1 1
50 20 20 1 1 1 1 1 1 1 1 1 1
...
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
which does not quite accord with some of the other results given.
DWIM is Perl's answer to Gödel
| [reply] [d/l] |
|
my @parts = (100, 50, 20, 10, 5, 1);
to match the allowed parts when comparing output. In your post (and TedPride's post) you allow $2 bills, so to get the same answer from my code you would change itthe original line above to
my @parts = (100, 50, 20, 10, 5, 2, 1);
and then the count matches. In blokhead's post, he uses coins instead of bills, so to get his answer you would change itthe original line above to
my @parts = (50, 25, 10, 5, 1);
and then the count matches.
Further update: My "original" and "change to" lines are not swapped. I'm using "original" and "change to" in reference to the code in my post above. I have added some text above to clarify which line is the "original" line and which lines are the "changed" lines.
There is a $2 bill. Just try finding one nowadays. Apparently the U.S. MintBureau of Engraving and Printing (thanks for the correction halley) is still printing them, but it must not be issuing large quantities because I almost never see one. I think it's unrealistic to expect to be able to make $100 with 50 $2 bills, for example.
Also, in the OP's $10 problem, $2 bills were not allowed:
It took them awhile, but they came up with the correct answer:
(1 ten), (2 5's), (1 5 and 5 1's), and (10 1's)
| [reply] [d/l] [select] |
|
|
|
|
|
Re: puzzle: how many ways to make $100
by TedPride (Priest) on Apr 29, 2006 at 04:51 UTC
|
Perhaps not the most beautiful or efficient thing in the world, but it works:
use strict;
use warnings;
find(100, [], [100, 50, 20, 10, 5, 2, 1]);
sub find {
my $left = $_[0];
my @set = @{$_[1]};
my ($denom, @denom) = @{$_[2]};
print join(', ', map { "($_->[1] $_->[0]'s)" } @set), "\n" if !$le
+ft;
return if !$left || !$denom;
find($left, [@set], [@denom]);
for (1..($left / $denom)) {
find(($left - $denom * $_), [@set, [$denom, $_]], [@denom]);
}
}
| [reply] [d/l] |
Re: puzzle: how many ways to make $100
by blokhead (Monsignor) on Apr 29, 2006 at 04:32 UTC
|
There are about as many approaches to this problem as there are ways to make change for $100 ;) ... There are a few more examples/ideas in this thread: How to generate restricted partitions of an integer (the solutions towards the bottom are the ones that actually work!)
And for yet another opinion on the subject (s/coin/bill/ throughout the rest of this, if you prefer)... Just because it's a little simpler, I would first just try counting the ways to make change for the amount (i.e, without keeping track of what those ways are). To make change for an amount, I first choose which coin will be the biggest coin that I'm going to include, which can be any available coin. I subtract that coin from my total, and then I need to find how many ways I can make change for what's left over, using none of the coins bigger than the one I just chose (since it was supposed to be the biggest). Of course, that's just nothing more than a recursive subcall! In code it looks like this:
sub make_change {
my ($N, @coins) = @_;
return 0 if $N < 0;
return 1 if $N == 0;
my $total = 0;
for (0 .. $#coins) {
$total += make_change( $N-$coins[$_], @coins[$_ .. $#coins] );
}
return $total;
}
print make_change( 100 => 50, 25, 10, 5, 1 );
Then instead of just counting, I'd modify the code to keep track of the choices it made so far (using an additional argument), and when it gets to the end, do something with them. This is called using an accumulator (I called it @so_far for this sub).
sub make_change {
my ($N, $coins, $callback, @so_far) = @_;
my @coins = @$coins;
return if $N < 0;
return $callback->(@so_far) if $N == 0;
for (0 .. $#coins) {
make_change( $N - $coins[$_],
[@coins[ $_ .. $#coins ]],
$callback,
($coins[$_], @so_far) );
}
}
make_change(
100,
[50, 25, 10, 5, 1],
sub { print "@_\n" }
);
Cheers!
PS: here are two other cute money denomination puzzles I've posted about, if you're interested: Golf: Buying with exact change & The greedy change-making problem using regexes
| [reply] [d/l] [select] |
Re: puzzle: how many ways to make $100
by ikegami (Patriarch) on Apr 29, 2006 at 02:30 UTC
|
arg, I've been working on the following (brute force regexp engine) solution for a while, but I can't get it to work. It finds some matches, then gives up. I suspect there's some kind of optimization in the regexp engine making it think it's done. I figured I'd post it in case someone else wants to tinker with it.
use strict;
use warnings;
use re 'eval';
#use re 'debug';
use Data::Dumper qw( Dumper );
my $amount = shift;
my @bills = (1, 5, 10, 20, 50, 100);
my $choices = join "\n ",
map { "( .{$_} (?{ my \%r = \%{\$^R}; \$r{$_}++; +{ \%r
+ } }) )*" }
@bills;
my $regexp = qr/
^
(?{ +{} })
$choices
$
(?{ push(@matches, $^R) })
(?!)
/x;
print($regexp, "\n");
our @matches;
('.' x $amount) =~ $regexp;
print(Dumper(\@matches));
outputs
>perl 546453.pl 20
(?x-ism:
^
(?{ +{} })
( .{1} (?{ my %r = %{$^R}; $r{1}++; +{ %r } }) )*
( .{5} (?{ my %r = %{$^R}; $r{5}++; +{ %r } }) )*
( .{10} (?{ my %r = %{$^R}; $r{10}++; +{ %r } }) )*
( .{20} (?{ my %r = %{$^R}; $r{20}++; +{ %r } }) )*
( .{50} (?{ my %r = %{$^R}; $r{50}++; +{ %r } }) )*
( .{100} (?{ my %r = %{$^R}; $r{100}++; +{ %r } }) )*
$
(?{ push(@matches, $^R) })
(?!)
)
$VAR1 = [
{
'1' => '20'
},
{
'1' => '15',
'5' => '1'
},
{
'1' => '10',
'5' => '2'
},
{
'1' => '10',
'10' => '1'
},
{
'1' => '5',
'5' => '3'
}
];
It's missing
{
'1' => '5',
'5' => '2'
'10' => '1'
},
{
'5' => '4'
},
{
'5' => '2'
'10' => '1'
},
{
'10' => '2'
},
{
'20' => '1',
},
| [reply] [d/l] [select] |
|
yeah, first "*" never tries 0. (update: hmm, no, it does try, for 10.. then I don't know why..) But if you actually specify the max number of matches
my $choices = join "\n ",
map { "( .{$_} (?{ my \%r = \%{\$^R}; \$r{$_}++; +{ \%r } }) ){0,
+".(int($amount/$_))."}" }
@bills;
it works fine:
12:28pm /home/Ivancho/bin> probichka.pl 20
(?x-ism:
^
(?{ +{} })
( .{1} (?{ my %r = %{$^R}; $r{1}++; +{ %r } }) ){0,20}
( .{5} (?{ my %r = %{$^R}; $r{5}++; +{ %r } }) ){0,4}
( .{10} (?{ my %r = %{$^R}; $r{10}++; +{ %r } }) ){0,2}
( .{20} (?{ my %r = %{$^R}; $r{20}++; +{ %r } }) ){0,1}
( .{50} (?{ my %r = %{$^R}; $r{50}++; +{ %r } }) ){0,0}
( .{100} (?{ my %r = %{$^R}; $r{100}++; +{ %r } }) ){0,0}
$
(?{ push(@matches, $^R) })
(?!)
)
$VAR1 = [
{
'1' => 20
},
{
'1' => 15,
'5' => 1
},
{
'1' => 10,
'5' => 2
},
{
'1' => 10,
'10' => 1
},
{
'1' => 5,
'5' => 3
},
{
'1' => 5,
'10' => 1,
'5' => 1
},
{
'5' => 4
},
{
'10' => 1,
'5' => 2
},
{
'10' => 2
},
{
'20' => 1
}
];
| [reply] [d/l] [select] |
Re: puzzle: how many ways to make $100
by Nevtlathiel (Friar) on Apr 29, 2006 at 16:30 UTC
|
We did almost this exact problem earlier this year on my course at uni but using the functional language ML, and actually returning a list of lists of ways to make the change. The solution is really neat in ML and since I have exams in a month or so I thought it wouldn't be such a bad idea for me to go over it and try to explain it to the other monks. I'll give the code first and then try and explain what it does.
1. fun change (till, 0) = [[]]
2. | change ([], amt) = []
3. | change (coin::till, amt) =
4. if amt < coin then change(till, amt)
5. else
6. let fun allchange [] = []
7. | allchange (cs::css) = (coin::cs) :: allchange css
8. in allchange (change (coin::till, amt - coin)) @ change (til
+l, amt)
9. end;
The first line starts our function declaration and matches the input pattern of some list of coins that we can use (till) and an amount left over to make of 0. There is exactly one way to do this, an empty list of coins, so we return a list (the outer set of square brackets) containing the empty list (the inner set of square brackets). Line 2 is a second base case: we have run out of suitable types of coin, but we still need to make change. In this case there are no solutions so we return the empty list. From here onwards we get into the recursive magic, the case where we have a list of coins (the first of which is called coin, the rest of the list being contained in till) and an amount we are aiming to make. If the coin at the front of the list is too big, we simply discard it and try making change for that amount using the other coins in the till with a recursive call to change(till, amount) (line 4). Otherwise we define a new function allchange which takes a list of lists (cs is a list of coins, css is a list of such lists) and adds a coin to the front of all lists of coins in that list (line 7). We then call allchange on all the solutions found by the recursive call to change(till, amt-coin) and append (@) it to the list of ways of simply making change from coin (ie always taking the biggest coin we can).
Hopefully that makes sense, all the magic happens in line 8. It seemed like a pretty neat solution and short even in comparison with the Perl ones on offer (even if you do have to invest more brain power to understand it).
----------
My cow-orkers were talking in punctuation the other day. What disturbed me most was that I understood it.
| [reply] [d/l] [select] |
Re: puzzle: how many ways to make $100
by spiritway (Vicar) on Apr 29, 2006 at 01:27 UTC
|
Unfortunately, there is also a $2, valid US currency, to muddy the waters.
| [reply] |
Re: puzzle: how many ways to make $100
by billh (Pilgrim) on Apr 29, 2006 at 16:40 UTC
|
It's actually quite a classic problem,
here's
a link to a solution (for $1.00) in scheme
Bill H
perl -e 'print sub { "Hello @{[shift]}!\n" }->("World")'
| [reply] [d/l] |
Re: puzzle: how many ways to make $100
by swampyankee (Parson) on Apr 29, 2006 at 17:29 UTC
|
| [reply] |
Re: puzzle: how many ways to make $100
by davidj (Priest) on May 03, 2006 at 01:12 UTC
|
Fellow Monks,
Just want to say thanks for your input on this. My daughter really enjoys it. After playing with it for a few minutes, from across the rooms she says, "Hey, daddy, how many ways can you make 30 dollars?" So we spent the next few minutes working it out together. It was a marvelous time.
davidj | [reply] |