(************** Content-type: application/mathematica ************** 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[ 78185, 2157]*) (*NotebookOutlinePosition[ 80375, 2208]*) (* CellTagsIndexPosition[ 80331, 2204]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["Legal Notice, Disclaimer, and Book Ordering Information:", \ "Subsubsection", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "(* Legal Notice, Disclaimer, and Book Ordering Information:\n\nLast \ Modified: FIO June 8, 2002\n\n", StyleBox["Mathematica For Physics: 2nd Edition", FontColor->RGBColor[1, 0, 0]], "\n\nRobert L. Zimmerman and Fredrick I. Olness\n", "\nWebSite: \n", StyleBox[" www.physics.smu.edu/~olness\n darkwing.uoregon.edu/~phys600/\n\ \n", FontColor->RGBColor[1, 0, 0]], "MathSource Number: 0206-862", StyleBox["\n", FontColor->RGBColor[1, 0, 0]], "\nISBN 0-201-53796-6\nFor ordering information, call 1-800-282-0693\n\ Addison-Wesley Publishing Company\n", "\nCommunication with the authors:\nFredrick I. Olness: \ olness@mail.physics.smu.edu\nRobert L. Zimmerman: bob@zim.uoregon.edu\n\n\ Copyright 2002, Addison-Wesley Publishing Company, Inc. The material in\nthis \ file may be distributed freely so long as the content remains\nunchanged, \ and the copyright and reference notices are included. The\npublisher grants \ permission for the noncommercial use of these programs\nand program segments. \ All other uses require the prior written consent\nof the publisher. \n\n\ All rights are reserved with regard to the material in the\n\"Mathematica \ For Physics\" text, and may not be reproduced, stored in a\nretrieval system, \ or transmitted, in any form or by any means,\nelectronic, mechanical, \ photocopying, recording, or otherwise, without\nthe prior written permission \ of the publisher. \n\nThe programs and applications presented in this book \ have been included\nfor their instructional value. They have been tested \ with care but are\nnot guaranteed for any particular purpose. The publisher \ does not\noffer any warranties or representations, nor does it accept any\n\ liabilities with respect to the programs or applications. \n\n *)\n" }], "Input", Evaluatable->False, ImageRegion->{{0, 1}, {0, 1}}] }, Closed]], Cell["4. NonLinear Oscillating Systems", "Title", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell["Introduction", "Section", Hyphenation->False], Cell[BoxData[{ \(\(Off[General::"\"];\)\ \), "\[IndentingNewLine]", \(\(Off[General::"\"];\)\)}], "Input", Hyphenation->False] }, Closed]], Cell["4.1 Nonlinear Pendulum ", "Section", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell["Overview of the Nonlinear Pendulum", "Subsection", Hyphenation->False], Cell["Initialization of User-Defined Functions:", "Subsection", Hyphenation->False], Cell[CellGroupData[{ Cell["\<\ 1. User-defined procedure for the Pendulum's angle-time graph \ \ \>", "Subsubsection", Hyphenation->False], Cell[BoxData[ RowBox[{" ", RowBox[{\(anglePend[{\[Theta]0_, d\[Theta]0_}, {\[Gamma]_, f0_, \[Omega]0_, \[Omega]d_}, tmax_, step_, \ opts___]\), ":=", "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{\({temp}\), ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"temp", "=", RowBox[{ RowBox[{"NDSolve", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{\(\(d\[Theta]'\)[ t] + \[Gamma]\ \ d\[Theta][ t] + \[Omega]0^2\ \ Sin[\[Theta][ t]] \[Equal] f0\ Cos[t\ \[Omega]d]\), " ", ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ SuperscriptBox["\[Theta]", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], " ", "\[Equal]", \(d\[Theta][t]\)}], ",", \(\[Theta][0] \[Equal] \[Theta]0\), ",", \(d\[Theta][0] == d\[Theta]0\)}], "}"}], ",", "\[IndentingNewLine]", \({d\[Theta][t], \[Theta][t]}\), ",", "\[IndentingNewLine]", \({t, 0, tmax}\), ",", \(MaxSteps \[Rule] step\)}], " ", "\[IndentingNewLine]", "]"}], "//", "Flatten"}]}], " ", ";", "\[IndentingNewLine]", "\[IndentingNewLine]", \(Plot[{\ \[Theta][t]\ \ } /. temp\ \ // Evaluate, \[IndentingNewLine]{t, 0, tmax}, \[IndentingNewLine]opts, \ \[IndentingNewLine]DisplayFunction \[Rule] Identity]\)}]}], " ", "\[IndentingNewLine]", "\[IndentingNewLine]", "]"}]}]}]], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["2. User-defined procedure for the Pendulum's Phase diagram", \ "Subsubsection", Hyphenation->False], Cell[BoxData[ RowBox[{\(phasePend[{\[Theta]0_, d\[Theta]0_}, {\[Gamma]_, f0_, \[Omega]0_, \[Omega]d_}, tmax_, step_, \ opts___]\), ":=", "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{\({temp}\), ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"temp", "=", RowBox[{ RowBox[{"NDSolve", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{\(\(d\[Theta]'\)[ t] + \[Gamma]\ \ d\[Theta][ t] + \[Omega]0^2\ \ Sin[\[Theta][t]] \[Equal] f0\ Cos[t\ \[Omega]d]\), " ", ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{ SuperscriptBox["\[Theta]", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], " ", "\[Equal]", \(d\[Theta][t]\)}], ",", \(\[Theta][0] \[Equal] \[Theta]0\), ",", \(d\[Theta][0] == d\[Theta]0\)}], "}"}], ",", "\[IndentingNewLine]", \({d\[Theta][t], \[Theta][t]}\), ",", "\[IndentingNewLine]", \({t, 0, tmax}\), ",", \(MaxSteps \[Rule] step\)}], " ", "\[IndentingNewLine]", "]"}], "//", "Flatten"}]}], " ", ";", "\[IndentingNewLine]", "\[IndentingNewLine]", \(numgraph = \ \[IndentingNewLine]ParametricPlot[\[IndentingNewLine]{\ \[Theta][t]\ , d\[Theta][t]} /. temp\ // Evaluate, \[IndentingNewLine]{t, 0, tmax}, \[IndentingNewLine]opts, \ \[IndentingNewLine]DisplayFunction \[Rule] Identity]\)}]}], " ", "\[IndentingNewLine]", "]"}]}]], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["\<\ 3. User-defined procedure for the Pendulum's Poincar\[EAcute] \ diagram \ \>", "Subsubsection", Hyphenation->False], Cell[BoxData[ RowBox[{\(poincarePend[{\[Theta]0_, d\[Theta]0_}, {\[Gamma]_, f0_, \[Omega]0_, \[Omega]d_}, \ start_, tmax_, step_, \ opts___]\), ":=", "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{\({temp1, temp2}\), ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"temp1", "=", RowBox[{ RowBox[{"NDSolve", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{\(\(d\[Theta]'\)[ t] + \[Gamma]\ \ d\[Theta][ t] + \[Omega]0^2\ \ Sin[\[Theta][t]] \[Equal] f0\ Cos[t\ \[Omega]d]\), ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{ SuperscriptBox["\[Theta]", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], " ", "\[Equal]", \(d\[Theta][t]\)}], ",", \(\[Theta][0] \[Equal] \[Theta]0\), ",", \(d\[Theta][0] == d\[Theta]0\)}], "}"}], ",", "\[IndentingNewLine]", \({d\[Theta][t], \[Theta][t]}\), ",", "\[IndentingNewLine]", \({t, 0, tmax}\), ",", "\[IndentingNewLine]", \(MaxSteps \[Rule] step\)}], " ", "\[IndentingNewLine]", "]"}], "//", "Flatten"}]}], " ", ";", "\[IndentingNewLine]", "\[IndentingNewLine]", \(temp2 = \ Table[\ {\ \[Theta][t]\ , d\[Theta][t]} /. temp1, {t, start, tmax, 2\ \[Pi]/\[Omega]d}]\), ";", "\[IndentingNewLine]", \(ListPlot[temp2, \ PlotStyle -> PointSize[0.02], opts]\)}]}], "\[IndentingNewLine]", " ", "]"}]}]], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["\<\ 4. User-defined procedure to map the pendulum to the interval \ -\[Pi] and \[Pi]\ \>", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(\(\ \)\(\(reduce[x_]\)\(\ \)\(=\)\(\ \)\(Mod[x\ , \ 2 \[Pi], \(-\[Pi]\)]\)\(\ \)\)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Plot[reduce[x], {x, \(-4\) \[Pi]\ , 4\ \[Pi]}, Ticks \[Rule] {Table[i\ \[Pi], {i, \(-4\), 4}], None}];\)\)], "Input",\ Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["\<\ 5. User-defined procedure for the Pendulum's reduced angle-time \ graph \ \>", "Subsubsection", Hyphenation->False], Cell[BoxData[ RowBox[{\(anglePendR[{\[Theta]0_, d\[Theta]0_}, {\[Gamma]_, f0_, \[Omega]0_, \[Omega]d_}, tmax_, step_, \ opts___]\), ":=", RowBox[{"Module", "[", RowBox[{\({temp}\), ",", RowBox[{ RowBox[{"temp", "=", RowBox[{ RowBox[{"NDSolve", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{\(\(d\[Theta]'\)[ t] + \[Gamma]\ \ d\[Theta][ t] + \[Omega]0^2\ \ Sin[\[Theta][t]] \[Equal] f0\ Cos[t\ \[Omega]d]\), " ", ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{ SuperscriptBox["\[Theta]", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], " ", "\[Equal]", \(d\[Theta][t]\)}], ",", \(\[Theta][0] \[Equal] \[Theta]0\), ",", \(d\[Theta][0] == d\[Theta]0\)}], "}"}], ",", "\[IndentingNewLine]", \({d\[Theta][t], \[Theta][t]}\), ",", "\[IndentingNewLine]", \({t, 0, tmax}\), ",", "\[IndentingNewLine]", \(MaxSteps \[Rule] step\)}], " ", "\[IndentingNewLine]", "]"}], "//", "Flatten"}]}], " ", ";", "\[IndentingNewLine]", "\[IndentingNewLine]", \(Plot[ reduce[\[Theta][t] /. temp]\ // Evaluate, \[IndentingNewLine]{t, 0, tmax}, \[IndentingNewLine]opts, \ \[IndentingNewLine]DisplayFunction \[Rule] Identity]\)}]}], "\[IndentingNewLine]", "]"}]}]], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["\<\ 6. User-defined procedure for the Pendulum's reduced phase diagram \ \ \>", "Subsubsection", Hyphenation->False], Cell[BoxData[ RowBox[{\(phasePendR[{\[Theta]0_, d\[Theta]0_}, {\[Gamma]_, f0_, \[Omega]0_, \[Omega]d_}, tmax_, step_, \ opts___]\), ":=", RowBox[{"Module", "[", RowBox[{\({temp}\), ",", RowBox[{ RowBox[{"temp", "=", RowBox[{ RowBox[{"NDSolve", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{\(\(d\[Theta]'\)[ t] + \[Gamma]\ \ d\[Theta][ t] + \[Omega]0^2\ \ Sin[\[Theta][t]] \[Equal] f0\ Cos[t\ \[Omega]d]\), " ", ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{ SuperscriptBox["\[Theta]", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], " ", "\[Equal]", \(d\[Theta][t]\)}], ",", \(\[Theta][0] \[Equal] \[Theta]0\), ",", \(d\[Theta][0] == d\[Theta]0\)}], "}"}], ",", "\[IndentingNewLine]", \({d\[Theta][t], \[Theta][t]}\), ",", "\[IndentingNewLine]", \({t, 0, tmax}\), ",", "\[IndentingNewLine]", \(MaxSteps \[Rule] step\)}], " ", "\[IndentingNewLine]", "]"}], "//", "Flatten"}]}], " ", ";", "\[IndentingNewLine]", "\[IndentingNewLine]", \(ParametricPlot[{\ reduce[\[Theta][t] /. temp\ ], d\[Theta][t] /. temp} // Evaluate, {t, 0, tmax}, \[IndentingNewLine]opts, \ \[IndentingNewLine]DisplayFunction \[Rule] Identity]\)}]}], "\[IndentingNewLine]", "]"}]}]], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["\<\ 7. User-defined procedure for the Pendulum's reduced Poincar\ \[EAcute] diagram\ \>", "Subsubsection", Hyphenation->False], Cell[BoxData[ RowBox[{\(poincarePendR[{\[Theta]0_, d\[Theta]0_}, {\[Gamma]_, f0_, \[Omega]0_, \[Omega]d_}, \ start_, tmax_, step_, \ opts___]\), ":=", RowBox[{"Module", "[", RowBox[{\({temp1, temp2}\), ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"temp1", "=", "\[IndentingNewLine]", RowBox[{ RowBox[{"NDSolve", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{\(\(d\[Theta]'\)[ t] + \[Gamma]\ \ d\[Theta][ t] + \[Omega]0^2\ \ Sin[\[Theta][t]] \[Equal] f0\ Cos[t\ \[Omega]d]\), " ", ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{ SuperscriptBox["\[Theta]", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], " ", "\[Equal]", \(d\[Theta][t]\)}], ",", \(\[Theta][0] \[Equal] \[Theta]0\), ",", \(d\[Theta][0] == d\[Theta]0\)}], "}"}], ",", "\[IndentingNewLine]", \({d\[Theta][t], \[Theta][t]}\), ",", "\[IndentingNewLine]", \({t, \ 0, tmax}\), ",", "\[IndentingNewLine]", \(MaxSteps \[Rule] step\)}], " ", "\[IndentingNewLine]", "]"}], "//", "Flatten"}]}], " ", ";", "\[IndentingNewLine]", "\n", \(temp2 = \ \[IndentingNewLine]Table[\ {reduce[\ \[Theta][ t] /. temp1]\ , d\[Theta][t] /. temp1}\ , \[IndentingNewLine]{t, start, tmax, 2\ \[Pi]/\[Omega]d}]\), ";", "\[IndentingNewLine]", "\[IndentingNewLine]", \(ListPlot[temp2, PlotStyle -> PointSize[0.02], opts]\)}]}], "\[IndentingNewLine]", " ", "]"}]}]], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["8. Protect User-defined procedures", "Subsubsection", Hyphenation->False], Cell["\<\ Protect[anglePend,phasePend,poincarePend, reduce,anglePendR,phasePendR,poincarePendR];\ \>", "Input", Hyphenation->False, AspectRatioFixed->True], Cell["\<\ Off[Clear::wrsym]; Off[SetDelayed::write];\ \>", "Input", Hyphenation->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell["Problem 1: Analytic Solution for the Planar Pendulum ", "Subsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell["Remarks and Outline: ", "Subsubsection", Hyphenation->False, ImageRegion->{{0, 1}, {0, 1}}], Cell[CellGroupData[{ Cell["Solution", "Subsubsection", Hyphenation->False, ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ \(Clear["\"]\)], "Input", Hyphenation->False], Cell[CellGroupData[{ Cell[TextData[StyleBox["Part a ", FontWeight->"Bold"]], "Subsubsection", Hyphenation->False, ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ \(NLeq = \(\[Theta]''\)[t] + g/L\ Sin[\[Theta][t]] \[Equal] 0\)], "Input",\ Hyphenation->False], Cell[BoxData[ \(eq1 = En \[Equal] \((\(\(\[Theta]'\)[t] NLeq[\([1]\)]\ // ExpandAll\) // Integrate[#, t] &)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Erule = {En \[Rule] \(-g\)/\ L\ \ Cos[\[Theta]0]};\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(\(En /. Erule\)\(/.\)\({\[Theta]0 \[Rule] {0, \[Pi]}}\)\(\ \)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(pt = ContourPlot[ eq1[\([2]\)] /. {g \[Rule] 1, L \[Rule] 1} // Evaluate, \ \[IndentingNewLine]{\[Theta][t], \(-4\) \[Pi], \ 4\ \ \[Pi]}, \[IndentingNewLine]{\(\[Theta]'\)[t], \(-3\), 3}\ , \[IndentingNewLine]Contours \[Rule] Range[\(-1\), 3, 0.5], \ \[IndentingNewLine]FrameTicks \[Rule] \ {\[Pi]\ \ Range[\(-4\), 4\ \ ], Automatic}, \[IndentingNewLine]ColorFunction \[Rule] Hue, \[IndentingNewLine]PlotPoints \[Rule] 100, \ \[IndentingNewLine]FrameLabel \[Rule] {"\<\[Theta]\>", "\<\ \[Theta]'\>"}, \[IndentingNewLine]DisplayFunction \[Rule] Identity\ ];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Show[ pt, \ \[IndentingNewLine]Graphics[{Hue[ .2], PointSize[ .02], Map[Point, \({\ \ \[Pi] \((2\ # + 1)\), 0\ }\ &\) /@ Range[\(-2\), 1]]}], \[IndentingNewLine]Graphics[{Hue[ .8], PointSize[ .03], \[IndentingNewLine]Map[ Point, \({2\ \[Pi] #, 0\ }\ &\) /@ Range[\(-2\), 2]]}], \[IndentingNewLine]DisplayFunction \[Rule] \ $DisplayFunction];\)\)], "Input", Hyphenation->False], Cell[BoxData[{ \(\(\(cylind = \ ParametricPlot3D[\[IndentingNewLine]{v, Sin[\[Theta]], Cos[\[Theta]]}, \[IndentingNewLine]{\[Theta], \(-\[Pi]\), \[Pi]}, \ \[IndentingNewLine]{v, \(-3\), 3}, \[IndentingNewLine]DisplayFunction \[Rule] Identity\ \ ];\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(\(Show[cylind, DisplayFunction \[Rule] $DisplayFunction];\)\)}], "Input",\ Hyphenation->False], Cell[BoxData[ \(\(Show[\ \ cylind, \ \[IndentingNewLine]Graphics3D[\[IndentingNewLine]{AbsoluteThickness[ 3], \[IndentingNewLine]Cases[Graphics[pt], _Line, Infinity] /. \[IndentingNewLine]{\[Theta]_\ , v_} :> {v, 1.02\ \ Cos[\[Theta]\ ], 1.02 Sin[\[Theta]\ ]\ }}], \[IndentingNewLine]\ ViewPoint \[Rule] {1, 1, 1}, \[IndentingNewLine]DisplayFunction \[Rule] $DisplayFunction\ \[IndentingNewLine]];\)\)], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["Part b ", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(eq2 = \(\(Solve[eq1, \(\[Theta]'\)[t]]\)[\([2]\)]\ /. Erule // Simplify\) // PowerExpand\)], "Input", Hyphenation->False], Cell[BoxData[ \(eq3 = \ \ \(t == Integrate[\ \ 1\/\(\[Theta]'\)[t] //. eq2\ , {\[Theta][t], 0, \[Theta]}]\ // Simplify\) // PowerExpand\)], "Input", Hyphenation->False], Cell[BoxData[ \(eq4 = \(\(Solve[eq3, \[Theta], InverseFunctions \[Rule] True\ ]\)\(//\)\(Flatten\)\(\ \)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(NL\[Theta]sol[ t1_, \[Theta]1_, \[Omega]_\ ]\ = \[IndentingNewLine]\(\(\(\[Theta]\ \ /. \(Solve[eq3, \[Theta], InverseFunctions \[Rule] True]\)[\([1]\)]\)\ /. {t \[Rule] t1, \[Theta]0 \[Rule] \[Theta]1, g \[Rule] \ \ L\ \[Omega]\^2\ }\)\(\ \)\(//\)\(PowerExpand\)\(\ \ \)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(NLeq[\([1]\)] /. \[Theta] \[Rule] \((\((NL\[Theta]sol[#, \[Theta]0\ , \ \[Omega]\ \ ])\) &)\)\) /. g \[Rule] \[Omega]\^2\ L // Simplify\)], "Input", Hyphenation->False], Cell[BoxData[ \(initial = \[IndentingNewLine]{\[Theta][0], \(\[Theta]'\)[ 0]} \[Equal] \[IndentingNewLine]{\ NL\[Theta]sol[0, \[Theta]0, \[Omega]]\ , D[NL\[Theta]sol[t, \[Theta]0, \[Omega]], t]} /. t \[Rule] 0 // Thread\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(list = \ Table[\ NL\[Theta]sol[t\ , i\ \[Pi], 1\ ], {i, 0.1\ , 0.9\ , 0.2}]\ ;\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Plot[ list // Evaluate, \[IndentingNewLine]{t, 0, 16}, \[IndentingNewLine]AxesLabel \[Rule] {"\", \ "\<\[Theta]\>"}, \[IndentingNewLine]PlotStyle \[Rule] \((\({Thickness[#/100], Hue[#]} &\)\ /@ \ Range[0.1, 0.9, 0.2] // Evaluate)\)\[IndentingNewLine]];\)\)], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell[TextData[StyleBox["Part c", FontWeight->"Bold"]], "Subsubsection", Hyphenation->False], Cell[BoxData[ \(eq3[\([2]\)]\ /. \ {\[Theta] -> \[Theta]0}\)], "Input", Hyphenation->False], Cell[BoxData[ \(period = \ 4\ eq3[\([2]\)] /. {\[Theta] -> \[Theta]0}\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(\(Plot[\ \(period\ /. {g \[Rule] 1, L \[Rule] 1}\ // Re\)\ // Evaluate, \[IndentingNewLine]{\[Theta]0, 0.0\ , \[Pi]\ }, \[IndentingNewLine]GridLines \[Rule] Automatic, \[IndentingNewLine]AxesLabel \[Rule] {"\<\[Theta]0\>", "\ \"}, \[IndentingNewLine]PlotStyle \[Rule] {Hue[ .6], Thickness[ .01]}, \[IndentingNewLine]Ticks \[Rule] {\[Pi]/4 Range[0, 4, 1], \[Pi]\ Range[0, 10, 2]}, \[IndentingNewLine]PlotRange \[Rule] {{0, \[Pi]}, {0, 10\ \[Pi]}}, \[IndentingNewLine]Epilog \[Rule] \ {Hue[ .8], Thickness[0.01], Line[{\ {0, 2\ \[Pi]}, {\[Pi], 2 \[Pi]}}\ ]}\[IndentingNewLine]];\)\(\ \)\)\)], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["Part d", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(Leq = \(\[Theta]''\)[t] + g/L\ \[Theta][t] \[Equal] 0;\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(L\[Theta]sol[ t1_, \[Theta]o_, \[Omega]_\ ] = \(\[Theta][ t] /. \(DSolve[{Leq, \[Theta][0] \[Equal] 0, \(\[Theta]'\)[0] \[Equal] 2\ \[Omega]\ Sin[\[Theta]0/2]}, \[Theta][t], t]\)[\([1]\)]\) /. {t \[Rule] t1, \[Theta]0 \[Rule] \[Theta]o\ , g \[Rule] \ \ L\ \[Omega]^2\ \ \ } // PowerExpand\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(pt1 = Plot[{\ \ L\[Theta]sol[t, \[Pi]/2, 1], \ NL\[Theta]sol[t, \[Pi]/2, 1]}\ // Evaluate, \[IndentingNewLine]{t, 0, 4\ \[Pi]}, \[IndentingNewLine]PlotStyle \[Rule] {\ \[IndentingNewLine]{Dashing[{1.00, 0.00}], Thickness[0.01]}, {Dashing[{0.06, 0.03}], Thickness[0.001]}}, \[IndentingNewLine]Frame \[Rule] True, \ \[IndentingNewLine]DisplayFunction \[Rule] Identity\[IndentingNewLine]];\)\)], "Input", Hyphenation->False], Cell[BoxData[{ \(\(\(Lpts = \ \(\(\({#, \ L\[Theta]sol[#, \[Pi]/2, 1]} &\)\ \ /@ \ \ Range[0, 4\ \[Pi], .5] // Flatten\) // Partition[#, 2] &\) // Chop;\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(\(NLpts = \ \(\(\({#, \ NL\[Theta]sol[#, \[Pi]/2, 1]} &\) /@ Range[0, 4\ \[Pi], .5] // Flatten\) // Partition[#, 2] &\) // Chop;\)\)}], "Input", Hyphenation->False], Cell[BoxData[ \(\(Show[\[IndentingNewLine]pt1, \[IndentingNewLine]Epilog \[Rule] {Hue[ \ .6], PointSize[ .02], Map[\ Point, Join[NLpts\ , Lpts\ ]]}, \[IndentingNewLine]DisplayFunction \[Rule] \ $DisplayFunction\[IndentingNewLine]];\)\)], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell[TextData[StyleBox["Part e ", FontWeight->"Bold"]], "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(?Fourier\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(fourierdataNL = Table[NL\[Theta]sol[t, 0.99 \[Pi]\ , 1]\ // N, {t, 0, 100, 100/511}]\ ;\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(ptNL = ListPlot[ Fourier[fourierdataNL]\ // Abs, \[IndentingNewLine]PlotJoined \[Rule] True, \[IndentingNewLine]PlotStyle \[Rule] Hue[Random[]], \[IndentingNewLine]PlotRange \[Rule] All\[IndentingNewLine]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Show[ptNL, PlotRange \[Rule] {{0, 45}, {0, 8\ }}];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(fourierdataL = Table[L\[Theta]sol[t, .99 \[Pi]\ , 1]\ // N, {t, 0, 100, 100/511}]\ ;\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(ptL = ListPlot[ Fourier[fourierdataL]\ // Abs, \[IndentingNewLine]PlotJoined \[Rule] True, \[IndentingNewLine]PlotStyle \[Rule] Thickness[ .01], \ \[IndentingNewLine]PlotRange \[Rule] {{0, 45}, {0, 10\ }}, \[IndentingNewLine]Epilog \[Rule] ptNL[\([1]\)]\[IndentingNewLine]];\)\)], "Input", Hyphenation->False] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Problem 2: Damped Pendulum ", "Subsection", Hyphenation->False], Cell[CellGroupData[{ Cell["Solution", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(Clear["\"]\)], "Input", Hyphenation->False], Cell[CellGroupData[{ Cell["Part a ", "Subsubsection", Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ RowBox[{ RowBox[{"eq1", "=", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{ SuperscriptBox["\[Theta]", "\[DoublePrime]", MultilineFunction->None], "[", "t", "]"}], "+", RowBox[{"\[Gamma]", " ", RowBox[{ SuperscriptBox["\[Theta]", "\[Prime]", MultilineFunction->None], "[", "t", "]"}]}], "+", \(\[Omega]0^2\ Sin[\[Theta][t]]\)}], "==", "0"}], ",", "\[IndentingNewLine]", \(\[Theta][ 0] \[Equal] .9 \[Pi]\), ",", RowBox[{ RowBox[{ SuperscriptBox["\[Theta]", "\[Prime]", MultilineFunction->None], "[", "0", "]"}], "\[Equal]", "0"}]}], "}"}], "/.", \({\[Gamma] \[Rule] 0.2, \[Omega]0 \[Rule] 1}\)}], "//", "Flatten"}]}], ";"}]], "Input", Hyphenation->False], Cell[BoxData[ \(\(solDP = NDSolve[\ eq1, \ \[Theta][t]\ , {t, 0, 40}] // Flatten;\)\)], "Input",\ Hyphenation->False], Cell[BoxData[ \(\(Plot[\ \ \[Theta][t] /. solDP\ \ \ // Evaluate, \[IndentingNewLine]{t, 0, 40}, \[IndentingNewLine]AxesLabel \[Rule] {"\", \ "\<\[Theta]\>"}, \[IndentingNewLine]PlotRange \[Rule] All, \[IndentingNewLine]PlotStyle \[Rule] {\ Thickness[0.01], Hue[Random[]]}\[IndentingNewLine]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ RowBox[{\(angle[{\[Theta]0_, v0_}, {\[Gamma]_, \[Omega]0_}, tmax_, \ opts___]\), ":=", "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{\({numsol}\), ",", "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{ RowBox[{"numsol", "=", "\[IndentingNewLine]", RowBox[{"NDSolve", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{ SuperscriptBox["\[Theta]", "\[DoublePrime]", MultilineFunction->None], "[", "t", "]"}], "+", RowBox[{"\[Gamma]", " ", RowBox[{ SuperscriptBox["\[Theta]", "\[Prime]", MultilineFunction->None], "[", "t", "]"}]}], "+", \(\[Omega]0^2\ Sin[\[Theta][t]]\)}], "==", "0"}], ",", "\[IndentingNewLine]", \(\[Theta][ 0] \[Equal] \[Theta]0\), ",", RowBox[{ RowBox[{ SuperscriptBox["\[Theta]", "\[Prime]", MultilineFunction->None], "[", "0", "]"}], "==", "v0"}]}], "}"}], ",", \(\[Theta][t]\), ",", "\[IndentingNewLine]", \({t, 0, tmax}\)}], "]"}]}], ";", "\[IndentingNewLine]", "\[IndentingNewLine]", \(numgraph = \[IndentingNewLine]Plot[\ \[IndentingNewLine]\[Theta][t] /. numsol, \[IndentingNewLine]{t, 0, tmax}, \[IndentingNewLine]opts, \ \[IndentingNewLine]DisplayFunction \[Rule] Identity]\)}]}], " ", "\[IndentingNewLine]", "]"}]}]], "Input", Hyphenation->False], Cell[BoxData[ \(\(\(grlist = \ \ \[IndentingNewLine]\(angle[\ {0, #}\ , {0.3, 1}, 23, AxesLabel \[Rule] {"\", "\<\[Theta]\>"}, \ \[IndentingNewLine]GridLines \[Rule] Automatic, \[IndentingNewLine]PlotStyle \[Rule] {Thickness[ \ .01], Hue[Random[]]\ }, \[IndentingNewLine]Ticks \[Rule] {\[Pi]\ Range[0, 8, 2], 2\ \[Pi]\ \ Range[\(-2\), 2\ ]}, \[IndentingNewLine]PlotRange \[Rule] All\ , \[IndentingNewLine]DisplayFunction \[Rule] Identity\[IndentingNewLine]] &\)\ \ /@ \ \ {\(-6\), \(-3\), \ \(-1\), 1, 3, 6}\ ;\)\(\ \ \)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Show[grlist, \ DisplayFunction \[Rule] $DisplayFunction];\)\)], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["Part b", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(ParametricPlot[\[IndentingNewLine]{\[Theta][t] /. solDP, D[\ \[Theta][t] /. solDP\ , t]\ }\ // Evaluate, \[IndentingNewLine]{t, 0, 40}, \[IndentingNewLine]AxesLabel \[Rule] {"\<\[Theta]\>", "\<\ \[Theta]'\>"}, \[IndentingNewLine]Ticks \[Rule] {\[Pi]\ Range[\(-2\), 2, 1/4], Automatic}, \[IndentingNewLine]PlotRange \[Rule] All, \[IndentingNewLine]PlotStyle \[Rule] {Hue[ .8], Thickness[ .009]\ }\[IndentingNewLine]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ RowBox[{\(phase[{\[Theta]0_, v0_}, {\[Gamma]_, \[Omega]0_}, tmax_, \ opts___]\), ":=", "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{\({numsol}\), ",", "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{ RowBox[{"numsol", "=", "\[IndentingNewLine]", RowBox[{ RowBox[{"NDSolve", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{\(\(v'\)[ t] + \[Gamma]\ \ v[ t] + \[Omega]0^2\ \ Sin[\[Theta][t]] == 0\), " ", ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{ SuperscriptBox["\[Theta]", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], " ", "\[Equal]", \(v[t]\)}], ",", "\[IndentingNewLine]", " ", \(\[Theta][0] \[Equal] \[Theta]0\), ",", \(v[0] == v0\)}], "}"}], ",", "\[IndentingNewLine]", \({v[t], \[Theta][t]}\), ",", " ", "\[IndentingNewLine]", \({t, 0, tmax}\)}], "]"}], "//", "Flatten"}]}], ";", "\[IndentingNewLine]", "\[IndentingNewLine]", \(numgraph = ParametricPlot[\[IndentingNewLine]{\ \[Theta][t]\ , v[t]} /. numsol\ // Evaluate, \[IndentingNewLine]{t, 0, tmax}, \[IndentingNewLine]opts, \ \[IndentingNewLine]DisplayFunction \[Rule] Identity]\)}]}], "\[IndentingNewLine]", "]"}]}]], "Input", Hyphenation->False], Cell[BoxData[ \(\(pt1 = \ \[IndentingNewLine]phase[{0, 4}, { .2, 1}, 40, \[IndentingNewLine]PlotRange \[Rule] All, \[IndentingNewLine]AxesLabel \[Rule] {"\<\[Theta]\>", "\<\ \[Theta]'\>"}, \[IndentingNewLine]PlotStyle \[Rule] {Thickness[ .009], Hue[ .7]}, \[IndentingNewLine]Ticks \[Rule] {\ \[Pi]\ \ Range[ 0, 4\ ], Range[\(-2\), 4\ ]}, \[IndentingNewLine]GridLines \[Rule] Automatic, \ PlotPoints \[Rule] 200, \[IndentingNewLine]DisplayFunction \[Rule] $DisplayFunction\ \[IndentingNewLine]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(phlist = \ \ \[IndentingNewLine]\(phase[{0, #\ }, { .3, 1}, 23, \[IndentingNewLine]AxesLabel \[Rule] {"\<\[Theta]\>", "\<\ \[Theta]'\>"}, \[IndentingNewLine]PlotStyle \[Rule] {Thickness[ .008], Hue[Random[]]\ }, \[IndentingNewLine]Ticks \[Rule] {\[Pi]\ \ Range[\(-8\), 8, 2], Range[\(-6\), 6\ ]}, \[IndentingNewLine]PlotRange \[Rule] All\ \ \[IndentingNewLine]] &\)\ \ /@ \ \ {\(-6\), \(-3\), \ \(-1\), 1, 3, 6}\ ;\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(\(pt2 = Show[\ \ \[IndentingNewLine]phlist\ , \[IndentingNewLine]GridLines \ \[Rule] Automatic, DisplayFunction \[Rule] $DisplayFunction\[IndentingNewLine]];\)\(\ \ \)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(\(list = \({0, 3 + #} &\) /@ Range[\(-0.51\)\ , 0.51\ , 0.2];\)\(\ \ \)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(grlist = \ \[IndentingNewLine]\(phase[#, { .2, 1}, 155, \[IndentingNewLine]PlotPoints \[Rule] 100, \[IndentingNewLine]AxesLabel \[Rule] {"\<\[Theta]\>", \ "\<\[Theta]'\>"}, \[IndentingNewLine]PlotStyle \[Rule] {Thickness[ .005], Hue[ .9]}\ \ \[IndentingNewLine]] &\)\ /@ \ list\ ;\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(pt3 = Show[\[IndentingNewLine]grlist, \[IndentingNewLine]Graphics[\ \ \(Point[{2\ \[Pi]\ #, 0}\ ] &\) /@ Range[0, 2]\ ], \[IndentingNewLine]PlotRange \[Rule] All, Ticks \[Rule] {\[Pi]\ Range[0, 4\ ], \ \ \[Pi]\ /4\ Range[0, 4\ ]}, DisplayFunction \[Rule] $DisplayFunction\[IndentingNewLine]];\)\)], \ "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["Part c ", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(Needs["\"]\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(pt4 = PlotVectorField[\[IndentingNewLine]{\ y, \(- .2\) y\ - 1\ \ Sin[x]\ \ \ }, \[IndentingNewLine]{x, 0, \ 5\ \ \[Pi]}, \[IndentingNewLine]{y, \(-1\), \ 5}, \[IndentingNewLine]PlotPoints \[Rule] 20, \[IndentingNewLine]ScaleFunction \[Rule] \(( .4 # &)\), \ \[IndentingNewLine]ScaleFactor \[Rule] None\ , \[IndentingNewLine]DisplayFunction \[Rule] Identity\ \[IndentingNewLine]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Show[\ pt4, pt1, pt3, DisplayFunction \[Rule] $DisplayFunction];\)\)], "Input", Hyphenation->False] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["Problem 3: P", "Subsection"], "eriodic Solutions for the Driven Pendulum " }], "Subsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell["Solution", "Subsubsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ \(Clear["\"]\)], "Input", Hyphenation->False], Cell[CellGroupData[{ Cell["Part a ", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(pt1 = \(anglePend[{\ 0, #\ \ \ \[Pi]\ }, {\ .5\ \ , 1\ , 1, 2/3}, 100\ , 5000\ , \[IndentingNewLine]AxesLabel \[Rule] \ {"\<\[Theta]\>", "\<\[Theta]'\>"}, \[IndentingNewLine]PlotRange \[Rule] All, \[IndentingNewLine]Ticks \[Rule] {\[Pi]\ Range[0, 20\ , 5], \[Pi]\ Range[0, 10\ , 2\ ]}, \ \[IndentingNewLine]PlotStyle \[Rule] Hue[Random[]]\ \[IndentingNewLine]] &\)\ \ /@ \ \ {1/2, 3/2, 2, 3};\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Show[pt1, DisplayFunction \[Rule] $DisplayFunction]\ ;\)\)], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["Part b", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(pt2 = \ \(phasePend[{\ 0, #\ \[Pi]}, {\ .5\ \ , 1\ , 1, 2/3}, 400\ , 5000\ , \ AxesLabel \[Rule] {"\<\[Theta]\>", "\<\[Theta]'\>"}, \ \[IndentingNewLine]PlotRange \[Rule] All, \[IndentingNewLine]Ticks \[Rule] {\[Pi]\ Range[0, 6\ \ \ ], \ Automatic}, PlotPoints \[Rule] 150, \[IndentingNewLine]PlotStyle \[Rule] Hue[Random[]]\ \ \ \[IndentingNewLine]] &\)\ \ /@ \ \ {1/2, 3/2, 2, 3};\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(\(Show[pt2, DisplayFunction \[Rule] $DisplayFunction];\)\(\ \)\)\)], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["Part c", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(pt3 = \ \[IndentingNewLine]\(poincarePend[\[IndentingNewLine]{\ 0, #\ \[Pi]}, {\ .5\ \ , 1\ , 1, 2/3}, 100, \ 400\ , 5000\ , \[IndentingNewLine]PlotRange \[Rule] {{\(-25\), 25}, {\(-3\), 3}}\ , \[IndentingNewLine]DisplayFunction \[Rule] Identity\ \[IndentingNewLine]] &\)\ /@ \ \ {1/2, 3/2, 2, 3};\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Show[\ \[IndentingNewLine]GraphicsArray[Partition[pt3, 2]]\ , \ DisplayFunction \[Rule] $DisplayFunction\[IndentingNewLine]];\)\)], \ "Input", Hyphenation->False], Cell[BoxData[ \(\(Show[\ pt3, \ DisplayFunction \[Rule] $DisplayFunction];\)\)], "Input",\ Hyphenation->False] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["Problem 4: ", "Subsection"], "Looping Solutions for the Driven Pendulum " }], "Subsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ \(Clear["\"]\)], "Input", Hyphenation->False], Cell[CellGroupData[{ Cell["Solution", "Subsubsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell["Part a ", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(\(eq1 = \ \[IndentingNewLine]anglePend[\ {0, 0}\ , {\ 1/2, 1.44\ , 1, 2/3}, 50\ , 10000\ , AxesLabel \[Rule] {"\", "\<\[Theta]\>"}, Ticks \[Rule] {Automatic, \(-\[Pi]\)\ Range[0, 10, 2\ \ ]\ }, \ \[IndentingNewLine]PlotStyle \[Rule] \ {\ \ \ Thickness[ .01]}, \ DisplayFunction \[Rule] $DisplayFunction\ \ \[IndentingNewLine]]\ ;\ \)\(\ \ \)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(eq2 = \ \ \[IndentingNewLine]anglePendR[\ {0, 0}\ \ , {\ 1/2, 1.44, 1, 2/3}, 50, 6000\ , Ticks \[Rule] {\[Pi]\ Range[0, 20\ , \ 5], Range[\(-30\), 0\ , 5\ ]}, \[IndentingNewLine]PlotStyle \[Rule] \ \ Thickness[ \ .01]\ \[IndentingNewLine]]\ ;\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(\(Show[\ \ eq1, eq2, DisplayFunction \[Rule] $DisplayFunction];\)\(\ \)\)\)], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["Part b", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(eq3 = \ \[IndentingNewLine]\ \(#[{0, 0}\ \ , \[IndentingNewLine]{\ 1/2, 1.44\ \ , 1, 2/3}, 100\ , 6000\ , PlotRange \[Rule] All, \[IndentingNewLine]Ticks \[Rule] None, PlotPoints \[Rule] 150, \ \[IndentingNewLine]PlotStyle \[Rule] Hue[Random[]]\[IndentingNewLine]]\ &\)\ /@ \ \ {phasePend, phasePendR}\ ;\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Show[GraphicsArray[eq3]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(\(Show[\ \[IndentingNewLine]eq3[\([2]\)], \ \[IndentingNewLine]PlotRange \[Rule] {{\(-1\), 0\ }, {\(-1\), 1}}, DisplayFunction \[Rule] $DisplayFunction\[IndentingNewLine]];\)\(\ \ \ \)\)\)], "Input", Hyphenation->False], Cell["Part c", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(poincarePend[{0, 0}\ \ , \[IndentingNewLine]{\ 1/2, 1.44\ , 1, 2/3}, 400, 500\ , 6000\ \ ]\ ;\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(poincarePendR[{0, 0}\ , \[IndentingNewLine]{\ 1/2, 1.44\ , 1, 2/3}, 400, 500\ , 6000\ \ ]\ ;\)\)], "Input", Hyphenation->False] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Problem 5: Chaotic motion for the Driven Pendulum ", "Subsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell["Solution", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(Clear["\"]\)], "Input", Hyphenation->False], Cell[CellGroupData[{ Cell[TextData[StyleBox["Part a", FontWeight->"Bold"]], "Subsubsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ \(\(\(eq1 = \(anglePend[\[IndentingNewLine]{\ \[Pi]/2, 0}, \[IndentingNewLine]{\ 0.2, \ #, 1, 0.694}, 50\ , 10000\ , PlotRange \[Rule] All\ \ \[IndentingNewLine]] &\)\ /@ \ \ Range[0, 0.3, 0.1]\ ;\)\(\ \ \ \)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Show[ GraphicsArray[ Partition[eq1, 2]]\ , \[IndentingNewLine]DisplayFunction \[Rule] \ $DisplayFunction];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(eq2 = \ \(phasePend[\[IndentingNewLine]{\ \[Pi]/2, 0}, \[IndentingNewLine]{\ 0.2, #, 1, 0.694}\ , \ \ 600\ , 10000\ , \ \[IndentingNewLine]PlotRange \[Rule] All\ , \[IndentingNewLine]Ticks\ \[Rule] {\[Pi]\ \ Range[\(-1\)/2, 1/2, 1/4], None}, \[IndentingNewLine]PlotPoints \[Rule] 100\ \[IndentingNewLine]] &\)\ /@ \ \ Range[0, 0.3, 0.1];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Show[GraphicsArray[Partition[\ eq2, 2]\ ]\ , DisplayFunction \[Rule] $DisplayFunction];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(eq3 = \(poincarePend[\[IndentingNewLine]{\ \[Pi]/2, 0}, \[IndentingNewLine]{\ 0.2, #, 1, 0.694}\ , \ 500, \ \ 600\ , 10000\ , \[IndentingNewLine]Ticks\ \[Rule] False\ \ , \[IndentingNewLine]PlotRange \[Rule] {{\(-1\)\ , 1}, {\(-1\), 1}}\ , \[IndentingNewLine]DisplayFunction \[Rule] Identity\[IndentingNewLine]] &\)\ \ /@ \ \ Range[0, 0.3, 0.1];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Show[GraphicsArray[Partition[\ eq3, 2]\ ]\ , DisplayFunction \[Rule] $DisplayFunction];\)\)], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell[TextData[StyleBox["Part b ", FontWeight->"Bold"]], "Subsubsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ \(\(\(anglePend[\[IndentingNewLine]{\ \[Pi]/2, 0}, \[IndentingNewLine]{\ 0.2, \ 0.69, 1, 0.694}, 200\ , 10000\ , \[IndentingNewLine]Ticks \[Rule] {Automatic, \[Pi]\ Range[0, 2, 1/2\ ]}\ , \[IndentingNewLine]PlotPoints \[Rule] 150, \[IndentingNewLine]DisplayFunction \[Rule] $DisplayFunction\ \ \[IndentingNewLine]];\)\(\ \)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(phasePend[\[IndentingNewLine]{\ \[Pi]/2, 0}, \[IndentingNewLine]{\ 0.2, \ 0.69, 1, 0.694}, \ \ 700\ , 8000\ , \ \[IndentingNewLine]PlotRange \[Rule] All, \ \[IndentingNewLine]PlotPoints \[Rule] 200, \[IndentingNewLine]DisplayFunction \[Rule] $DisplayFunction\ \[IndentingNewLine]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(poincarePend[\[IndentingNewLine]{\ \[Pi]/2, 0}, \[IndentingNewLine]{\ 0.2, \ 0.69, 1, 0.694}, \ \ 200, 700\ , 10000\ , \[IndentingNewLine]PlotRange \[Rule] {{\(-5\)\ , 10}, {\(-3\), 3}}\ , \ \ \[IndentingNewLine]DisplayFunction \[Rule] \ $DisplayFunction\[IndentingNewLine]];\)\)], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["Part c", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(anglePend[\[IndentingNewLine]{\ \[Pi]/2, 0}, \[IndentingNewLine]{\ 0.2, \ 0.74\ , 1, 0.694}, 300\ , 12000\ , \[IndentingNewLine]AxesLabel \[Rule] {"\", \ "\<\[Theta]\>"}, \[IndentingNewLine]Ticks \[Rule] {Automatic, \[Pi]\ \ Range[\(-5\), 5, 1\ \ ]}\ , \ DisplayFunction \[Rule] $DisplayFunction\ \[IndentingNewLine]]\ \ ;\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(phasePendR[\[IndentingNewLine]{\ \[Pi]/2, 0}, \[IndentingNewLine]{\ 0.2\ , \ 0.83\ , 1, 0.694}, \ \ 300\ , 10000\ , \ \[IndentingNewLine]PlotRange \[Rule] All, \ \[IndentingNewLine]DisplayFunction \[Rule] $DisplayFunction\ \[IndentingNewLine]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(\(\ \)\(poincarePendR[\[IndentingNewLine]{\ \[Pi]/2, 0}, \[IndentingNewLine]{\ 0.2, \ 0.8, 1, 0.694}, 100, \ \ 300\ , 10000\ , \ \[IndentingNewLine]PlotRange \[Rule] All, \ \[IndentingNewLine]DisplayFunction \[Rule] $DisplayFunction\ \[IndentingNewLine]];\)\)\)], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["Part d", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(\(anglePend[\[IndentingNewLine]{\ \[Pi]/2, 0}, \[IndentingNewLine]{\ 0.2, \ 0.982\ , 1, 0.694}, 50\ , 12000\ , \[IndentingNewLine]AxesLabel \[Rule] {"\", \ "\<\[Theta]\>"}, \[IndentingNewLine]Ticks \[Rule] {Automatic, \[Pi]\ \ Range[\(-1\), 1, 1/2\ \ ]}\ , DisplayFunction \[Rule] $DisplayFunction\ \[IndentingNewLine]];\)\(\ \ \)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(\(anglePendR[\[IndentingNewLine]{\ \[Pi]/2, 0}, \[IndentingNewLine]{\ 0.2, \ 0.982\ , 1, 0.694}, 50\ , 12000\ , \[IndentingNewLine]AxesLabel \[Rule] {"\", \ "\<\[Theta]\>"}, \[IndentingNewLine]Ticks \[Rule] {Automatic, \[Pi]\ \ Range[\(-1\), 1, 1/2\ \ ]}\ , DisplayFunction \[Rule] $DisplayFunction\ \ \[IndentingNewLine]]\ ;\)\ \(\ \ \ \)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(phasePend[\[IndentingNewLine]{\ \[Pi]/2, 0}, \[IndentingNewLine]{\ 0.2, \ 1\ , 0.982\ , 0.694}, \ \ 300\ , 12000\ , \[IndentingNewLine]PlotPoints \[Rule] 150, \[IndentingNewLine]DisplayFunction \[Rule] $DisplayFunction\ \[IndentingNewLine]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(pt1 = \ phasePendR[\[IndentingNewLine]{\ \[Pi]/2, 0}, \[IndentingNewLine]{\ 0.2, \ 1\ , 0.982\ , 0.694}, \ \ 300\ , 12000\ , \[IndentingNewLine]PlotPoints \[Rule] 150, \[IndentingNewLine]DisplayFunction \[Rule] $DisplayFunction\ \[IndentingNewLine]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(\(Show[\ \[IndentingNewLine]pt1, \[IndentingNewLine]PlotRange \[Rule] \ {{\ 1, 3\ }, {\(-1\), 1}}, \[IndentingNewLine]DisplayFunction \[Rule] \ $DisplayFunction\[IndentingNewLine]]\ ;\)\(\ \)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(poincarePendR[\[IndentingNewLine]{\ \[Pi]/2, 0}, \[IndentingNewLine]{\ 0.2, \ 1\ , 0.985, 0.694}, 200, 300\ , 12000\ \ , \ \[IndentingNewLine]PlotRange \[Rule] {{\(-3\)\ , 3}, {\(-3\), 3}}\ , \ \[IndentingNewLine]DisplayFunction \[Rule] \ $DisplayFunction\[IndentingNewLine]];\)\)], "Input", Hyphenation->False] }, Closed]] }, Closed]] }, Closed]], Cell["4.2 Duffing Equation ", "Section", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell["Overview of the Duffing Equation", "Subsection", Hyphenation->False], Cell["Initializations for the Duffing Equation", "Subsection", Hyphenation->False], Cell[CellGroupData[{ Cell["\<\ 1. User-defined procedure to plot the Duffing displacement motion\ \ \>", "Subsubsection", Hyphenation->False], Cell[BoxData[ RowBox[{" ", RowBox[{\(dispDuff[{q0_, p0_}, {a_, b_, c_, f0_, wd_}, tmax_, step_, \ opts___]\), ":=", RowBox[{"Module", "[", RowBox[{\({temp}\), ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"temp", "=", "\[IndentingNewLine]", RowBox[{ RowBox[{"NDSolve", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{\(\(p'\)[t] - a\ q[t] + b\ q[t]^3 + c\ \ p[t]\ \[Equal] f0\ \ Cos[t\ wd]\), ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{ SuperscriptBox["q", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], " ", "\[Equal]", \(p[t]\)}], ",", "\[IndentingNewLine]", \(q[0] \[Equal] q0\), ",", "\[IndentingNewLine]", \(p[0] \[Equal] p0\)}], "}"}], ",", "\[IndentingNewLine]", \({p[t], q[t]}\), ",", "\[IndentingNewLine]", \({t, 0, tmax}\), ",", "\[IndentingNewLine]", \(MaxSteps \[Rule] step\)}], " ", "\[IndentingNewLine]", "]"}], "//", "Flatten"}]}], " ", ";", "\[IndentingNewLine]", "\[IndentingNewLine]", \(numgraph = \ \[IndentingNewLine]Plot[\ \ \[IndentingNewLine]q[t] /. temp\ // Evaluate, \[IndentingNewLine]{t, 0, tmax}, \[IndentingNewLine]opts, \ \[IndentingNewLine]DisplayFunction \[Rule] Identity\[IndentingNewLine]]\)}]}], "\[IndentingNewLine]", "\[IndentingNewLine]", "]"}]}]}]], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["2. User-defined procedure to plot the Duffing phase ", "Subsubsection", Hyphenation->False], Cell[BoxData[ RowBox[{\(phaseDuff[{q0_, p0_}, {a_, b_, c_, f0_, \[Omega]d_}, tmax_, step_, \ opts___]\), ":=", RowBox[{"Module", "[", RowBox[{\({temp}\), ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"temp", "=", "\[IndentingNewLine]", RowBox[{ RowBox[{"NDSolve", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{\(\(p'\)[t] - a\ \ q[t] + b\ q[t]^3\ + c\ p[t] \[Equal] f0\ Cos[t\ \[Omega]d]\), " ", ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ SuperscriptBox["q", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], " ", "\[Equal]", \(p[t]\)}], ",", "\[IndentingNewLine]", \(q[0] \[Equal] q0\), ",", "\[IndentingNewLine]", \(p[0] \[Equal] p0\)}], "}"}], ",", "\[IndentingNewLine]", \({p[t], q[t]}\), ",", "\[IndentingNewLine]", \({t, 0, tmax}\), ",", "\[IndentingNewLine]", \(MaxSteps \[Rule] step\)}], " ", "\[IndentingNewLine]", "]"}], "//", "Flatten"}]}], " ", ";", "\[IndentingNewLine]", "\[IndentingNewLine]", \(ParametricPlot[\[IndentingNewLine]{\ q[t]\ , p[t]} /. temp\ // Evaluate, \[IndentingNewLine]{t, 0, tmax}, \[IndentingNewLine]opts, \ \[IndentingNewLine]DisplayFunction \[Rule] Identity]\)}]}], " ", "\[IndentingNewLine]", "\[IndentingNewLine]", "]"}]}]], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["3. User-defined procedure to plot the Duffing Poincar\[EAcute] map", \ "Subsubsection", Hyphenation->False], Cell[BoxData[ RowBox[{\(poincareDuff[{q0_, p0_}, {a_, b_, c_, f0_, \[Omega]d_}, \ start_, tmax_, step_, \ opts___]\), ":=", "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{\({temp1, temp2}\), ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"temp1", "=", "\[IndentingNewLine]", RowBox[{ RowBox[{"NDSolve", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{\(\(p'\)[t] - a\ \ q[t] + b\ q[t]^3 + c\ \ p[t]\ \[Equal] f0\ Cos[t\ \[Omega]d]\), ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ SuperscriptBox["q", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], " ", "\[Equal]", \(p[t]\)}], ",", "\[IndentingNewLine]", \(q[0] \[Equal] q0\), ",", "\[IndentingNewLine]", \(p[0] \[Equal] p0\)}], "}"}], ",", "\[IndentingNewLine]", \({p[t], q[t]}\), ",", "\[IndentingNewLine]", \({t, 0, tmax}\), ",", "\[IndentingNewLine]", \(MaxSteps \[Rule] step\)}], " ", "\[IndentingNewLine]", "]"}], "//", "Flatten"}]}], " ", ";", " ", "\[IndentingNewLine]", "\[IndentingNewLine]", \(temp2 = \ \[IndentingNewLine]Table[\ {\ q[t]\ , p[t]} /. temp1\ \ , \[IndentingNewLine]{t, start, tmax, 2\ \[Pi]/\[Omega]d}\[IndentingNewLine]]\), ";", "\[IndentingNewLine]", "\[IndentingNewLine]", \(ListPlot[temp2, PlotStyle -> PointSize[0.02], opts]\)}]}], "\[IndentingNewLine]", "\[IndentingNewLine]", "]"}]}]], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["4. Protect User-defined procedures", "Subsubsection", Hyphenation->False], Cell["\<\ Protect[dispDuff,phaseDuff,poincareDuff]; Off[Clear::wrsym] \ \>", "Input", Hyphenation->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "Problem 1: Potential and Phase Diagrams for the Duffing Oscillator ", StyleBox[" ", FontColor->RGBColor[0, 1, 0]] }], "Subsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell["Remarks and outline ", "Subsubsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell["Solution", "Subsubsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ \(Clear["\"]\)], "Input", Hyphenation->False], Cell[CellGroupData[{ Cell[TextData[StyleBox["Part a ", FontWeight->"Bold"]], "Subsubsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ RowBox[{ RowBox[{"Acc", "=", RowBox[{ SuperscriptBox["q", "\[DoublePrime]", MultilineFunction->None], "[", "t", "]"}]}], ";"}]], "Input", Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(Flinear = \ a\ q[t];\)\ \), "\[IndentingNewLine]", \(\(Fnonlinear = \(-\ b\)\ q[t]\^3;\)\)}], "Input", Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ \(\(\(\ \)\(eqMotion = \ Acc - Flinear - Fnonlinear == 0\)\)\)], "Input", Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ \(\(\(energy\)\(=\)\(Integrate[\ \(q'\)[t] \((\ Acc - Flinear - Fnonlinear)\)\ , t]\)\(\ \)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(\({T = \ Integrate[\ \(q'\)[t] Acc\ , t], \n V0 = \(-Integrate[\ \(q'\)[t] Flinear, t]\), \n V1 = \(-Integrate[\ \(q'\)[t] Fnonlinear\ , t]\)}\)\(\n\) \(\ \)\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Plot3D[ V0 + V1 //. {q[t] \[Rule] q, b \[Rule] 0.05}\ // Evaluate, \[IndentingNewLine]{q, \(-15\), 15}, \[IndentingNewLine]{a, \(-1\), 4}, \ \[IndentingNewLine]AxesLabel \[Rule] {"\", "\", \ "\"}, \[IndentingNewLine]BoxRatios \[Rule] {1, 1, 1}, \[IndentingNewLine]PlotRange \[Rule] {\(-100\), 50}, \[IndentingNewLine]ViewPoint \[Rule] {0, 3, 1}\[IndentingNewLine]];\)\)], "Input"], Cell[BoxData[ \(Needs["\"]\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(Plot[\(V0 + V1 //. {q[t] \[Rule] q, b \[Rule] 0.05}\) /. \ a \[Rule] {\(-1\), 4}\ // Evaluate, \[IndentingNewLine]{q, \(-15\), 15}, \ \[IndentingNewLine]Ticks -> None, \[IndentingNewLine]PlotStyle -> {\[IndentingNewLine]{Dashing[\ \ {0.01}\ ], Hue[0.6]}, \[IndentingNewLine]{Dashing[\ {0.03}\ ], Hue[0.9]}}, \[IndentingNewLine]PlotLegend -> {"\< a=-1\>", "\< \ a=4\>"}, \ \ \ \ \[IndentingNewLine]LegendPosition -> {0.1, 0.3\ }]\ ;\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part b ", "Subsubsection", Hyphenation->False], Cell[BoxData[ RowBox[{ RowBox[{"values", "=", RowBox[{"{", RowBox[{\(q[t] \[Rule] q\), ",", RowBox[{ RowBox[{ SuperscriptBox["q", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], "\[Rule]", "v"}], ",", \(b \[Rule] 0.05\)}], "}"}]}], ";"}]], "Input", Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ \(\(contour = \ \[IndentingNewLine]\(ContourPlot[\(energy //. values\) //. {\ a \[Rule] \ #\ }\ // Evaluate, \[IndentingNewLine]{q, \(-\ 15\), \ 15}, \[IndentingNewLine]{v, \(-15\), 15}, \[IndentingNewLine]Contours \[Rule] 10\ , \ \[IndentingNewLine]PlotPoints \[Rule] 20, \[IndentingNewLine]ColorFunction \[Rule] Hue, \ \ \ \[IndentingNewLine]DisplayFunction -> Identity\[IndentingNewLine]] &\)\ \ /@ \ \ {\(-1\), 4};\)\)], "Input"], Cell[BoxData[ \(\(Show[GraphicsArray[contour]];\)\)], "Input", Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ \(\(\(pt1 = \ ContourPlot[\(energy //. values\) //. {\ a \[Rule] \ 4\ }\ // Evaluate, \[IndentingNewLine]{q, \(-15\), 15}, \[IndentingNewLine]{v, \(-15\), 15}, \[IndentingNewLine]Contours \[Rule] 10\ , \[IndentingNewLine]DisplayFunction \[Rule] Identity\ \[IndentingNewLine]];\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(pt2 = \ \ Plot3D[\(energy //. values\) //. {\ a \[Rule] \ 4\ \ }\ // Evaluate, \[IndentingNewLine]{q, \(-15\), 15}, \[IndentingNewLine]{v, \(-15\), 15}, \ \ \[IndentingNewLine]PlotPoints \[Rule] 20, \ \[IndentingNewLine]ColorFunction \[Rule] \((If[# < 0.226\ , Hue[0.9], Hue[0.1]] &)\), \[IndentingNewLine]DisplayFunction \[Rule] Identity\[IndentingNewLine]\ ];\)\)], "Input"], Cell[BoxData[ \(\(Show[\ \[IndentingNewLine]pt2, \[IndentingNewLine]Graphics3D[\ \[IndentingNewLine]{AbsoluteThickness[ 3], \[IndentingNewLine]Cases[Graphics[pt1]\ , _Line, Infinity] /. \[IndentingNewLine]{\ q_Real\ , v_} :> {q, v, 15\ - 2\ q\^2 + 1/2\ \ v\^2\ + .0125\ q\^4}}\[IndentingNewLine]], \ \[IndentingNewLine]ViewPoint \[Rule] {0, 1, 0.8}, \[IndentingNewLine]DisplayFunction \[Rule] $DisplayFunction\ \[IndentingNewLine]];\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part c", "Subsubsection", Hyphenation->False], Cell[BoxData[ RowBox[{"eq1", "=", RowBox[{"{", RowBox[{ RowBox[{"eqMotion", "/.", RowBox[{"{", RowBox[{ RowBox[{ SuperscriptBox["q", "\[DoublePrime]", MultilineFunction->None], "[", "t", "]"}], "\[Rule]", RowBox[{ SuperscriptBox["p", "\[Prime]", MultilineFunction->None], "[", "t", "]"}]}], "}"}]}], ",", RowBox[{ RowBox[{ SuperscriptBox["q", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], "==", \(p[t]\)}]}], "}"}]}]], "Input", Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ \(\(initial = {p[0] == 0.001, q[0] == 0};\)\)], "Input", Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ \(\(eq2 = Join[eq1, initial]\ ;\)\)], "Input", Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ \(ndsol1 = \[IndentingNewLine]NDSolve[ eq2 //. {b \[Rule] 0.05, a \[Rule] \(-1\)}, {q[t], p[t]}, {t, 0, 30}] // Flatten\)], "Input", Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(q1[t_] = q[t] //. ndsol1;\)\ \), "\[IndentingNewLine]", \(\(p1[t_] = p[t] //. ndsol1;\)\)}], "Input", Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ \(pt[var_, opts___]\ \ := \ Plot[var[t], {t, 0, 30}, opts, \ DisplayFunction -> Identity]\)], "Input"], Cell[BoxData[ \(\(Show[\[IndentingNewLine]GraphicsArray[\[IndentingNewLine]{pt[q1, PlotStyle -> Hue[0.7]\ ]\ , \[IndentingNewLine]pt[p1, PlotStyle -> Hue[0.9]\ ]\ }\[IndentingNewLine]]\[IndentingNewLine]];\)\)], \ "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Part d", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(ndsol2 = NDSolve[eq2 //. {b \[Rule] 0.05, a \[Rule] \(+4\)}, {q[t], p[t]}, {t, 0, 30}] // Flatten;\)\)], "Input", Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(q2[t_] = q[t] //. ndsol2;\)\ \), "\[IndentingNewLine]", \(\(p2[t_] = p[t] //. ndsol2;\)\)}], "Input", Hyphenation->False, AspectRatioFixed->True], Cell[BoxData[ \(\(Show[ GraphicsArray[\[IndentingNewLine]{pt[q2, PlotStyle -> Hue[ .7]\ ]\ , \[IndentingNewLine]pt[p2, PlotStyle -> Hue[ .9]\ ]\ }\[IndentingNewLine]]\[IndentingNewLine]];\)\)], \ "Input"], Cell[BoxData[ \(\(ParametricPlot[\[IndentingNewLine]{\ q2[t]\ , p2[t]}\ \ \ // Evaluate, \[IndentingNewLine]{t, 0, 30}, \[IndentingNewLine]AxesLabel \[Rule] {"\", "\"}\ , \ \[IndentingNewLine]AspectRatio \[Rule] Automatic\[IndentingNewLine]];\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part e", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(oscMovie[f_, tMax_, frames_, range_: Automatic] := Module[{t, i}, \[IndentingNewLine]Do[\[IndentingNewLine]t = i\ tMax/frames; \[IndentingNewLine]plot[ i] = \[IndentingNewLine]Show[\[IndentingNewLine]Graphics[\ \[IndentingNewLine]{PointSize[0.05], Point[{N[f[t]], 0}]}, \[IndentingNewLine]PlotRange \[Rule] {range, \ {\(-1\), 1}}], \[IndentingNewLine]Axes \[Rule] True\[IndentingNewLine]], \[IndentingNewLine]{i, 1, frames}]\[IndentingNewLine]];\)\)], "Input"], Cell[BoxData[{ \(\(frames = 1;\)\), "\n", \(\(oscMovie[q2, 30, frames, {\(-15\), 15}];\)\)}], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "Problem 2: Phase Diagram and Orbits for the Damped, Duffing Equation \ ", StyleBox[" ", FontColor->RGBColor[0, 1, 0]] }], "Subsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell["Solution", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(Clear["\"]\)], "Input", Hyphenation->False], Cell[CellGroupData[{ Cell["Part a ", "Subsubsection", Hyphenation->False, ImageRegion->{{0, 1}, {0, 1}}], Cell[BoxData[ \(Needs["\"]\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(lista = \[IndentingNewLine]\(PlotVectorField[\ \[IndentingNewLine]{p, \ #\ q - \ .05\ \ q^3 - .15\ \ p\ \ }, \[IndentingNewLine]{q, \(-13\), 13}, \[IndentingNewLine]{p, \(-20\)\ \ , 20\ }\ , \[IndentingNewLine]PlotPoints \[Rule] 10, \[IndentingNewLine]ScaleFunction \[Rule] \(( .2 # &)\), \ \[IndentingNewLine]ScaleFactor \[Rule] None, \[IndentingNewLine]DisplayFunction \[Rule] Identity\ \[IndentingNewLine]] &\)\ \ /@ \ \ {\ 4\ , \(-1\)};\)\)], "Input"], Cell[BoxData[ \(\(pt1 = Show[GraphicsArray[lista]];\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part b ", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(values = {{\(-4\), 4\ }, {4, 4}\ , {4, 23}, {\(-4\), \(-23\)}};\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(\(listb = \[IndentingNewLine]\(dispDuff[\ \[IndentingNewLine]#\ \ , \ \[IndentingNewLine]{4, .05, .1, 0, 0}, 30, 1000\ , \[IndentingNewLine]PlotStyle \[Rule] Hue[Random[]], \[IndentingNewLine]PlotRange \[Rule] All\[IndentingNewLine]] &\)\ \ /@ \ \ values;\)\(\ \)\)\)], \ "Input"], Cell[BoxData[ \(\(Show[\[IndentingNewLine]listb[\([{1, 2}]\)], \[IndentingNewLine]PlotRange \[Rule] {{0, 30}, {\(-14\), 14}}, \[IndentingNewLine]DisplayFunction \[Rule] \ $DisplayFunction\ \[IndentingNewLine]];\)\)], "Input"], Cell[BoxData[ \(\(Show[\[IndentingNewLine]listb[\([{3, 4}]\)], \[IndentingNewLine]PlotRange \[Rule] {{0, 30}, {\(-14\), 14}}, \[IndentingNewLine]DisplayFunction \[Rule] \ $DisplayFunction\ \[IndentingNewLine]];\)\)], "Input"], Cell[BoxData[ \(\(listc = \[IndentingNewLine]\(phaseDuff[\ \[IndentingNewLine]#\ \ , \ \[IndentingNewLine]{4, .05, .1, 0, 0}, 30, 1000\ , \[IndentingNewLine]PlotStyle \[Rule] Hue[ .6], \[IndentingNewLine]PlotRange \[Rule] All\[IndentingNewLine]] &\)\ \ /@ \ \ values;\)\)], "Input"], Cell[BoxData[ \(\(Show[GraphicsArray[Partition[\ listc, 2]], DisplayFunction \[Rule] $DisplayFunction\ ];\)\)], "Input"], Cell[BoxData[ \(\(Show[\[IndentingNewLine]{\ \ listc[\([4]\)]\ , lista[\([1]\)]\ }, \[IndentingNewLine]PlotRange \[Rule] {{\(-15\), 15}, {\(-20\), 20}}, \[IndentingNewLine]DisplayFunction \[Rule] \ $DisplayFunction\[IndentingNewLine]];\)\)], "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Problem 3: Driven Duffing Orbits with No Damping", "Subsection", Hyphenation->False], Cell["Solution", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(Clear["\"]\)], "Input", Hyphenation->False], Cell[CellGroupData[{ Cell["Part a ", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(\(dispDuff[\[IndentingNewLine]{2.038, \(-1.5\)\ }, \ \[IndentingNewLine]{\ \(-1\)\ , 1\ , 0\ , 1/4, 2\ }, 100, 10000\ , \[IndentingNewLine]PlotPoints \[Rule] 200, \[IndentingNewLine]DisplayFunction\ -> $DisplayFunction\ \ \[IndentingNewLine]];\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(pt1 = \ \[IndentingNewLine]phaseDuff[\[IndentingNewLine]{2.038, \ \(-1.5\)\ }, \[IndentingNewLine]{\ \(-1\)\ , 1\ , 0\ , 1/4, 2\ }, 100\ , 10000\ , \[IndentingNewLine]PlotPoints \[Rule] 300, \[IndentingNewLine]DisplayFunction\ -> $DisplayFunction\ \ \[IndentingNewLine]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(\(phaseDuff[\[IndentingNewLine]{2.038, \(-1.5\)\ }, \ \[IndentingNewLine]{\(-1\)\ , 1\ , 0\ , 1/4, 2}, 100, 10000\ , \[IndentingNewLine]PlotPoints \[Rule] 300, \[IndentingNewLine]PlotRange \[Rule] {{1.93, 2.2}, {\(-3\)\ , 3\ }}, \[IndentingNewLine]DisplayFunction \[Rule] \ $DisplayFunction\ \[IndentingNewLine]];\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(\(list = \ \[IndentingNewLine]\(phaseDuff[\[IndentingNewLine]{2.038, \ \(-1.5\)\ }, \[IndentingNewLine]{\ \(-1\)\ , 1\ , 0\ , 1/4, 2\ }, #, 10000\ , \[IndentingNewLine]PlotPoints \[Rule] 300, \[IndentingNewLine]PlotRange \[Rule] {{1.93, 2.2}, {\(-3\)\ , 3\ }}\ \ \[IndentingNewLine]] &\)\ \ /@ \ \ {30, 50};\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(Show[GraphicsArray[\ list\ ]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(pt2 = \ \[IndentingNewLine]poincareDuff[\[IndentingNewLine]{2.038, \ \(-1.5\)\ }, \[IndentingNewLine]{\ \(-1\)\ , 1\ , 0\ , 1/4, 2\ }, 0\ , 300, 10000\ , \[IndentingNewLine]DisplayFunction\ -> $DisplayFunction\ \ \[IndentingNewLine]];\)\)], "Input"], Cell[BoxData[ \(\(Show[pt1, pt2, PlotRange \[Rule] {{1.8, 2.4}, {\(-3\)\ , 3\ }}\ ];\)\)], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["Part b ", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(dispDuff[\[IndentingNewLine]{ .99\ , 0\ }, \[IndentingNewLine]{1/5\ , 1\ , 0\ , 1/4, 2}, 200, 10000\ , \[IndentingNewLine]PlotPoints \[Rule] 200, \[IndentingNewLine]DisplayFunction\ -> $DisplayFunction\ \ \[IndentingNewLine]];\)\)], "Input"], Cell[BoxData[ \(\(pt3 = \ \[IndentingNewLine]phaseDuff[\[IndentingNewLine]{ .99\ \ , 0\ }, \[IndentingNewLine]{\ \ 1/5\ , 1\ , 0\ , 1/4, 2\ }, 300, 10000\ , \[IndentingNewLine]PlotPoints \[Rule] 200, DisplayFunction\ -> $DisplayFunction\ \[IndentingNewLine]];\)\)], \ "Input"], Cell[BoxData[ \(\(pt4 = \ \[IndentingNewLine]poincareDuff[\ \[IndentingNewLine]{ .99\ \ \ , 0\ }, \[IndentingNewLine]{\ \ 1/5\ , 1\ , 0\ , 1/4, 2\ }, 0\ , 350, 10000\ \ , DisplayFunction \[Rule] $DisplayFunction\ \ \[IndentingNewLine]];\)\)], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Problem 4: Two Well Driven Duffing Oscillator with Damping ", \ "Subsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell["Solution", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(Clear["\"]\)], "Input", Hyphenation->False], Cell[CellGroupData[{ Cell["Part a ", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(lista\ = \[IndentingNewLine]\(dispDuff[\[IndentingNewLine]{\ \(- .13\ \), \(- .7\)}, \[IndentingNewLine]{\ .5, .5, .3, #, 1\ }, 50\ , 10000, PlotStyle \[Rule] Hue[Random[]], \[IndentingNewLine]PlotPoints \[Rule] 200\ \ \ \[IndentingNewLine]] &\)\ \ /@ \ \ \ { .05\ \ , \ .24\ };\)\)], "Input"], Cell[BoxData[ \(\(Show[GraphicsArray[Partition[lista, 2]]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(lista = \[IndentingNewLine]\(phaseDuff[\[IndentingNewLine]{\ \(- \ .13\), \(- .7\)}, \[IndentingNewLine]{\ .5, .5, .3, #, 1\ }, 300\ , 10000, \[IndentingNewLine]PlotPoints \[Rule] 200\ \ \ \[IndentingNewLine]] &\)\ \ /@ \ \ { .05\ \ , .24\ \ };\)\)], "Input"], Cell[BoxData[ \(\(Show[GraphicsArray[\ lista\ ]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(listb = \[IndentingNewLine]\(poincareDuff[\[IndentingNewLine]{\ \(- \ .13\), \(- .7\)}, \[IndentingNewLine]{\ .5, .5, .3, #, 1\ }, \ 100, 400\ , 10000, PlotRange \[Rule] {{\(-2\), 2}, {\(-1\), 1}}, \[IndentingNewLine]Ticks \[Rule] False, \ \[IndentingNewLine]DisplayFunction \[Rule] Identity\ \[IndentingNewLine]] &\)\ \ /@ \ \ { .05\ , .24\ \ };\)\)], "Input"], Cell[BoxData[ \(\(Show[GraphicsArray[\ listb]\ \ ];\)\)], "Input", Hyphenation->False] }, Closed]], Cell[CellGroupData[{ Cell["Part b ", "Subsubsection", Hyphenation->False], Cell[BoxData[ \(\(listc\ = \[IndentingNewLine]\(dispDuff[\[IndentingNewLine]{\ \(-0.13\ \), \(-0.7\)}, \[IndentingNewLine]{\ 0.5, 0.5, 0.3, #, 1\ }, 50\ , 10000, PlotStyle \[Rule] Hue[Random[]], \[IndentingNewLine]PlotPoints \[Rule] 200\ \ \ \[IndentingNewLine]] &\)\ \ /@ \ \ {\ 0.29\ , 0.32};\)\)], "Input"], Cell[BoxData[ \(\(Show[GraphicsArray[\ listc\ ]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(listd = \[IndentingNewLine]\(phaseDuff[\[IndentingNewLine]{\ \ \(-0.13\), \(-0.7\)}, \[IndentingNewLine]{\ 0.5, 0.5, 0.3, #, 1\ }, 300\ , 10000, \[IndentingNewLine]PlotPoints \[Rule] 200\ \ \ \[IndentingNewLine]] &\)\ \ /@ \ \ {\ 0.29\ , 0.32};\)\)], "Input"], Cell[BoxData[ \(\(Show[GraphicsArray[\ listd\ ]];\)\)], "Input", Hyphenation->False], Cell[BoxData[ \(\(liste = \[IndentingNewLine]\(poincareDuff[\[IndentingNewLine]{\ \ \(-0.13\), \(-0.7\)}, \[IndentingNewLine]{\ 0.5, 0.5, 0.3, #, 1\ }, \ 100, 400\ , 10000, PlotRange \[Rule] {{\(-2\), 2}, {\(-1\), 1}}, \[IndentingNewLine]Ticks \[Rule] False, \[IndentingNewLine]\ DisplayFunction \[Rule] Identity\ \[IndentingNewLine]] &\)\ \ /@ \ \ {\ 0.29, 0.32};\)\)], "Input"], Cell[BoxData[ \(\(Show[GraphicsArray[\ liste\ ]];\)\)], "Input", Hyphenation->False] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["4.3 Exercises", "Section", Hyphenation->False], Cell[TextData[{ "Exercise 1: van der Pol Oscillator and Limiting Cycles ", StyleBox[" ", FontColor->RGBColor[0, 1, 0]], " (Solved in the Appendix) " }], "Subsubsection", Evaluatable->False, Hyphenation->False, AspectRatioFixed->True], Cell["Exercise 2: Springs ", "Subsubsection", Hyphenation->False], Cell["Exercise 3: Buckling column system", "Subsubsection", Hyphenation->False], Cell[TextData[{ "Exercise 4: ", StyleBox["Nonlinear Equation", FontVariations->{"CompatibilityType"->0}] }], "Subsubsection", Hyphenation->False], Cell["Exercise 5: Inverted Pendulum ", "Subsubsection", Hyphenation->False], Cell[TextData[{ "Exercise 6:", StyleBox[" ", FontWeight->"Plain"], StyleBox["Driven Nonlinear Equation", FontVariations->{"CompatibilityType"->0}] }], "Subsubsection", Hyphenation->False] }, Closed]] }, FrontEndVersion->"4.1 for X", ScreenRectangle->{{0, 1024}, {0, 768}}, AutoGeneratedPackage->None, WindowToolbars->"EditBar", CellGrouping->Manual, WindowSize->{786, 587}, WindowMargins->{{26, Automatic}, {Automatic, 34}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}}, ShowCellLabel->True, ShowCellTags->False, SpellingOptions->{"AlwaysStop"->"RepeatedWords"}, SpellingDictionaries->{"CorrectWords"->{ "descrete", "Poincar\[EAcute]", "Mandelbrot", "xo", "Gfixpt", "Gfixptpt", "Lvalues", "Spoints", "fdata", "rdata", "returnpt", "diff", "Gder", "prob", "Scobweb", "Svalues", "fder", "Lagrange's", "Lagrange", "qi", "Qi", "eq", "eqin", "Ser", "eqs", "vars", "Diff", "zpsol", "zp", "perturbative", "firstorderpert", "xfirst", "ro", "''", "Rx", "Ry", "Rz", "Eq", "Kepler", "Keplerian", "Johannes", "Kepler's", "uo", "ee", "cterm", "plotorbit", "num", "uforce", "ndsol", "ndsol.", "numorbit", "rrule", "Urule", "Lpt", "tmax", "Mgraph", "fx", "fy", "tfinal", "hrule", "vxo", "vyo", "eqlist", "Equi", "Lgraph", "jac", "nonrotating", "accreting", "Lagragian", "rl", "zeropt", "yi", "yrs", "Ll", "freq", "invfreq", "xy", "tmoon", "Descrete", "Poincare", "eigenfrequencies", "eigenfrequency", "eigenmatrix", "Acc", "Flinear", "Fnonlinear", "eqmotion", "var", "fo", "wd", "poincare", "listc", "osc", "ii.", "numgraph", "iii.", "wrsym", "Leq", "Erule", "cylind", "Lpts", "fourierdata", "numsol", "grlist", "phlist", "separatrix.", "fo.", "Pend", "tmax.", "Henri", "Poincar\[EAcute]."}}, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False}, Magnification->1 ] (******************************************************************* 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[1727, 52, 116, 2, 42, "Subsubsection"], Cell[1846, 56, 1886, 33, 657, "Input", Evaluatable->False] }, Closed]], Cell[3747, 92, 119, 3, 81, "Title", Evaluatable->False], Cell[CellGroupData[{ Cell[3891, 99, 53, 1, 60, "Section"], Cell[3947, 102, 154, 3, 43, "Input"] }, Closed]], Cell[4116, 108, 113, 3, 40, "Section", Evaluatable->False], Cell[4232, 113, 78, 1, 45, "Subsection"], Cell[4313, 116, 85, 1, 45, "Subsection"], Cell[CellGroupData[{ Cell[4423, 121, 120, 4, 42, "Subsubsection"], Cell[4546, 127, 1959, 36, 251, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[6542, 168, 107, 2, 28, "Subsubsection"], Cell[6652, 172, 1946, 37, 267, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[8635, 214, 127, 4, 28, "Subsubsection"], Cell[8765, 220, 1939, 36, 219, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[10741, 261, 137, 4, 28, "Subsubsection"], Cell[10881, 267, 151, 3, 27, "Input"], Cell[11035, 272, 172, 4, 24, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[11244, 281, 127, 4, 28, "Subsubsection"], Cell[11374, 287, 1827, 35, 219, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[13238, 327, 125, 4, 28, "Subsubsection"], Cell[13366, 333, 1848, 35, 203, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[15251, 373, 134, 4, 28, "Subsubsection"], Cell[15388, 379, 2037, 37, 267, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[17462, 421, 81, 1, 28, "Subsubsection"], Cell[17546, 424, 159, 5, 42, "Input"], Cell[17708, 431, 116, 5, 42, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[17861, 441, 145, 3, 29, "Subsection", Evaluatable->False], Cell[18009, 446, 101, 2, 42, "Subsubsection"], Cell[CellGroupData[{ Cell[18135, 452, 88, 2, 28, "Subsubsection"], Cell[18226, 456, 76, 2, 27, "Input"], Cell[CellGroupData[{ Cell[18327, 462, 129, 3, 42, "Subsubsection"], Cell[18459, 467, 116, 3, 27, "Input"], Cell[18578, 472, 169, 4, 24, "Input"], Cell[18750, 478, 109, 2, 24, "Input"], Cell[18862, 482, 129, 3, 27, "Input"], Cell[18994, 487, 755, 15, 152, "Input"], Cell[19752, 504, 504, 10, 91, "Input"], Cell[20259, 516, 449, 9, 120, "Input"], Cell[20711, 527, 530, 10, 136, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[21278, 542, 54, 1, 42, "Subsubsection"], Cell[21335, 545, 155, 3, 27, "Input"], Cell[21493, 550, 205, 4, 43, "Input"], Cell[21701, 556, 169, 4, 24, "Input"], Cell[21873, 562, 384, 8, 44, "Input"], Cell[22260, 572, 192, 3, 26, "Input"], Cell[22455, 577, 313, 6, 56, "Input"], Cell[22771, 585, 159, 4, 24, "Input"], Cell[22933, 591, 371, 7, 91, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[23341, 603, 95, 2, 42, "Subsubsection"], Cell[23439, 607, 98, 2, 27, "Input"], Cell[23540, 611, 108, 2, 24, "Input"], Cell[23651, 615, 795, 13, 152, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[24483, 633, 53, 1, 42, "Subsubsection"], Cell[24539, 636, 113, 2, 27, "Input"], Cell[24655, 640, 452, 9, 43, "Input"], Cell[25110, 651, 556, 11, 120, "Input"], Cell[25669, 664, 470, 9, 59, "Input"], Cell[26142, 675, 317, 7, 91, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[26496, 687, 98, 2, 42, "Subsubsection"], Cell[26597, 691, 67, 2, 27, "Input"], Cell[26667, 695, 170, 4, 27, "Input"], Cell[26840, 701, 337, 8, 91, "Input"], Cell[27180, 711, 109, 2, 24, "Input"], Cell[27292, 715, 168, 4, 24, "Input"], Cell[27463, 721, 422, 9, 107, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[27946, 737, 71, 1, 29, "Subsection"], Cell[CellGroupData[{ Cell[28042, 742, 55, 1, 42, "Subsubsection"], Cell[28100, 745, 76, 2, 27, "Input"], Cell[CellGroupData[{ Cell[28201, 751, 80, 2, 42, "Subsubsection"], Cell[28284, 755, 1120, 26, 43, "Input"], Cell[29407, 783, 133, 4, 27, "Input"], Cell[29543, 789, 385, 7, 107, "Input"], Cell[29931, 798, 1948, 38, 264, "Input"], Cell[31882, 838, 678, 11, 139, "Input"], Cell[32563, 851, 125, 3, 27, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[32725, 859, 53, 1, 42, "Subsubsection"], Cell[32781, 862, 552, 9, 139, "Input"], Cell[33336, 873, 1755, 33, 280, "Input"], Cell[35094, 908, 644, 12, 155, "Input"], Cell[35741, 922, 544, 9, 120, "Input"], Cell[36288, 933, 246, 6, 75, "Input"], Cell[36537, 941, 141, 3, 24, "Input"], Cell[36681, 946, 402, 7, 107, "Input"], Cell[37086, 955, 399, 8, 91, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[37522, 968, 54, 1, 42, "Subsubsection"], Cell[37579, 971, 87, 2, 27, "Input"], Cell[37669, 975, 528, 10, 155, "Input"], Cell[38200, 987, 132, 3, 27, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[38393, 997, 192, 6, 29, "Subsection", Evaluatable->False], Cell[CellGroupData[{ Cell[38610, 1007, 103, 3, 42, "Subsubsection", Evaluatable->False], Cell[38716, 1012, 76, 2, 27, "Input"], Cell[CellGroupData[{ Cell[38817, 1018, 56, 1, 42, "Subsubsection"], Cell[38876, 1021, 561, 9, 107, "Input"], Cell[39440, 1032, 113, 2, 27, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[39590, 1039, 53, 1, 42, "Subsubsection"], Cell[39646, 1042, 558, 10, 91, "Input"], Cell[40207, 1054, 130, 3, 27, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[40374, 1062, 53, 1, 42, "Subsubsection"], Cell[40430, 1065, 462, 8, 107, "Input"], Cell[40895, 1075, 195, 4, 59, "Input"], Cell[41093, 1081, 117, 3, 24, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[41271, 1091, 191, 6, 29, "Subsection", Evaluatable->False], Cell[41465, 1099, 76, 2, 27, "Input"], Cell[CellGroupData[{ Cell[41566, 1105, 103, 3, 42, "Subsubsection", Evaluatable->False], Cell[CellGroupData[{ Cell[41694, 1112, 56, 1, 42, "Subsubsection"], Cell[41753, 1115, 458, 8, 75, "Input"], Cell[42214, 1125, 357, 7, 72, "Input"], Cell[42574, 1134, 139, 3, 27, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[42750, 1142, 53, 1, 42, "Subsubsection"], Cell[42806, 1145, 442, 7, 107, "Input"], Cell[43251, 1154, 84, 2, 27, "Input"], Cell[43338, 1158, 252, 5, 72, "Input"], Cell[43593, 1165, 53, 1, 28, "Subsubsection"], Cell[43649, 1168, 161, 3, 43, "Input"], Cell[43813, 1173, 160, 3, 40, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[44034, 1183, 143, 3, 29, "Subsection", Evaluatable->False], Cell[CellGroupData[{ Cell[44202, 1190, 55, 1, 42, "Subsubsection"], Cell[44260, 1193, 76, 2, 27, "Input"], Cell[CellGroupData[{ Cell[44361, 1199, 143, 4, 42, "Subsubsection", Evaluatable->False], Cell[44507, 1205, 326, 6, 75, "Input"], Cell[44836, 1213, 196, 6, 43, "Input"], Cell[45035, 1221, 477, 8, 120, "Input"], Cell[45515, 1231, 155, 3, 27, "Input"], Cell[45673, 1236, 542, 10, 120, "Input"], Cell[46218, 1248, 155, 3, 27, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[46410, 1256, 144, 4, 42, "Subsubsection", Evaluatable->False], Cell[46557, 1262, 426, 7, 123, "Input"], Cell[46986, 1271, 382, 7, 120, "Input"], Cell[47371, 1280, 384, 7, 104, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[47792, 1292, 53, 1, 42, "Subsubsection"], Cell[47848, 1295, 414, 8, 107, "Input"], Cell[48265, 1305, 334, 6, 104, "Input"], Cell[48602, 1313, 347, 6, 104, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[48986, 1324, 53, 1, 42, "Subsubsection"], Cell[49042, 1327, 422, 8, 107, "Input"], Cell[49467, 1337, 431, 8, 104, "Input"], Cell[49901, 1347, 331, 6, 104, "Input"], Cell[50235, 1355, 355, 7, 104, "Input"], Cell[50593, 1364, 265, 5, 88, "Input"], Cell[50861, 1371, 385, 7, 104, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[51285, 1383, 112, 3, 40, "Section", Evaluatable->False], Cell[51400, 1388, 76, 1, 45, "Subsection"], Cell[51479, 1391, 84, 1, 45, "Subsection"], Cell[CellGroupData[{ Cell[51588, 1396, 122, 4, 42, "Subsubsection"], Cell[51713, 1402, 1855, 33, 347, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[53605, 1440, 100, 1, 28, "Subsubsection"], Cell[53708, 1443, 1795, 33, 315, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[55540, 1481, 115, 2, 28, "Subsubsection"], Cell[55658, 1485, 1928, 34, 347, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[57623, 1524, 81, 1, 28, "Subsubsection"], Cell[57707, 1527, 135, 7, 72, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[57879, 1539, 228, 7, 29, "Subsection", Evaluatable->False], Cell[58110, 1548, 115, 3, 42, "Subsubsection", Evaluatable->False], Cell[CellGroupData[{ Cell[58250, 1555, 103, 3, 28, "Subsubsection", Evaluatable->False], Cell[58356, 1560, 76, 2, 27, "Input"], Cell[CellGroupData[{ Cell[58457, 1566, 144, 4, 42, "Subsubsection", Evaluatable->False], Cell[58604, 1572, 240, 7, 27, "Input"], Cell[58847, 1581, 178, 4, 45, "Input"], Cell[59028, 1587, 139, 3, 27, "Input"], Cell[59170, 1592, 159, 3, 27, "Input"], Cell[59332, 1597, 232, 5, 72, "Input"], Cell[59567, 1604, 503, 9, 136, "Input"], Cell[60073, 1615, 84, 2, 24, "Input"], Cell[60160, 1619, 543, 9, 139, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[60740, 1633, 54, 1, 42, "Subsubsection"], Cell[60797, 1636, 407, 11, 27, "Input"], Cell[61207, 1649, 606, 10, 155, "Input"], Cell[61816, 1661, 114, 3, 27, "Input"], Cell[61933, 1666, 392, 7, 104, "Input"], Cell[62328, 1675, 502, 8, 123, "Input"], Cell[62833, 1685, 538, 9, 192, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[63408, 1699, 53, 1, 42, "Subsubsection"], Cell[63464, 1702, 724, 20, 27, "Input"], Cell[64191, 1724, 122, 3, 24, "Input"], Cell[64316, 1729, 112, 3, 27, "Input"], Cell[64431, 1734, 221, 5, 43, "Input"], Cell[64655, 1741, 177, 4, 40, "Input"], Cell[64835, 1747, 137, 3, 27, "Input"], Cell[64975, 1752, 273, 5, 107, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[65297, 1763, 53, 1, 42, "Subsubsection"], Cell[65353, 1766, 207, 5, 27, "Input"], Cell[65563, 1773, 177, 4, 43, "Input"], Cell[65743, 1779, 263, 6, 91, "Input"], Cell[66009, 1787, 303, 5, 104, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[66349, 1797, 53, 1, 42, "Subsubsection"], Cell[66405, 1800, 616, 11, 203, "Input"], Cell[67024, 1813, 111, 2, 43, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[67184, 1821, 234, 8, 29, "Subsection", Evaluatable->False], Cell[CellGroupData[{ Cell[67443, 1833, 55, 1, 42, "Subsubsection"], Cell[67501, 1836, 76, 2, 27, "Input"], Cell[CellGroupData[{ Cell[67602, 1842, 87, 2, 42, "Subsubsection"], Cell[67692, 1846, 87, 2, 27, "Input"], Cell[67782, 1850, 579, 9, 171, "Input"], Cell[68364, 1861, 70, 1, 27, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[68471, 1867, 55, 1, 42, "Subsubsection"], Cell[68529, 1870, 135, 3, 27, "Input"], Cell[68667, 1875, 354, 6, 123, "Input"], Cell[69024, 1883, 274, 5, 91, "Input"], Cell[69301, 1890, 274, 5, 88, "Input"], Cell[69578, 1897, 338, 5, 120, "Input"], Cell[69919, 1904, 133, 2, 27, "Input"], Cell[70055, 1908, 295, 5, 88, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[70411, 1920, 92, 1, 29, "Subsection"], Cell[70506, 1923, 55, 1, 42, "Subsubsection"], Cell[70564, 1926, 76, 2, 27, "Input"], Cell[CellGroupData[{ Cell[70665, 1932, 55, 1, 42, "Subsubsection"], Cell[70723, 1935, 309, 5, 107, "Input"], Cell[71035, 1942, 355, 6, 120, "Input"], Cell[71393, 1950, 393, 6, 120, "Input"], Cell[71789, 1958, 440, 7, 120, "Input"], Cell[72232, 1967, 89, 2, 27, "Input"], Cell[72324, 1971, 283, 4, 104, "Input"], Cell[72610, 1977, 134, 3, 24, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[72781, 1985, 55, 1, 42, "Subsubsection"], Cell[72839, 1988, 295, 5, 107, "Input"], Cell[73137, 1995, 316, 5, 104, "Input"], Cell[73456, 2002, 277, 5, 88, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[73782, 2013, 153, 4, 29, "Subsection", Evaluatable->False], Cell[CellGroupData[{ Cell[73960, 2021, 55, 1, 42, "Subsubsection"], Cell[74018, 2024, 76, 2, 27, "Input"], Cell[CellGroupData[{ Cell[74119, 2030, 54, 1, 42, "Subsubsection"], Cell[74176, 2033, 370, 6, 107, "Input"], Cell[74549, 2041, 100, 2, 27, "Input"], Cell[74652, 2045, 318, 5, 104, "Input"], Cell[74973, 2052, 90, 2, 27, "Input"], Cell[75066, 2056, 458, 7, 120, "Input"], Cell[75527, 2065, 92, 2, 27, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[75656, 2072, 54, 1, 42, "Subsubsection"], Cell[75713, 2075, 377, 6, 107, "Input"], Cell[76093, 2083, 90, 2, 27, "Input"], Cell[76186, 2087, 327, 5, 104, "Input"], Cell[76516, 2094, 90, 2, 27, "Input"], Cell[76609, 2098, 497, 9, 120, "Input"], Cell[77109, 2109, 90, 2, 27, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[77260, 2118, 54, 1, 40, "Section"], Cell[77317, 2121, 251, 8, 42, "Subsubsection", Evaluatable->False], Cell[77571, 2131, 68, 1, 28, "Subsubsection"], Cell[77642, 2134, 81, 1, 28, "Subsubsection"], Cell[77726, 2137, 155, 5, 28, "Subsubsection"], Cell[77884, 2144, 79, 1, 28, "Subsubsection"], Cell[77966, 2147, 203, 7, 28, "Subsubsection"] }, Closed]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)