Introduction to Programming 
with 
Mathematica

By
Richard J. Gaylord 
(gaylord@ux1.cso.uiuc.edu)

Samuel N. Kamin 
(kamin@cs.uiuc.edu)

Paul R. Wellin 
(wellin@sonoma.edu)

Copyright ã 1993 by TELOS/Springer-Verlag

Chapter 4 ± Functions

(Mathematica code)

Functions defined in this Notebook...(page no. in book)

carddeck...78
areEltsEven...77,84
maxima...77, 85
removeRand...78, 85
deal...79,81,82,86
pick...79
perfect2...83
perfectK...83
chooseWithoutReplacement...79
perfecto...83
survivor...88
pocketChange...90
frequencies...91
split1...91
split2...91
lotto1...91
lotto2...92
makeChange...92

Initialization (evaluate to turn off spell messages)

Off[General::spell]

Off[General::spell1]

Section 4.2  Programs as functions

Clear[c,d,h,s,J,Q,K,A]

Trace[Cos[Sin[Tan[4.0]]]]

Apply[And, Map[EvenQ, {2, 4, 6, 7, 8}] ]

Union[Rest[FoldList[Max, 0, {3, 1, 6, 5, 4, 8, 7}]]]

Trace[Union[Rest[FoldList[Max, 0, {3, 1, 6, 5, 4, 8, 7}]]]]

Flatten[Outer[List, {c, d, h, s},
	Join[Range[2, 10], {J, Q, K, A}]], 1]

Join[Range[2, 10], {J, Q, K, A}]

Outer[List, {c, d, h, s}, 
	Join[Range[2, 10], {J, Q, K, A}]]

Flatten[%, 1]

carddeck = 
   Flatten[Outer[List, {c, d, h, s}, 
		Join[Range[2, 10], {J, Q, K, A}]], 1]

Section 4.3  User-defined functions

areEltsEven[lis_] := Apply[And, Map[EvenQ, lis] ]

areEltsEven[{2, 8, 14, 6, 16}]

maxima[x_] := Union[Rest[FoldList[Max, 0, x]]]

maxima[{4, 2, 7, 3, 4, 9, 14, 11, 17}]

Clear[c,d,h,s,J,Q,K,A]

carddeck = 
   Flatten[Outer[List, {c, d, h, s},
		Join[Range[2, 10], {J, Q, K, A}]], 1];

removeRand[lis_] := 
   Delete[lis, Random[Integer, {1, Length[lis]}]]

deal[n_] := 
   Complement[carddeck, Nest[removeRand, carddeck, n]]

deal[5]

pick[n_] := Table[Random[Integer, {0, 9}], {n}]

pick[4]

Section 4.4  Auxiliary functions

Clear[c,d,h,s,J,Q,K,A]

deal[n_] :=
	(carddeck = Flatten[Outer[List, {c, d, h, s},
		            Join[Range[2, 10], {J, Q, K, A}]], 1];
	 removeRand[lis_] := 
	 	Delete[lis, Random[Integer, {1, Length[lis]}] ];
	 Complement[carddeck, Nest[removeRand, carddeck, n]]
	)

deal[5]

deal[n_] := Module[{removeRand, carddeck},
	carddeck = Flatten[Outer[List, {c, d, h, s},
		Join[Range[2, 10], {J,Q,K,A}]], 1];
	removeRand[lis_] := Delete[lis, Random[Integer, {1, Length[lis]}]];
	Complement[carddeck, Nest[removeRand, carddeck, n]]  
	]

deal[5]

4.4  Exercises

perfect2[{n_Integer,m_Integer}] :=
	Position[Map[perfectQ, Range[n,m]], True] + (n-1)

(* Remove comments to evaluate *)
(* perfect2[{8100,8200}] *)

perfectK[n_Integer, m_Integer, k_Integer] :=
	(test[j_] := Apply[Plus, Divisors[j]] == k j;
	Position[Map[test, Range[n,m]], True] + (n - 1)
	)

