(* 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[      9238,        344]
NotebookOptionsPosition[      7905,        296]
NotebookOutlinePosition[      8295,        313]
CellTagsIndexPosition[      8252,        310]
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"]
}, 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"],

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"]
}, 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"]
}, 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"]
}, Closed]]
}, Open  ]]
},
WindowSize->{648, 775},
WindowMargins->{{72, Automatic}, {Automatic, 111}},
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"]
}, Closed]],
Cell[CellGroupData[{
Cell[1211, 47, 68, 0, 39, "Section"],
Cell[1282, 49, 386, 6, 75, "Text"],
Cell[1671, 57, 1653, 63, 159, "Text"],
Cell[3327, 122, 261, 7, 43, "Text"],
Cell[3591, 131, 388, 14, 28, "Input"],
Cell[3982, 147, 151, 4, 28, "Input"],
Cell[4136, 153, 472, 19, 61, "Text"],
Cell[4611, 174, 144, 4, 43, "Text"],
Cell[4758, 180, 231, 6, 59, "Text"]
}, Closed]],
Cell[CellGroupData[{
Cell[5026, 191, 36, 0, 39, "Section"],
Cell[5065, 193, 116, 3, 27, "Text"],
Cell[5184, 198, 510, 11, 75, "Text"]
}, Closed]],
Cell[CellGroupData[{
Cell[5731, 214, 46, 0, 39, "Section"],
Cell[5780, 216, 185, 4, 43, "Text"],
Cell[5968, 222, 572, 20, 28, "Input"],
Cell[6543, 244, 139, 4, 28, "Input"],
Cell[6685, 250, 197, 6, 27, "Text"],
Cell[6885, 258, 340, 10, 28, "Input"],
Cell[7228, 270, 59, 1, 28, "Input"],
Cell[7290, 273, 587, 19, 63, "Text"]
}, Closed]]
}, Open  ]]
}
]
*)

(* End of internal cache information *)