[Date Index]
[Thread Index]
[Author Index]
Re: sum of coins article in mathematica journal
*To*: mathgroup at smc.vnet.net
*Subject*: [mg128399] Re: sum of coins article in mathematica journal
*From*: Bob Hanlon <hanlonr357 at gmail.com>
*Date*: Tue, 16 Oct 2012 03:21:35 -0400 (EDT)
*Delivered-to*: l-mathgroup@mail-archive0.wolfram.com
*Delivered-to*: l-mathgroup@wolfram.com
*Delivered-to*: mathgroup-newout@smc.vnet.net
*Delivered-to*: mathgroup-newsend@smc.vnet.net
*References*: <k5assc$noo$1@smc.vnet.net>
You can add the use of Reduce to see multiple equivalent results:
minimalChange[coins_, amount_] :=
Module[
{var = r /@ Range[Length[coins]], cnt},
cnt = Minimize[{Total[var],
coins.var == amount,
Thread[var >= 0]},
var, Integers][[1]];
{cnt, {Reduce[Flatten[
{Total[var] == cnt,
coins.var == amount,
Thread[var >= 0]}],
var, Integers] //
ToRules}} /. {
(r[n_] -> 0) :> Sequence[],
(r[n_] -> m_) :> {coins[[n]], m}}]
minimalChange[{5, 7, 11, 26}, 377]
{18, {{{7, 4}, {11, 1}, {26, 13}}, {{5, 2}, {7, 1}, {11, 2}, {26,
13}}}}
minimalChange[{4, 7, 11, 23}, 499]
{25, {{{7, 1}, {11, 5}, {23, 19}}, {{7, 4}, {11, 1}, {23, 20}}, {{4,
4}, {23, 21}}}}
Bob Hanlon
On Sun, Oct 14, 2012 at 11:41 PM, Bob Hanlon <hanlonr357 at gmail.com> wrote:
> You can just use Minimize and it will also give you the total number of coins
>
> minimalChange[coins_, amount_] := Module[
> {var = r /@ Range[Length[coins]]},
> Minimize[{Total[var],
> coins.var == amount,
> Thread[var >= 0]},
> var, Integers] /.
> {(r[n_] -> 0) :> Sequence[],
> (r[n_] -> m_) :> {coins[[n]], m}}]
>
> coins = {1, 5, 10, 25, 50};
>
> minimalChange[coins, 247]
>
> {9, {{1, 2}, {10, 2}, {25, 1}, {50, 4}}}
>
> minimalChange[{4, 7, 11, 23}, 247]
>
> {13, {{7, 1}, {11, 3}, {23, 9}}}
>
> minimalChange[{5, 7, 11, 26}, 377]
>
> {18, {{7, 4}, {11, 1}, {26, 13}}}
>
>
> Bob Hanlon
>
>
> On Sun, Oct 14, 2012 at 12:15 AM, <daniel.lichtblau0 at gmail.com> wrote:
>> On Saturday, October 13, 2012 12:08:01 AM UTC-5, von dremel wrote:
>>> a long time ago I read a short text in mathematica journal.
>>>
>>> A neat little program that calculated the numer of coins needed to reac=
h a certain sum. you put in the coin values e.g. 25 cent 50 cent etc and go=
t the minimum anount of how many coins you need.
>>>
>>> I think Allan Hayes wrote it.
>>>
>>> does anyone have a pointer to it please?
>>>
>>>
>>> Peter W
>>
>> You might try looking in library.wolfram.com. I believe (some? many?) back issues of TMJ are archived there.
>>
>> If I'm not mistaken, the method involves looking at a coefficient of 1/((1-x[1]*t)*(1-x[5]^t^5)*(1-x[10]*t^10)*(1-x[25]*t^25)*(1-x[50]*t^50)) expanded at the origin. Specifically, to make j cents in total change, look at the jth coefficient. Find the summand that uses smallest total powers of x[k]s.
>>
>> Here is a bit of code for this.
>>
>> minimalChange[coins_, amount_] := Module[
>> {len = Length[coins], mu, mus, x, ratfun, coeff, totals, bestpos},
>> mus = Map[mu, coins];
>> ratfun = Times @@ (1/Table[1 - mus[[j]]*x^coins[[j]], {j, len}]);
>> coeff = (List @@
>> Expand[SeriesCoefficient[ratfun, {x, 0, amount}]]);
>> coeff = coeff /. Times -> Plus;
>> totals = Map[# /. mu[_]^j_. :> j &, coeff];
>> bestpos = Ordering[totals, 1];
>> coeff[[bestpos]] /. Plus -> List /. mu[k_]^j_. :> {k, j}
>> ]
>>
>> Example:
>>
>> coins = {1, 5, 10, 25, 50};
>>
>> In[339]:= minimalChange[coins, 247]
>>
>> Out[339]= {{{1, 2}, {10, 2}, {25, 1}, {50, 4}}}
>>
>> So 4 50 cent pieces, 1 quarter, 2 dimes, two pennies. No surprises here.
>>
>> I think this is a bit slow. There may be a more efficient way to get at the relevant series term.
>>
>> I should allso note that the "obvious" greedy method does not work on all possible coin sets.
>>
>> In[341]:= minimalChange[{4, 7, 11, 23}, 247]
>>
>> Out[341]= {{{7, 1}, {11, 3}, {23, 9}}}
>>
>> Also one can have a tie.
>>
>> In[353]:= minimalChange[{5, 7, 11, 26}, 377]
>>
>> Out[353]= {{{7, 4}, {11, 1}, {26, 13}}}
>>
>> Could instead have had {5,2}, {7,1}, {11,2}, {26,13} for that.
>>
>> Daniel Lichtblau
>> Wolfram Research
>>
>
Prev by Date:
**3D plotting problem in Mathematica**
Next by Date:
**Power of infinity, NDSolve**
Previous by thread:
**Re: sum of coins article in mathematica journal**
Next by thread:
**[no subject]**
| |