(* 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[ 52914, 1626] NotebookOptionsPosition[ 46030, 1435] NotebookOutlinePosition[ 46494, 1453] CellTagsIndexPosition[ 46451, 1450] WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Phys 262 Math session--Jan 26", "Section", CellChangeTimes->{{3.441537185237*^9, 3.441537204514*^9}, { 3.4736772675708*^9, 3.4736772711275997`*^9}, {3.5051221306032*^9, 3.5051221372202*^9}, {3.5365769997096786`*^9, 3.5365770106764984`*^9}}], Cell[CellGroupData[{ Cell["Matrix Manipulations", "Subsection", CellChangeTimes->{{3.473677575858*^9, 3.473677582098*^9}}], Cell["Suppose we want to solve the simultaneous equations", "Text", CellChangeTimes->{{3.4736775844379997`*^9, 3.4736775944376*^9}, { 3.4736777417483997`*^9, 3.4736777460696*^9}, 3.4736778016534*^9}], Cell[BoxData[{ RowBox[{"eq1", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"3", " ", "x"}], " ", "-", " ", RowBox[{"5", " ", "y"}]}], " ", "\[Equal]", " ", "5"}]}], "\[IndentingNewLine]", RowBox[{"eq2", " ", "=", " ", RowBox[{ RowBox[{"x", " ", "-", " ", "y"}], " ", "\[Equal]", " ", "2"}]}]}], "Input", CellChangeTimes->{{3.4736775963408003`*^9, 3.4736777288784*^9}}], Cell[TextData[{ Cell[BoxData[ FormBox[ StyleBox[ RowBox[{"Your", " ", "task"}], "Subsection"], TraditionalForm]]], ": Solve[] for x and y." }], "Text", CellChangeTimes->{{3.4736777544468*^9, 3.4736777881906*^9}}], Cell["\<\ Next, phrase the problem in matrix form. I'll type some random numbers \ here---you fix it up to match the above:\ \>", "Text", CellChangeTimes->{{3.4736778362542*^9, 3.4736779024449997`*^9}}], Cell[BoxData[ RowBox[{"matrix", " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"1", ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{"3", ",", "4"}], "}"}]}], "}"}]}]], "Input", CellChangeTimes->{{3.4736779062358*^9, 3.4736779262818003`*^9}}], Cell[BoxData[ RowBox[{"MatrixForm", "[", "matrix", "]"}]], "Input", CellChangeTimes->{{3.4736779452514*^9, 3.4736779496818*^9}}], Cell["\<\ Here is how to get every output in matrix form:\ \>", "Text", CellChangeTimes->{{3.5365770350749407`*^9, 3.5365770530461726`*^9}}], Cell[BoxData[ RowBox[{"$Post", " ", "=", " ", "MatrixForm"}]], "Input", CellChangeTimes->{{3.536577055448577*^9, 3.536577059317384*^9}}], Cell[BoxData[ RowBox[{"b", " ", "=", " ", RowBox[{"{", RowBox[{"1", ",", "0"}], "}"}]}]], "Input", CellChangeTimes->{{3.473677951585*^9, 3.4736779558906*^9}, { 3.4736780340934*^9, 3.4736780360278*^9}}], Cell[TextData[{ "Then here is the system we want to solve, written on neatly on the screen: \ (this is only for formatting purposes; the \[OpenCurlyDoubleQuote]equation\ \[CloseCurlyDoubleQuote] doesn\[CloseCurlyQuote]t make sense to ", StyleBox["Mathematica", FontSlant->"Italic"], " in this form)" }], "Text", CellChangeTimes->{{3.4736779904914*^9, 3.4736780105374002`*^9}, { 3.5365770915158405`*^9, 3.5365771303443084`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"MatrixForm", "[", "matrix", "]"}], ".", RowBox[{"MatrixForm", "[", RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}], "]"}]}], " ", "\[Equal]", " ", RowBox[{"MatrixForm", "[", "b", "]"}]}]], "Input", CellChangeTimes->{{3.4736779619902*^9, 3.473677982785*^9}}], Cell["\<\ Once you have fixed up the matrix and the vector b, the solution can be \ obtained using the Inverse function:\ \>", "Text", CellChangeTimes->{{3.4736780487418003`*^9, 3.4736780928585997`*^9}}], Cell[BoxData[ RowBox[{"Inverse", "[", "matrix", "]"}]], "Input", CellChangeTimes->{{3.4736780689282*^9, 3.4736780852925997`*^9}, { 3.5365771373487206`*^9, 3.5365771424343295`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Inverse", "[", "matrix", "]"}], ".", "b"}]], "Input", CellChangeTimes->{{3.473678095729*^9, 3.473678107975*^9}, { 3.4736781788302*^9, 3.4736781796882*^9}, {3.536577145367135*^9, 3.5365771481439395`*^9}}], Cell["\<\ For good measure, perhaps you want to check your homework by repeating for \ the system\ \>", "Text", CellChangeTimes->{{3.4736781490966*^9, 3.4736781622318*^9}}], Cell[BoxData[{ RowBox[{"eq1", " ", "=", " ", RowBox[{ RowBox[{"x1", " ", "+", " ", RowBox[{"2", "x2"}]}], " ", "\[Equal]", " ", "9"}]}], "\[IndentingNewLine]", RowBox[{"eq2", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"3", " ", "x1"}], " ", "+", " ", RowBox[{"4", " ", "x2"}]}], " ", "==", " ", "23"}]}]}], "Input", CellChangeTimes->{{3.4736781814354*^9, 3.4736782599658003`*^9}}], Cell["\<\ And here is how you turn off the MatrixForm output:\ \>", "Text", CellChangeTimes->{{3.536577157597556*^9, 3.536577181356398*^9}}], Cell[BoxData[ RowBox[{"$Post", " ", "=", " ", "."}]], "Input", CellChangeTimes->{{3.536577183275201*^9, 3.5365771843516035`*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["Celestial orbits", "Subsection", CellChangeTimes->{{3.441537230428*^9, 3.441537234913*^9}}], Cell["\<\ Here are the incantations which have appeared repeatedly in class already. Start by writing down the effective potential, which gives the diffeq for r. We choose specific numerical parameters so we can use numerical integration, \ by default all are 1 in some units:\ \>", "Text", CellChangeTimes->{{3.4736815051146*^9, 3.4736815204026003`*^9}, { 3.4736817155274*^9, 3.4736817349182*^9}}], Cell[BoxData[ RowBox[{"l", " ", "=", " ", RowBox[{"m", " ", "=", " ", RowBox[{"\[Alpha]", "=", " ", "1"}]}]}]], "Input", CellChangeTimes->{{3.4414715791392*^9, 3.4414716124452*^9}, { 3.441472449189*^9, 3.441472453439*^9}, {3.4414731763929996`*^9, 3.4414731767679996`*^9}, {3.441473206773*^9, 3.441473207199*^9}, 3.4414733116359997`*^9, {3.441537274553*^9, 3.441537275367*^9}, { 3.441537318151*^9, 3.441537321519*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Ueff", "[", "r_", "]"}], " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"-", "\[Alpha]"}], "/", "r"}], " ", "+", " ", RowBox[{ RowBox[{"l", "^", "2"}], "/", " ", RowBox[{"(", " ", RowBox[{"2", " ", "m", " ", RowBox[{"r", "^", "2"}]}], ")"}]}]}]}]], "Input", CellChangeTimes->{{3.4414715550928*^9, 3.4414715951292*^9}, { 3.441472437649*^9, 3.441472438085*^9}, {3.441537257808*^9, 3.441537272156*^9}}], Cell[BoxData[ RowBox[{"reqn", " ", "=", " ", RowBox[{ RowBox[{"m", " ", RowBox[{ RowBox[{"r", "''"}], "[", "t", "]"}]}], " ", "\[Equal]", " ", RowBox[{"-", " ", RowBox[{"D", "[", RowBox[{ RowBox[{"Ueff", "[", RowBox[{"r", "[", "t", "]"}], "]"}], ",", RowBox[{"r", "[", "t", "]"}]}], "]"}]}]}]}]], "Input"], Cell["Next find the mininum of this potential", "Text", CellChangeTimes->{{3.4415373446280003`*^9, 3.441537365865*^9}, { 3.44153744756*^9, 3.441537447908*^9}, {3.441537518815*^9, 3.4415375229849997`*^9}}], Cell[BoxData[ RowBox[{"sUmin", " ", "=", " ", RowBox[{"FindMinimum", "[", RowBox[{ RowBox[{"Ueff", "[", "r", "]"}], ",", RowBox[{"{", RowBox[{"r", ",", ".8"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.4415374280880003`*^9, 3.4415374733450003`*^9}}], Cell["and save the information in the symbols r0 and e0", "Text", CellChangeTimes->{{3.44153752595*^9, 3.441537539745*^9}}], Cell[BoxData[ RowBox[{"r0", " ", "=", " ", RowBox[{"r", " ", "/.", " ", RowBox[{"sUmin", "[", RowBox[{"[", "2", "]"}], "]"}]}]}]], "Input", CellChangeTimes->{{3.441473213545*^9, 3.441473238468*^9}, 3.441537425123*^9, {3.441537481335*^9, 3.441537483705*^9}}], Cell[BoxData[ RowBox[{"e0", " ", "=", " ", RowBox[{"sUmin", "[", RowBox[{"[", "1", "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.44153748912*^9, 3.44153750155*^9}}], Cell["\<\ Choose an energy for our motion somewhat bigger than the minimum:\ \>", "Text", CellChangeTimes->{{3.44153754471*^9, 3.44153758906*^9}}], Cell[BoxData[ RowBox[{" ", RowBox[{"e", " ", "=", " ", RowBox[{"e0", "+", " ", ".05"}]}]}]], "Input", CellChangeTimes->{{3.4415374172650003`*^9, 3.441537417692*^9}, { 3.44153750851*^9, 3.441537513*^9}, {3.44153755305*^9, 3.441537569035*^9}, { 3.4415383167864*^9, 3.441538318908*^9}}], Cell["And finally make our diagram:", "Text", CellChangeTimes->{{3.441537596215*^9, 3.441537604625*^9}}], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Ueff", "[", "r", "]"}], ",", "e"}], "}"}], ",", RowBox[{"{", RowBox[{"r", ",", RowBox[{".1", " ", "r0"}], ",", RowBox[{"3", " ", "r0"}]}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4414715848176003`*^9, 3.441471586362*^9}, { 3.4414716179364*^9, 3.4414716340355997`*^9}, {3.4415373872530003`*^9, 3.441537412505*^9}}], Cell["We might as well locate the turning points:", "Text", CellChangeTimes->{{3.441537621435*^9, 3.4415376279300003`*^9}}], Cell[BoxData[ RowBox[{"r1", " ", "=", " ", RowBox[{"(", RowBox[{"r", "/.", RowBox[{"FindRoot", "[", RowBox[{ RowBox[{ RowBox[{"Ueff", "[", "r", "]"}], "\[Equal]", "e"}], ",", RowBox[{"{", RowBox[{"r", ",", RowBox[{".5", "r0"}]}], "}"}]}], "]"}]}], ")"}]}]], "Input", CellChangeTimes->{{3.44153761473*^9, 3.4415376148*^9}}], Cell[BoxData[ RowBox[{"r2", " ", "=", " ", RowBox[{"(", RowBox[{"r", "/.", RowBox[{"FindRoot", "[", RowBox[{ RowBox[{ RowBox[{"Ueff", "[", "r", "]"}], "\[Equal]", "e"}], ",", RowBox[{"{", RowBox[{"r", ",", RowBox[{"2", "r0"}]}], "}"}]}], "]"}]}], ")"}]}]], "Input", CellChangeTimes->{{3.44153761713*^9, 3.44153761749*^9}, { 3.4736817918738003`*^9, 3.4736817919986*^9}}], Cell["\<\ Now to find the actual motion we need to set up initial conditions. Let us agree to launch at r[0]=r0 with whatever speed we need to make the energy right:\ \>", "Text", CellChangeTimes->{{3.441537640575*^9, 3.44153768138*^9}}], Cell[BoxData[ RowBox[{"eeqn", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "m", RowBox[{ RowBox[{"(", "rdot", ")"}], "^", "2"}]}], " ", "+", " ", RowBox[{"Ueff", "[", "r0", "]"}]}], " ", "\[Equal]", " ", "e"}]}]], "Input", CellChangeTimes->{3.4415372957980003`*^9}], Cell[BoxData["rdot"], "Input", CellChangeTimes->{{3.4736819593241997`*^9, 3.4736819819598*^9}}], Cell[BoxData[ RowBox[{"rdot0", " ", "=", " ", RowBox[{"(", RowBox[{"rdot", "/.", RowBox[{ RowBox[{"(", RowBox[{"Solve", "[", RowBox[{"eeqn", ",", "rdot"}], "]"}], ")"}], "[", RowBox[{"[", "2", "]"}], "]"}]}], ")"}]}]], "Input", CellChangeTimes->{{3.4415373018929996`*^9, 3.441537304742*^9}}], Cell[BoxData[ RowBox[{"rdot0", "=", "0"}]], "Input", CellChangeTimes->{{3.4736820536418*^9, 3.4736820570425997`*^9}}], Cell["Now we are ready to solve:", "Text", CellChangeTimes->{{3.44153770356*^9, 3.4415377072650003`*^9}}], Cell[BoxData[ RowBox[{"nsoln", " ", "=", " ", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{"reqn", ",", RowBox[{ RowBox[{ RowBox[{"r", "'"}], "[", "0", "]"}], "\[Equal]", "rdot0"}], ",", RowBox[{ RowBox[{"r", "[", "0", "]"}], "\[Equal]", "r0"}]}], "}"}], ",", RowBox[{"r", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "100"}], "}"}]}], "]"}]}]], "Input"], Cell["And save a copy of the solution as \"myr[t]\"", "Text", CellChangeTimes->{{3.44153771025*^9, 3.44153772169*^9}, {3.4736820620034*^9, 3.4736820632358*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"myr", "[", "t_", "]"}], " ", "=", " ", RowBox[{"(", RowBox[{ RowBox[{"r", "[", "t", "]"}], "/.", RowBox[{"nsoln", "[", RowBox[{"[", "1", "]"}], "]"}]}], ")"}]}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"myr", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "100"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{3.4414716795564003`*^9, 3.44153772926*^9}], Cell["\<\ Now that we have r[t], find \[Theta][t].\ \>", "Text", CellChangeTimes->{{3.441537735825*^9, 3.441537736895*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"\[Theta]eqn", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"\[Theta]", "'"}], "[", "t", "]"}], " ", "\[Equal]", " ", RowBox[{"l", "/", RowBox[{"(", RowBox[{"m", " ", RowBox[{ RowBox[{"(", RowBox[{"myr", "[", "t", "]"}], ")"}], "^", "2"}]}], ")"}]}]}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"\[Theta]soln", " ", "=", " ", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{"\[Theta]eqn", ",", RowBox[{ RowBox[{"\[Theta]", "[", "0", "]"}], "\[Equal]", "0"}]}], "}"}], ",", RowBox[{"\[Theta]", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "100"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"my\[Theta]", "[", "t_", "]"}], " ", "=", " ", RowBox[{ RowBox[{"\[Theta]", "[", "t", "]"}], "/.", RowBox[{"\[Theta]soln", "[", RowBox[{"[", "1", "]"}], "]"}]}]}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"my\[Theta]", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "10"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{3.4414716940176*^9}], Cell["\<\ And now we can draw the curve. Note that you might want to play with the \ aspect ratio.\ \>", "Text", CellChangeTimes->{{3.441537752035*^9, 3.4415377907650003`*^9}}], Cell[BoxData[ RowBox[{"ParametricPlot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"myr", "[", "t", "]"}], "*", RowBox[{"Cos", "[", RowBox[{"my\[Theta]", "[", "t", "]"}], "]"}]}], ",", RowBox[{ RowBox[{"myr", "[", "t", "]"}], "*", RowBox[{"Sin", "[", RowBox[{"my\[Theta]", "[", "t", "]"}], "]"}]}]}], "}"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "100"}], "}"}], ",", RowBox[{"AspectRatio", "\[Rule]", "Automatic"}]}], "]"}]], "Input", CellChangeTimes->{{3.441537766645*^9, 3.441537773065*^9}}], Cell["And to make the movie:", "Text", CellChangeTimes->{{3.473681827083*^9, 3.4736818299533997`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"orbit", "[", "tt_", "]"}], " ", ":=", " ", RowBox[{"Show", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"ParametricPlot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"myr", "[", "t", "]"}], "*", RowBox[{"Cos", "[", RowBox[{"my\[Theta]", "[", "t", "]"}], "]"}]}], ",", RowBox[{ RowBox[{"myr", "[", "t", "]"}], "*", RowBox[{"Sin", "[", RowBox[{"my\[Theta]", "[", "t", "]"}], "]"}]}]}], "}"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "tt"}], "}"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "3"}], ",", "3"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "3"}], ",", "3"}], "}"}]}], "}"}]}], ",", RowBox[{"AspectRatio", "\[Rule]", "1"}]}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"{", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"myr", "[", "tt", "]"}], "*", RowBox[{"Cos", "[", RowBox[{"my\[Theta]", "[", "tt", "]"}], "]"}]}], ",", RowBox[{ RowBox[{"myr", "[", "tt", "]"}], "*", RowBox[{"Sin", "[", RowBox[{"my\[Theta]", "[", "tt", "]"}], "]"}]}]}], "}"}], "}"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"PointSize", "[", ".03", "]"}], ",", RowBox[{"RGBColor", "[", RowBox[{"1", ",", "0", ",", "0"}], "]"}]}], "}"}]}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}]}], "}"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "$DisplayFunction"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.4415382695652*^9, 3.4415382761484003`*^9}}], Cell[BoxData[ RowBox[{"Animate", "[", RowBox[{ RowBox[{"orbit", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "20"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4414717577124*^9, 3.4414717584768*^9}, { 3.4414733908529997`*^9, 3.4414734095950003`*^9}, {3.4415382834648*^9, 3.4415382858984003`*^9}}], Cell[CellGroupData[{ Cell["Your optional tasks:", "Subsubsection", CellChangeTimes->{{3.441538427328*^9, 3.441538429824*^9}, {3.473682504825*^9, 3.4736825063538*^9}}], Cell["\<\ Repeat for a variety of energies. Choose a small one and satisfy yourself \ that r[t] looks sinusoidal; choose a large one and see that it is not.\ \>", "Text", CellChangeTimes->{{3.4415384352528*^9, 3.4415384786988*^9}}], Cell["\<\ Repeat for a slightly perturbed potential, and notice that the orbits no \ longer close\ \>", "Text", CellChangeTimes->{{3.4415384856408*^9, 3.441538500726*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Ueff", "[", "r_", "]"}], " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"-", " ", "c"}], "/", "r"}], " ", "+", " ", RowBox[{ RowBox[{"l", "^", "2"}], "/", " ", RowBox[{"(", " ", RowBox[{"2", " ", "m", " ", RowBox[{"r", "^", "2"}]}], ")"}]}], " ", "+", " ", RowBox[{ RowBox[{"(", RowBox[{"1", "/", "100"}], ")"}], "/", RowBox[{"r", "^", "3"}]}]}]}]], "Input"], Cell["\<\ Repeat for an \[Alpha] r^k potential for a variety of k's. Goal: reproduce \ the plots on p.303 of Morin.\ \>", "Text", CellChangeTimes->{{3.441538505328*^9, 3.441538571472*^9}}] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Homework Task: Morin 7.12", "Subsection", CellChangeTimes->{{3.4736783245030003`*^9, 3.4736783293234*^9}, 3.4736794086166*^9, 3.4736796036166*^9, {3.4736825602674*^9, 3.4736825629505997`*^9}, {3.5365772640677433`*^9, 3.536577265565346*^9}, { 3.536577495035149*^9, 3.5365775042547655`*^9}}], Cell["\<\ We are asked: suppose the earth's tangential velocity suddenly dropped to zero. How long would it take to fall in to the Sun? The straighforward way of formulating the problem is to say that at time t=0 \ we start at r(0)=R, where R is the usual 1.5x10^11 meters to the sun, and we obey the F=ma \ equation which says:\ \>", "Text", CellChangeTimes->{{3.4736773135439997`*^9, 3.4736773368972*^9}, { 3.4736795337286*^9, 3.4736796059566*^9}, {3.4736800264546003`*^9, 3.4736801034406*^9}}], Cell[BoxData[ RowBox[{"fma", " ", "=", " ", RowBox[{ RowBox[{"m", " ", RowBox[{ RowBox[{"r", "''"}], "[", "t", "]"}]}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"-", "\[Alpha]"}], "/", RowBox[{ RowBox[{"r", "[", "t", "]"}], "^", "2"}]}]}]}]], "Input", CellChangeTimes->{{3.4736801057650003`*^9, 3.4736801266222*^9}, { 3.4736818899198*^9, 3.4736818920882*^9}}], Cell[TextData[{ "With great hope, one might try to DSolve, but ", StyleBox["Mathematica", FontSlant->"Italic"], " gets us only halfway there (i.e. it can find t(r), but not r(t)).\nInstead \ choosing the numerical parameters as above (\[Alpha]=1,m=1) and using the \ appriate r0 (which is then 1),\ntry NDSolve for the motion. Find the time at \ which r[t] hits zero, i.e. we crash in to the Sun.\n(This is treating the Sun \ as a point, of course.) \nTricky point #1: you will get complaints from \ NDSolve that something funny happens at a particular time. That time is of \ course when r=0 the force blows up. Cure #1: ignore the complaint; Cure #2: \ adjust your integration time to just short of the singularity.\nTricky point \ #2: you've found a numerical value for the time, but what are the units? \ Answer: units such that the original orbit at r0=1 takes one year. And what \ was the numerical value of the period above? (The period being the time it \ takes for \[Theta] to advance by 2\[Pi].)\nTricky point #3: the book problem \ hints that you can do this by thinking of falling in as the limiting case of \ a very eccentric ellipse. That is, we want (half of) the period of an \ ellipse with major axis r0. Since any orbit with major axis 2r0 (such as \ Earth) takes one year, Kepler's third tells us that (half of) the period of \ the skinny ellipse is ... (what?!)" }], "Text", CellChangeTimes->{{3.4736818747254*^9, 3.4736818833522*^9}, { 3.4736825702981997`*^9, 3.4736827262046003`*^9}, {3.4736827761246*^9, 3.473682963231*^9}, {3.4736831563746*^9, 3.4736833171014*^9}, { 3.4736833474122*^9, 3.4736834088606*^9}, {3.5051220328512*^9, 3.5051220679032*^9}, {3.5051222468592*^9, 3.5051222882672*^9}}], Cell[TextData[{ StyleBox["Your tasks: ", "Subsection"], "Construct and print cells showing the NDSolve and the resulting time, as \ well as a quick \"N[some sqrt to some power] involving 2's and \[Pi]'s\" to \ demonstrate that the result of the NDSolve agrees with point #3." }], "Text", CellChangeTimes->{{3.4736834158962*^9, 3.4736836559294*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["(BONUS segment): Halley's Comet", "Subsection", CellChangeTimes->{{3.4736825294574003`*^9, 3.4736825537778*^9}}], Cell["\<\ Let' s make a movie of Halley' s comet. Start by carefully drawing the \ Earth' s orbit, including nonzeor eccentricity. Choose parameters by convention :\ \>", "Text", CellChangeTimes->{{3.4736831669046*^9, 3.4736831764986*^9}}], Cell[BoxData[{ RowBox[{"\[Alpha]", " ", "=", " ", "1"}], "\[IndentingNewLine]", RowBox[{"m", " ", "=", "1"}], "\[IndentingNewLine]"}], "Input", CellChangeTimes->{{3.442314551624*^9, 3.442314552427*^9}, { 3.4736795093458*^9, 3.4736795142130003`*^9}}], Cell["\<\ Take as inputs the period T (measured in years) and the eccentricity \ \[Epsilon], e.g. for Earth,\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"T", " ", "=", " ", "1"}], ";", " ", RowBox[{"\[Epsilon]", "=", ".017"}], ";"}]], "Input"], Cell["To convert to the parameters L and E we use Kepler's law:", "Text"], Cell[BoxData[ RowBox[{"s", " ", "=", " ", RowBox[{"Solve", "[", RowBox[{ RowBox[{ RowBox[{"T", "^", "2"}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"\[Pi]", "^", "2"}], " ", "m", " ", RowBox[{ RowBox[{"\[Alpha]", "^", "2"}], "/", RowBox[{"(", RowBox[{ RowBox[{"-", "2"}], " ", RowBox[{"e", "^", "3"}]}], ")"}]}]}]}], ",", "e"}], "]"}]}]], "Input", CellChangeTimes->{{3.4423145577790003`*^9, 3.4423145583529997`*^9}}], Cell["We want the real solution:", "Text"], Cell[BoxData[ RowBox[{"e0", " ", "=", " ", RowBox[{"e", "/.", " ", RowBox[{"s", "[", RowBox[{"[", "3", "]"}], "]"}]}]}]], "Input"], Cell["To get L ", "Text", CellChangeTimes->{{3.4736774211996*^9, 3.4736774221823997`*^9}}], Cell[BoxData[ RowBox[{"s", "=", RowBox[{"Solve", "[", RowBox[{ RowBox[{"\[Epsilon]", " ", "\[Equal]", " ", RowBox[{"Sqrt", "[", RowBox[{"1", " ", "+", " ", RowBox[{"2", " ", "e0", " ", RowBox[{ RowBox[{"L", "^", "2"}], "/", RowBox[{"(", RowBox[{"m", " ", RowBox[{"\[Alpha]", "^", "2"}]}], ")"}]}]}]}], "]"}]}], ",", "L"}], "]"}]}]], "Input", CellChangeTimes->{{3.442314586888*^9, 3.4423145876800003`*^9}}], Cell[BoxData[ RowBox[{"L0", " ", "=", " ", RowBox[{"L", "/.", RowBox[{"s", "[", RowBox[{"[", "2", "]"}], "]"}]}]}]], "Input"], Cell["With L in hand we can define the effective potential:", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"Ueff", "[", "r_", "]"}], " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"-", " ", "\[Alpha]"}], "/", "r"}], " ", "+", RowBox[{ RowBox[{"L0", "^", "2"}], "/", " ", RowBox[{"(", " ", RowBox[{"2", " ", "m", " ", RowBox[{"r", "^", "2"}]}], ")"}]}]}]}]], "Input", CellChangeTimes->{{3.4423145982530003`*^9, 3.44231459898*^9}}], Cell["We can draw a line on the graph with:", "Text"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Ueff", "[", "r", "]"}], ",", "e0"}], "}"}], ",", RowBox[{"{", RowBox[{"r", ",", ".1", ",", "2"}], "}"}]}], "]"}]], "Input"], Cell["Find the minimum:", "Text"], Cell[BoxData[ RowBox[{"s", "=", RowBox[{"FindMinimum", "[", RowBox[{ RowBox[{"Ueff", "[", "r", "]"}], ",", RowBox[{"{", RowBox[{"r", ",", ".5"}], "}"}]}], "]"}]}]], "Input"], Cell["Choose as our starting r0 that radius:", "Text"], Cell[BoxData[ RowBox[{"r0", " ", "=", " ", RowBox[{"r", "/.", RowBox[{"s", "[", RowBox[{"[", "2", "]"}], "]"}]}]}]], "Input"], Cell["\<\ And figure out the appropriate v0, i.e. the one consistent with the energy \ (e0) we have.\ \>", "Text"], Cell[BoxData[ RowBox[{"s", "=", RowBox[{"Solve", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "m", " ", RowBox[{"v", "^", "2"}]}], " ", "+", " ", RowBox[{"Ueff", "[", "r0", "]"}]}], "\[Equal]", " ", "e0"}], ",", "v"}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"v0", " ", "=", " ", RowBox[{"v", "/.", RowBox[{"s", "[", RowBox[{"[", "1", "]"}], "]"}]}]}]], "Input"], Cell["Now that we have the boundary conditions, let's solve F=ma:", "Text"], Cell[BoxData[ RowBox[{"reqn", " ", "=", " ", RowBox[{ RowBox[{"m", " ", RowBox[{ RowBox[{"r", "''"}], "[", "t", "]"}]}], " ", "\[Equal]", " ", RowBox[{"-", " ", RowBox[{"D", "[", RowBox[{ RowBox[{"Ueff", "[", RowBox[{"r", "[", "t", "]"}], "]"}], ",", RowBox[{"r", "[", "t", "]"}]}], "]"}]}]}]}]], "Input"], Cell[BoxData[ RowBox[{"s", "=", " ", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{"reqn", ",", RowBox[{ RowBox[{"r", "[", "0", "]"}], "\[Equal]", "r0"}], ",", RowBox[{ RowBox[{ RowBox[{"r", "'"}], "[", "0", "]"}], "\[Equal]", "v0"}]}], "}"}], ",", RowBox[{"r", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "80"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"rE", " ", "=", " ", RowBox[{ RowBox[{"r", "[", "t", "]"}], "/.", RowBox[{"s", "[", RowBox[{"[", "1", "]"}], "]"}]}]}]], "Input"], Cell["\<\ Plot the r[t] we've got and see if the period really is one year:\ \>", "Text"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{"rE", ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "2"}], "}"}]}], "]"}]], "Input"], Cell["\<\ And with r[t] in hand, we can NDSolve for \[Theta][t] using the fact that\ \>", "Text"], Cell[BoxData[ RowBox[{"\[Theta]eqn", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"\[Theta]", "'"}], "[", "t", "]"}], " ", "\[Equal]", " ", RowBox[{"L0", "/", RowBox[{"(", RowBox[{"m", " ", RowBox[{ RowBox[{"(", "rE", ")"}], "^", "2"}]}], ")"}]}]}]}]], "Input"], Cell[BoxData[ RowBox[{"s", "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{"\[Theta]eqn", ",", RowBox[{ RowBox[{"\[Theta]", "[", "0", "]"}], "\[Equal]", "0"}]}], "}"}], ",", RowBox[{"\[Theta]", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "80"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"\[Theta]E", " ", "=", " ", RowBox[{ RowBox[{"\[Theta]", "[", "t", "]"}], "/.", RowBox[{"s", "[", RowBox[{"[", "1", "]"}], "]"}]}]}]], "Input"], Cell["Then make a position vector function:", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"pE", "[", "t_", "]"}], "=", " ", RowBox[{"{", RowBox[{ RowBox[{"rE", "*", RowBox[{"Cos", "[", "\[Theta]E", "]"}]}], ",", " ", RowBox[{"rE", "*", RowBox[{"Sin", "[", "\[Theta]E", "]"}]}]}], "}"}]}]], "Input"], Cell["And plot", "Text"], Cell[BoxData[ RowBox[{"ParametricPlot", "[", RowBox[{ RowBox[{"pE", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "1"}], "}"}], ",", RowBox[{"AspectRatio", "\[Rule]", "1"}]}], "]"}]], "Input"], Cell["Now repeat all these steps for Halley's comet:", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"T", " ", "=", " ", "76"}], ";", " ", RowBox[{"\[Epsilon]", "=", ".967"}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"s", " ", "=", " ", RowBox[{"Solve", "[", RowBox[{ RowBox[{ RowBox[{"T", "^", "2"}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"\[Pi]", "^", "2"}], " ", "m", " ", RowBox[{ RowBox[{"\[Alpha]", "^", "2"}], "/", RowBox[{"(", RowBox[{ RowBox[{"-", "2"}], " ", RowBox[{"e", "^", "3"}]}], ")"}]}]}]}], ",", "e"}], "]"}]}]], "Input", CellChangeTimes->{{3.442314813368*^9, 3.4423148141289997`*^9}}], Cell[BoxData[ RowBox[{"e1", " ", "=", " ", RowBox[{"e", "/.", RowBox[{"s", "[", RowBox[{"[", "2", "]"}], "]"}]}]}]], "Input"], Cell[BoxData[ RowBox[{"s", "=", RowBox[{"Solve", "[", RowBox[{ RowBox[{"\[Epsilon]", " ", "\[Equal]", " ", RowBox[{"Sqrt", "[", RowBox[{"1", " ", "+", " ", RowBox[{"2", " ", "e1", " ", RowBox[{ RowBox[{"L", "^", "2"}], "/", RowBox[{"(", RowBox[{"m", " ", RowBox[{"\[Alpha]", "^", "2"}]}], ")"}]}]}]}], "]"}]}], ",", "L"}], "]"}]}]], "Input", CellChangeTimes->{{3.442314822914*^9, 3.442314823769*^9}}], Cell[BoxData[ RowBox[{"L1", " ", "=", " ", RowBox[{"L", "/.", RowBox[{"s", "[", RowBox[{"[", "2", "]"}], "]"}]}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"Ueff", "[", "r_", "]"}], " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"-", " ", "\[Alpha]"}], "/", "r"}], " ", "+", RowBox[{ RowBox[{"L1", "^", "2"}], "/", " ", RowBox[{"(", " ", RowBox[{"2", " ", "m", " ", RowBox[{"r", "^", "2"}]}], ")"}]}]}]}]], "Input", CellChangeTimes->{{3.44231478306*^9, 3.442314783901*^9}}], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Ueff", "[", "r", "]"}], ",", "e1"}], "}"}], ",", RowBox[{"{", RowBox[{"r", ",", ".1", ",", "2"}], "}"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"s", "=", RowBox[{"FindMinimum", "[", RowBox[{ RowBox[{"Ueff", "[", "r", "]"}], ",", RowBox[{"{", RowBox[{"r", ",", ".4"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.4423148601219997`*^9, 3.442314860459*^9}}], Cell[BoxData[ RowBox[{"r1", " ", "=", " ", RowBox[{"r", "/.", RowBox[{"s", "[", RowBox[{"[", "2", "]"}], "]"}]}]}]], "Input"], Cell[BoxData[ RowBox[{"s", "=", RowBox[{"Solve", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "m", " ", RowBox[{"v", "^", "2"}]}], " ", "+", " ", RowBox[{"Ueff", "[", "r1", "]"}]}], "\[Equal]", " ", "e1"}], ",", "v"}], "]"}], " "}]], "Input"], Cell[BoxData[ RowBox[{"v1", " ", "=", " ", RowBox[{"v", "/.", RowBox[{"s", "[", RowBox[{"[", "2", "]"}], "]"}]}]}]], "Input"], Cell[BoxData[ RowBox[{"reqn", " ", "=", " ", RowBox[{ RowBox[{"m", " ", RowBox[{ RowBox[{"r", "''"}], "[", "t", "]"}]}], " ", "\[Equal]", " ", RowBox[{"-", " ", RowBox[{"D", "[", RowBox[{ RowBox[{"Ueff", "[", RowBox[{"r", "[", "t", "]"}], "]"}], ",", RowBox[{"r", "[", "t", "]"}]}], "]"}]}]}]}]], "Input"], Cell[BoxData[ RowBox[{"s", "=", " ", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{"reqn", ",", RowBox[{ RowBox[{"r", "[", "0", "]"}], "\[Equal]", "r1"}], ",", RowBox[{ RowBox[{ RowBox[{"r", "'"}], "[", "0", "]"}], "\[Equal]", "v1"}]}], "}"}], ",", RowBox[{"r", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "80"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"rH", " ", "=", " ", RowBox[{ RowBox[{"r", "[", "t", "]"}], "/.", RowBox[{"s", "[", RowBox[{"[", "1", "]"}], "]"}]}]}]], "Input"], Cell[BoxData[ RowBox[{"\[Theta]eqn", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"\[Theta]", "'"}], "[", "t", "]"}], " ", "\[Equal]", " ", RowBox[{"L0", "/", RowBox[{"(", RowBox[{"m", " ", RowBox[{ RowBox[{"(", "rH", ")"}], "^", "2"}]}], ")"}]}]}]}]], "Input"], Cell[BoxData[ RowBox[{"s", "=", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{"\[Theta]eqn", ",", RowBox[{ RowBox[{"\[Theta]", "[", "0", "]"}], "\[Equal]", "0"}]}], "}"}], ",", RowBox[{"\[Theta]", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "80"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"\[Theta]H", "=", " ", RowBox[{ RowBox[{"\[Theta]", "[", "t", "]"}], "/.", RowBox[{"s", "[", RowBox[{"[", "1", "]"}], "]"}]}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"pH", "[", "t_", "]"}], "=", " ", RowBox[{"{", RowBox[{ RowBox[{"rH", "*", RowBox[{"Cos", "[", "\[Theta]H", "]"}]}], ",", " ", RowBox[{"rH", "*", RowBox[{"Sin", "[", "\[Theta]H", "]"}]}]}], "}"}]}]], "Input"], Cell[BoxData[ RowBox[{"ParametricPlot", "[", RowBox[{ RowBox[{"pH", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "76"}], "}"}]}], "]"}]], "Input"], Cell["\<\ And now define a function to draw dots at the locations of Earth and Halley's \ comet:\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"drawstate2", "[", "t_", "]"}], " ", ":=", " ", RowBox[{"Show", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"pE", "[", "t", "]"}], ",", RowBox[{"pH", "[", "t", "]"}]}], "}"}], ",", RowBox[{"AspectRatio", "\[Rule]", "1"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"Hue", "[", "1", "]"}], ",", RowBox[{"PointSize", "[", ".02", "]"}]}], "}"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "6"}], ",", "6"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "11"}], "}"}]}], "}"}]}]}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"ParametricPlot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"pE", "[", "tprime", "]"}], ",", RowBox[{"pH", "[", "tprime", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"tprime", ",", "0", ",", "t"}], "}"}]}], "]"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.4423149397539997`*^9, 3.442314960417*^9}}], Cell["And animate", "Text"], Cell[BoxData[ RowBox[{"?", "*Animate*"}]], "Input", CellChangeTimes->{{3.442315180645*^9, 3.442315184351*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["Morin 7.17", "Subsection", CellChangeTimes->{{3.4736783245030003`*^9, 3.4736783293234*^9}, 3.4736794086166*^9, 3.4736796036166*^9, {3.4736825602674*^9, 3.4736825629505997`*^9}, {3.5365772640677433`*^9, 3.536577265565346*^9}, { 3.5365774536014767`*^9, 3.5365774541006775`*^9}}], Cell["\<\ This problem asks about the angular momentum (Lz), given that a satellite is \ in parabolic orbit with a given distance of closest approach (L). Here is a \ plot, choosing L=1, with a red dot at the focus, and a generic blue point.\ \>", "Text", CellChangeTimes->{{3.5365775227563977`*^9, 3.5365776113489532`*^9}, { 3.536577650068221*^9, 3.5365777313131638`*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"p1", " ", "=", " ", RowBox[{"Plot", "[", RowBox[{ RowBox[{ RowBox[{"x", "^", "2"}], "/", "4"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "4"}], "}"}]}], "]"}]}], ";", " ", RowBox[{"p2", " ", "=", " ", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"{", RowBox[{"{", RowBox[{"0", ",", "1"}], "}"}], "}"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"Red", ",", RowBox[{"PointSize", "[", ".03", "]"}]}], "}"}]}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"p3", " ", "=", " ", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"x", ",", RowBox[{ RowBox[{"x", "^", "2"}], "/", "4"}]}], "}"}], "/.", RowBox[{"x", "\[Rule]", "3.8"}]}], "}"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"Blue", ",", RowBox[{"PointSize", "[", ".02", "]"}]}], "}"}]}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"Show", "[", RowBox[{"p1", ",", "p2", ",", "p3"}], "]"}]}], "Input", CellChangeTimes->{{3.536428716901365*^9, 3.5364288479571953`*^9}, { 3.5365776257945786`*^9, 3.536577668039453*^9}}], Cell[TextData[{ "Part (a) of the problem asks you to compute Lz as the satellites passes \ through the origin, noting that you know the speed from the fact that the \ total energy is exactly zero. Part (b) asks you to express Lz using formulae \ for r0 (k) and \[Epsilon]. Part (c) asks you to compute Lz at a generic \ point (x0,y0) on the orbit, simplifying various expressions under the \ assumption that x0 is much larger than L. Here let\[CloseCurlyQuote]s use ", StyleBox["Mathematica", FontSlant->"Italic"], " to compute Lz exactly." }], "Text", CellChangeTimes->{{3.5365777786124473`*^9, 3.536578078582575*^9}}], Cell["\<\ First express y0 in terms of x0\ \>", "Text", CellChangeTimes->{{3.5364288782680483`*^9, 3.5364288858964615`*^9}, { 3.5365780824981813`*^9, 3.5365780885041924`*^9}}], Cell[BoxData[ RowBox[{"y0", " ", "=", " ", RowBox[{ RowBox[{"x0", "^", "2"}], "/", RowBox[{"(", RowBox[{"4", " ", "L"}], ")"}]}]}]], "Input", CellChangeTimes->{{3.5364280951000395`*^9, 3.5364281144907064`*^9}}], Cell["\<\ The displacement vector from the red origin to the blue point is:\ \>", "Text", CellChangeTimes->{{3.5364288964732804`*^9, 3.536428910873706*^9}}], Cell[BoxData[ RowBox[{"r", " ", "=", " ", RowBox[{"{", RowBox[{"x0", ",", RowBox[{"y0", "-", "L"}]}], "}"}]}]], "Input", CellChangeTimes->{{3.5364281237883234`*^9, 3.5364281518371725`*^9}, { 3.5364285436318607`*^9, 3.5364285528514767`*^9}}], Cell["which has length", "Text", CellChangeTimes->{{3.5364289202181225`*^9, 3.536428926114933*^9}}], Cell[BoxData[ RowBox[{"dist", " ", "=", " ", RowBox[{"Sqrt", "[", RowBox[{"r", ".", "r"}], "]"}]}]], "Input", CellChangeTimes->{{3.5364289291413383`*^9, 3.536428938017754*^9}}], Cell["\<\ In terms of this distance we know the kinetic energy (again since total \ energy is exactly 0), and the speed:\ \>", "Text", CellChangeTimes->{{3.5364289452405663`*^9, 3.5364289656922026`*^9}, { 3.536578112185034*^9, 3.5365781126530347`*^9}}], Cell[BoxData[ RowBox[{"speed", " ", "=", " ", RowBox[{"Sqrt", "[", RowBox[{ RowBox[{"(", RowBox[{"2", "/", "m"}], ")"}], " ", RowBox[{"\[Alpha]", "/", "dist"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.5364281539431763`*^9, 3.53642817316241*^9}, { 3.5364286148459854`*^9, 3.536428615844387*^9}, {3.536428968328607*^9, 3.536428969373809*^9}}], Cell["\<\ And this speed is the magnitude of a velocity vector which is directed at an \ angle with slope:\ \>", "Text", CellChangeTimes->{{3.5364289821502314`*^9, 3.5364289928518505`*^9}, { 3.536578135694275*^9, 3.5365781659583282`*^9}}], Cell[BoxData[ RowBox[{"tan\[Theta]", " ", "=", " ", RowBox[{"D", "[", RowBox[{"y0", ",", "x0"}], "]"}]}]], "Input", CellChangeTimes->{{3.536428199620056*^9, 3.536428209058073*^9}}], Cell["\<\ From tan(\[Theta]) we can figure out the sin and cos as:\ \>", "Text", CellChangeTimes->{{3.536429000870264*^9, 3.5364290073598757`*^9}, { 3.5365781740391426`*^9, 3.5365781936639767`*^9}}], Cell[BoxData[ RowBox[{"sin\[Theta]", " ", "=", " ", RowBox[{"tan\[Theta]", "/", RowBox[{"Sqrt", "[", RowBox[{"1", "+", RowBox[{"tan\[Theta]", "^", "2"}]}], "]"}]}]}]], "Input", CellChangeTimes->{{3.536428225438102*^9, 3.5364282295253086`*^9}, { 3.5364285737867136`*^9, 3.536428591165144*^9}}], Cell[BoxData[ RowBox[{"cos\[Theta]", " ", "=", " ", RowBox[{"1", "/", RowBox[{"Sqrt", "[", RowBox[{"1", "+", RowBox[{"tan\[Theta]", "^", "2"}]}], "]"}]}]}]], "Input", CellChangeTimes->{{3.536428225438102*^9, 3.5364282295253086`*^9}, { 3.5364285737867136`*^9, 3.5364286080287733`*^9}}], Cell["So the velocity vector is:", "Text", CellChangeTimes->{{3.5364290182642946`*^9, 3.5364290381075296`*^9}}], Cell[BoxData[ RowBox[{"v", "=", RowBox[{"speed", " ", RowBox[{"{", RowBox[{"cos\[Theta]", ",", "sin\[Theta]"}], "}"}]}]}]], "Input", CellChangeTimes->{{3.5364286197911944`*^9, 3.5364286359528227`*^9}}], Cell["Neatened up:", "Text", CellChangeTimes->{{3.536578525055359*^9, 3.536578530031768*^9}}], Cell[BoxData[ RowBox[{"FullSimplify", "[", RowBox[{"v", ",", RowBox[{"Assumptions", "->", RowBox[{"{", RowBox[{ RowBox[{"\[Alpha]", ">", "0"}], ",", RowBox[{"x0", ">", "0"}], ",", RowBox[{"m", ">", "0"}], ",", RowBox[{"L", ">", "0"}]}], "}"}]}]}], "]"}]], "Input"], Cell["\<\ and the angular momentum is this cross product: (note the fancy way we \ compute this!)\ \>", "Text", CellChangeTimes->{{3.536429049308349*^9, 3.536429059136367*^9}, { 3.536578225082432*^9, 3.5365782447696667`*^9}}], Cell[BoxData[ RowBox[{"Det", "[", RowBox[{"{", " ", RowBox[{"r", ",", RowBox[{"m", " ", "v"}]}], "}"}], "]"}]], "Input", CellChangeTimes->{{3.5364286403676305`*^9, 3.536428655811658*^9}, { 3.536429151582129*^9, 3.536429153750533*^9}, {3.536429193655403*^9, 3.536429195324606*^9}}], Cell["which simplifies to .... (drum roll)", "Text", CellChangeTimes->{{3.536429216946244*^9, 3.536429222905454*^9}}], Cell[BoxData[ RowBox[{"FullSimplify", "[", RowBox[{"%", ",", RowBox[{"Assumptions", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"\[Alpha]", ">", "0"}], ",", RowBox[{"x0", ">", "0"}], ",", RowBox[{"m", ">", "0"}], ",", RowBox[{"L", ">", "0"}]}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{{3.536428657933261*^9, 3.5364286595244637`*^9}, { 3.5364290726615906`*^9, 3.5364290896968203`*^9}, {3.536429178398576*^9, 3.5364291796933784`*^9}}], Cell["\<\ Your job on the homework is to do the same steps where you assume x0 is \ large, and keep only the leading (dominant) contribution in each expression. \ For example the exact distance is\ \>", "Text", CellChangeTimes->{{3.536578257015688*^9, 3.5365783369658284`*^9}, { 3.5365787296965184`*^9, 3.536578762581376*^9}}], Cell[BoxData[ RowBox[{"FullSimplify", "[", RowBox[{"dist", ",", RowBox[{"Assumptions", "->", RowBox[{"{", RowBox[{ RowBox[{"\[Alpha]", ">", "0"}], ",", RowBox[{"x0", ">", "0"}], ",", RowBox[{"m", ">", "0"}], ",", RowBox[{"L", ">", "0"}]}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{{3.5365784533264327`*^9, 3.536578496647709*^9}, { 3.536578567674634*^9, 3.536578568485835*^9}}], Cell[TextData[{ "which means the potential energy is some factors times 1/x0^2 plus terms of \ order L^2/x0^2 and higher, which we drop. Here is how to get ", StyleBox["Mathematica", FontSlant->"Italic"], " to express this:" }], "Text", CellChangeTimes->{{3.536578773189395*^9, 3.5365787758882*^9}, { 3.5365788076966553`*^9, 3.5365788761495757`*^9}, {3.536578926740464*^9, 3.536578936677682*^9}}], Cell[BoxData[ RowBox[{"Series", "[", RowBox[{"dist", ",", RowBox[{"{", RowBox[{"x0", ",", "Infinity", ",", "2"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.5365789068036294`*^9, 3.5365789160076456`*^9}}], Cell["Similarly, for the speed ...", "Text", CellChangeTimes->{{3.536578959609722*^9, 3.5365789664269342`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Series", "[", RowBox[{"speed", ",", RowBox[{"{", RowBox[{"x0", ",", "Infinity", ",", "2"}], "}"}]}], "]"}], "//", RowBox[{"(", RowBox[{ RowBox[{"FullSimplify", "[", RowBox[{"#", ",", RowBox[{"Assumptions", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"\[Alpha]", ">", "0"}], ",", RowBox[{"x0", ">", "0"}], ",", RowBox[{"m", ">", "0"}], ",", RowBox[{"L", ">", "0"}]}], "}"}]}]}], "]"}], "&"}], ")"}]}]], "Input", CellChangeTimes->{{3.536578877459978*^9, 3.536578897490413*^9}, { 3.536578971902544*^9, 3.5365790229302335`*^9}}], Cell["and the whole velocity vector:", "Text", CellChangeTimes->{{3.536579212345766*^9, 3.536579218039776*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Series", "[", RowBox[{"v", ",", RowBox[{"{", RowBox[{"x0", ",", "Infinity", ",", "2"}], "}"}]}], "]"}], "//", RowBox[{"(", RowBox[{ RowBox[{"FullSimplify", "[", RowBox[{"#", ",", RowBox[{"Assumptions", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"\[Alpha]", ">", "0"}], ",", RowBox[{"x0", ">", "0"}], ",", RowBox[{"m", ">", "0"}], ",", RowBox[{"L", ">", "0"}]}], "}"}]}]}], "]"}], "&"}], ")"}]}]], "Input", CellChangeTimes->{{3.536579042586268*^9, 3.536579062757103*^9}}], Cell["\<\ Since Lz is exactly the same for any x0, it should come as no surprise that \ we get the same result for Lz order by order in powers of (1/x0).\ \>", "Text", CellChangeTimes->{{3.536579224638588*^9, 3.5365793017651234`*^9}}] }, Open ]] }, Open ]] }, WindowSize->{1008, 647}, WindowMargins->{{0, Automatic}, {Automatic, 0}}, ShowSelection->True, Magnification:>FEPrivate`If[ FEPrivate`Equal[FEPrivate`$VersionNumber, 6.], 1.5, 1.5 Inherited], FrontEndVersion->"8.0 for Microsoft Windows (32-bit) (February 23, 2011)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[567, 22, 252, 3, 105, "Section"], Cell[CellGroupData[{ Cell[844, 29, 102, 1, 54, "Subsection"], Cell[949, 32, 203, 2, 41, "Text"], Cell[1155, 36, 393, 10, 71, "Input"], Cell[1551, 48, 224, 7, 45, "Text"], Cell[1778, 57, 204, 4, 41, "Text"], Cell[1985, 63, 279, 8, 43, "Input"], Cell[2267, 73, 130, 2, 43, "Input"], Cell[2400, 77, 141, 3, 41, "Text"], Cell[2544, 82, 138, 2, 43, "Input"], Cell[2685, 86, 212, 5, 43, "Input"], Cell[2900, 93, 435, 9, 66, "Text"], Cell[3338, 104, 319, 8, 43, "Input"], Cell[3660, 114, 204, 4, 41, "Text"], Cell[3867, 120, 184, 3, 43, "Input"], Cell[4054, 125, 244, 5, 43, "Input"], Cell[4301, 132, 173, 4, 41, "Text"], Cell[4477, 138, 412, 11, 71, "Input"], Cell[4892, 151, 141, 3, 41, "Text"], Cell[5036, 156, 131, 2, 43, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[5204, 163, 98, 1, 54, "Subsection"], Cell[5305, 166, 401, 7, 90, "Text"], Cell[5709, 175, 441, 8, 43, "Input"], Cell[6153, 185, 472, 13, 43, "Input"], Cell[6628, 200, 358, 11, 43, "Input"], Cell[6989, 213, 210, 3, 41, "Text"], Cell[7202, 218, 280, 7, 43, "Input"], Cell[7485, 227, 124, 1, 41, "Text"], Cell[7612, 230, 275, 6, 43, "Input"], Cell[7890, 238, 174, 4, 43, "Input"], Cell[8067, 244, 147, 3, 41, "Text"], Cell[8217, 249, 296, 6, 43, "Input"], Cell[8516, 257, 105, 1, 41, "Text"], Cell[8624, 260, 439, 12, 43, "Input"], Cell[9066, 274, 124, 1, 41, "Text"], Cell[9193, 277, 379, 11, 43, "Input"], Cell[9575, 290, 428, 12, 43, "Input"], Cell[10006, 304, 239, 5, 90, "Text"], Cell[10248, 311, 357, 11, 43, "Input"], Cell[10608, 324, 96, 1, 43, "Input"], Cell[10707, 327, 331, 9, 43, "Input"], Cell[11041, 338, 119, 2, 43, "Input"], Cell[11163, 342, 106, 1, 41, "Text"], Cell[11272, 345, 451, 13, 43, "Input"], Cell[11726, 360, 164, 2, 41, "Text"], Cell[11893, 364, 228, 7, 43, "Input"], Cell[12124, 373, 234, 6, 43, "Input"], Cell[12361, 381, 124, 3, 41, "Text"], Cell[12488, 386, 361, 12, 43, "Input"], Cell[12852, 400, 373, 10, 43, "Input"], Cell[13228, 412, 222, 6, 43, "Input"], Cell[13453, 420, 218, 6, 43, "Input"], Cell[13674, 428, 178, 4, 41, "Text"], Cell[13855, 434, 590, 16, 71, "Input"], Cell[14448, 452, 103, 1, 41, "Text"], Cell[14554, 455, 2096, 57, 206, "Input"], Cell[16653, 514, 340, 8, 43, "Input"], Cell[CellGroupData[{ Cell[17018, 526, 149, 2, 38, "Subsubsection"], Cell[17170, 530, 233, 4, 66, "Text"], Cell[17406, 536, 172, 4, 41, "Text"], Cell[17581, 542, 443, 14, 43, "Input"], Cell[18027, 558, 190, 4, 41, "Text"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[18266, 568, 307, 4, 54, "Subsection"], Cell[18576, 574, 502, 10, 115, "Text"], Cell[19081, 586, 395, 11, 43, "Input"], Cell[19479, 599, 1741, 26, 384, "Text"], Cell[21223, 627, 352, 6, 70, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[21612, 638, 119, 1, 54, "Subsection"], Cell[21734, 641, 243, 5, 66, "Text"], Cell[21980, 648, 255, 4, 98, "Input"], Cell[22238, 654, 122, 3, 41, "Text"], Cell[22363, 659, 127, 3, 43, "Input"], Cell[22493, 664, 73, 0, 41, "Text"], Cell[22569, 666, 495, 14, 43, "Input"], Cell[23067, 682, 42, 0, 41, "Text"], Cell[23112, 684, 143, 4, 43, "Input"], Cell[23258, 690, 91, 1, 41, "Text"], Cell[23352, 693, 494, 14, 43, "Input"], Cell[23849, 709, 138, 4, 43, "Input"], Cell[23990, 715, 69, 0, 41, "Text"], Cell[24062, 717, 388, 11, 43, "Input"], Cell[24453, 730, 53, 0, 41, "Text"], Cell[24509, 732, 224, 7, 43, "Input"], Cell[24736, 741, 33, 0, 41, "Text"], Cell[24772, 743, 196, 6, 43, "Input"], Cell[24971, 751, 54, 0, 41, "Text"], Cell[25028, 753, 138, 4, 43, "Input"], Cell[25169, 759, 114, 3, 41, "Text"], Cell[25286, 764, 341, 11, 43, "Input"], Cell[25630, 777, 138, 4, 43, "Input"], Cell[25771, 783, 75, 0, 41, "Text"], Cell[25849, 785, 358, 11, 43, "Input"], Cell[26210, 798, 438, 13, 43, "Input"], Cell[26651, 813, 167, 5, 43, "Input"], Cell[26821, 820, 89, 2, 41, "Text"], Cell[26913, 824, 140, 4, 43, "Input"], Cell[27056, 830, 97, 2, 41, "Text"], Cell[27156, 834, 297, 9, 43, "Input"], Cell[27456, 845, 351, 10, 43, "Input"], Cell[27810, 857, 181, 5, 43, "Input"], Cell[27994, 864, 53, 0, 41, "Text"], Cell[28050, 866, 270, 8, 43, "Input"], Cell[28323, 876, 24, 0, 41, "Text"], Cell[28350, 878, 229, 6, 43, "Input"], Cell[28582, 886, 62, 0, 41, "Text"], Cell[28647, 888, 128, 3, 43, "Input"], Cell[28778, 893, 490, 14, 43, "Input"], Cell[29271, 909, 138, 4, 43, "Input"], Cell[29412, 915, 489, 14, 43, "Input"], Cell[29904, 931, 138, 4, 43, "Input"], Cell[30045, 937, 383, 11, 43, "Input"], Cell[30431, 950, 224, 7, 43, "Input"], Cell[30658, 959, 261, 7, 43, "Input"], Cell[30922, 968, 138, 4, 43, "Input"], Cell[31063, 974, 346, 11, 43, "Input"], Cell[31412, 987, 138, 4, 43, "Input"], Cell[31553, 993, 358, 11, 43, "Input"], Cell[31914, 1006, 438, 13, 43, "Input"], Cell[32355, 1021, 167, 5, 43, "Input"], Cell[32525, 1028, 297, 9, 43, "Input"], Cell[32825, 1039, 351, 10, 43, "Input"], Cell[33179, 1051, 176, 5, 43, "Input"], Cell[33358, 1058, 270, 8, 43, "Input"], Cell[33631, 1068, 180, 5, 43, "Input"], Cell[33814, 1075, 110, 3, 41, "Text"], Cell[33927, 1080, 1254, 36, 125, "Input"], Cell[35184, 1118, 27, 0, 41, "Text"], Cell[35214, 1120, 112, 2, 43, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[35363, 1127, 294, 4, 54, "Subsection"], Cell[35660, 1133, 377, 6, 66, "Text"], Cell[36040, 1141, 1295, 39, 125, "Input"], Cell[37338, 1182, 628, 11, 115, "Text"], Cell[37969, 1195, 178, 4, 41, "Text"], Cell[38150, 1201, 227, 6, 43, "Input"], Cell[38380, 1209, 157, 3, 41, "Text"], Cell[38540, 1214, 256, 6, 43, "Input"], Cell[38799, 1222, 100, 1, 41, "Text"], Cell[38902, 1225, 185, 4, 43, "Input"], Cell[39090, 1231, 255, 5, 41, "Text"], Cell[39348, 1238, 371, 9, 43, "Input"], Cell[39722, 1249, 241, 5, 41, "Text"], Cell[39966, 1256, 189, 4, 43, "Input"], Cell[40158, 1262, 201, 4, 41, "Text"], Cell[40362, 1268, 314, 7, 43, "Input"], Cell[40679, 1277, 306, 7, 43, "Input"], Cell[40988, 1286, 112, 1, 41, "Text"], Cell[41103, 1289, 215, 5, 43, "Input"], Cell[41321, 1296, 94, 1, 41, "Text"], Cell[41418, 1299, 310, 9, 43, "Input"], Cell[41731, 1310, 229, 5, 41, "Text"], Cell[41963, 1317, 299, 7, 43, "Input"], Cell[42265, 1326, 118, 1, 41, "Text"], Cell[42386, 1329, 487, 12, 43, "Input"], Cell[42876, 1343, 330, 6, 66, "Text"], Cell[43209, 1351, 430, 11, 43, "Input"], Cell[43642, 1364, 408, 9, 66, "Text"], Cell[44053, 1375, 222, 5, 43, "Input"], Cell[44278, 1382, 112, 1, 41, "Text"], Cell[44393, 1385, 654, 18, 71, "Input"], Cell[45050, 1405, 112, 1, 41, "Text"], Cell[45165, 1408, 599, 17, 71, "Input"], Cell[45767, 1427, 235, 4, 66, "Text"] }, Open ]] }, Open ]] } ] *) (* End of internal cache information *)