Chapter 4
Functions

from
Introduction to Programming with Mathematica,
2nd Ed.

by
Richard J. Gaylord
Samuel N. Kamin
Paul R. Wellin

Copyright 1995 TELOS/Springer-Verlag

4.2 Programs as Functions

Code from book

Mod[5, 3]

Sort[{1, 3, 2, 8, 3, 6, 3, 2}]

Fold[Plus, 0, {5, 2, 9, 12, 4, 23}]

Cos[Sin[Tan[4.0]]]

Tan[4.0]

Sin[%]

Cos[%]

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

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

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

Apply[And, %]

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}, %]

Flatten[%, 1]

Range[6]

Partition[%, 3]

Transpose[%]

Flatten[%, 1]

Flatten[Transpose[Partition[Out[14], 26]], 1]

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

carddeck

Flatten[Transpose[Partition[carddeck, 26]], 1]

Exercises

Ex.1

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

Flatten[Transpose[Partition[cardDeck, 26]], 1 ]

Ex.2

FromCharacterCode[Join[ToCharacterCode["To be, "],
	ToCharacterCode["or not to be"]]]

FromCharacterCode[Reverse[ToCharacterCode[%]]]

Ex.3

Flatten[Partition[Rest[{a, b, c, d, e, f, g}], 1, 2]]

Transpose[Sort[Transpose[{{3, 2, 4, 1},
	{a, b, c, d}}]]][[2]]

FoldList[Plus, 0, Table[(-1)^Random[Integer], {10}]]

FoldList[Plus,
        {0,0}, 
        {{1,0}, {-1,0}, {0,1}, {0,-1}}[[Table[Random[Integer, {1, 4}], {10}]]]]

Map[Reverse, Transpose[{{1, 2, 3}, {4, 5, 6}}]]

Apply[Plus, Transpose[{{1, 2}, {3, 4}}] {x, y}]

4.3 User-Defined Functions

Code from book

square[x_] := x^2

square[5]

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

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

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

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

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

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

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

Clear[maxima]

maxima[{6, 3, 9, 2}]

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]

Exercises

Ex.1

chooseWithReplacement[lis_, n_] :=
   lis[[Table[Random[Integer, {1, Length[lis]}], {n}]]]

chooseWithReplacement[{a, b, c, d, e, f, g, h}, 3]

Ex.2

stringinsert[str1_, str2_, pos_] :=
FromCharacterCode[Join[Take[ToCharacterCode[str1],
                           pos - 1],
		      ToCharacterCode[str2],
                 Drop[ToCharacterCode[str1], pos - 1]]]

stringdrop[str_,pos_]:=
FromCharacterCode[Drop[ToCharacterCode[str], pos]]

Ex.3

distance[lis_] :=
  (N[Sqrt[Apply[Plus, {lis[[1, 1]] - lis[[2, 1]], 
                lis[[1, 2]] - lis[[2, 2]]}^2]]])

distance[{{2, 5}, {6, 8}}]

Ex.4

name1[lis_] := Flatten[Partition[Rest[lis], 1, 2]]

name2[lis1_, lis2_] := 
  Transpose[Sort[Transpose[{lis1, lis2}]]][[2]]

name3[n_] :=
   FoldList[Plus, 0, Table[(-1)^Random[Integer], {n}]]

name3[n_] :=
   FoldList[Plus, {0, 0}, {{1, 0}, {-1, 0}, {0, 1}, {0, -1}}[[Table[Random[Integer, {1, 4}], {n}]]]]

name4[lis_] :=Map[Reverse, Transpose[lis]]

name5[lis_] := 
   Apply[Plus, Transpose[lis] {x, y}]

capitalizeFirstLetter[x_] :=
  StringJoin[FromCharacterCode[
   ToCharacterCode[StringTake[x, 1]]- 32], 
   StringDrop[x, 1]]

stringToInteger[x_] := 
    (ToCharacterCode[x][[1]] - 48) * 10 + 
    (ToCharacterCode[x][[2]] - 48)

