Chapter 11
Applications

from
Introduction to Programming with Mathematica, 
(2nd Ed.)

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

Copyright 1995 TELOS/Springer-Verlag

12.1  The Game of Life

Code from book

(GameBoard = Table[Random[Integer], {4}, {4}])//TableForm

Wrap = Join[{Last[#]}, #, {First[#]}]&

Wrap[Map[Wrap, GameBoard]]//TableForm

(Neighborhoods = 
 Partition[Wrap[Map[Wrap, GameBoard]], 
          {3, 3}, {1, 1}]) //MatrixForm

LiveOrDie[lis_] := Module[{Nghbrs},
   Nghbrs = Count[lis, 1, {2}] ;
   If[lis[[2, 2]] == 1 && Nghbrs == 4 || Nghbrs == 3, 1, 0]]

Map[LiveOrDie, Neighborhoods, {2}]//MatrixForm

LivingNghbrs[mat_] := 
   Apply[Plus, Map[RotateRight[mat, #]&,
                  {{-1,-1},{-1,0},{-1,1},{0,-1},
		   {0,1},{1,-1},{1,0},{1,1}}]]

LivingNghbrs[GameBoard] //MatrixForm

update[1, 2] := 1

update[_, 3] := 1

update[_, _] := 0

Attributes[update] := Listable

Attributes[g] = Listable;

g[GameBoard, LivingNghbrs[GameBoard]] //MatrixForm

update[GameBoard, LivingNghbrs[GameBoard]] // MatrixForm

FixedPointList[update[#,LivingNghbrs[#]]&,
              GameBoard, 3] //MatrixForm

Map[Transpose, %] //MatrixForm

LifeGame[s_, t_]:= 
  Module[{initconfig, livingNghbrs, update},
        initconfig = Table[Random[Integer],{s},{s}] ;

        livingNghbrs[mat_]:= 
                Apply[Plus,  Map[RotateRight[mat, #]&,
                {{-1,-1},{-1,0},{-1,1},{0,-1},
                 {0,1},{1,-1},{1,0},{1,1}}]];
        update[1, 2] := 1;
        update[_, 3] := 1;
        update[_, _] := 0;
        Attributes[update] = Listable;
       
        FixedPointList[update[#, livingNghbrs[#]]&,
	              initconfig, t]
        ]

ShowLife[list_]:=
   Scan[(Show[Graphics[RasterArray[Reverse[list[[#]] /.
                     {1 -> RGBColor[1,0,0], 
                      0 -> RGBColor[0,0,0]}]],
             AspectRatio->Automatic]])&,
      Range[Length[list]]]

ShowLife[LifeGame[20,10]]

Exercises

glider[x_, y_] := 
{{x, y}, {x+1, y}, {x+2, y}, {x+2, y+1}, {x+1, y+2}}

LifeGame[s_, t_, lifeform_List]:= 
Module[{init=Table[0,{s},{s}], board,
        livingNghbrs, update},
   board = ReplacePart[init, 1, lifeform];
   livingNghbrs[mat_]:= 
      Apply[Plus, Map[RotateRight[mat, #]&,
                     {{-1,-1}, {-1,0}, {-1,1}, {0,-1},
                      {0,1}, {1,-1}, {1,0}, {1,1}}]
           ];
   update[1, 2] := 1;
   update[_, 3] := 1;
   update[_, _] := 0;
   Attributes[update] = Listable;
   FixedPointList[update[#, livingNghbrs[#]]&,
                 board, t]]

lg50 = LifeGame[50, 20, glider[20,20]];

ShowLife[ lg50 ]

12.2  Random Walks

Code from book

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

FoldList[Plus, 0, %]

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

Walk1D[10]

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

Walk2D[10]

ShowWalk2D[coords_, opts___]:=
   Show[Graphics[Line[coords],
                opts,
                AspectRatio -> Automatic]]

ShowWalk2D[ Walk2D[20] ]

walk = Walk2D[10]

Map[{Min[#], Max[#]}&, Transpose[ walk ]]

AnimateWalk2D[coords_, opts___]:=
   Map[Show[Graphics[Line[Take[coords, #]]],
                    opts, AspectRatio -> Automatic,
                    PlotRange -> Map[{Min[#]-1, Max[#]+1}&,
                                    Transpose[coords]]]&,
      Range[2, Length[coords]]]

Show[GraphicsArray[Partition[AnimateWalk2D[walk, 
        DisplayFunction -> Identity], 5] ]];

SquareDistance[walk_List] := Apply[Plus, Last[walk]^2]

SquareDistance[walk]

MeanSquareDistance[n_Integer, m_Integer] := 
   Module[{walk2D},
         walk2D[s_] :=
	    FoldList[Plus, {0, 0}, 
                    {{0,1},{1,0},{0,-1},{-1,0}}[[
               Table[Random[Integer,{1,4}],{s}]]]]; 
         N[Sum[Apply[Plus, Last[walk2D[n]]^2], {m}]/m]
        ]

MeanSquareDistance[10, 25]

MeanSquareRadiusGyration[m_Integer, n_Integer] := 
   Module[{squareRadiusGyration},
         squareRadiusGyration[s_Integer] := 
         Module[{locs, cm, choices = {{1,0},{-1,0},{0,1},{0,-1}}},
               locs = FoldList[Plus,{0,0}, 
               choices[[Table[ Random[Integer,{1,4}],{s}]]]];
               cm = N[Apply[Plus, locs]/(s+1)];
               Apply[Plus, Flatten[(Transpose[locs]-cm)^2]]/(s+1)
               ];
         N[Sum[squareRadiusGyration[n], {m}]/m]
   ]

MeanSquareRadiusGyration[15, 20]

data = Map[({MeanSquareDistance[#, 75], #})&,
          Range[10, 90, 20]]

calculatedExponent = Fit[N[Log[data]], {x}, x]

calculatedGraph = Plot[calculatedExponent, {x, 0, 90}]

Needs["Graphics`Graphics`"]

dataGraph = 
   LogLogListPlot[data, PlotStyle -> PointSize[.03]]

Show[dataGraph, calculatedGraph]

Exercises

Ex.1

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

Ex.2

OffLattice[n_] := 
   FoldList[Plus, {0.0 , 0.0}, 
           Map[{Cos[#], Sin[#]}&,
	      Table[Random[Real, {0,N[2Pi]}], {n}]]]

Ex.3

AnimateWalk2D[coords_, opts___]:=
	Map[Show[Graphics[{
		{RGBColor[1,0,0], PointSize[.02],
		 Point[ coords[[#]] ]},
		Line[Take[coords, #]]}],
	 opts,
	 AspectRatio -> Automatic,
	 PlotRange -> Map[{Min[#]-.2, Max[#]+.2}&,
		             Transpose[coords]]]&, 
			 Range[2, Length[coords]]]

12.3  Implementing Languages

Initializations

SetDirectory["/Zeppo/IPM2/DisketteFiles"]

<<PDL`

<<syntrees`

<<EPDL`

$DefaultFont = {"Helvetica",8};

Book Images

PDL[ex1]

PDL[ex2]

Show[ptree,
	DefaultFont->{"Helvetica",8},
	PlotRange->All]

p1 = EPDL[squaredirs]

Show[p1, PlotRange->All]

p2 = EPDL[circledirs]

p2 = Show[p2, PlotRange->All]

p3 = EPDL[ovaldirs]

p3 = Show[p3, PlotRange->All]

p4 = EPDL[rectangledirs]

p4 = Show[p4, PlotRange->All]

Show[GraphicsArray[{{p1,p2}, {p4,p3}},
	GraphicsSpacing -> {.55,.25}]]

PDL[ex3]

PDL[ex4]

Show[ptree1,PlotRange->All]

Show[ptree2,PlotRange->All]

Show[ptree3,PlotRange->All]

Show[ptree4,PlotRange->All]

Show[ptree5,PlotRange->All]

Show[ptree6,PlotRange->All]

Show[ptree7,PlotRange->All]