(* 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[ 29024, 1004] NotebookOptionsPosition[ 25016, 877] NotebookOutlinePosition[ 25405, 894] CellTagsIndexPosition[ 25362, 891] WindowFrame->Normal ContainsDynamic->False*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Exercises (6)", "Title"], Cell["\<\ Assigned: March 5, 2009 Due: March 12, 2009\ \>", "Subsubtitle", CellChangeTimes->{{3.44525095775655*^9, 3.445250974577828*^9}}], Cell[CellGroupData[{ Cell["Rolling Dice (in-class)", "Section"], Cell[TextData[{ "What is the probability of throwing 8 or less with three dice, each with \ six sides numbered 1 through 6? Write a ", StyleBox["Mathematica", FontSlant->"Italic"], " simulation (with at least 1000 trial dice rolls) to numerically estimate \ the probability. (Can you estimate the probability analytically?) " }], "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsection"], Cell[BoxData[ RowBox[{ RowBox[{"diceRoll", "[", "]"}], ":=", RowBox[{"RandomInteger", "[", RowBox[{"{", RowBox[{"1", ",", "6"}], "}"}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"Table", "[", RowBox[{ RowBox[{"diceRoll", "[", "]"}], ",", " ", RowBox[{"{", "10", "}"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"eightOrLess", "[", "]"}], " ", ":=", " ", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"diceRoll", "[", "]"}], " ", "+", " ", RowBox[{"diceRoll", "[", "]"}], " ", "+", " ", RowBox[{"diceRoll", "[", "]"}]}], " ", "\[LessEqual]", " ", "8"}], ",", " ", "1", ",", " ", "0"}], "]"}]}]], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{"rolls", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"eightOrLess", "[", "]"}], ",", " ", RowBox[{"{", "1000", "}"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"Plus", " ", "@@", " ", "rolls"}], ")"}], "/", "1000"}], " ", "//", " ", "N"}]}], "Input"], Cell["\<\ This probability can be estimated by counting all of the ways to roll 8 or \ less and all of the ways to roll three dice.\ \>", "Text"], Cell[TextData[{ "The number of ways to roll eight with three dice:\n\t1, 1, 6\t\t2, 1, 5\t\t\ 3, 1, 4\t\t4, 1, 3\t\t5, 1, 2\t\t6, 1, 1\n\t1, 2, 5\t\t2, 2, 4\t\t3, 2, 3\t\t\ 4, 2, 2\t\t5, 2, 1\n\t1, 3, 4\t\t2, 3, 3\t\t3, 3, 2\t\t4, 3, 1\n\t1, 4, 3\t\t\ 2, 4, 2\t\t3, 4, 1\n\t1, 5, 2\t\t2, 5, 1\n\t1, 6, 1\nis 6 + 5 + 4 +3 + 2 +1 = \ 6 (6 + 1)/2 = 21\nThe number of ways to roll seven with three dice:\n\t1, 1, \ 5\t\t2, 1, 4\t\t3, 1, 3\t\t4, 1, 2\t\t5, 1, 1\n\t1, 2, 4\t\t2, 2, 3\t\t3, 2, \ 2\t\t4, 2, 1\n\t1, 3, 3\t\t2, 3, 2\t\t3, 3, 1\n\t1, 4, 2\t\t2, 4, 1\n\t1, 5, \ 1\nis 5 + 4 + 3 + 2 + 1 = 5 (5 + 1)/2 = 15\nThe number of ways to roll six is \ 4(4 + 1)/2 = 10.\nThe number of ways to roll five is 3(3 + 1)/2 = 6.\nThe \ number of ways to roll four is 2(2 + 1)/2 = 3.\nThe number of ways to roll \ three is 1.\n", StyleBox["Therefore", FontSlant->"Italic"], ", the number of ways to roll eight or less is 21 +15 + 10 + 6 + 3 + 1 = \ 56." }], "Text"], Cell[TextData[{ "The total number of ways to roll three dice is ", Cell[BoxData[ FormBox[ SuperscriptBox["6", "3"], TraditionalForm]]], "= 216." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"56", "/", "216"}], " ", "//", " ", "N"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"Sum", "[", RowBox[{ RowBox[{"n", RowBox[{ RowBox[{"(", RowBox[{"n", "+", "1"}], ")"}], "/", "2"}]}], ",", " ", RowBox[{"{", RowBox[{"n", ",", " ", "1", ",", " ", "6"}], "}"}]}], "]"}], "/", SuperscriptBox["6", "3"]}], " "}]], "Input"], Cell[BoxData[ RowBox[{"%", " ", "//", " ", "N"}]], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Langevin Equations for Brownian Motion (in-class)", "Section"], Cell["\<\ The Langevin equation for Brownian motion can be written as a sequence of \ random steps. Each time step, random motion of molecules cause particles to \ change their velocities. Friction with the surroundings cause the velocity to \ slow back towards zero. This is a model for the random motion of fine dust \ particles on the surface of liquid, for example. \ \>", "Text"], Cell[TextData[{ "The Langevin equation describes the trajectory of an object with a random \ force, ", StyleBox["s", FontSlant->"Italic"], ", and a frictional damping, \[Gamma]", ". In differential form, the Langevin equation is\n\t", Cell[BoxData[ FormBox[ RowBox[{ SubscriptBox["\[PartialD]", "t"], " ", "v"}], TraditionalForm]]], " = - \[Gamma] ", StyleBox["v", FontSlant->"Italic"], " + ", StyleBox["s\n\t", FontSlant->"Italic"], Cell[BoxData[ FormBox[ RowBox[{ SubscriptBox["\[PartialD]", "t"], " ", "x"}], TraditionalForm]]], " = ", StyleBox["v", FontSlant->"Italic"], "\nThe Langevin equation can be written in finite-difference form as a \ two-dimensional map:\n\t", Cell[BoxData[ FormBox[ SubscriptBox["v", "n"], TraditionalForm]]], " = (1 \[Dash] \[Gamma] \[CapitalDelta]t) ", Cell[BoxData[ FormBox[ SubscriptBox["v", RowBox[{"n", "-", "1"}]], TraditionalForm]]], " + ", Cell[BoxData[ FormBox[ SubscriptBox["s", "n"], TraditionalForm]]], "\n\t", Cell[BoxData[ FormBox[ RowBox[{ SubscriptBox["x", "n"], " "}], TraditionalForm]]], "= ", Cell[BoxData[ FormBox[ SubscriptBox["x", RowBox[{"n", "-", "1"}]], TraditionalForm]]], " + \[CapitalDelta]t ", Cell[BoxData[ FormBox[ SubscriptBox["v", RowBox[{"n", "-", "1"}]], TraditionalForm]]], "\nThis map has a similar form to the deterministic equations for planetary \ orbits and pendulums. The big difference here is that the change in velocity \ cause by ", Cell[BoxData[ FormBox[ SubscriptBox["s", "n"], TraditionalForm]]], "is ", StyleBox["random", FontSlant->"Italic"], "!" }], "Text"], Cell[TextData[{ "A trajectory following the Langevin equations can be found from the map \ below, where \[Gamma] = 0.1, \[CapitalDelta]t = 1, and where ", Cell[BoxData[ FormBox[ SubscriptBox["s", "n"], TraditionalForm]]], "= \[PlusMinus] 1." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"langevin", "[", RowBox[{"{", RowBox[{"x_", ",", "v_"}], "}"}], "]"}], ":=", RowBox[{"{", RowBox[{ RowBox[{"x", "+", "v"}], ",", RowBox[{ RowBox[{"0.9", " ", "v"}], "+", RowBox[{"(", RowBox[{ RowBox[{"2", " ", RowBox[{"RandomInteger", "[", "]"}]}], "-", "1"}], ")"}]}]}], "}"}]}]], "Input", CellChangeTimes->{{3.445271798968389*^9, 3.4452718032446632`*^9}}], Cell[BoxData[ RowBox[{"langevin", "[", RowBox[{"langevin", "[", RowBox[{"{", RowBox[{"0", ",", " ", "10"}], "}"}], "]"}], "]"}]], "Input"], Cell[TextData[{ StyleBox["Part a", FontWeight->"Bold"], ":\nConstruct a simulation using ", StyleBox["langevin[\[Ellipsis]]", FontWeight->"Bold"], " and ", StyleBox["NestList[...]", FontWeight->"Bold"], " ", "beginning with {", Cell[BoxData[ FormBox[ SubscriptBox["x", "0"], TraditionalForm]]], ", ", Cell[BoxData[ FormBox[ SubscriptBox["v", "0"], TraditionalForm]]], "} = {0, 10} for about 50 steps and for about 1000 \"walkers\". " }], "Text"], Cell[TextData[{ StyleBox["Part b", FontWeight->"Bold"], ":\nWhat is the evolution of the average position and average velocity?" }], "Text"], Cell[TextData[{ StyleBox["Part c", FontWeight->"Bold"], ":\nPlot the mean-squared position and velocity of the walkers. Does the \ velocity and position diffuse? If so, can you estimate the diffusion \ coefficient?" }], "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsection"], Cell[CellGroupData[{ Cell["Part a", "Subsubsection"], Cell[BoxData[ RowBox[{ RowBox[{"nWalkers", " ", "=", " ", "1000"}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"walkList", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"NestList", "[", RowBox[{"langevin", ",", " ", RowBox[{"{", RowBox[{"0", ",", " ", "10"}], "}"}], ",", " ", "50"}], "]"}], ",", " ", RowBox[{"{", "nWalkers", "}"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"walkList", " ", "//", " ", "Dimensions"}]], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part b", "Subsubsection"], Cell[BoxData[ RowBox[{ RowBox[{"avgX", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"Mean", "[", RowBox[{"walkList", "\[LeftDoubleBracket]", RowBox[{"All", ",", " ", "n", ",", " ", "1"}], "\[RightDoubleBracket]"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", " ", "1", ",", " ", "51"}], "}"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{"avgX", ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{ "\"\\"", ",", "\"\<\[LeftAngleBracket]x\[RightAngleBracket]\>\""}], "}"}]}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"avgV", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"Mean", "[", RowBox[{"walkList", "\[LeftDoubleBracket]", RowBox[{"All", ",", " ", "n", ",", " ", "2"}], "\[RightDoubleBracket]"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", " ", "1", ",", " ", "51"}], "}"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{"avgV", ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{ "\"\\"", ",", "\"\<\[LeftAngleBracket]v\[RightAngleBracket]\>\""}], "}"}]}]}], "]"}]], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part c", "Subsubsection"], Cell[BoxData[ RowBox[{ RowBox[{"avg\[CapitalDelta]X2", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"Variance", "[", RowBox[{"walkList", "\[LeftDoubleBracket]", RowBox[{"All", ",", " ", "n", ",", " ", "1"}], "\[RightDoubleBracket]"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", " ", "1", ",", " ", "51"}], "}"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{"avg\[CapitalDelta]X2", ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{ "\"\\"", ",", "\"\<\[LeftAngleBracket](x - \ \[LeftAngleBracket]x\[RightAngleBracket]\\!\\(\\*SuperscriptBox[\\()\\), \\(2\ \\)]\\)\[RightAngleBracket]\>\""}], "}"}]}]}], "]"}]], "Input"], Cell["\<\ The particle trajectories begin very little spatial diffusion, and later \ diffuse strongly. \ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"avg\[CapitalDelta]V2", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"Variance", "[", RowBox[{"walkList", "\[LeftDoubleBracket]", RowBox[{"All", ",", " ", "n", ",", " ", "2"}], "\[RightDoubleBracket]"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", " ", "1", ",", " ", "51"}], "}"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{"avg\[CapitalDelta]V2", ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{ "\"\\"", ",", "\"\<\[LeftAngleBracket](v - \ \[LeftAngleBracket]v\[RightAngleBracket]\\!\\(\\*SuperscriptBox[\\()\\), \\(2\ \\)]\\)\[RightAngleBracket]\>\""}], "}"}]}], ",", RowBox[{"PlotRange", "\[Rule]", "All"}]}], "]"}]], "Input"], Cell["\<\ The velocity initially diffuses, and then finds an equilibrium where the \ average velocity fluctuations are constant in time.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Part c (Estimating the diffusion coefficient)", "Subsubsection"], Cell[BoxData[ RowBox[{ RowBox[{"gridX", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"BinCounts", "[", RowBox[{ RowBox[{"walkList", "\[LeftDoubleBracket]", RowBox[{"All", ",", " ", "n", ",", " ", "1"}], "\[RightDoubleBracket]"}], ",", " ", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"-", "0"}], "-", RowBox[{"1", "/", "2"}]}], ",", " ", RowBox[{ RowBox[{"+", "100"}], " ", "+", " ", RowBox[{"1", "/", "2"}]}], ",", "1"}], "}"}]}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", " ", "1", ",", " ", "51"}], "}"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"ListDensityPlot", "[", RowBox[{"gridX", ",", RowBox[{"Mesh", "\[Rule]", "False"}], ",", RowBox[{"ColorFunction", "\[Rule]", "Hue"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{"1", ",", "250"}], "}"}]}], ",", RowBox[{"PerformanceGoal", " ", "\[Rule]", " ", "\"\\""}], ",", RowBox[{"MaxPlotPoints", " ", "\[Rule]", " ", "100"}], ",", RowBox[{"FrameLabel", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", "nWalkers", "]"}], "<>", "\"\< Walkers\>\""}], ",", "\"\\""}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{3.445252435968828*^9}], Cell[BoxData[ RowBox[{ RowBox[{"gridV", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"BinCounts", "[", RowBox[{ RowBox[{"walkList", "\[LeftDoubleBracket]", RowBox[{"All", ",", " ", "n", ",", " ", "2"}], "\[RightDoubleBracket]"}], ",", " ", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"-", "20"}], "-", RowBox[{"1", "/", "2"}]}], ",", " ", RowBox[{ RowBox[{"+", "20"}], " ", "+", " ", RowBox[{"1", "/", "2"}]}], ",", "1"}], "}"}]}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", " ", "1", ",", " ", "51"}], "}"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"ListDensityPlot", "[", RowBox[{"gridV", ",", RowBox[{"Mesh", "\[Rule]", "False"}], ",", RowBox[{"ColorFunction", "\[Rule]", "Hue"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{"1", ",", "250"}], "}"}]}], ",", RowBox[{"PerformanceGoal", " ", "\[Rule]", " ", "\"\\""}], ",", RowBox[{"MaxPlotPoints", " ", "\[Rule]", " ", "100"}], ",", RowBox[{"FrameLabel", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", "nWalkers", "]"}], "<>", "\"\< Walkers\>\""}], ",", "\"\\""}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{3.445252438144952*^9}], Cell[TextData[{ "An estimate of the spatial diffusion coefficient is found from the linear \ part of the \[LeftAngleBracket]", Cell[BoxData[ FormBox[ SuperscriptBox["\[CapitalDelta]x", "2"], TraditionalForm]]], "\[RightAngleBracket] curve, where \[LeftAngleBracket]", Cell[BoxData[ FormBox[ SuperscriptBox["\[CapitalDelta]x", "2"], TraditionalForm]]], "\[RightAngleBracket] \[Proportional] 2 ", StyleBox["D ", FontSlant->"Italic"], "t. " }], "Text"], Cell[BoxData[ RowBox[{"Fit", "[", RowBox[{ RowBox[{"avg\[CapitalDelta]X2", "\[LeftDoubleBracket]", RowBox[{"Range", "[", RowBox[{"30", ",", "50"}], "]"}], "\[RightDoubleBracket]"}], ",", " ", RowBox[{"{", RowBox[{"1", ",", " ", "t"}], "}"}], ",", " ", "t"}], "]"}]], "Input"], Cell[TextData[{ "Therefore, ", StyleBox["D", FontSlant->"Italic"], " ~ 50." }], "Text"], Cell[TextData[{ "Notice also that \[LeftAngleBracket]", Cell[BoxData[ FormBox[ SuperscriptBox["\[CapitalDelta]v", "2"], TraditionalForm]]], "\[RightAngleBracket] initially increases with time. The velocity diffusion \ coefficient is found from" }], "Text"], Cell[BoxData[ RowBox[{"Fit", "[", RowBox[{ RowBox[{"avg\[CapitalDelta]V2", "\[LeftDoubleBracket]", RowBox[{"Range", "[", RowBox[{"1", ",", "4"}], "]"}], "\[RightDoubleBracket]"}], ",", " ", RowBox[{"{", RowBox[{"1", ",", " ", "t"}], "}"}], ",", " ", "t"}], "]"}]], "Input"], Cell[TextData[{ "Therefore, ", Cell[BoxData[ FormBox[ SubscriptBox["D", "v"], TraditionalForm]]], " ~ 0.4, which is about ", StyleBox["D", FontSlant->"Italic"], " ", Cell[BoxData[ FormBox[ SuperscriptBox["\[Gamma]", "2"], TraditionalForm]]], ". The equilibrium mean-square velocity is \[LeftAngleBracket]", Cell[BoxData[ FormBox[ SuperscriptBox["v", "2"], TraditionalForm]]], "\[RightAngleBracket] ~ \[Gamma] ", StyleBox["D ", FontSlant->"Italic"], "~ ", Cell[BoxData[ FormBox[ SubscriptBox["D", "v"], TraditionalForm]]], "/\[Gamma]. This relationship between the diffusion and dissipation was \ first described by Albert Einstein." }], "Text"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["The Game of Craps", "Section"], Cell["\<\ Create a simulation and estimate the probability that you will win in a \ \"game of craps.\"\ \>", "Text"], Cell[TextData[{ "The game of craps is a game played by rolling two dice (numbered 1 to 6). \ If you roll 2, 3, or 12 on the first try, you lose. If you roll 7 or 11 on \ the first try, you win. If you roll anything else (", StyleBox["i.e. ", FontSlant->"Italic"], "4, 5, 6, 8, 9, 10), to win you must roll that number again ", StyleBox["before", FontSlant->"Italic"], " you roll 7. If you roll 7 first, then you lose. You can roll as many times \ as you need until you either win or lose." }], "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsection"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"crapRoll", "[", "]"}], " ", ":=", " ", RowBox[{ RowBox[{"diceRoll", "[", "]"}], " ", "+", " ", RowBox[{"diceRoll", "[", "]"}]}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"crapWin", "[", "]"}], " ", ":=", " ", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"roll", ",", " ", "nextRoll"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"roll", " ", "=", " ", RowBox[{"crapRoll", "[", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"roll", " ", "\[Equal]", " ", "2"}], ")"}], " ", "||", " ", RowBox[{"(", RowBox[{"roll", " ", "\[Equal]", " ", "3"}], ")"}], " ", "||", " ", RowBox[{"(", RowBox[{"roll", " ", "\[Equal]", " ", "12"}], ")"}]}], ",", " ", RowBox[{"Return", "[", "0", "]"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"roll", " ", "\[Equal]", " ", "7"}], ")"}], " ", "||", " ", RowBox[{"(", RowBox[{"roll", " ", "\[Equal]", " ", "11"}], ")"}]}], ",", " ", RowBox[{"Return", "[", "1", "]"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"While", "[", RowBox[{ RowBox[{"nextRoll", " ", "=", " ", RowBox[{"crapRoll", "[", "]"}]}], ";", RowBox[{ RowBox[{"(", RowBox[{"nextRoll", " ", "\[NotEqual]", " ", "roll"}], ")"}], " ", "&&", " ", RowBox[{"(", RowBox[{"nextRoll", " ", "\[NotEqual]", " ", "7"}], ")"}]}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{"nextRoll", " ", "\[Equal]", " ", "roll"}], ",", " ", "1", ",", " ", "0"}], "]"}]}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"Table", "[", RowBox[{ RowBox[{"crapWin", "[", "]"}], ",", " ", RowBox[{"{", "10", "}"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"Plus", " ", "@@", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"crapWin", "[", "]"}], ",", " ", RowBox[{"{", "1000", "}"}]}], "]"}]}], ")"}], "/", "1000"}], " ", "//", " ", "N"}]], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Two-Dimensional Random Walk", "Section"], Cell["\<\ For the two-dimensional random walk, particles make unit steps in one of four \ orthogonal directions: up, down, right, or left. A simple 2D walker function \ is\ \>", "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"}], "}"}]}], "}"}], "\[LeftDoubleBracket]", RowBox[{"RandomInteger", "[", RowBox[{"{", RowBox[{"1", ",", "4"}], "}"}], "]"}], "\[RightDoubleBracket]"}]}]], "Input"], Cell[BoxData[ RowBox[{"Table", "[", RowBox[{ RowBox[{"step2D", "[", "]"}], ",", " ", RowBox[{"{", "5", "}"}]}], "]"}]], "Input"], Cell[TextData[{ "If a walker starts at the origin {x, y} \[Equal] {0, 0}, then the following \ command generates a trajectory with ", StyleBox["n", FontSlant->"Italic"], " steps. " }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"walk2D", "[", "n_", "]"}], " ", ":=", " ", RowBox[{"NestList", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"#", " ", "+", " ", RowBox[{"step2D", "[", "]"}]}], ")"}], "&"}], ",", " ", RowBox[{"{", RowBox[{"0", ",", "0"}], "}"}], ",", " ", "n"}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"walk2D", "[", "5", "]"}]], "Input"], Cell[TextData[{ StyleBox["Question", FontSlant->"Italic"], ": what is the mean distance of a two-dimensional random walk as a function \ of ", StyleBox["n", FontSlant->"Italic"], "? (Hint, define a function ", StyleBox["radius[{x_, y_}]", FontWeight->"Bold"], " that returns the radius from the origin, and ", StyleBox["Map[...]", FontWeight->"Bold"], " this function to every coordinate-pair of each walker's trajectory.) You \ should find that the mean radius increases in proportion to ", Cell[BoxData[ FormBox[ SqrtBox["n"], TraditionalForm]]], "." }], "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsection"], Cell[BoxData[{ RowBox[{ RowBox[{"nWalkers", " ", "=", " ", "1000"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"walkList", " ", "=", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"walk2D", "[", "500", "]"}], ",", RowBox[{"{", "nWalkers", "}"}]}], "]"}]}], ";"}]}], "Input"], Cell[BoxData[ RowBox[{"walkList", " ", "//", " ", "Dimensions", " ", RowBox[{"(*", " ", RowBox[{"1000", " ", "walks", " ", "500", " ", "steps", " ", "long"}], " ", "*)"}]}]], "Input"], Cell[CellGroupData[{ Cell["Average position (\"center of mass\")", "Subsubsection"], Cell[BoxData[ RowBox[{ RowBox[{"avgXY", "[", "walkers_List", "]"}], " ", ":=", " ", RowBox[{"N", "[", RowBox[{ RowBox[{"(", RowBox[{"Plus", " ", "@@", " ", "walkers"}], ")"}], "/", RowBox[{"Length", "[", "walkers", "]"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"avgXYList", " ", "=", " ", RowBox[{"avgXY", " ", "/@", " ", RowBox[{"Transpose", "[", "walkList", "]"}]}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"avgXYList", " ", "//", " ", "Shallow"}]], "Input"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{"avgXYList", ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}]}], "}"}]}], ",", RowBox[{"AspectRatio", "\[Rule]", "Automatic"}], ",", RowBox[{"Joined", "\[Rule]", "True"}], ",", RowBox[{ "PlotLabel", "\[Rule]", "\"\\""}]}], "]"}]], "Input"], Cell["\<\ The average position of all walkers remains near the origin (as expected).\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Average radius", "Subsubsection"], Cell[BoxData[ RowBox[{ RowBox[{"radius", "[", RowBox[{"{", RowBox[{"x_", ",", " ", "y_"}], "}"}], "]"}], " ", ":=", " ", RowBox[{"Sqrt", "[", RowBox[{"N", "[", RowBox[{ RowBox[{"x", "^", "2"}], " ", "+", " ", RowBox[{"y", "^", "2"}]}], "]"}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"rList", " ", "=", " ", RowBox[{"Map", "[", RowBox[{"radius", ",", " ", "walkList", ",", RowBox[{"{", "2", "}"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"rList", "//", "Shallow"}]], "Input"], Cell[BoxData[{ RowBox[{ RowBox[{"avgR", "=", RowBox[{"Mean", "/@", RowBox[{"Transpose", "[", "rList", "]"}]}]}], ";"}], "\n", RowBox[{"ListPlot", "[", "avgR", "]"}]}], "Input"], Cell[BoxData[ RowBox[{"Fit", "[", RowBox[{"avgR", ",", " ", RowBox[{"{", SqrtBox["n"], "}"}], ",", " ", "n"}], "]"}]], "Input"] }, Closed]] }, Closed]] }, Closed]] }, Open ]] }, WindowSize->{648, 775}, WindowMargins->{{101, Automatic}, {Automatic, 6}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, FrontEndVersion->"6.0 for Mac OS X x86 (32-bit) (May 21, 2008)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[590, 23, 30, 0, 73, "Title"], Cell[623, 25, 139, 4, 45, "Subsubtitle"], Cell[CellGroupData[{ Cell[787, 33, 42, 0, 69, "Section"], Cell[832, 35, 342, 7, 59, "Text"], Cell[CellGroupData[{ Cell[1199, 46, 30, 0, 33, "Subsection"], Cell[1232, 48, 169, 5, 28, "Input"], Cell[1404, 55, 142, 4, 28, "Input"], Cell[1549, 61, 375, 10, 28, "Input"], Cell[1927, 73, 368, 11, 46, "Input"], Cell[2298, 86, 145, 3, 43, "Text"], Cell[2446, 91, 958, 16, 331, "Text"], Cell[3407, 109, 164, 6, 30, "Text"], Cell[3574, 117, 86, 2, 28, "Input"], Cell[3663, 121, 331, 11, 33, "Input"], Cell[3997, 134, 60, 1, 28, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[4106, 141, 68, 0, 39, "Section"], Cell[4177, 143, 386, 6, 75, "Text"], Cell[4566, 151, 1653, 63, 159, "Text"], Cell[6222, 216, 261, 7, 43, "Text"], Cell[6486, 225, 455, 15, 28, "Input"], Cell[6944, 242, 151, 4, 28, "Input"], Cell[7098, 248, 472, 19, 61, "Text"], Cell[7573, 269, 144, 4, 43, "Text"], Cell[7720, 275, 231, 6, 59, "Text"], Cell[CellGroupData[{ Cell[7976, 285, 30, 0, 33, "Subsection"], Cell[CellGroupData[{ Cell[8031, 289, 31, 0, 24, "Subsubsection"], Cell[8065, 291, 87, 2, 28, "Input"], Cell[8155, 295, 342, 10, 28, "Input"], Cell[8500, 307, 76, 1, 28, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[8613, 313, 31, 0, 24, "Subsubsection"], Cell[8647, 315, 390, 11, 28, "Input"], Cell[9040, 328, 243, 7, 28, "Input"], Cell[9286, 337, 390, 11, 28, "Input"], Cell[9679, 350, 243, 7, 28, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[9959, 362, 31, 0, 24, "Subsubsection"], Cell[9993, 364, 410, 11, 28, "Input"], Cell[10406, 377, 352, 9, 46, "Input"], Cell[10761, 388, 117, 3, 27, "Text"], Cell[10881, 393, 410, 11, 28, "Input"], Cell[11294, 406, 402, 10, 63, "Input"], Cell[11699, 418, 150, 3, 43, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[11886, 426, 70, 0, 24, "Subsubsection"], Cell[11959, 428, 689, 20, 63, "Input"], Cell[12651, 450, 700, 16, 63, "Input"], Cell[13354, 468, 689, 20, 63, "Input"], Cell[14046, 490, 700, 16, 63, "Input"], Cell[14749, 508, 468, 14, 46, "Text"], Cell[15220, 524, 302, 7, 28, "Input"], Cell[15525, 533, 92, 5, 27, "Text"], Cell[15620, 540, 264, 7, 30, "Text"], Cell[15887, 549, 300, 7, 28, "Input"], Cell[16190, 558, 681, 25, 46, "Text"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[16932, 590, 36, 0, 39, "Section"], Cell[16971, 592, 116, 3, 27, "Text"], Cell[17090, 597, 510, 11, 75, "Text"], Cell[CellGroupData[{ Cell[17625, 612, 30, 0, 33, "Subsection"], Cell[17658, 614, 207, 6, 28, "Input"], Cell[17868, 622, 1686, 45, 114, "Input"], Cell[19557, 669, 141, 4, 28, "Input"], Cell[19701, 675, 284, 9, 28, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[20034, 690, 46, 0, 39, "Section"], Cell[20083, 692, 185, 4, 43, "Text"], Cell[20271, 698, 572, 20, 28, "Input"], Cell[20846, 720, 139, 4, 28, "Input"], Cell[20988, 726, 197, 6, 27, "Text"], Cell[21188, 734, 340, 10, 28, "Input"], Cell[21531, 746, 59, 1, 28, "Input"], Cell[21593, 749, 587, 19, 63, "Text"], Cell[CellGroupData[{ Cell[22205, 772, 30, 0, 33, "Subsection"], Cell[22238, 774, 303, 8, 46, "Input"], Cell[22544, 784, 195, 4, 28, "Input"], Cell[CellGroupData[{ Cell[22764, 792, 62, 0, 24, "Subsubsection"], Cell[22829, 794, 267, 7, 28, "Input"], Cell[23099, 803, 169, 4, 28, "Input"], Cell[23271, 809, 74, 1, 28, "Input"], Cell[23348, 812, 548, 16, 63, "Input"], Cell[23899, 830, 98, 2, 27, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[24034, 837, 39, 0, 24, "Subsubsection"], Cell[24076, 839, 296, 9, 28, "Input"], Cell[24375, 850, 190, 5, 28, "Input"], Cell[24568, 857, 60, 1, 28, "Input"], Cell[24631, 860, 190, 5, 46, "Input"], Cell[24824, 867, 140, 4, 38, "Input"] }, Closed]] }, Closed]] }, Closed]] }, Open ]] } ] *) (* End of internal cache information *)