Ex.5

interLeave2[lis1_, lis2_] :=
 Flatten[Join[Transpose[{lis2, Take[lis1, Length[lis2]]}],
    Take[lis1, (Length[lis2] - Length[lis1])]]]

interLeave2[{a, b, c, d}, {1, 2, 3}]

4.4 Auxiliary Functions

Code from book

Clear[deal,n,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]

Clear[deal]

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]

Exercises

Ex.1

name1[lis_] := Flatten[Partition[Rest[lis], 1, 2]]

name2[lis1_, lis2_] := 
  (pairing[m_, n_] := Transpose[{m, n}]; 
   Transpose[Sort[pairing[lis1, lis2]]][[2]])

name3[n_] :=
   (steps[m_] := Table[(-1)^Random[Integer], {m}];
    FoldList[Plus, 0, steps[n]])

name3[n_] :=
   FoldList[Plus, {0, 0}, {{1, 0}, {-1, 0}, {0, 1}, {0, -1}}[[Table[Random[Integer, {1, 4}], {n}]]]]

name4[lis_] :=
   Map[Reverse, Transpose[lis]]

name5[lis_] := 
   Apply[Plus, Transpose[lis] {x, y}]

capitalizeFirstLetter[str1_] :=
 (ucletter = FromCharacterCode[
              ToCharacterCode[StringTake[str1, 1]]-32]; 
  StringJoin[ucletter, StringDrop[str1, 1]])

stringToInteger[str2_] := 
  (tensplace = (ToCharacterCode[str2][[1]] - 48) * 10; 
   onesplace = ToCharacterCode[str2][[2]] - 48; 
   tensplace + onesplace)

Ex.2

latticeWalk1[n_] :=
   (steps[m_] := 
     {{1, 0}, {-1, 0}, {0, 1}, 
            {0, -1}}[[Table[Random[Integer, {1, 4}], {m}]]];
    FoldList[Plus, {0, 0}, steps[n]])

latticeWalk1[10]

latticeWalk2[n_] :=
   (choices = {{1, 0}, {-1, 0}, {0, 1}, {0, -1}}; 
    steps[m_] := choices[[Table[Random[Integer, {1, 4}],
                    {m}]]];
    FoldList[Plus, {0, 0}, steps[n]])

latticeWalk2[10]

Ex.3

searchPerfect[n_, m_] := Module[{perfectQ},
	perfectQ[j_] := Apply[Plus,Divisors[j]]==2j;
	Select[Range[n,m,2], perfectQ]]

searchPerfect[2, 1000]

searchPerfect[1, 1000]

Clear[searchPerfect]
searchPerfect[n_?EvenQ, m_] := Module[{perfectQ},
	perfectQ[j_] := Apply[Plus,Divisors[j]]==2j;
	Select[Range[n,m,2], perfectQ]]

searchPerfect[2, 1000]

searchPerfect[1,1000]

Ex.4

search3Perfect[n_, m_] := Module[{perfectQ},
	perfectQ[j_] := Apply[Plus,Divisors[j]]==3j;
	Select[Range[n,m], perfectQ]]

search3Perfect[1, 1000]

Ex.5

search4Perfect[n_, m_] := Module[{perfectQ},
	perfectQ[j_] := Apply[Plus,Divisors[j]] == 4j;
	Select[Range[n,m], perfectQ]]

search4Perfect[1, 10^5]

search4Perfect[1, 2200000]

Ex.6

searchKPerfect[n_, m_, k_] := Module[{perfectQ},
	perfectQ[j_] := Apply[Plus,Divisors[j]] == k j;
	Select[Range[n,m], perfectQ]]

searchKPerfect[1, 100, 2]

Ex.7

searchSuperperfect[a_, b_] :=
	Module[{sigma, superQ},
	   sigma[n_] := Apply[Plus, Divisors[n]];
	   superQ[n_]:= Nest[sigma, n, 2] == 2n;
	   Select[Range[a,b], superQ]]

