(* Content-type: application/mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 6.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 145, 7] NotebookDataLength[ 55882, 1799] NotebookOptionsPosition[ 50589, 1628] NotebookOutlinePosition[ 51368, 1661] CellTagsIndexPosition[ 51300, 1656] WindowFrame->Normal ContainsDynamic->False*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Understanding Statistical Physics", "Title"], Cell["\<\ Project Suggestions for APAM 1601 Due: Monday, March 30, 2009\ \>", "Subsubtitle", CellChangeTimes->{3.447062194336042*^9}], Cell["\<\ All projects must have\[Ellipsis] Name:____________ Email:_____@columbia.edu\ \>", "Subsubtitle"], Cell[CellGroupData[{ Cell["Introduction", "Section"], Cell[TextData[{ "During the past few lectures, we've explored simple models for the \ evolution of complex systems interacting with random motions. Although these \ models are very simple, they can be used to develop insights to real physical \ systems, such as proteins, cluster, magnets and polymers.\n\nFor your next \ project, I ask that you prepare a notebook that reports your investigations \ related to a problem or question in statistical physics and/or random \ numbers. I listed below several possible subjects each phrased like a \ homework problem, but I encourage you to look beyond the simple answer to the \ question. Like before, your notebook should contain ", StyleBox["Mathematica", FontSlant->"Italic"], " expressions and graphics which illustrate your solution. Try not to \ include a large number of repeated expressions. Instead, generate a table or \ graphic of your results. Also, consider collecting ", StyleBox["Mathematica", FontSlant->"Italic"], " expressions that are used repeatedly into a single ", StyleBox["Module[...]", FontWeight->"Bold"], " that can be executed within a ", StyleBox["Table[ ]", FontWeight->"Bold"], " statement or by mapping to elements of a list. \n\nIn all cases, format \ your notebook and include textual comments and descriptions. Your notebook \ need not be long. It should begin with an Introduction describing your \ problem, approach, and a brief abstract of your results. It should also be \ interesting and arrive at a definite conclusion.\n\nI've also attached (to \ our class website) an article from ", StyleBox["American Scientist", FontSlant->"Italic"], " (written by former editor Brian Hayes) that provide some background for \ one possible investigation, entitled \"How to Avoid Yourself\" and describes \ counting of possible self-avoiding random walks. Feel free to use any idea \ contained in this article to motivate questions for you project. (Ideas for \ the Eden simulation and for \"diffusion limited aggregation\" came from \ Giordano's textbook.)" }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Random and Self-Avoiding Walks", "Section"], Cell["\<\ Using our in-class notebook describing the \"pivot\" method for generating \ self-avoiding walks and Brian Hayes's article \"How to Avoid Yourself\", \ compare the statistics of (i) random walks, (ii) non-reversing walks, and \ (iii) self-avoiding walks. \ \>", "Text"], Cell[TextData[{ "Your analyses will have several steps. First, you must verify that your \ three \"stepper\" functions work as designed and that you are able to \ construct ensembles of walks using the three techniques. Secondly, compute \ statistical averages and variations of your walks as a function of the length \ of the walks. The average position is the \"center of mass\", {", Cell[BoxData[ FormBox[ SubscriptBox["x", "cm"], TraditionalForm]]], ",", Cell[BoxData[ FormBox[ SubscriptBox["y", "cm"], TraditionalForm]]], "}. The root-mean-square size of the walkers is \[CapitalDelta] \[Congruent] \ ", Cell[BoxData[ FormBox[ SqrtBox[ RowBox[{"\[LeftAngleBracket]", FormBox[ SuperscriptBox[ RowBox[{"(", RowBox[{"|", RowBox[{ FormBox[ SubscriptBox["r", "i"], TraditionalForm], " ", "\[Dash]", " ", FormBox[ SubscriptBox["r", "cm"], TraditionalForm]}], "|"}], ")"}], "2"], TraditionalForm], "\[RightAngleBracket]"}]], TraditionalForm]]], ". \[CapitalDelta] is a measure of the average \"radius\" of random walk \ process. The end-to-end length is ", StyleBox["L = |", FontSlant->"Italic"], Cell[BoxData[ FormBox[ SubscriptBox["r", "n"], TraditionalForm]]], " - ", Cell[BoxData[ FormBox[ SubscriptBox["r", "0"], TraditionalForm]]], "| is a measure of how far one can walk in ", StyleBox["n", FontSlant->"Italic"], " steps. C", "alculate averages of \[CapitalDelta] and ", StyleBox["L", FontSlant->"Italic"], " as a function of the number of steps, ", StyleBox["n", FontSlant->"Italic"], ", for a large number of random walkers and for each of the three types of \ walks. We know that \[LeftAngleBracket]", "\[CapitalDelta]\[RightAngleBracket] and \[LeftAngleBracket]", StyleBox["L", FontSlant->"Italic"], "\[RightAngleBracket]", " scale like ", Cell[BoxData[ FormBox[ SqrtBox["n"], TraditionalForm]]], " for an unbiased random walk. How do these quantities vary with ", StyleBox["n", FontSlant->"Italic"], " for the other two types of walks?" }], "Text"], Cell[CellGroupData[{ Cell["Defining the Walkers", "Subsection"], Cell[TextData[{ "See class notebooks: ", ButtonBox["8-3D_Walks.nb", BaseStyle->"Hyperlink", ButtonData:>{ URL["http://www.apam.columbia.edu/courses/ap1601y/8-3D_Walks.nb"], None}], " and ", ButtonBox["8-SelfAvoidingWalks.nb", BaseStyle->"Hyperlink", ButtonData:>{ URL["http://www.apam.columbia.edu/courses/ap1601y/8-SelfAvoidingWalks.nb"]\ , None}], "." }], "Text"], Cell[CellGroupData[{ Cell["2D Random Walk", "Subsubsection"], Cell[BoxData[ RowBox[{ RowBox[{"step2D", "[", "]"}], ":=", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"1", ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", RowBox[{"-", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "0"}], "}"}]}], "}"}], "\[LeftDoubleBracket]", RowBox[{"RandomInteger", "[", RowBox[{"{", RowBox[{"1", ",", "4"}], "}"}], "]"}], "\[RightDoubleBracket]"}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"walk2D", "[", "n_", "]"}], " ", ":=", " ", RowBox[{"NestList", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"#", " ", "+", " ", RowBox[{"step2D", "[", "]"}]}], ")"}], "&"}], ",", " ", RowBox[{"{", RowBox[{"0", ",", "0"}], "}"}], ",", " ", "n"}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"walk2D", "[", "50", "]"}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"Thickness", "[", "0.01`", "]"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "14"}], ",", "14"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "14"}], ",", "14"}], "}"}]}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}], ",", RowBox[{"AspectRatio", "\[Rule]", "Automatic"}]}], "]"}]], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["2D Non-Reversing Walk", "Subsubsection"], Cell[BoxData[ RowBox[{ RowBox[{"oldStep", " ", "=", " ", RowBox[{"{", "}"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"stepNR2D", "[", "]"}], " ", ":=", " ", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", "s", "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"While", "[", RowBox[{ RowBox[{"s", " ", "=", " ", RowBox[{"step2D", "[", "]"}]}], ";", " ", RowBox[{"s", " ", "\[Equal]", " ", RowBox[{"-", "oldStep"}]}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"oldStep", " ", "=", " ", "s"}], ";", "\[IndentingNewLine]", "s"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"walkNR2D", "[", "n_", "]"}], " ", ":=", " ", RowBox[{"(", RowBox[{ RowBox[{"oldStep", " ", "=", " ", RowBox[{"{", "}"}]}], ";", " ", RowBox[{"NestList", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"#", " ", "+", " ", RowBox[{"stepNR2D", "[", "]"}]}], ")"}], "&"}], ",", " ", RowBox[{"{", RowBox[{"0", ",", "0"}], "}"}], ",", " ", "n"}], "]"}]}], ")"}]}]], "Input"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"walkNR2D", "[", "50", "]"}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"Thickness", "[", "0.01`", "]"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "14"}], ",", "14"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "14"}], ",", "14"}], "}"}]}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}], ",", RowBox[{"AspectRatio", "\[Rule]", "Automatic"}]}], "]"}]], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Self-Avoiding Walk", "Subsubsection"], Cell[BoxData[{ RowBox[{ RowBox[{"rot90", " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "1"}], "}"}], ",", " ", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "0"}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"rot180", " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "0"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"0", ",", RowBox[{"-", "1"}]}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"rot270", " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", RowBox[{"-", "1"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"1", ",", "0"}], "}"}]}], "}"}]}], ";"}]}], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"twist", "[", "chain_List", "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{ "n", ",", "iPivot", ",", "fixpart", ",", "movepart", ",", "rotchoice", ",", "newpart", ",", "newchain", ",", "rot"}], "}"}], ",", RowBox[{ RowBox[{"rot", "=", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "0"}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", RowBox[{"-", "1"}]}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", RowBox[{"-", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"1", ",", "0"}], "}"}]}], "}"}]}], "}"}]}], ";", RowBox[{"n", "=", RowBox[{ RowBox[{"Length", "[", "chain", "]"}], "-", "1"}]}], ";", RowBox[{"iPivot", "=", RowBox[{"RandomInteger", "[", RowBox[{"{", RowBox[{"1", ",", RowBox[{"n", "-", "1"}]}], "}"}], "]"}]}], ";", RowBox[{"fixpart", "=", RowBox[{"Take", "[", RowBox[{"chain", ",", "iPivot"}], "]"}]}], ";", RowBox[{"movepart", "=", RowBox[{"Take", "[", RowBox[{"chain", ",", RowBox[{"iPivot", "-", RowBox[{"(", RowBox[{"n", "+", "1"}], ")"}]}]}], "]"}]}], ";", RowBox[{"rotchoice", "=", RowBox[{"rot", "\[LeftDoubleBracket]", RowBox[{"RandomInteger", "[", RowBox[{"{", RowBox[{"1", ",", "3"}], "}"}], "]"}], "\[RightDoubleBracket]"}]}], ";", RowBox[{"newpart", "=", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{ RowBox[{ "chain", "\[LeftDoubleBracket]", "iPivot", "\[RightDoubleBracket]"}], "+", RowBox[{ RowBox[{"(", RowBox[{"#1", "-", RowBox[{ "chain", "\[LeftDoubleBracket]", "iPivot", "\[RightDoubleBracket]"}]}], ")"}], ".", "rotchoice"}]}], "&"}], ")"}], "/@", "movepart"}]}], ";", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"newpart", "\[Intersection]", "fixpart"}], "\[Equal]", RowBox[{"{", "}"}]}], ",", RowBox[{"newchain", "=", RowBox[{"Join", "[", RowBox[{"fixpart", ",", "newpart"}], "]"}]}], ",", "chain"}], "]"}]}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"nSteps", " ", "=", " ", "50"}], ";", RowBox[{"chain0", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"{", RowBox[{"i", ",", "0"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"i", ",", " ", "0", ",", " ", "nSteps"}], "}"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"Nest", "[", RowBox[{"twist", ",", "chain0", ",", "500"}], "]"}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"Thickness", "[", "0.01`", "]"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "14"}], ",", "14"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "14"}], ",", "14"}], "}"}]}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}], ",", RowBox[{"AspectRatio", "\[Rule]", "Automatic"}]}], "]"}]], "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Problems in Protein Folding", "Section"], Cell["\<\ One of the most interesting subjects of statistical physics is the phase \ transition. You are familiar with the phase transitions of water. As water is \ heated, ice melts, water boils, and eventually the atoms ionize. Similar \ phenomenon occur in proteins. The structure of the protein is compact when \ cold, and it becomes \"stretched out\" when it is heated. \ \>", "Text"], Cell[TextData[{ "Using our in-class notebook that develops a simple model for protein \ folding, you can study the phase transitions of proteins. There will be two \ types of variables that you will measure in your simulation, and these \ variables change as the ", StyleBox["temperature", FontSlant->"Italic"], " used in your folding simulation changes. The first type of measurement is \ the ", StyleBox["size", FontSlant->"Italic"], ". You can measure either the \"end-to-end length\" or the root-mean-squared \ radius of the amino acids. The size variable will increase as the temperature \ increases. The second type of measurement is the (chemical) ", StyleBox["potential energy", FontSlant->"Italic"], ". This is the sum of the interaction energies of your protein. If the \ thermal agitation is not too large, then the amino acids of the protein chain \ can find and bind together is a \"low energy state\". As the temperature \ increases, then the average chemical energy of the protein will also \ increase. " }], "Text"], Cell["\<\ You find that the chemical potential energy and the protein size will not be \ linear functions of the temperature. Indeed, you will find a sharp increase \ in the average energy at a critical temperature that corresponds to the \ \"un-folding\" of the protein. This is a phase transition, just like the \ melting of ice. \ \>", "Text"], Cell[CellGroupData[{ Cell["Suggested Investigations", "Subsection"], Cell[TextData[{ StyleBox["(a)", FontWeight->"Bold"], " Select a protein (or a protein segment) and create a simulation as a \ function of temperature. Examine a range of temperatures, and find bounds \ that are ", StyleBox["below", FontSlant->"Italic"], " and ", StyleBox["above", FontSlant->"Italic"], " the critical temperature for the protein structure phase transition." }], "Text"], Cell[TextData[{ StyleBox["(b)", FontWeight->"Bold"], " Prepare a sequence of simulations as the temperature gradually varies from \ the lower to upper bounds", ". For each case, compute the average energy and size of the protein. This \ could be done by averaging protein configurations from the final stages of \ the simulation. You may also want to observe the standard deviation, or \ fluctuations, from the average. During a phase transition, the fluctuations \ increase." }], "Text"], Cell[TextData[{ StyleBox["(c)", FontWeight->"Bold"], " Examine how the protein structure, phase-transition, and/or critical \ temperature changes with amino acid sequence", "." }], "Text"], Cell[TextData[{ StyleBox["(d)", FontWeight->"Bold"], " Examine how the protein structure, phase-transition, and/or critical \ temperature changes with different interaction matrices. For example, you \ could change the coefficients for hydophobacity or coulomb interactions. You \ could also create a \"random\" interaction matrix. Does the nature of the \ interaction matrix effect the equilibrium size of the protein? Does it effect \ the critical temperature?" }], "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["The Eden Cluster", "Section"], Cell[TextData[StyleBox["One of the earliest models of stochastic growth was \ originally developed by biologist Murry Eden (National Institute of Health at \ Bethesda, MD) for simulating the appearance of various biological patterns; \ in particular, bacterial colonies. Although it received little attention from \ biologists, some twenty years later it was adopted by crystallographers, \ solid state researchers, other physicists and chemists. Because of the \ model's flexibility it is being used by them after modifications appropriate \ to the application, in order to simulate their physical study objects under a \ variety of conditions. Only within the last few years has there been any \ interest in using this and similar digital models to represent the possible \ products of biological processes. It is also worth noting that aside from its \ relevance to probabilistically influenced pattern formation, the model has \ possible use in image processing for image compression and as an \ information-lossless way to code, regions, contours, or line segments.", FontVariations->{"CompatibilityType"->0}]], "Text", CellTags->"i:78"], Cell[TextData[StyleBox["Consider the following model for a small cluster of \ tumor cells infect cells on the perimeter of the tumor, and these infect \ other adjacent cells, and so on. At each step in the process, one of the \ perimeter cells is chosen randomly to become infected, after which it is \ added to the cluster and a new perimeter is calculated, from which a new \ infected cell will be chosen in the next step. The resulting tumor growth is \ surprisingly realistic (and rather horrifying to watch as an animation.) \ This model is one of a large group of random processes, variously referred to \ as kinetic growth or percolation models. For your project consider performing \ the Eden model on a 2D square lattice. Initially, only one cell at the origin \ is in the tumor cluster. (See \"Examples and Hints\" below.)", FontVariations->{"CompatibilityType"->0}]], "Text", CellTags->"i:78"], Cell[CellGroupData[{ Cell["Suggested Investigations", "Subsection"], Cell[TextData[{ StyleBox["(a)", FontWeight->"Bold"], " Create an animation of the cluster growth for up to ", Cell[BoxData[ FormBox[ RowBox[{"n", "=", "2000"}], TraditionalForm]]], ", showing only every 20th step. (Use a ", StyleBox["ListPlot", FontFamily->"Courier", FontWeight->"Bold"], " to display the positions.)" }], "Text"], Cell[TextData[{ StyleBox["(b)", FontWeight->"Bold"], " The edge of the tumor cluster is highly corrugated. The length ", Cell[BoxData[ FormBox["L", TraditionalForm]]], " of the perimeter is simply the number of cells in the list ", StyleBox["perim", FontFamily->"Courier", FontWeight->"Bold"], " . Show using a log-log plot that ", Cell[BoxData[ FormBox[ RowBox[{"L", " ", "\[Proportional]", " ", SuperscriptBox["n", "b"]}], TraditionalForm]]], ", and find a value of ", Cell[BoxData[ FormBox["b", TraditionalForm]]], " from your simulation. What value of ", Cell[BoxData[ FormBox["b", TraditionalForm]]], " would you expect if the tumor had a smooth edge?" }], "Text"], Cell[TextData[{ StyleBox["(c)", FontWeight->"Bold"], " The Eden model can be made more realistic by assigning a probability of \ immunity ", Cell[BoxData[ FormBox["p", TraditionalForm]]], " to each member of the perimeter. When a perimeter cell is chosen, use the \ rejection method to determine whether to infect the cell: evaluate a random \ number ", Cell[BoxData[ FormBox["r", TraditionalForm]]], " with ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"0", "<", "r", "<", "1"}], ";"}], TraditionalForm]]], " if ", Cell[BoxData[ FormBox[ RowBox[{"r", "<", "p"}], TraditionalForm]]], ", the cell is not allowed to be infected in any future step: set it aside \ in a new list ", StyleBox["immunes", FontFamily->"Courier", FontWeight->"Bold"], ", which can never enter the tumor cluster, and choose another perimeter \ cell until one is found that can be infected." }], "Text"], Cell[TextData[{ "(i) Reevaluate the improved Eden model taking ", Cell[BoxData[ FormBox[ RowBox[{"p", "=", "0.5"}], TraditionalForm]]], " for all cells and ", Cell[BoxData[ FormBox[ RowBox[{"n", "=", "200"}], TraditionalForm]]], ". Create an animation as in part (a), and reevaluate the exponent ", Cell[BoxData[ FormBox["b", TraditionalForm]]], " for the length of the perimeter (include the immunes in the perimeter). \ Note: If ", Cell[BoxData[ FormBox[ RowBox[{"p", " "}], TraditionalForm]]], "is chosen too large then the tumor has a good probability of not growing, \ as it can be surrounded by immune cells. Did the tumor grow without bound or \ stop?" }], "Text"], Cell[TextData[{ "(ii) Repeat for different values of ", StyleBox["p", FontSlant->"Italic"], " (like", " ", Cell[BoxData[ FormBox[ RowBox[{"p", "=", "0.2"}], TraditionalForm]]], " and ", Cell[BoxData[ FormBox[ RowBox[{"n", "=", "2000"}], TraditionalForm]]], "). Can you determine a relationship between immunity probability (", StyleBox["p", FontSlant->"Italic"], ") and tumor growth? " }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Defining the Eden Model", "Subsection"], Cell[TextData[{ "[MEM: These hints came from my colleagues new book, ", StyleBox["Numerical and Analytical Methods for Scientists and Engineers \ Using Mathematica", FontSlant->"Italic"], ", by Dan Dubin at UCSD.]" }], "Text"], Cell[TextData[{ "Initialize the cluster. Here, ", StyleBox["cluster[i]", FontWeight->"Bold"], " is a list of cells within the cluster at the ", StyleBox["i", FontSlant->"Italic"], "th iteration. To start, at ", StyleBox["i", FontSlant->"Italic"], " = 0, the cluster is" }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"cluster", "[", "0", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{"{", RowBox[{"0", ",", "0"}], "}"}], "}"}]}], ";"}]], "Input"], Cell[TextData[{ "We also need a list of the perimeter points of the cluster. Define the list \ ", StyleBox["perim[i]", FontWeight->"Bold"], ", which represents the perimeter after the ", StyleBox["i", FontSlant->"Italic"], "th iteration. " }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"perim", "[", "0", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"1", ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", RowBox[{"-", "1"}]}], "}"}]}], "}"}]}], ";"}]], "Input"], Cell[TextData[{ "From this perimeter list, a newly-infected cell is chosen at random. We \ define a function ", StyleBox["newsite[n]", FontFamily->"Courier", FontWeight->"Bold"], ", which is the position of this cell, chosen from the previous perimeter \ list, ", StyleBox["perim[n-1]", FontFamily->"Courier", FontWeight->"Bold"], ":" }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"newsite", "[", "n_", "]"}], ":=", RowBox[{ RowBox[{"newsite", "[", "n", "]"}], "=", RowBox[{ RowBox[{"perim", "[", RowBox[{"n", "-", "1"}], "]"}], "\[LeftDoubleBracket]", RowBox[{"RandomInteger", "[", RowBox[{"{", RowBox[{"1", ",", RowBox[{"Length", "[", RowBox[{"perim", "[", RowBox[{"n", "-", "1"}], "]"}], "]"}]}], "}"}], "]"}], "\[RightDoubleBracket]"}]}]}]], "Input"], Cell["\<\ The new cluster is the union of the old cluster with the new site:\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"cluster", "[", "n_", "]"}], " ", ":=", " ", RowBox[{ RowBox[{"cluster", "[", "n", "]"}], " ", "=", " ", RowBox[{"Append", "[", RowBox[{ RowBox[{"cluster", "[", RowBox[{"n", "-", "1"}], "]"}], ",", RowBox[{"newsite", "[", "n", "]"}]}], "]"}]}]}]], "Input"], Cell["\<\ Finally, we must calculate the new perimeter, by first removing the new site \ from the old perimeter, and then adding the group of nearest neighbors to the \ new site onto the perimeter (making sure to avoid those nearest neighbors \ already in the cluster):\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"perim", "[", "n_", "]"}], " ", ":=", " ", RowBox[{ RowBox[{"perim", "[", "n", "]"}], "=", " ", RowBox[{ StyleBox["(", FontColor->RGBColor[1, 0, 1]], " ", RowBox[{ RowBox[{"perim1", " ", "=", " ", RowBox[{"Complement", "[", RowBox[{ RowBox[{"perim", "[", RowBox[{"n", "-", "1"}], "]"}], ",", RowBox[{"{", RowBox[{"newsite", "[", "n", "]"}], "}"}]}], "]"}]}], " ", StyleBox[ RowBox[{"(*", " ", RowBox[{ "Removes", " ", "newsite", " ", "from", " ", "the", " ", "perimeter"}], " ", "*)"}], FontColor->RGBColor[0, 1, 0]], ";", "\[IndentingNewLine]", RowBox[{"nn", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"newsite", "[", "n", "]"}], "+", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"1", ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", RowBox[{"-", "1"}]}], "}"}]}], "}"}], "[", RowBox[{"[", "m", "]"}], "]"}]}], ",", RowBox[{"{", RowBox[{"m", ",", "1", ",", "4"}], "}"}]}], "]"}]}], ";", " ", "\[IndentingNewLine]", RowBox[{"nn", " ", "=", " ", RowBox[{"Complement", "[", RowBox[{"nn", ",", " ", RowBox[{"cluster", "[", "n", "]"}]}], "]"}]}], ";", " ", StyleBox[ RowBox[{"(*", " ", RowBox[{ RowBox[{ "nn", " ", "is", " ", "the", " ", "nearest", " ", "neighbors", " ", "to", " ", "the", " ", "new", " ", "site"}], ",", " ", RowBox[{ "excluding", " ", "those", " ", "in", " ", "the", " ", "cluster"}]}], " ", "*)"}], FontColor->RGBColor[0, 1, 0]], "\[IndentingNewLine]", RowBox[{"Union", "[", RowBox[{"perim1", ",", "nn"}], "]"}]}], " ", StyleBox[ RowBox[{"(*", " ", RowBox[{"Finally", ",", " ", RowBox[{ "add", " ", "nearest", " ", "neighbors", " ", "to", " ", "the", " ", "perimeter", " ", "list", " ", "and", " ", "return", " ", "the", " ", "new", " ", "perimeter", " ", "list"}]}], " ", "*)"}], FontColor->RGBColor[0, 1, 0]], StyleBox[" ", FontColor->RGBColor[0, 1, 0]], StyleBox[")", FontColor->RGBColor[1, 0, 1]]}]}]}]], "Input"], Cell["Example", "Text"], Cell[BoxData[ RowBox[{"cluster", "[", "5", "]"}]], "Input"], Cell[BoxData[ RowBox[{"perim", "[", "5", "]"}]], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Diffusion Limited Aggregation (DLA)", "Section"], Cell[TextData[StyleBox["Diffusion limited aggregation (DLA) is another \ example of cluster growth. With a DLA model, the cluster grows by the \ attachment of new cells that precipitate or randomly wander to the cluster. \ This could represent the growth of ice-crystals to make a snow flake, or the \ deposition of materials onto a surface. While the Eden model tends to form \ filled regions with rough surfaces, the DLA model tends to form complex \ cluster with large and deep voids. As matter randomly attaches to a DLA \ cluster, fine, leafy structures are created. ", FontVariations->{"CompatibilityType"->0}]], "Text", CellTags->"i:78"], Cell[TextData[{ StyleBox["Consider the following model for DLA cluster growth. At each step \ in the process, a particle is created at a random location at some outer \ surface. The particle randomly walks until (1) it moves too far away from the \ outersurface, or (2) until it comes into contact with the cluster, after \ which it is added to the cluster. The resulting DLA cluster growth is \ surprisingly realistic (like the Eden cluster). For your project consider \ performing DLA clusters on a 2D square lattice (although it is not at all \ difficult to study 3D cluster growth!) Initially, only one cell at the origin \ is starting cluster. Since particle moves slowly as a random walker (like ", FontVariations->{"CompatibilityType"->0}], Cell[BoxData[ FormBox[ SqrtBox["n"], TraditionalForm]]], "), as the distance that the particle must move to before attaching to the \ cluster increases, so does the calculation time." }], "Text", CellTags->"i:78"], Cell[CellGroupData[{ Cell["Suggested Investigations", "Subsection"], Cell[TextData[{ StyleBox["(a)", FontWeight->"Bold"], " Create an animation of the cluster growth for up to ", Cell[BoxData[ FormBox[ RowBox[{"n", "=", "1000"}], TraditionalForm]]], ", showing only every 20th step. (Use a ", StyleBox["ListPlot", FontFamily->"Courier", FontWeight->"Bold"], " to display the positions.)" }], "Text"], Cell[TextData[{ StyleBox["(b)", FontWeight->"Bold"], " What happens if the particle source is from a point, or a line, (initially \ far from the cluster) instead of a circle surrounding the cluster?" }], "Text"], Cell[TextData[{ StyleBox["(c)", FontWeight->"Bold"], " What if the cluster is initialized by a line instead of a point? Imagine \ the cluster begins with 100 points located along the ", StyleBox["x", FontSlant->"Italic"], "-axis? Imagine other initial conditions, like an array of seed clusters. \ What happens for different initial conditions?" }], "Text"], Cell[TextData[{ StyleBox["(d)", FontWeight->"Bold"], " What is the ", StyleBox["fractal dimension ", FontSlant->"Italic"], "of the cluster? The fractal dimension, ", Cell[BoxData[ FormBox[ SubscriptBox["d", "f"], TraditionalForm]]], ",", " is relatively easy to compute. It is the ratio of the ", Cell[BoxData[ FormBox[ SubscriptBox["d", "f"], TraditionalForm]]], " = log(number of particles)/log(radius). For example, if all of the \ particles were tightly spaced on a 2D surface, the fractal dimension would \ equal to 2. This is because the area of a circle increases with the square of \ the radius. When a 2D cluster is filled with voids, its dimension is ", StyleBox["less than 2.", FontSlant->"Italic"], " (For a 3D DLA cluster, the fractal dimension will be ", StyleBox["less than", FontSlant->"Italic"], " 3.) Can you compute the fractal dimension of your clusters? " }], "Text"], Cell[TextData[{ StyleBox["(e) ", FontWeight->"Bold"], "Can you investigate a 3D cluster?" }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Defining the DLA Algorithm", "Subsection"], Cell[TextData[{ "Initialize the cluster. Here, ", StyleBox["cluster[i]", FontWeight->"Bold"], " is a list of cells within the cluster at the ", StyleBox["i", FontSlant->"Italic"], "th iteration. To start, at ", StyleBox["i", FontSlant->"Italic"], " = 0, the cluster is" }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"cluster", "[", "0", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{"{", RowBox[{"0", ",", "0"}], "}"}], "}"}]}], ";"}]], "Input"], Cell[TextData[{ "Let's start new particles at a radius about 10 steps larger than the ", StyleBox["maximum radius", FontSlant->"Italic"], " of the cluster. Therefore, at each cluster size, we will need to compute \ the maximum radius, ", Cell[BoxData[ FormBox[ SqrtBox[ RowBox[{ SuperscriptBox["x", "2"], "+", " ", SuperscriptBox["y", "2"]}]], TraditionalForm]]], ", of the particles contained within the cluster. " }], "Text"], Cell["\<\ We copy (and modify) the algorithm for 2D random walkers from 6-Exercise.nb. \ For this random-walker, we allow particles to move along the diagonals.\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"step2D", "[", "]"}], ":=", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"1", ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", RowBox[{"-", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", RowBox[{"-", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"1", ",", RowBox[{"-", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"1", ",", "1"}], "}"}]}], "}"}], "\[LeftDoubleBracket]", RowBox[{"RandomInteger", "[", RowBox[{"{", RowBox[{"1", ",", "8"}], "}"}], "]"}], "\[RightDoubleBracket]"}]}]], "Input"], Cell[TextData[{ "Finally, we use a ", StyleBox["While[\[Ellipsis]]", FontWeight->"Bold"], " structure to take our random steps. ", "Random steps are taken until (1) the walker returns moves too far away, or \ (2) it comes into contact with the cluster." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"walk2D", "[", "n_", "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{ "maxRadius", ",", "oldLocation", ",", "newLocation", ",", "theStep"}], "}"}], ",", RowBox[{ RowBox[{"maxRadius", "=", RowBox[{"Max", "[", RowBox[{"Apply", "[", RowBox[{ RowBox[{ SqrtBox[ RowBox[{ SuperscriptBox["#1", "2"], "+", SuperscriptBox["#2", "2"]}]], "&"}], ",", RowBox[{"cluster", "[", RowBox[{"n", "-", "1"}], "]"}], ",", RowBox[{"{", "1", "}"}]}], "]"}], "]"}]}], ";", RowBox[{"maxRadius", "=", RowBox[{"Max", "[", RowBox[{"maxRadius", ",", "1"}], "]"}]}], ";", RowBox[{"oldLocation", "=", RowBox[{"Floor", "[", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"maxRadius", "+", "10"}], ")"}], " ", RowBox[{"{", RowBox[{ RowBox[{"Cos", "[", "#1", "]"}], ",", RowBox[{"Sin", "[", "#1", "]"}]}], "}"}]}], "&"}], ")"}], "[", RowBox[{"RandomReal", "[", RowBox[{"{", RowBox[{"0", ",", RowBox[{"2", " ", "\[Pi]"}]}], "}"}], "]"}], "]"}], "]"}]}], ";", RowBox[{"While", "[", RowBox[{ RowBox[{ RowBox[{"theStep", "=", RowBox[{"step2D", "[", "]"}]}], ";", RowBox[{"newLocation", "=", RowBox[{"oldLocation", "+", "theStep"}]}], ";", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"newLocation", ".", "newLocation"}], ">", SuperscriptBox[ RowBox[{"(", RowBox[{"maxRadius", "+", "20"}], ")"}], "2"]}], ",", RowBox[{"newLocation", "=", RowBox[{"Floor", "[", FractionBox[ RowBox[{"oldLocation", " ", SuperscriptBox[ RowBox[{"(", RowBox[{"maxRadius", "+", "10"}], ")"}], "2"]}], RowBox[{"newLocation", ".", "newLocation"}]], "]"}]}]}], "]"}], ";", RowBox[{ RowBox[{ RowBox[{"{", "newLocation", "}"}], "\[Intersection]", RowBox[{"(", RowBox[{"cluster", "[", RowBox[{"n", "-", "1"}], "]"}], ")"}]}], "\[Equal]", RowBox[{"{", "}"}]}]}], ",", RowBox[{"oldLocation", "=", "newLocation"}]}], "]"}], ";", RowBox[{ RowBox[{"cluster", "[", "n", "]"}], "=", RowBox[{ RowBox[{"{", "oldLocation", "}"}], "\[Union]", RowBox[{"cluster", "[", RowBox[{"n", "-", "1"}], "]"}]}]}], ";"}]}], "]"}]}]], "Input"], Cell[TextData[{ "A few notes: (1) You can reset and compute another random cluster just by \ re-evaluating a sequence of calls to ", StyleBox["walk2D[i]", FontWeight->"Bold"], ". (2) You could try to speed up the algorithm by applying a \"bias\" to \ each step. If the random walk moves to larger radius (and away from the \ cluster) do not accept this step as frequently as when the random walk moves \ to smaller radii. " }], "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Fractal Trees", "Section"], Cell[TextData[{ StyleBox["Speaking of fractals, nature is full of them! Trees, flowers, and \ especially ferns are tremendously beautiful. They exhibit regularity of \ pattern, yet each is unique. There is an inherent ", FontVariations->{"CompatibilityType"->0}], StyleBox["randomness", FontSlant->"Italic", FontVariations->{"CompatibilityType"->0}], StyleBox[" in natural fractals that can be represented by simple computer \ programs using random numbers. ", FontVariations->{"CompatibilityType"->0}] }], "Text", CellTags->"i:78"], Cell[TextData[{ "Algorithms for constructing fractals involve the scaling of one point to \ another. Let ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ FormBox[ RowBox[{"{", SubscriptBox["x", "i"]}], TraditionalForm], ",", SubscriptBox["y", "i"]}], "}"}], TraditionalForm]]], " be one point, and ", StyleBox["s", FontSlant->"Italic"], " be a scaling function that maps this point to another, ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ FormBox[ RowBox[{"{", SubscriptBox["x", RowBox[{"i", "+", "1"}]]}], TraditionalForm], ",", SubscriptBox["y", RowBox[{"i", "+", "1"}]]}], "}"}], TraditionalForm]]], StyleBox[" = ", FontWeight->"Bold"], StyleBox["s", FontSlant->"Italic"], "(", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ FormBox[ RowBox[{"{", SubscriptBox["x", "i"]}], TraditionalForm], ",", SubscriptBox["y", "i"]}], "}"}], TraditionalForm]]], "). When ", StyleBox["s", FontSlant->"Italic"], " > 1, an amplification occurs. When ", StyleBox["s < ", FontSlant->"Italic"], "1, a reduction occurs. In general, our mappings can also involve a ", StyleBox["translation", FontSlant->"Italic"], ", ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ FormBox[ RowBox[{"{", SubscriptBox["x", RowBox[{"i", "+", "1"}]]}], TraditionalForm], ",", SubscriptBox["y", RowBox[{"i", "+", "1"}]]}], "}"}], TraditionalForm]]], StyleBox[" = ", FontWeight->"Bold"], StyleBox["s", FontSlant->"Italic"], "(", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ FormBox[ RowBox[{"{", SubscriptBox["x", "i"]}], TraditionalForm], ",", SubscriptBox["y", "i"]}], "}"}], TraditionalForm]]], ") + ", Cell[BoxData[ FormBox[ RowBox[{"{", RowBox[{ SubscriptBox["a", "x"], ",", " ", SubscriptBox["a", "y"]}], "}"}], TraditionalForm]]], ", and/or a ", StyleBox["rotation", FontSlant->"Italic"], ", ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ FormBox[ RowBox[{"{", SubscriptBox["x", RowBox[{"i", "+", "1"}]]}], TraditionalForm], ",", SubscriptBox["y", RowBox[{"i", "+", "1"}]]}], "}"}], TraditionalForm]]], StyleBox[" = ", FontWeight->"Bold"], StyleBox["s", FontSlant->"Italic"], "(", StyleBox["M", FontWeight->"Bold"], "\[CenterDot]", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ FormBox[ RowBox[{"{", SubscriptBox["x", "i"]}], TraditionalForm], ",", SubscriptBox["y", "i"]}], "}"}], TraditionalForm]]], ") + ", Cell[BoxData[ FormBox[ RowBox[{"{", RowBox[{ SubscriptBox["a", "x"], ",", " ", SubscriptBox["a", "y"]}], "}"}], TraditionalForm]]], ", where ", StyleBox["M", FontWeight->"Bold"], " is a 2\[Times]2 rotation matrix. The entire set of transformations, \ scaling, rotations, and translations, define a so-called ", StyleBox["affine transformation", FontSlant->"Italic"], ". (The word \"affine\" denotes a close relationship between successive \ points. After an affine transformation, points originally along a line, \ remain on a line. And the ratios of distances between points remain constant. \ In other words, only rotations, scalings, and (finite) translations are \ allowed.) What is important in affine transformations is that the object \ created with these rules turn out to be self-similar. Each new point leads to \ new parts of the object that bare the same relation to the previous points. \ This creates the fractal: an object that appears self-similar at many scale \ sizes. Whereas unbiased random walks with equal step sizes model diffusion, \ when the random walks involve scale-sizing, the overall size ", StyleBox["does not increase", FontSlant->"Italic"], " as more steps are taken. " }], "Text"], Cell[CellGroupData[{ Cell["A Tree", "Subsubsection"], Cell["\<\ Below are six transformations that create a nice \"tree\". From the first to \ the sixth, the transformations are applied with probabilities: 10%, 10%,20%, \ 20%, 20%, 20%. The tree is constructed by making a \"random walk\" with each \ step being one of six possible affine transformations.\ \>", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"m", "[", "1", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0.05", ",", " ", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "0.6"}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"a", "[", "1", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{"0.0", ",", "0.0"}], "}"}]}], ";"}]}], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"m", "[", "2", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0.05", ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", RowBox[{"-", "0.5"}]}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"a", "[", "2", "]"}], "=", " ", RowBox[{"{", RowBox[{"0", ",", "1.0"}], "}"}]}], ";"}]}], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"m", "[", "3", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0.46", ",", RowBox[{"-", "0.15"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0.39", ",", "0.38"}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"a", "[", "3", "]"}], "=", " ", RowBox[{"{", RowBox[{"0", ",", "0.6"}], "}"}]}], ";"}]}], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"m", "[", "4", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0.47", ",", RowBox[{"-", "0.15"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0.17", ",", "0.42"}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"a", "[", "4", "]"}], "=", " ", RowBox[{"{", RowBox[{"0", ",", "1.1"}], "}"}]}], ";"}]}], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"m", "[", "5", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0.43", ",", "0.28"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.25"}], ",", "0.45"}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"a", "[", "5", "]"}], "=", " ", RowBox[{"{", RowBox[{"0", ",", "1.0"}], "}"}]}], ";"}]}], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"m", "[", "6", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0.42", ",", "0.26"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.35"}], ",", "0.31"}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"a", "[", "6", "]"}], "=", " ", RowBox[{"{", RowBox[{"0", ",", "0.7"}], "}"}]}], ";"}]}], "Input"], Cell["\<\ What happens as you change the coefficients of the transformations?\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Barnsley's Fern", "Subsubsection"], Cell[TextData[{ "The Barnsley Fern is a famous fractal constructed from a (random) mixture \ of four affine transformations. The matrices, ", Cell[BoxData[ FormBox[ SubscriptBox["M", "i"], TraditionalForm]]], ", scale and rotate coordinates. The translation vectors, ", Cell[BoxData[ FormBox[ SubscriptBox["a", "i"], TraditionalForm]]], ", move points a distance appropriate to the scaling and translation. Which \ transformation is applied is determined by a random number and a pre-set \ probability. Transformation 1 occurs only 2% of the time. Transformation 2 \ only 15% of the time; transformation 3 only 13% of the time; and the fourth \ transformation 70%." }], "Text"], Cell["\<\ Once the four transformations are defined, the fern is created by taking a \ \"random walk\" to finer and finer scales. As the walk continues, the fern is \ constructed with finer and finer details.\ \>", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"m", "[", "1", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", " ", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "0.27"}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"a", "[", "1", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{"0.5", ",", "0.0"}], "}"}]}], ";"}]}], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"m", "[", "2", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "0.139"}], ",", " ", "0.263"}], "}"}], ",", RowBox[{"{", RowBox[{"0.246", ",", "0.224"}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"a", "[", "2", "]"}], "=", " ", RowBox[{"{", RowBox[{"0.57", ",", RowBox[{"-", "0.036"}]}], "}"}]}], ";"}]}], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"m", "[", "3", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0.17", ",", RowBox[{"-", "0.215"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0.222", ",", "0.176"}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"a", "[", "3", "]"}], "=", " ", RowBox[{"{", RowBox[{"0.408", ",", "0.0893"}], "}"}]}], ";"}]}], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"m", "[", "4", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0.781", ",", "0.034"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.032"}], ",", "0.739"}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"a", "[", "4", "]"}], "=", " ", RowBox[{"{", RowBox[{"0.1075", ",", "0.27"}], "}"}]}], ";"}]}], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Suggested Investigations", "Subsection"], Cell[TextData[{ StyleBox["(a)", FontWeight->"Bold"], " Create an animation of the fractal construction for many steps (maybe ", Cell[BoxData[ FormBox[ RowBox[{"n", "=", "5000"}], TraditionalForm]]], "), showing only every 50th step. How does the fractal grow?" }], "Text"], Cell[TextData[{ StyleBox["(b)", FontWeight->"Bold"], " How does the fractal change it's shape for small changes in the affine \ transformation?" }], "Text"], Cell[TextData[{ StyleBox["(c)", FontWeight->"Bold"], " What is the ", StyleBox["fractal dimension ", FontSlant->"Italic"], "of the fractal? The fractal dimension, ", Cell[BoxData[ FormBox[ SubscriptBox["d", "f"], TraditionalForm]]], ", is relatively easy to compute. It is the ratio of the ", Cell[BoxData[ FormBox[ SubscriptBox["d", "f"], TraditionalForm]]], " = log(number of particles)/log(radius). For these fractals, it may be \ better to use squares instead of circles. For squares, ", Cell[BoxData[ FormBox[ SubscriptBox["d", "f"], TraditionalForm]]], " = log(number of particles)/log(side). As the side of the square decreases, \ the number of particles within a square should decrease as ", Cell[BoxData[ FormBox[ SuperscriptBox["s", "2"], TraditionalForm]]], " for a 2D object and as ", StyleBox["s", FontSlant->"Italic"], " for a 1D object.", ". Since fractal does not fully fill the 2D plane, the fractal dimension \ will be ", StyleBox["less than 2.", FontSlant->"Italic"], " (For a 3D fractal, the fractal dimension will be ", StyleBox["less than", FontSlant->"Italic"], " 3.) Can you compute the fractal dimension of your objects? " }], "Text"] }, Closed]] }, Closed]] }, Open ]] }, WindowSize->{677, 945}, WindowMargins->{{53, Automatic}, {Automatic, 0}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, ShowSelection->True, Magnification->1, FrontEndVersion->"6.0 for Mac OS X x86 (32-bit) (May 21, 2008)", StyleDefinitions->"Classic.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{ "i:78"->{ Cell[17870, 557, 1144, 15, 155, "Text", CellTags->"i:78"], Cell[19017, 574, 907, 12, 123, "Text", CellTags->"i:78"], Cell[28984, 902, 646, 9, 90, "Text", CellTags->"i:78"], Cell[29633, 913, 973, 17, 127, "Text", CellTags->"i:78"], Cell[38303, 1185, 544, 12, 58, "Text", CellTags->"i:78"]} } *) (*CellTagsIndex CellTagsIndex->{ {"i:78", 50962, 1642} } *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[590, 23, 50, 0, 119, "Title"], Cell[643, 25, 134, 4, 67, "Subsubtitle"], Cell[780, 31, 107, 4, 81, "Subsubtitle"], Cell[CellGroupData[{ Cell[912, 39, 31, 0, 46, "Section"], Cell[946, 41, 2067, 37, 350, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[3050, 83, 49, 0, 20, "Section"], Cell[3102, 85, 280, 5, 58, "Text"], Cell[3385, 92, 2140, 66, 155, "Text"], Cell[CellGroupData[{ Cell[5550, 162, 42, 0, 27, "Subsection"], Cell[5595, 164, 391, 14, 25, "Text"], Cell[CellGroupData[{ Cell[6011, 182, 39, 0, 27, "Subsubsection"], Cell[6053, 184, 572, 20, 33, "Input"], Cell[6628, 206, 340, 10, 33, "Input"], Cell[6971, 218, 681, 19, 68, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[7689, 242, 46, 0, 27, "Subsubsection"], Cell[7738, 244, 102, 3, 33, "Input"], Cell[7843, 249, 538, 14, 85, "Input"], Cell[8384, 265, 478, 15, 33, "Input"], Cell[8865, 282, 683, 19, 68, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[9585, 306, 43, 0, 27, "Subsubsection"], Cell[9631, 308, 824, 29, 68, "Input"], Cell[10458, 339, 2725, 81, 153, "Input"], Cell[13186, 422, 328, 10, 33, "Input"], Cell[13517, 434, 724, 20, 68, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[14302, 461, 46, 0, 20, "Section"], Cell[14351, 463, 390, 6, 60, "Text"], Cell[14744, 471, 1044, 21, 152, "Text"], Cell[15791, 494, 346, 6, 60, "Text"], Cell[CellGroupData[{ Cell[16162, 504, 46, 0, 30, "Subsection"], Cell[16211, 506, 398, 12, 66, "Text"], Cell[16612, 520, 493, 10, 84, "Text"], Cell[17108, 532, 193, 6, 48, "Text"], Cell[17304, 540, 479, 9, 78, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[17832, 555, 35, 0, 20, "Section"], Cell[17870, 557, 1144, 15, 155, "Text", CellTags->"i:78"], Cell[19017, 574, 907, 12, 123, "Text", CellTags->"i:78"], Cell[CellGroupData[{ Cell[19949, 590, 46, 0, 27, "Subsection"], Cell[19998, 592, 348, 12, 47, "Text"], Cell[20349, 606, 705, 22, 63, "Text"], Cell[21057, 630, 911, 28, 95, "Text"], Cell[21971, 660, 698, 20, 76, "Text"], Cell[22672, 682, 421, 17, 48, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[23130, 704, 45, 0, 19, "Subsection"], Cell[23178, 706, 231, 6, 42, "Text"], Cell[23412, 714, 294, 11, 42, "Text"], Cell[23709, 727, 187, 6, 33, "Input"], Cell[23899, 735, 260, 9, 42, "Text"], Cell[24162, 746, 437, 15, 33, "Input"], Cell[24602, 763, 360, 12, 42, "Text"], Cell[24965, 777, 477, 14, 24, "Input"], Cell[25445, 793, 90, 2, 25, "Text"], Cell[25538, 797, 323, 9, 33, "Input"], Cell[25864, 808, 284, 5, 58, "Text"], Cell[26151, 815, 2577, 71, 204, "Input"], Cell[28731, 888, 23, 0, 25, "Text"], Cell[28757, 890, 60, 1, 33, "Input"], Cell[28820, 893, 58, 1, 33, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[28927, 900, 54, 0, 20, "Section"], Cell[28984, 902, 646, 9, 90, "Text", CellTags->"i:78"], Cell[29633, 913, 973, 17, 127, "Text", CellTags->"i:78"], Cell[CellGroupData[{ Cell[30631, 934, 46, 0, 27, "Subsection"], Cell[30680, 936, 348, 12, 47, "Text"], Cell[31031, 950, 215, 5, 46, "Text"], Cell[31249, 957, 365, 9, 64, "Text"], Cell[31617, 968, 920, 25, 98, "Text"], Cell[32540, 995, 105, 4, 30, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[32682, 1004, 48, 0, 19, "Subsection"], Cell[32733, 1006, 294, 11, 42, "Text"], Cell[33030, 1019, 187, 6, 33, "Input"], Cell[33220, 1027, 454, 13, 69, "Text"], Cell[33677, 1042, 174, 3, 42, "Text"], Cell[33854, 1047, 912, 31, 68, "Input"], Cell[34769, 1080, 271, 7, 42, "Text"], Cell[35043, 1089, 2733, 77, 266, "Input"], Cell[37779, 1168, 440, 9, 74, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[38268, 1183, 32, 0, 20, "Section"], Cell[38303, 1185, 544, 12, 58, "Text", CellTags->"i:78"], Cell[38850, 1199, 3909, 142, 213, "Text"], Cell[CellGroupData[{ Cell[42784, 1345, 31, 0, 27, "Subsubsection"], Cell[42818, 1347, 315, 5, 58, "Text"], Cell[43136, 1354, 436, 15, 51, "Input"], Cell[43575, 1371, 447, 16, 51, "Input"], Cell[44025, 1389, 454, 16, 51, "Input"], Cell[44482, 1407, 454, 16, 51, "Input"], Cell[44939, 1425, 454, 16, 51, "Input"], Cell[45396, 1443, 454, 16, 51, "Input"], Cell[45853, 1461, 91, 2, 25, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[45981, 1468, 40, 0, 27, "Subsubsection"], Cell[46024, 1470, 692, 15, 90, "Text"], Cell[46719, 1487, 222, 4, 42, "Text"], Cell[46944, 1493, 434, 15, 51, "Input"], Cell[47381, 1510, 489, 17, 51, "Input"], Cell[47873, 1529, 464, 16, 51, "Input"], Cell[48340, 1547, 464, 16, 51, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[48841, 1568, 46, 0, 27, "Subsection"], Cell[48890, 1570, 284, 8, 42, "Text"], Cell[49177, 1580, 160, 5, 25, "Text"], Cell[49340, 1587, 1209, 36, 119, "Text"] }, Closed]] }, Closed]] }, Open ]] } ] *) (* End of internal cache information *)