perfectK[n_Integer, m_Integer, k_Integer] :=
	Module[{test,j},
		test[j_] := Apply[Plus, Divisors[j]] == k j;
		Position[Map[test, Range[n,m]], True] + (n - 1)
	]

(* Remove comments to evaluate: time consuming *)
(* perfectK[1,9000,2] *)

(* Remove comments to evaluate: time consuming *)
(* perfectK[1,1000,3] *)

Section 4.5  Anonymous functions

areEltsEven

areEltsEven[lis_] := Apply[And, Map[EvenQ, lis] ]

(Apply[And, Map[EvenQ, #] ])&

Function[x, Apply[And, Map[EvenQ, x] ] ]

maxima

maxima[x_] := Union[Rest[FoldList[Max, 0, x]]]

(Union[Rest[FoldList[Max, 0, #]]])&

Function[y, Union[Rest[FoldList[Max, 0, y]]]]

removeRand

removeRand[lis_] := 
	Delete[lis, Random[Integer, {1, Length[lis]}] ]

(Delete[#, Random[Integer, {1, Length[#]}] ])&

Function[x, Delete[x, Random[Integer, {1, Length[x]}] ] ]

Nested anonymous functions

(Map[(#^2)&, #])&[{3, 2, 7}]

Function[y, Map[Function[x, x^2], y]][{3, 2, 7}]

deal

Clear[c,d,h,s,J,Q,K,A]

deal[n_] := Module[{carddeck},
   carddeck = Flatten[Outer[List, {c, d, h, s},
		Join[Range[2, 10], {J,Q,K,A}]], 1];
   Complement[carddeck, 
		Nest[(Delete[#, Random[Integer, {1, Length[#]}] ])&,
			carddeck, n]]
   ]

deal[5]

chooseWithoutReplacement

chooseWithoutReplacement[lis_, n_] :=
   Complement[lis,
      Nest[(Delete[#, Random[Integer, {1, Length[#]}] ])&,
		lis, n]]

perfecto

Here is a good exercise to convert the perfect[ ] function to a self-contained one by using anonymous functions:

perfecto[n_] := Select[Range[n], 
	(Apply[Plus,Divisors[#]] == 2#)&]

perfecto[500]

Section 4.6  One-liners

survivor

survivor[lis_] := 
   Nest[(Rest[RotateLeft[#]])&, lis, Length[lis] - 1]

survivor[Range[10]]

pocket change

Clear[p,n,d,q]

coins = {p, p, q, n, d, d, p, q, q, p}

Map[(Count[coins, #])&,  {p, n, d, q}]

pocketChange[x_] := 
   Apply[Plus, Map[(Count[x, #])&,
		{p, n, d, q}] {1, 5, 10, 25}]

pocketChange[coins]

Exercises

4.6.1  frequencies

frequencies[lis_] := 
   Map[({#, Count[lis, #]})&, Union[lis]]

Clear[a,b,c]

frequencies[{a, a, b, b, b, a, c, c}]

4.6.2  split1

split1[lis_, parts_] := 
   Inner[Take[lis, {#1, #2}]&,
        Drop[#1, -1] + 1,
        Rest[#1],
        List]&[FoldList[Plus, 0, parts]]

split1[Range[10], {2, 5, 0, 3}]

4.6.3  split2

split2[lis_, parts_] := 
   Map[(Take[lis, # + {1, 0}])&,
       Partition[FoldList[Plus, 0, parts], 2, 1]]

4.6.4  lotto1

lotto1[lis_, n_] :=  
  (Flatten[Rest[MapThread[Complement,
  	{RotateRight[#], #}, 1]]])& [NestList[Delete[#,
  		Random[Integer,{1, Length[#]}]]&,
		 lis, n]]

lotto1[Range[10], 5]

4.6.5  lotto2

lotto2[lis_, n_] :=
    Take[Transpose[Sort[
             Transpose[{Table[Random[],
                            {Length[lis]}], lis}]]][[2]],
	    n]

4.6.7  makeChange

makeChange[x_] :=
   Quotient[Drop[FoldList[Mod, x, {25, 10, 5, 1}], -1],
		{25, 10, 5, 1}]

makeChange[119]