Mathematica Pearls:
Problems and Solutions

Edited by Donald T. Piele	                                                                             Volume 6, No. 1

Welcome back to Mathematica Pearls, the column devoted to examining those small bytes of polished Mathematica code that are smooth, tightly packed, and insanely swift. They are  not easy to find, yet there are thousands of them waiting to be uncovered. However, you won't just pick them up off the beach. You'll need to dig a little deeper and crack a few tough shells. But WOW, the result can be a  gem of regal beauty.

Have you got a Mathematica Pearl burried deep in your  files?  I invite you
to share them in  this column and add them to our string. If you have the goods, then "Show me  the pearls!"

Here's a problem whose solution should yield many gems.

Factorial Prime Decomposition

As we all have experienced, factorials grow very rapidly.

\(\({\(5!\), \(10!\), \(20!\)}
\)\)

One way of specifying such large numbers is by computing the number of times each prime
number occurs as a factor. In this way 20! could be specified as {18,8,4,2,1,1,1,1} from the
prime decomposition 20! = \(TraditionalForm
      \`\(2\^18\) \(3\^8\) \(5\^4\) \(7\^2\) 11\ 13\ 17\ 19.\) Notice that for factorials, all primes 
up to the largest prime  factor are present in the decomposition. In addition, the sequence  of multiples 
is non-increasing.

With the built-in function, FactorInteger, this prime decompositon is very easy to achieve.

Last[Transpose[FactorInteger[20!]]]

The FactorInteger function is amazingly fast.

Last[Transpose[FactorInteger[200!]]] // Timing

But for large N, N>1000, it slows down considerably and can be easily beat by building a special function to do the job for factorials. 
Now it's your turn to find a pearl.

factorialPrimeDecomposition[n]

Create a function factorialPrimeDecomposition[n], that will generate the prime decomposition for
n!  as illustrated above. Speed counts, so time your solution for n=5000 and compare it with
the time for  FactorInteger[n!]. A good solution will have more than a 10-fold speed increase. Like many good
pearls, it can also be written as  a one-liner.

Last[Transpose[FactorInteger[5000!]]];  // Timing // First
      a = %;

factorialPrimeDecomposition[5000];  // Timing // Firstb = %;

improvementFactor = a/b

Making Change

In the last issue, I posed the following problem.

Write a function that will compute how many ways any amount of money X.Y (with X dollars, and Y cents) can be represented using any combination of US coins and bills up to the 100 dollar bill. The denominations are: penny, nickel, dime, quarter, half dollar, dollar, 2 dollar, 5 dollar, 10 dollar, 20 dollar, 50 dollar, 100 dollar.

One solution is based on writing a simple recursion relationship.  Suppose W[m,n] is the number of ways that you can make make change for n cents using  the first m coins in the list of demoninations d (expressed as cents).

d = {1, 5, 10, 25, 50, 100, 200, 500, 1000, 2000, 5000, 10000};

The key recursion relationship is discovered by working through one example. W[4,100] is the number of
ways of making change for 100 cents ($1) with the  first four coins {penny, nickel, dime, quarter}.
W[3,100] is the number of ways of making change for 1 dollar with the first  three coins {penny, nickel,
dime}. In making change for 1 dollar, you can do  it by using one quarter, leaving 75 cents which can be changed  in W[4, 100-25] ways, or by not using a quarter and doing it  W[3,100] ways. The two ways are mutally exclusive. Thus,W[4,100] = W[3,100] + W[4,75] is the key recursion relationship. A similar relationship can be made  for all the coins. 

Of course, you can make change using only pennies in  only one way, W[1,n]=1. Also,
W[m,0] means you have no money left, and your change is a single coin, which is done in 1 way. Putting this all  together, we have the following pearl.

Clear[W]W[m_, n_] := 0   /;  n < 0\(W[m_, 0] = 1\ ; 
W[1, n_] = 1; 

    W[m_, n_] := \(W[m, n] = W[m - 1, n] + W[m, n - d[\([m]\)]]\)\)

Here is a table for the number ways of making change with all 12 coins in amounts up to $50.

sol = Table[{n, W[12, n]}, {n, 100, 2000, 100}]

\(ListPlot[sol, PlotJoined -> True, 

      	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
      PlotLabel -> "MAKING CHANGE"\ , \ 

      		\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
      Frame -> True]\)

Show me the pearls!

The best way to get my attention is to send your work via email to <piele@cs.uwp.edu>. Little pearls slip nicely into an email message and 
can zip to me from anywhere. You will get immediate feedback. Accompany your 
work with an explanation of how it was created. That's it, and thanks.

CONTACTING THE EDITOR
Don Piele
Mathematics Department
University of Wisconsin-Parkside
Kenosha, WI 53141
piele@cs.uwp.edu

ELECTRONIC SUBSCRIPTIONS

Included in the distribution for each electronic subscription is the file Pearls61.nb containing Mathematica code for the material described in this article.