searchSuperperfect[1, 10000]

4.5 Anonymous Function

Code from book

Function[z, z^2]

(#^2)&[6]

squared = (#^2)&;

squared[6]

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

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

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

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

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

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

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

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

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

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

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

Clear[deal]

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[lis_, n_] :=
   Complement[lis,
              Nest[(Delete[#, Random[Integer, {1,Length[#]}]])&,
                  lis, n]]

Exercises

Ex.1

elementsSquared[x_] := Apply[Plus, x^2]

elementsSquared[{3, 29, 2, 17}]

Ex.2

name7[x_Integer] := Apply[Plus, IntegerDigits[x]]

name7[629]

Ex.3

setOfDistances[x_] :=
  Module[{distance},
    pairOff[lis_] := 
      Flatten[Table[{lis[[i]], lis[[j]]},
       {i, 1, Length[lis] - 1}, {j, i + 1, Length[lis]}], 1];
    distance = Sqrt[Apply[Plus,(#[[1]] - #[[2]])^2]]&;
   Map[distance, pairOff[x]]
      ]

points = {{0.78078, 0.807045}, {0.541564, 0.512377},
          {0.226454, 0.56383}, {0.797958, 0.261694},
          {0.27265, 0.689889}};

setOfDistances[points]

Ex.4

(# + {{1,0}, {-1,0}, 
      {0,1}, {0,-1}}[[Random[Integer, {1,4}]]])&

NestList[(# + {{1,0}, {-1,0}, {0,1}, {0,-1}}[[
	Random[Integer, {1, 4}]]])&,
    {0, 0}, 10]

4.6 One-Liners

Code from book

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

survivor[Range[10]]

TracePrint[survivor[Range[10]], RotateLeft]

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

Count[coins, p]

{Count[coins, p], Count[coins, n], 
 Count[coins, d], Count[coins, q]}

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

(4 1) + (1 5) + (2 10) + (3 25)

Apply[Plus, {4, 1, 2, 3} * {1, 5, 10, 25}]

{4, 1, 2, 3} . {1, 5, 10, 25}

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

pocketChange[coins]

Exercises

Ex.1

frequencies[lis_] :=
 Module[{pair},
    pair[x_] := {x, Count[lis, x]};
    Map[pair, Union[lis]]]

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

Ex.2

split1[lis_, parts_] :=
  Module[{dog, cat}, 
     dog[y_, z_] := Take[lis,{y,z}];
     cat[x_] := Inner[dog, Drop[x,-1]+1, Rest[x], List];  
     cat[FoldList[Plus, 0, parts]] ]

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

Ex.3

split2[lis_, parts_] := 
   Module[{pig},
      pig[x_] := Take[lis, x + {1, 0}];
      Map[pig, Partition[FoldList[Plus, 0, parts], 2, 1]] ]

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

Ex.4

lotto1[lis_, n_] :=
  Module[{chicken, dove, fox},
   chicken[x_] := 
      Flatten[Rest[
         MapThread[Complement, {RotateRight[x], x}, 1]]];
   dove[y_] := Delete[y, Random[Integer, {1, Length[y]}]];      
   fox[z_] := NestList[dove, z, n];
   chicken[fox[lis]]]

lotto1[Range[10], 5]

Ex.5

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

lotto2[Range[10], 5]

Ex.6

{Timing[lotto1[Range[500], 3];], 
 Timing[lotto2[Range[500], 3];]}

{Timing[lotto1[Range[500], 60];], 
 Timing[lotto2[Range[500], 60];]}

Ex.7

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

makeChange[119]

Ex.8

offLattice[n_] :=
  Map[({Sin[#], Cos[#]})&, Table[Random[Real, {0, N[2Pi]}], {n}]]

offLattice[n_] :=
    Module[{step},
    step[x_] := {Sin[x], Cos[x]};
    Map[step, Table[Random[Real, {0, N[2Pi]}], {n}]]]