(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 5.2' Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 10978, 300]*) (*NotebookOutlinePosition[ 11668, 324]*) (* CellTagsIndexPosition[ 11624, 320]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["Execises (4)", "Title"], Cell[TextData[{ "Assigned: February 9, 2006\nDue: (", StyleBox["Thursday", FontColor->RGBColor[1, 0, 0]], ") February 16, 2006" }], "Subsubtitle"], Cell[CellGroupData[{ Cell["Setup your Solution Notebook (in-class)", "Section"], Cell["\<\ Just like last week's exercises, you must set-up your notebook in \ order to solve these execises. Copy the definitions for the equations of \ motion for Hyperion orbiting Saturn. \ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Eccentricity (in-class)", "Section"], Cell[TextData[{ "A command is defined below that can be used to find the eccentricity of an \ orbit. To use this command, you must make a table of the square of the radius \ of the orbit for at least one orbital period. (Remember, you can find this \ using \"(", StyleBox["x[t]^2 + y[t]^2 /. solution)\"", FontWeight->"Bold"], "Use this command to compute the eccentricity of the circular and \ elliptical orbits demonstrated in class (and called \"h1\" and \"h2\"). " }], "Text"], Cell[BoxData[ RowBox[{\(eccentricty[r2_List]\), " ", ":=", " ", RowBox[{ "Module", "[", \({mn, mx}, \n\t\tmn\ = \ Sqrt[\ Min[r2]]; \n\t\tmx\ = \ Sqrt[Max[r2]]; \n\t\t\((mx - mn)\)/\((mx\ + \ mn)\)\), " ", StyleBox[\( (*\ e\ = \ c/a\ *) \), FontColor->RGBColor[1, 0, 1]], "]"}]}]], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Lyapunov (in-class)", "Section"], Cell["\<\ The command below takes a list of the differences (of the logrythm \ of the magnitude) between two orbits and fits these list of points to a \ straight line. Demonstrate the use of this function by recreating a table of \ the logrythm of the magnitude of two solutions with slightly different \ initial conditions. (Use the solution \"h2a\" illustrated in class.)\ \>", \ "Text"], Cell[BoxData[ \(lyapunov[dt_List]\ := \ Module[{ft}, \n\t\tft\ = \ Fit[dt, {1, t}, \ t]; \n\t\tCoefficient[ft, t]]\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Measure Chaos versus Eccentricity (in-class)", "Section"], Cell["\<\ When Hyperion is in a circular orbit, then the orientation of the \ long axis is stable. When the orbit is sufficiently elliptical, the \ orientation becomes unstable and \"flips\" randomly. \ \>", "Text"], Cell["\<\ In this assignment, you are to use the computer to estimate how \ elliptical the orbit must be to create chaotic tumbling. This is when the \ difference between orientations of two nearly identical initial conditions \ grows exponentially fast.\ \>", "Text"], Cell["\<\ Execute the commands described by this notebook for different \ eccentricities of Hyperion's orbit. As the eccentricity increases, calculate \ the Lyapunov number using the method previously demonstrated. Can you \ estimate for what values of eccentricity the moon tumbles chaotically? If you \ can, create a plot of the Lyapunov exponent as a function of \ eccentricity.\ \>", "Text"], Cell[TextData[{ "To help your study, the \"", StyleBox["getLyapunov", FontWeight->"Bold"], "\" command is defined below. ", "This is command first solves two orbits beginning with the initial \ velocity, \"v0\". The second orbit begin \"nearly\" the same as the first. \ Second, the command computes the eccentricity of the orbit. Finally, it \ compares the two closely-spaced orbits, and computes a Lyapunov exponent. The \ command returns a list of two numbers: the eccentricity and an estimate of \ the Lyapunov exponent." }], "Text"], Cell[BoxData[ RowBox[{\(getLyapunov[v0_Real]\), " ", ":=", RowBox[{"Module", "[", RowBox[{\({h1, h2, r2, dt}\), ",", RowBox[{ RowBox[{"h1", " ", "=", " ", StyleBox[\( (*\ solution\ 1\ *) \), FontColor->RGBColor[1, 0, 1]], \(NDSolve[\(\(\(\(\(eqs\ /. x0\ -> \ 1\)\ /. \ y0\ -> \ 0\)\ /. \ vy0 -> v0\) /. \ vx0\ -> \ 0\) /. \[Theta]0\ -> \ 0\)\ /. \ \[Omega]0\ -> \ 1, \ p, \ {t, \ 0, 5}, MaxSteps \[Rule] 3000]\ // \ Flatten\)}], ";", "\t", RowBox[{"h2", " ", "=", " ", StyleBox[\( (*\ solution\ 2\ *) \), FontColor->RGBColor[1, 0, 1]], \(NDSolve[\(\(\(\(\(eqs\ /. x0\ -> \ 1\)\ /. \ y0\ -> \ 0\)\ /. \ vy0 -> v0\) /. \ vx0\ -> \ 0\) /. \[Theta]0\ -> \ 0.01\)\ /. \ \[Omega]0\ -> \ 1, \ p, \ {t, \ 0, 5}, MaxSteps \[Rule] 3000]\ // \ Flatten\)}], ";", "\[IndentingNewLine]", RowBox[{"r2", " ", "=", " ", StyleBox[\( (*\ list\ of\ radii\ for\ eccentricity\ *) \), FontColor->RGBColor[1, 0, 1]], \(Table[ x[t]^2\ + \ y[t]^2\ /. \ h1, \ {t, \ 0, \ 5, \ 0.1}]\)}], ";", RowBox[{"dt", " ", "=", " ", StyleBox[\( (*\ how\ far\ \(\(apart\)\(?\)\)\ *) \), FontColor->RGBColor[1, 0, 1]], "\[IndentingNewLine]", \(Table[{t, Log[Abs[\((\[Theta][t]\ /. \ h1)\)\ - \ \((\[Theta][t]\ /. \ h2)\)]]}, {t, 0, 5, 0.05}]\)}], ";", "\[IndentingNewLine]", \({eccentricty[r2], lyapunov[dt]}\)}]}], "]"}]}]], "Input"], Cell[TextData[{ "When you are finished, you should find Hyperion becomes chaotic (", StyleBox["i.e.", FontSlant->"Italic"], " unstable) when ", "the eccentricity exceeds a critical value (about 0.35 for our model \ problem)." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Chirikov Map", "Section"], Cell[TextData[{ "The Russian mathematician and physicist, Chirikov, studied the dynamics of \ coupled oscillators in 1979. Instead of solving a differential equation, he \ defined a \"map\" or a \"stepper\" that advances the system according to a \ model. \nHis map is often called the \"circle map\", and it is relatively \ easy to model on the computer. The map has a single parameter, \"k\", that \ controls the interaction between the drive and the natural oscillations. When \ ", StyleBox["k", FontSlant->"Italic"], " ~ 0, then the motion is purely periodic. As ", StyleBox["k", FontSlant->"Italic"], " exceeds unity, the motion is chaotic. \nIn ", StyleBox["Mathematica", FontSlant->"Italic"], ", we use the Chirikov map with ", StyleBox["NestList[...]", FontWeight->"Bold"], " instead of ", StyleBox["NDSolve[\[Ellipsis]]", FontWeight->"Bold"], ", and this is computationally efficient." }], "Text"], Cell["One simple model for the Chirikov's map is:", "Text"], Cell[BoxData[ \(\(\(chirikov[k_]\)[{th_, p_}]\ := \ Module[{thp, \ pp}, \n\t\tpp\ = \ Mod[p\ - \ k\ Sin[th], \ 2\ Pi]; \n\t\tthp\ = \ Mod[th\ + \ pp, \ 2\ Pi]; \n\t\t{thp, \ pp}];\)\)], "Input"], Cell[TextData[{ "Note that this map has a parameter, \"k\". To use the map, you must assign \ a value to ", StyleBox["k", FontSlant->"Italic"], "." }], "Text"], Cell[BoxData[ \(\(chirikov[0.5]\)[{\[Pi]/2, \ 3\ \[Pi]/4}]\)], "Input"], Cell[BoxData[ \(NestList[chirikov[0.5], \ {\[Pi]/2, \ 3\ \[Pi]/4}, \ 5]\)], "Input"], Cell[BoxData[ \(\(ListPlot[NestList[chirikov[0.5], \ {\[Pi]/2, \ 3\ \[Pi]/4}, \ 1000], PlotRange -> {{0, 2\ Pi}, \ {0, \ 2\ Pi}}, \n\t\ Frame -> True, \n\t FrameLabel\ -> \ {"\<\[Theta]\>", \ "\"}];\)\)], "Input"], Cell[BoxData[ \(\(ListPlot[NestList[chirikov[1.5], \ {\[Pi]/2, \ 3\ \[Pi]/4}, \ 1000], PlotRange -> {{0, 2\ Pi}, \ {0, \ 2\ Pi}}, \n\t\ Frame -> True, \n\t FrameLabel\ -> \ {"\<\[Theta]\>", \ "\"}];\)\)], "Input"], Cell[TextData[{ "In this exercise, you are to write a module that takes a parameter ", StyleBox["k", FontSlant->"Italic"], " and an initial condition and computes the Lyapunov exponent for the \ Chirikov map. When the Lyapunov exponent becomes large, the system is \ chaotic. Determine, approximately, the value of ", StyleBox["k", FontSlant->"Italic"], " when this system becomes chaotic. (With some ", StyleBox["very ", FontSlant->"Italic"], " sophisticated mathematics, it can be shown that the critical value of ", StyleBox["k", FontSlant->"Italic"], " leading to global chaos is ", StyleBox["k", FontSlant->"Italic"], " = 0.9716.)" }], "Text"], Cell[TextData[{ "Perhaps the best way to illustrate the onset of chaos is to compute the \ Lyapunov exponent as ", StyleBox["k", FontSlant->"Italic"], " slowly increases. If you choose this method, you should start two \ trajectories very close together (differing by perhaps a few hundreds of a \ percent) and compute how quickly (or slowly) these points move away from each \ other. Note, however, the important point: the trajectories can never be more \ than about \[Pi] apart! Thus, look for exponential divergence only when the \ separation of the two trajectories are less than unity." }], "Text"] }, Closed]] }, Open ]] }, FrontEndVersion->"5.2 for Macintosh", ScreenRectangle->{{0, 1280}, {0, 797}}, WindowSize->{648, 793}, WindowMargins->{{20, Automatic}, {Automatic, 3}}, PrintingCopies->1, PrintingPageRange->{1, Automatic} ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1776, 53, 29, 0, 88, "Title"], Cell[1808, 55, 156, 5, 46, "Subsubtitle"], Cell[CellGroupData[{ Cell[1989, 64, 58, 0, 69, "Section"], Cell[2050, 66, 204, 4, 46, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[2291, 75, 42, 0, 39, "Section"], Cell[2336, 77, 490, 9, 80, "Text"], Cell[2829, 88, 349, 7, 75, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[3215, 100, 38, 0, 39, "Section"], Cell[3256, 102, 389, 7, 78, "Text"], Cell[3648, 111, 151, 3, 59, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[3836, 119, 63, 0, 39, "Section"], Cell[3902, 121, 215, 4, 46, "Text"], Cell[4120, 127, 268, 5, 62, "Text"], Cell[4391, 134, 395, 7, 78, "Text"], Cell[4789, 143, 549, 11, 96, "Text"], Cell[5341, 156, 1900, 35, 251, "Input"], Cell[7244, 193, 249, 7, 48, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[7530, 205, 31, 0, 39, "Section"], Cell[7564, 207, 948, 23, 148, "Text"], Cell[8515, 232, 59, 0, 30, "Text"], Cell[8577, 234, 238, 4, 75, "Input"], Cell[8818, 240, 169, 6, 32, "Text"], Cell[8990, 248, 75, 1, 27, "Input"], Cell[9068, 251, 88, 1, 27, "Input"], Cell[9159, 254, 239, 3, 75, "Input"], Cell[9401, 259, 239, 3, 75, "Input"], Cell[9643, 264, 690, 19, 84, "Text"], Cell[10336, 285, 614, 11, 96, "Text"] }, Closed]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)