(*^
::[	Information =

	"This is a Mathematica Notebook file.  It contains ASCII text, and can be
	transferred by email, ftp, or other text-file transfer utility.  It should
	be read or edited using a copy of Mathematica or MathReader.  If you 
	received this as email, use your mail application or copy/paste to save 
	everything from the line containing (*^ down to the line containing ^*)
	into a plain text file.  On some systems you may have to give the file a 
	name ending with ".ma" to allow Mathematica to recognize it as a Notebook.
	The line below identifies what version of Mathematica created this file,
	but it can be opened using any other version as well.";

	FrontEndVersion = "Macintosh Mathematica Notebook Front End Version 2.2";

	MacintoshStandardFontEncoding; 
	
	fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e8,  24, "Times"; 
	fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6,  18, "Times"; 
	fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, e6,  14, "Times"; 
	fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, a20,  18, "Times"; 
	fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, a15,  14, "Times"; 
	fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, a12,  12, "Times"; 
	fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  10, "Times"; 
	fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L-5,  12, "Courier"; 
	fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5,  12, "Courier"; 
	fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, R65535, L-5,  12, "Courier"; 
	fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5,  12, "Courier"; 
	fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, B65535, L-5,  12, "Courier"; 
	fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287,  12, "Courier"; 
	fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic,  10, "Geneva"; 
	fontset = header, inactive, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = leftheader, inactive, L2,  12, "Times"; 
	fontset = footer, inactive, noKeepOnOnePage, preserveAspect, center, M7,  12, "Times"; 
	fontset = leftfooter, inactive, L2,  12, "Times"; 
	fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  10, "Times"; 
	fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	paletteColors = 128; automaticGrouping; currentKernel; 
]
:[font = special1; inactive; preserveAspect]
                                                        Diffusion

This lab has two parts.  The first part looks at diffusion using simulation.  The second part uses Markov chains.

The Mathematica  procedure  Random[]  produces random numbers between zero and one, possibly zero but never one.  Evaluate the cell below to see some examples.
;[s]
6:0,1;65,0;186,2;197,0;296,3;340,0;342,-1;
4:3,13,9,Times,0,12,0,0,0;1,13,9,Times,1,12,0,0,0;1,13,9,Times,2,12,0,0,0;1,13,9,Times,1,12,65535,0,0;
:[font = input; preserveAspect]
Random[]
Random[]
:[font = special1; inactive; preserveAspect]
Now suppose that we want to simulate a molecule in one of the end, or outer, cells in our five-celled organism. Recall that in each unit of time or in each "tick of the clock" the molecule stays put with probability 75% and jumps to the adjacent cell with probability 25%. The Mathematica  procedure,  OuterCell[], defined below, simulates this.  Evaluate the cell below now.  Note that it tests the procedure OuterCell[].
;[s]
9:0,0;277,1;288,0;302,2;313,0;347,3;376,0;409,2;421,0;423,-1;
4:5,13,9,Times,0,12,0,0,0;1,13,9,Times,2,12,0,0,0;2,13,9,Times,1,12,0,0,0;1,13,9,Times,1,12,65535,0,0;
:[font = input; preserveAspect]
OuterCell[] :=
If[Random[] < 0.75, Print["Stay"], Print["Move"]]

(*                  Test OuterCell                  *)

For[i = 1, i <= 10, i = i + 1, OuterCell[]]
:[font = special1; inactive; preserveAspect]
The Mathematica  procedure, tick[n], defined below is more complicated and simulates what a molecule in any one of the five cells does in one "tick of the clock." That is, if you execute tick[n] where n is 1, 2, 3, 4, or 5 the procedure determines probabilistically where a molecule in cell n will be after one tick of the clock.   Evaluate the cell below now.  Note that it tests the procedure Tick[n].
;[s]
25:0,0;4,1;15,0;28,2;35,0;187,2;194,0;201,2;202,0;206,2;207,0;208,2;210,0;212,2;213,0;215,2;216,0;221,2;222,0;291,2;292,0;332,3;361,0;394,2;402,0;404,-1;
4:13,13,9,Times,0,12,0,0,0;1,13,9,Times,2,12,0,0,0;10,13,9,Times,1,12,0,0,0;1,13,9,Times,1,12,65535,0,0;
:[font = input; preserveAspect]
Tick[n_] :=
Block[{spinner, endcell},
      spinner = Random[];
      If[spinner < 0.25, endcell = n + 1,
         If[spinner < 0.50, endcell = n - 1, endcell = n]];
      endcell = Max[endcell, 1];
      endcell = Min[endcell, 5];
      endcell]
      
(*                    Test Tick                     *)
      
For[i = 1, i <= 10, i = i + 1, Print[Tick[1]]]
Print[""]
For[i = 1, i <= 10, i = i + 1, Print[Tick[3]]] 
Print[""]  
For[i = 1, i <= 10, i = i + 1, Print[Tick[5]]]      
:[font = special1; inactive; preserveAspect]
Explain how the procedure Tick[n] works.
;[s]
2:0,1;40,0;41,-1;
2:1,13,9,Times,0,12,0,0,0;1,13,9,Times,1,12,65535,0,0;
:[font = special1; inactive; preserveAspect]
You can use this function together with the usual tools for working with sequences to look at some examples of the travels of a molecule as it moves around the organism. The cell below shows an example for a molecule starting in the middle cell. 
:[font = input; preserveAspect]
Travel[0] := 3;
Travel[n_] := Travel[n] = Tick[Travel[n - 1]];

ListPlot[Table[{i, Travel[i]}, {i, 0, 50}],
               PlotJoined -> True,
               PlotRange -> {0, 6}]
:[font = special1; inactive; preserveAspect]
The Mathematica  procedure  TickSim[n], defined below runs simulations like the ones described in the narrative part of this module. Executing TickSim[n] simulates 40 ticks of the clock for n molecules. All the molecules start in the middle cell.  The results are printed in the form  

                         {1, {cell1, cell2, cell3, cell4, cell5}}

where cell1, cell2, cell3, cell4, cell5 are the numbers of molecules in each cell after i ticks of the clock.
;[s]
23:0,0;4,1;15,0;28,2;38,0;143,2;153,0;190,2;191,0;312,2;352,0;360,2;365,0;367,2;372,0;374,2;379,0;381,2;386,0;388,2;393,0;441,2;443,0;464,-1;
3:12,13,9,Times,0,12,0,0,0;1,13,9,Times,2,12,0,0,0;10,13,9,Times,1,12,0,0,0;
:[font = input; preserveAspect]
TickSim[n_] := Block[{count},
   molecule = Table[3, {i, 1, n}];
   For[j = 1, j <= 41, j = j + 1,
       count = {0, 0, 0, 0, 0};
       For[i = 1, i <= n, i = i + 1, 
           count[[molecule[[i]]]] = count[[molecule[[i]]]] + 1];
       Print[{j - 1, count}];
       For[i = 1, i <= n, i = i + 1,
           molecule[[i]] = Tick[molecule[[i]]]]
       ];
   ]
   
TickSim[200]
   
:[font = special1; inactive; preserveAspect]
                                                      Markov Chains

The cell below looks at diffusion using Markov chains.  It uses the matrix A to represent the probabilitiues of moving from one state (or cell) to another.  The initial probability vector, P[0}, is set to {1, 0, 0 , 0, 0 representing a situation in which all the molecules start in the leftmost cell.  Evaluate the next cell now.
;[s]
5:0,1;54,2;67,0;371,3;397,0;399,-1;
4:2,13,9,Times,0,12,0,0,0;1,13,9,Times,1,12,0,0,65535;1,13,9,Times,1,12,0,0,0;1,13,9,Times,1,12,65535,0,0;
:[font = input; preserveAspect]
Clear[A, P]

A = {{0.75, 0.25, 0.00, 0.00, 0.00},
     {0.25, 0.50, 0.25, 0.00, 0.00},
     {0.00, 0.25, 0.50, 0.25, 0.00},
     {0.00, 0.00, 0.25, 0.50, 0.25},
     {0.00, 0.00, 0.00, 0.25, 0.75}};

P[0] = {1, 0, 0, 0, 0};
P[n_] := P[n] = A.P[n - 1];

P[1]
P[2]
P[5]
P[10]
P[20]

NumberOfTicks := 30;
u1[n_] := P[n][[1]]
u2[n_] := P[n][[2]]
u3[n_] := P[n][[3]]
u4[n_] := P[n][[4]]
u5[n_] := P[n][[5]]

plot1 = ListPlot[Table[{i, u1[i]}, {i, 0, NumberOfTicks}], 
                 PlotJoined -> True,
                 PlotRange -> {0, 1},
                 DisplayFunction -> Identity,
                 PlotStyle -> {RGBColor[1, 0, 0]}];
                 
plot2 = ListPlot[Table[{i, u2[i]}, {i, 0, NumberOfTicks}], 
                 PlotJoined -> True,
                 PlotRange -> {0, 1},
                 DisplayFunction -> Identity,
                 PlotStyle -> {RGBColor[1, 0, 1]}];
                 
plot3 = ListPlot[Table[{i, u3[i]}, {i, 0, NumberOfTicks}], 
                 PlotJoined -> True,
                 PlotRange -> {0, 1},
                 DisplayFunction -> Identity,
                 PlotStyle -> {RGBColor[0, 0, 1]}];
                 
plot4 = ListPlot[Table[{i, u4[i]}, {i, 0, NumberOfTicks}], 
                 PlotJoined -> True,
                 PlotRange -> {0, 1},
                 DisplayFunction -> Identity,
                 PlotStyle -> {RGBColor[0, 0.75, 0.75]}];
                 
plot5 = ListPlot[Table[{i, u5[i]}, {i, 0, NumberOfTicks}], 
                 PlotJoined -> True,
                 PlotRange -> {0, 1},
                 DisplayFunction -> Identity,
                 PlotStyle -> {RGBColor[0, 0, 0]}];
                 
Show[plot1, plot2, plot3, plot4, plot5, DisplayFunction -> $DisplayFunction];

^*)