|
davidj has asked for the wisdom of the Perl Monks concerning the following question:
My Fellow Monks,
Every friday I volunteer my mornings in my daughter's classroom. (It's the most valuable 3 hours I spend each week). They are currently on a unit about money: monetary denominations (American), making change, etc. Today the teacher asked them "how many ways can you make $10?" It was an excellent opportunity for them to test their counting skills, especially involving objects that have weighted values. 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)
That got me to thinking: How could one determine that for an arbitrary amount, say $100? This question has challenged me off and on for the better part of the afternoon.
At first, I thought about using a weighted graph of some sort. That got me nowhere quickly. Not that I don't know what a weighted graph is, but my understanding of how to use graphs is very weak.
Next I thought about implementing some algorithm where I build down, incrementing to the next highest denomination (gowing down), or building up, incrementing to the next lowest denomination (going up). It seemed like a good idea, but I got stuck on how to implement it.
Here's what I'm currently thinking:
step 1: get all combinations where each value in the combination is the same:
(1 100), (2 50's), (5 20's), (10 10's), (20 5'2), and (100 1's)
step 2: recursively drill down each one of them creating a new list consisting of the combinations that take the next fewest bills. For example:
[50, 50] -> [20,20,10, 50] -> [10,10, 20, 10, 50] (and so on)
My problem is, (as you can clearly see by my previous posts), I'm not a good algorithms guy. I'm working on it, but I have a long way to go. And regarding this particular little puzzle, I'm not sure how to implement my idea. Also, I imagine there are much better ways to go about it.
The reason I'm seeking your assistance, other than for the learning, is that I think it would be pretty cool to write a little program that my daughter and her classmates can use to test differnt amounts and develop their math/counting/logic skills.
As always, your input and teaching are most welcome.
davidj |
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] |
|
|
