WOLFRAM

Services & Resources / Wolfram Forums / MathGroup Archive

MathGroup Archive 2008

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Re: Re: Need a Faster Solution

Daniel Lichtblau wrote:
> Daniel Lichtblau wrote:
>> John Snyder wrote:
>>> I got hooked on the following little number theory problem which appears in
>>> the August issue of Discovery magazine.  "Susan has more than one dollar in
>>> change, but she still can't make exact change for a dollar bill. What is the
>>> maximum amount of money that Susan could have in pennies, nickels, dimes and
>>> quarters for this to be true?"
>>>  
>>> I solved the problem using the following Mathematica code:
>>>  
>>> coins={1,5,10,25};
>>> dollar=FrobeniusSolve[coins,100];
>>>  
>>> Catch[Do[t=Times@@Length/@(Cases[dollar,{p_,n_,d_,q_}/; (p<=#1&&n<=#2 &&
>>> d<=#3 && q<=#4)]&@@@FrobeniusSolve[coins,a]);
>>> If[t==0,Throw[a]],{a,130,101,-1}]]
>>>  
>>> Starting with a maximum guess of $1.30 this gives the correct answer of
>>> $1.19 in about 5 seconds.  The problem is that if the problem is made more
>>> complicated by adding more possible coin denominations (and/or paper
>>> currency) the execution time become very long indeed.
>>>  
>>> Is there a way to speed up the solution to this type of problem so that I
>>> can handle more complicated cases in a reasonable time?
>>>  
>>> Thanks,
>>>  
>>> John
>> Late response, but I didn't get time to look hard at this until now. It 
>> seems to be a difficult problem in terms of complexity, though I'm not 
>> certain I have the best possible approach.
>> [...]
> 
> I forgot a few things. One is that Mathematica already has the 
> functionality for elbows-to-corners (e2c) conversion built in. It seems 
> to be maybe 10 x faster than what I had shown.
> 
> Another is that one can often use term rewriting methods to bring down 
> the number of elbows under consideration. This specifically applies in 
> the case where the first denomination divides all others, and the second 
> divides all others above it. In our example we can swap 5 pennies for a 
> nickel and not hurt ourselves. It turns out that this removes most of 
> the elbows from consideration, thus making the job of e2c easier.
> 
> Here is the entire code needed. It assumes the first two denominations 
> are 1 and 5 respectively. Were this not the case, one could still have 
> working code by removing the replacement rule that begins {p_,n_,rest}...
> 
> maxNoChange2[coins_List, amount_Integer /; amount >= 1] /;
>    Not[And @@ Map[IntegerQ, amount/coins]] := Infinity
> 
> maxNoChange2[coins_List, amount_Integer /; amount >= 1] :=
>   Reduce`FarthestCorner[
>     coins, (FrobeniusSolve[coins,
>        amount] /. {p_, n_, rest___} /;
>         p > 5 :> {p - 5*(Floor[p/5] - 1), n + Floor[p/5] - 1, rest})] -
>     Total[coins]
> 
> So here is the example that was taking around 80 seconds. Without the 
> elbow penny-to-nickel replacement rule it is around 6 seconds, and with 
> it we are down to 1 second.
> 
> In[19]:= coins = {1, 5, 10, 25, 50};
> 
> In[20]:= Timing[maxNoChange2[coins, 200]]
> Out[20]= {0.992062, 219}
> 
> There may well be further improvements to be had. I'm not certain I have 
> exhausted all possible replacements (though I am certain we need to 
> retain 5 pennies when there are more than 5). I am not certain there is 
> no better way to go about this. Frankly, I'm not sure of much of 
> anything at the moment.
> 
> One resource I will mention, since it is really good for computing 
> Frobenius numbers, is an article by Bjarke Roune.
> 
> http://portal.acm.org/citation.cfm?id=1328333.1328354&coll=&dl=
> 
> This and others of relevance can be obtained in pdf form at the URL below.
> 
> http://www.broune.com/papers/
> 
> Daniel Lichtblau
> Wolfram Research

This can get addicting. I'll outline a couple of additional speed 
improvements.

(1) We can do more swaps than just pennies for nickels. Provided we keep 
at least one nickel, we can safely swap 2 nickels for 1 dime. We can 
swap 5 dimes for 2 quarters. Etc. Here I show this with the two lowest 
denomination allowable swaps. AAgain, it is not so obvious (to me) how 
to generalize this idea for a different set of coin denominations.

maxNoChange3[coins_List, amount_Integer /; amount >= 1] /;
   Not[And @@ Map[IntegerQ, amount/coins]] := Infinity

maxNoChange3[coins_List, amount_Integer /; amount >= 1] :=
  Reduce`FarthestCorner[coins,
    Union[(FrobeniusSolve[coins,
         amount] /. ({p_, n_, rest___} /;
           p >= 5 :> {p - 5*(Floor[(p - 1)/5]), n + Floor[(p - 1)/5],
           rest}) /.
       {p_, n_, d_, rest__} /; n >= 3 :> {p,
         n - 2*Floor[(n - 1)/2], d + Floor[(n - 1)/2], rest})]] -
   Total[coins]

coins = {1, 5, 10, 25, 50};

In[150]:= Timing[maxNoChange3[coins, 200]]
Out[150]= {0.376025, 219}

The bottleneck is now in the FrobeniusSolve. Well, it would be, if we do 
more swaps as described above to further reduce the number of elbows. 
Already that solve step is more than 50% of the time spent.

We can reduce further, in general, by observing that we can reduce the 
amount to avoid ($2 above) by multiples of the lcm of our denominations, 
until we are less than twice that lcm. So in this case we might instead 
look at how much we can have if we cannot make change for 50 cents. Then 
just add 150 cents to the result. I leave proof of this to the 
interested reader.

Daniel Lichtblau
Wolfram Research
  • Prev by Date: Re: Hypergeometric1F1 polynomial
  • Next by Date: Re: Re: Solving nonlinear inequality constraints
  • Previous by thread: Re: Re: Need a Faster Solution to Number Theory
  • Next by thread: Recognize vector expression