(************** 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[ 33282, 1071]*) (*NotebookOutlinePosition[ 35610, 1124]*) (* CellTagsIndexPosition[ 35566, 1120]*) (*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["5. Discrete Dynamical Systems ", "Title", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell["Introduction", "Section"], Cell[BoxData[{ \(\(Off[General::spell];\)\ \ \), "\[IndentingNewLine]", \(\(Off[General::spell1];\)\)}], "Input"] }, Closed]], Cell["5.1 Logistic Map", "Section"], Cell["Overview of the Logistic Map", "Subsection"], Cell[CellGroupData[{ Cell["Problem 1: Logistic Map", "Subsection"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ \(Clear["\"]\)], "Input"], Cell[CellGroupData[{ Cell["Part a", "Subsubsection"], Cell[BoxData[ \(\(\(\ \)\(map[\ \[Mu]_]\ := \[Mu]\ # \((1 - #)\) &;\)\)\)], "Input"], Cell[BoxData[ \(\(\({x0, \ \(map[\ \[Mu]]\)[ x0], \(map[\[Mu]]\)[\(map[\ \[Mu]]\)[x0]]}\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(orbit[\[Mu]_, x0_, n_\ ] := NestList[\ \[Mu] # \((1 - #)\) &, x0\ , n\ ]\)], "Input"], Cell[BoxData[ \(orbit[\[Mu]\ , x0\ , 2\ ]\)], "Input"], Cell[BoxData[ \(orbit[2.9\ \ , 0.1, 20\ ]\)], "Input"], Cell[BoxData[ \(\(\(\ \)\(Take[orbit[2.9, 0.1, 300\ ], \(-8\)]\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(\(orbitplot[\[Mu]_, start_, n_\ \ , Opts___]\)\(\ \)\(:=\)\(\ \)\(ListPlot[ NestList[\ \[Mu] # \((1 - #)\) &, start\ , n\ ], \[IndentingNewLine]Opts\ , \[IndentingNewLine]PlotStyle \ \[Rule] {AbsolutePointSize[4], \ RGBColor[1, 0, 0]}\ , GridLines -> Automatic, \ \[IndentingNewLine]Epilog \[Rule] \(ListPlot[ NestList[\[Mu] # \((1 - #)\) &, start, n], \[IndentingNewLine]PlotJoined \[Rule] True\ , \[IndentingNewLine]DisplayFunction \[Rule] Identity\[IndentingNewLine]]\)[\([1]\)]\ \[IndentingNewLine]]\ \)\(\ \ \)\)\)], "Input"], Cell[BoxData[ \(\(orbitplot[2.9\ , 0.1, 50, AxesLabel \[Rule] {n, \ x\_i}\ ];\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part b", "Subsubsection"], Cell[BoxData[ \(\(\(\ \)\(list = orbitplot[3.4, 0.1, 50, \ \[IndentingNewLine]PlotRange \[Rule] {Automatic, {0, 1}}, \ \ \ \[IndentingNewLine]AxesLabel \[Rule] {n, \ x\_i}];\)\)\)], "Input"], Cell[BoxData[ \(\(\(eq1\)\(=\)\(\ \)\(Take[ orbit[3.4, .1, 200\ ], \(-8\)]\)\(\ \ \)\)\)], "Input"], Cell[BoxData[ \(\(\(Union[eq1, SameTest \[Rule] \((Abs[\((\ #2\ - \ #1\ )\)] < 10\^\(-12\) &)\)]\)\(\ \ \ \ \ \)\)\)], "Input"], Cell[BoxData[ \(\(\(\ \)\(list = orbitplot[3.54, .1, 50, \[IndentingNewLine]PlotRange \[Rule] {Automatic, {0, 1}}\ , \ \[IndentingNewLine]AxesLabel \[Rule] {n, \ x\_i}];\)\)\)], "Input"], Cell[BoxData[ \(\(\(eq2\)\(=\)\(\ \)\(Take[ orbit[3.54, 0.1, 200\ ], \(-8\)]\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(Union[eq2, SameTest \[Rule] \((Abs[\((#2 - #1)\)] < 10\^\(-4\) &)\)]\)], "Input"], Cell[BoxData[ \(\(\(\ \)\(list = orbitplot[3.55, .1, 50, \[IndentingNewLine]PlotRange \[Rule] {Automatic, {0, 1}}, \[IndentingNewLine]AxesLabel \[Rule] {n, \ x\_i}];\)\)\)], "Input"], Cell[BoxData[ \(\(\(eq3\)\(=\)\(\ \)\(Take[ orbit[3.55, 0.1, 1000\ ], \(-16\)]\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(Union[eq3, SameTest \[Rule] \((Abs[\((#2 - #1)\)] < 10\^\(-12\) &)\)]\)], "Input"], Cell[BoxData[ \(\(\(\ \)\(list = orbitplot[3.7, .1, 200, PlotRange \[Rule] {Automatic, {0, 1}}];\)\)\)], "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Problem 2: Logistic Fixed Points", "Subsection"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ \(Clear["\"]\)], "Input"], Cell[CellGroupData[{ Cell[TextData[StyleBox["Part a", FontWeight->"Bold"]], "Subsubsection", FontSize->12], Cell[BoxData[ \(period[ 1] = \(\[Mu]\ x0 \((1 - x0)\) \[Equal] x0 // Solve[#, x0] &\)\ \ // Flatten\)], "Input"], Cell[BoxData[ \(Nest[\ \[Mu] # \((1 - #)\) &, x0, 2\ ] \[Equal] x0\)], "Input"], Cell[BoxData[ \(eq1 = \ \(\(Nest[\ \[Mu] # \((1 - #)\) &, x0, 2\ ] == x0 // Solve[#, x0] &\)\ // FullSimplify\)\ // Flatten\)], "Input"], Cell[BoxData[ \(period[2] = Complement[eq1, period[1]]\)], "Input"], Cell[BoxData[ \(\(\(fixedpoint[\[Mu]_, n_, opts___]\)\(\ \)\(:=\)\(\[IndentingNewLine]\)\(Module[{temp1, x0}, \[IndentingNewLine]temp1 = Nest[\ \[Mu] # \((1 - #)\) &, x0, n\ ] \[Equal] x0 // NSolve[#, x0, opts] &\ ; \ \ \ Select[x0 /. temp1, Abs[Im[#]] < 10\^\(-10\)\ &]\ \ \[IndentingNewLine]]\)\(\ \ \)\)\)], "Input"], Cell[BoxData[{ \(\({pt1, pt2, pt3, pt4} = \ \ \(fixedpoint[7/2, #\ ] &\) /@ Range[4] // Rationalize;\)\), "\[IndentingNewLine]", \({pt1, pt2, pt3, pt4} // ColumnForm\ \)}], "Input"], Cell[BoxData[ \(Complement[\ pt2, pt1\ , \ SameTest \[Rule] \((Abs[\((\ #2\ - \ #1\ )\)] < 10\^\(-3\) &)\)]\)], "Input"], Cell[BoxData[ \(\(\(Complement[\ pt4, \ pt2\ , \ SameTest \[Rule] \((Abs[\((\ #2\ - \ #1\ )\)] < 10\^\(-4\) &)\)]\)\(\ \)\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell[TextData[StyleBox["Part b", FontWeight->"Bold"]], "Subsubsection", FontSize->12], Cell[BoxData[ \(\(Plot[{\(7/2 # \((1 - #)\) &\)[x]\ , x}\ , {x, 0, 1}, \[IndentingNewLine]PlotStyle \[Rule] {Thickness[0.01], RGBColor[1, 0, 0]}, \[IndentingNewLine]GridLines \[Rule] Automatic, Epilog \[Rule] {PointSize[0.04], Hue[0.3], Map[Point, Transpose[{\ fixedpoint[7/2, 1], fixedpoint[7/2, 1]}]]}\[IndentingNewLine]];\)\)], "Input"], Cell[BoxData[ \(fixedpointG[\[Mu]_, n_, \ Opts___]\ := Plot[{x, Nest[\ \[Mu]\ # \((1 - #)\) &, x, n\ ]}\ // Evaluate, {x, 0, 1}, \[IndentingNewLine]Opts, \[IndentingNewLine]PlotStyle \[Rule] \ {{Thickness[0.01], \ Hue[Random[]]}, {Hue[Random[]]}}, \ DisplayFunction -> Identity\ , \[IndentingNewLine]Epilog \[Rule] {PointSize[0.04], Hue[0.3], Map[Point, Transpose[{\ fixedpoint[\[Mu], n], fixedpoint[\[Mu], n]}\ ]\ ]}\[IndentingNewLine]]\)], "Input"], Cell[BoxData[ \(\(\(list = \(fixedpointG[7/2, #\ , PlotLabel \[Rule] #] &\)\ \ /@ \ \ Range[4, 1, \(-1\)]\ ;\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(Show[GraphicsArray[Partition[list, 2]]];\)\)], "Input"] }, Closed]], Cell[BoxData[ \(\(Show[\ list\ , DisplayFunction \[Rule] $DisplayFunction];\)\)], "Input"], Cell[CellGroupData[{ Cell[TextData[StyleBox["Part c", FontWeight->"Bold"]], "Subsubsection", FontSize->12], Cell[BoxData[ \(\(list2 = \(fixedpointG[#, 2, \ \[IndentingNewLine]Ticks \[Rule] {{0, 1/2, 1}\ , {0, 1/2, 1}}, \ \[IndentingNewLine]PlotRange \[Rule] {{0, 1}, {0, 1}}, \[IndentingNewLine]PlotLabel \[Rule] #\ ]\ &\)\ \ \ \ /@ \ \ \ {\ 2.5, 3, \ 3.5}\ \ ;\)\)], "Input"], Cell[BoxData[ \(\(\(Show[\ GraphicsArray[{{list2[\([1]\)]}, {list2[\([2]\)]\ , \ list2[\([3]\)]}}\ ]\ , PlotRange \[Rule] All\ ];\)\(\ \)\)\)], "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Problem 3: Logistic Cobwebs. ", "Subsection", Evaluatable->False], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ \(Clear["\"]\)], "Input"], Cell[CellGroupData[{ Cell["Part a", "Subsubsection"], Cell[BoxData[ \(cobweb[f_\ , x0_, n_, \ opts___]\ := \[IndentingNewLine]Module[\ {temp1, temp2, points, s\ , x}, \[IndentingNewLine]temp1[s_]\ := \ Nest[f[#]\ &, x0\ , s\ ]; \ \[IndentingNewLine]temp2\ = \ \ \({temp1[#\ ], temp1[#\ ], temp1[#\ ], temp1[# + 1]} &\) /@ Range[1, n]\ ; \[IndentingNewLine]points = \({x0, 0, x0, f[x0], temp2\ } // Flatten\)\ // Partition[#, 2] &\ \ ; \[IndentingNewLine]Plot[{x, f[x]}, \ {x, 0, 1}, \ Epilog -> {Hue[ .9], Line[points]}, opts]\[IndentingNewLine]]\)], "Input"], Cell[BoxData[ \(\(cobweb[7/2\ # \((1 - #)\) &, \ 5\ /7, 30\ ]\ ;\)\)], "Input"], Cell[BoxData[ \(\(list = \ \(cobweb[7/2\ # \((1 - #)\) &, \ #\ , 10\ , \ DisplayFunction \[Rule] Identity\ ] &\) /@ {\ 3/7, \ 1/2\ };\)\)], "Input"], Cell[BoxData[ \(\(Show[GraphicsArray[\ list\ \ ]];\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part b", "Subsubsection"], Cell[BoxData[ \(\(cobweb[\ \ \ 3.99\ # \((1 - #)\) &, \ 1/2\ , 150\ \ ];\)\)], "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Problem 4: Logistic Bifurcations", "Subsection"], Cell[BoxData[ \(Clear["\"]\)], "Input"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ \(\(Lvalues = Compile[{\[Mu]}, \(({\[Mu], #} &)\)\ /@ \ Drop[NestList[\[Mu]\ # \((1 - #)\) &, .62, 100], \ 75]];\)\)], "Input"], Cell["\<\ bifurcation[\[Mu]0_,\[Mu]1_,n_]:= Flatten[Table[Lvalues[\[Mu]],{\ \[Mu],\[Mu]0,\[Mu]1,(\[Mu]1-\[Mu]0)/n}],1]\ \>", "Input"], Cell[" Spoints = bifurcation[3,3.99,400]; ", "Input"], Cell[BoxData[ \(\(pt1 = \ ListPlot[Spoints\ , GridLines \[Rule] Automatic, \[IndentingNewLine]PlotStyle \[Rule] {Hue[ .9], AbsolutePointSize[ 1.4]}, \[IndentingNewLine]Epilog \[Rule] \ {\[IndentingNewLine]Thickness[ .007], \ \[IndentingNewLine]\(Line[{{#\ , 0}, {\ #\ , 1}}] &\)\ \ /@ \ \ {3.45, 3.54, 3.564\ }}\[IndentingNewLine]]\ ;\)\)], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Problem 5: Logistic Lyapunov Exponent and Entropy ", "Subsection"], Cell[CellGroupData[{ Cell[" Solution", "Subsubsection"], Cell[BoxData[ \(Clear["\"]\)], "Input"], Cell[CellGroupData[{ Cell["Part a ", "Subsubsection"], Cell[BoxData[ \(\(\(f[\[Mu]_]\ := \[Mu]*# \((1 - #)\) &;\)\(\ \ \ \)\)\)], "Input"], Cell[BoxData[ \(\(\(LGder[\[Mu]_]\)\(\ \)\(:=\)\(\ \)\(Log[ Abs[\[Mu]*\ \((1 - 2\ #)\)]] &\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(data = Table[\[IndentingNewLine]{\[Mu], 1/1000\ \ \ \(LGder[\[Mu]\ ]\)[\ NestList[\[Mu]*# \((1 - #)\) &, 0.1, 999]] /. List \[Rule] Plus\ }, \ \ \ {\[Mu], 3.5, 4.0, 0.001}];\)\)], "Input"], Cell[BoxData[ \(\(\(pt1 = ListPlot[ data, \[IndentingNewLine]PlotRange -> {\(-1\)\ , 1}, \[IndentingNewLine]PlotJoined -> True, \[IndentingNewLine]PlotStyle \[Rule] Thickness[ .001], \ \[IndentingNewLine]AxesLabel \[Rule] {\[Mu], \ \[Lambda]}];\)\(\ \)\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part b ", "Subsubsection"], Cell[BoxData[ \(\(\(\ \)\(Entropy[ p_List] := \(-\ \(\(p . Log[p]\)\(\ \)\)\)\)\)\)], "Input"], Cell[BoxData[ \(fdata[\[Mu]_] := Drop[NestList[\[Mu]\ # \((1 - #)\) &\ , .1, 500], 400]\)], "Input"], Cell[BoxData[ \(Needs["\"]\)], "Input"], Cell[BoxData[ \(\(?BinCounts\)\)], "Input"], Cell[BoxData[ \(\(\(prob[\[Mu]_]\)\(:=\)\(Select[ 1/500\ \ BinCounts[fdata[\[Mu]]\ , {0.0, 1, 1/500\ }]\ , Positive]\)\(\ \ \)\)\)], "Input"], Cell[BoxData[ \(\(\(entropylist = Table[{\[Mu], Entropy[prob[\[Mu]]]\ }, {\[Mu], 3.5, 4, 0.005}];\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(\(pt2 = ListPlot[ entropylist, \[IndentingNewLine]PlotJoined \[Rule] True, \[IndentingNewLine]GridLines \[Rule] Automatic, \[IndentingNewLine]PlotStyle \[Rule] Thickness[ .005], \ \[IndentingNewLine]AxesLabel \[Rule] {\[Mu], \ "\"}];\)\(\ \ \)\)\)], "Input"], Cell[BoxData[ \(\(Show[pt1, pt2, \[IndentingNewLine]PlotRange \[Rule] {{3.5, 3.9}, {\(-1.5\), 1.5}}, \[IndentingNewLine]Ticks \[Rule] {Automatic, None}];\)\)], "Input"] }, Closed]] }, Closed]] }, Closed]], Cell["5.2 Other Maps", "Section"], Cell["Overview of Other Maps", "Subsection"], Cell[CellGroupData[{ Cell["Problem 1: Salmon Map ", "Subsection"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ \(Clear["\"]\)], "Input"], Cell[CellGroupData[{ Cell["Part a", "Subsubsection"], Cell[BoxData[ \(map[\[Mu]_] := # Exp[\[Mu] \((1 - #)\)] &\)], "Input"], Cell[BoxData[ \(\(\(orbitG[\[Mu]_, start_, n_\ , Opts___]\)\(:=\)\(ListPlot[ NestList[map[\[Mu]\ ], start\ , n\ ], Opts\ , \ DisplayFunction -> Identity]\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(values = {\ 1.8\ , 2.2\ , 2.6, 2.99};\)\)], "Input"], Cell[BoxData[ \(\(list = \(orbitG[#, .4, 50, \[IndentingNewLine]PlotStyle \[Rule] AbsolutePointSize[2]\ , \[IndentingNewLine]Ticks \[Rule] False\ , \[IndentingNewLine]PlotLabel \[Rule] #\ \ \[IndentingNewLine]] &\)\ \ /@ \ \ values\ ;\)\)], "Input"], Cell[BoxData[ \(\(\(Show[ GraphicsArray\ [\ \ {list[\([{1, 2}]\)], \ list[\([{3, 4}]\)]}\ \ ]];\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(\(\(Take[NestList[map[#], 0.5\ , 200\ ], \(-4\)] &\) /@ {\ 1.8\ , 2.2\ \ , 2.6}\)\(//\)\(ColumnForm\)\(\ \)\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part b", "Subsubsection"], Cell["\<\ Svalues = Compile[{\[Mu]},({\[Mu],#}&) /@ Drop[NestList[ # \ Exp[\[Mu](1 - #)]&, 0.5, 200],175]]; \ \>", "Input"], Cell["\<\ bifurcation[\[Mu]0_, \[Mu]1_, n_] := Flatten[Table[Svalues[\[Mu]],{\[Mu], \[Mu]0, \[Mu]1, (\[Mu]1 - \[Mu]0)/n}], \ 1]\ \>", "Input"], Cell[" Spoints = bifurcation[1.9,3.5,1000]; ", "Input"], Cell[BoxData[ \(\(pt1 = ListPlot[ Spoints, \[IndentingNewLine]GridLines \[Rule] Automatic, \[IndentingNewLine]PlotStyle \[Rule] {Hue[\ .9]\ , AbsolutePointSize[ .5]}\ ]\ ;\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part c ", "Subsubsection"], Cell[BoxData[{ \(\(\(f[\[Mu]_] := #\ Exp[\[Mu] \((1 - #)\)] &;\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(fder[\[Mu]_] := \ Log[Abs[\((1 - \[Mu]\ #)\) Exp[\[Mu] \((1 - #)\)]]] &\ \)}], "Input"], Cell[BoxData[ \(\(\(points[n0_]\ := Table[{\[Mu], Apply[Plus, \(fder[\[Mu]\ ]\)[NestList[f[\[Mu]\ ], 0.1, n0 - 1]]/ n0]}, {\[Mu], 2\ , 3.5, 1/n0}];\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(pt2 = ListPlot[ points[300]\ , \ \[IndentingNewLine]PlotJoined -> True, \[IndentingNewLine]PlotStyle \[Rule] Thickness[ .006]];\)\)], "Input"], Cell[BoxData[ \(\(pt3 = Show[pt1, pt2];\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part d ", "Subsubsection", CellMargins->{{Inherited, Inherited}, {10, 18}}], Cell["Needs[\"Statistics`NormalDistribution`\"]", "Input", CellMargins->{{Inherited, Inherited}, {Inherited, 5}}], Cell[BoxData[ \(\(?NormalDistribution\ \)\)], "Input"], Cell["WNdata=Table[Random[NormalDistribution[1,0.5]], {500}]; ", "Input", CellMargins->{{Inherited, Inherited}, {Inherited, 5}}], Cell["chaos=NestList[map[2.9],0.95,500]; ", "Input"], Cell[BoxData[ \(\(Show[\[IndentingNewLine]GraphicsArray[\[IndentingNewLine]\(ListPlot[#,\ \[IndentingNewLine]PlotStyle \[Rule] AbsolutePointSize[2], \[IndentingNewLine]\ Ticks \[Rule] {{100, 300, 500}, {0, \ 1, 2}}, \ \[IndentingNewLine]DisplayFunction \[Rule] Identity\[IndentingNewLine]] &\)\ /@ \ {WNdata, chaos}\ \[IndentingNewLine]]\[IndentingNewLine]];\)\)], "Input"], Cell[BoxData[ \(\(Show[ GraphicsArray[\(ListPlot[ Transpose[{Drop[#1, \(-1\)], Drop[#1, 1]}], \[IndentingNewLine]PlotRange \[Rule] All, \[IndentingNewLine]AxesOrigin \[Rule] {0, 0}, \[IndentingNewLine]PlotStyle \[Rule] AbsolutePointSize[ 2], \[IndentingNewLine]DisplayFunction \[Rule] Identity\[IndentingNewLine]] &\)\ \ /@ \ {WNdata, chaos}\[IndentingNewLine]]\[IndentingNewLine]];\)\)], "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Problem 2: Sine-Circle Map", "Subsection"], Cell[BoxData[ \(Clear["\"]\)], "Input"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[CellGroupData[{ Cell[TextData[StyleBox["Part a ", FontWeight->"Bold"]], "Subsubsection"], Cell[BoxData[ \(map[\ \[CapitalOmega]_, K_]\ := Mod[\((\ # + \[CapitalOmega] - K/\((2\ \[Pi])\)\ Sin[2\ \[Pi]\ #])\), 1\ ] &\)], "Input"], Cell[BoxData[ \(cobweb[f_\ , \ x0_, n_, \ opts___]\ := \ \[IndentingNewLine]Module[\ {temp1, temp2, points, s\ , x}, \[IndentingNewLine]temp1[s_]\ := \ Nest[f[#]\ &, x0\ , s\ ]; \[IndentingNewLine]temp2\ = \ \ \({temp1[#\ ], temp1[#\ ], temp1[#\ ], temp1[# + 1]} &\) /@ Range[1, n]\ ; \[IndentingNewLine]points = \({x0, 0, x0, f[x0], temp2\ } // Flatten\)\ // Partition[#, 2] &\ \ ; \[IndentingNewLine]Plot[{x, f[x]}, \ {x, 0, 1}, \ Epilog -> {Hue[ .9], Line[points]}, opts]\[IndentingNewLine]]\)], "Input"], Cell[BoxData[ \(\(cobweb[map[1/7, 0], 1/10\ , 50\ ]\ ;\)\)], "Input"], Cell[BoxData[ \(\(\(\ \)\(\(Take[ NestList[map[1/7, 0], 1/10\ , 400]\ \ ]\)\(//\)\(Union\)\(\ \ \)\)\)\)], "Input"], Cell[BoxData[ \(\(\(\ \)\(cobweb[map[Sqrt[2], 0], 1/10\ , 50\ ]\ ;\)\)\)], "Input"], Cell[BoxData[ \(\(list = \ \[IndentingNewLine]\(cobweb[map[#, 0.9]\ , 0.45, 50, \ \[IndentingNewLine]Ticks \[Rule] {{0, .5, 1}, Automatic}, \[IndentingNewLine]PlotLabel \[Rule] #, DisplayFunction \[Rule] Identity\ \[IndentingNewLine]] &\)\ \ /@ \ {0.04, 0.61, 0.65}\ \ ;\)\)], "Input"], Cell[BoxData[ \(\(Show[ GraphicsArray[{{list[\([1]\)]}, list[\([{2, 3}]\)]}]];\)\)], "Input"], Cell[BoxData[ \(\(\(Take[ NestList[map[0.04, 0.9\ ], 0.45\ , 200], \(-9\)\ ]\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(\(Take[ NestList[map[0.65, 0.9\ ], 0.45, 200], \(-9\)\ ]\)\(//\)\(Union\)\(\ \)\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part b ", "Subsubsection"], Cell[BoxData[ StyleBox[\(orbit\ = \ \[IndentingNewLine]Compile[{K}, \ \[IndentingNewLine]Map[{K, #} &, \ \[IndentingNewLine]Drop[\ NestList[\ Mod[\((\ # + .65 - K/\((2\ \[Pi])\)\ Sin[2\ \[Pi]\ #]\ )\)\ , 1\ ] &\ , 0.1, 100], \ 75]\[IndentingNewLine]]\[IndentingNewLine]]\ ;\), FontVariations->{"CompatibilityType"->0}]], "Input"], Cell[BoxData[ StyleBox[\(bifurcation[K0_, K1_, n_]\ := \ Flatten[Table[orbit[K], {K, K0, K1, \((K1 - K0)\)/n}], 1]\), FontVariations->{"CompatibilityType"->0}]], "Input"], Cell["\<\ ListPlot[ bifurcation[0,6,800],PlotStyle -> \ AbsolutePointSize[1.1]]; \ \>", "Input", CellMargins->{{Inherited, Inherited}, {4, 0}}] }, Closed]], Cell[CellGroupData[{ Cell["Part c ", "Subsubsection"], Cell[BoxData[ \(wind[\ \[CapitalOmega]_, K_\ , \[Theta]_] := \[IndentingNewLine]Module[{temp1\ }, \ \[IndentingNewLine]temp1\ = \ NestList[\((\ # + \[CapitalOmega] - K/\((2\ \[Pi])\)\ Sin[2\ \[Pi]\ #]\ )\) &, \[Theta]\ , 699\ ]; \ \[IndentingNewLine]\((1/600\ )\) \((\ Last[\ temp1] - First[temp1])\)\[IndentingNewLine]]\)], "Input"], Cell[BoxData[ \(\(\(pt1 = \ ListPlot[\({#, wind[#, 1.2\ \ , .3]} &\) /@ Range[ .25\ , .75, .008], \[IndentingNewLine]PlotJoined \[Rule] True, \[IndentingNewLine]PlotStyle \[Rule] {Thickness[ .006], Hue[ .6]}, \[IndentingNewLine]GridLines \[Rule] Automatic\ , \[IndentingNewLine]AspectRatio \[Rule] 1\ ];\)\(\ \)\)\)], "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Problem 3: Taylor-Greene-Chirikov map ", "Subsection", ImageRegion->{{0, 1}, {0, 1}}], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ \(Clear["\"]\)], "Input"], Cell[CellGroupData[{ Cell["Part a", "Subsubsection"], Cell[BoxData[ \(\(\(map[k_]\)[{\[Theta]_, i_}] = {\ Mod[\[Theta] + i + k\ \ Sin[\[Theta]], 2\ \[Pi]], Mod[i + k\ Sin[\[Theta]], 2\ \[Pi]]};\)\)], "Input"], Cell[BoxData[ \(orbit[\[Theta]0_, i0_] := NestList[map[0.97\ \ ], {\[Theta]0, i0}, 150]\)], "Input"], Cell[BoxData[ \(orbitG[\[Theta]0_, i0_, Opts___]\ := \ \[IndentingNewLine]ListPlot[\ orbit[\ \[Theta]0, i0\ ]\ , \[IndentingNewLine]Opts\ , Frame \[Rule] True, Axes \[Rule] None, FrameLabel \[Rule] {"\<\[Theta]\>", "\"}\ , \ \[IndentingNewLine]PlotStyle \[Rule] {Hue[Random[]], PointSize[ .009\ ]}\ , \[IndentingNewLine]DisplayFunction \[Rule] Identity\[IndentingNewLine]]\)], "Input"], Cell[BoxData[ \(\(\(Show[\ \(orbitG[Random[Real, {0, 2\ \[Pi]}], Random[Real, {0, 2\ \[Pi]}]] &\) /@ Range[60\ ], \[IndentingNewLine]DisplayFunction \[Rule] \ $DisplayFunction, \[IndentingNewLine]GridLines \[Rule] Automatic, \[IndentingNewLine]AspectRatio \[Rule] Automatic];\)\(\ \)\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part b", "Subsubsection"], Cell[BoxData[ \(Ch\[Theta][{\[Theta]0_, i0_}] := Map[First, orbit[\[Theta]0, i0]]\)], "Input"], Cell[BoxData[ \(\(\(pt1 = \(ListPlot[ Take[Ch\[Theta][#\ ], \(-40\)]\ , \[IndentingNewLine]PlotJoined \ \[Rule] True, \[IndentingNewLine]AxesLabel \[Rule] {\ n, \[Theta]\ }, \[IndentingNewLine]DisplayFunction \[Rule] Identity\[IndentingNewLine]] &\)\ \ /@ \ \ {{\ 3, \ 0.1\ }, {0.65, 3}}\ ;\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(Show[GraphicsArray[{pt1\ }]];\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part c ", "Subsubsection"], Cell[BoxData[ \(wind[\ \ K_\ , \[Theta]_, i_] := \ \[IndentingNewLine]Module[{map1, orbit2, wind3, \ \[Theta]a, pb}, \[IndentingNewLine]map1[{\[Theta]a_, pb_}] := {\ \[Theta]a + pb + K\ \ Sin[\ \[Theta]a], pb + K\ \ Sin[\ \[Theta]a]}\ ; \[IndentingNewLine]orbit2 = NestList[map1, {\[Theta]\ , i\ }, 400\ \ ]\ ; \[IndentingNewLine]wind3 = \ Map[First, orbit2]\ \ ; \ \[IndentingNewLine]\((1/400\ )\) \((\ Last[\ wind3] - First[wind3])\)\[IndentingNewLine]]\)], "Input"], Cell[BoxData[ \(\(ListPlot[\({#, wind[\ 0.45\ \ , 0.2\ , #]} &\) /@ Range[0.15, 0.24, 0.005], \[IndentingNewLine]PlotJoined \[Rule] True, \[IndentingNewLine]PlotStyle \[Rule] {Thickness[0.005], Hue[0.6]}, \[IndentingNewLine]PlotLabel \[Rule] {"\"}, \[IndentingNewLine]AxesLabel\ \[Rule] {i, None\ }];\)\)], "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Problem 4: Henon Map ", "Subsection"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ \(Clear["\"]\)], "Input"], Cell[CellGroupData[{ Cell["Part a", "Subsubsection"], Cell[BoxData[ \(\(\(\(map[a_, b_]\)[{x_, y_}]\)\(:=\)\({1 - a\ x\^2 + y\ , b\ x\ \ }\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(pt1 = \[IndentingNewLine]ListPlot[\ \[IndentingNewLine]NestList[ map[1.4, \ 0.3], {\ 0\ , 0.1}, 20000\ ], \[IndentingNewLine]PlotStyle \[Rule] AbsolutePointSize[2], \ \[IndentingNewLine]GridLines \[Rule] Automatic\ ];\)\)], "Input"], Cell[BoxData[ \(\(Show[pt1, PlotRange \[Rule] {{0.3, 0.47}, {0.2, 0.217}}, GridLines \[Rule] Automatic];\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part b ", "Subsubsection"], Cell[BoxData[ \(\(\(Hx[a_]\)\(\ \)\(:=\)\(\ \ \ \)\(Map[First, Drop[\ NestList[\ \ map[a, 0.3\ ]\ , {0.3, 0.6}, 200], 150]\ ]\)\(\ \ \)\)\)], "Input"], Cell[BoxData[ StyleBox[\(bifurcation[a0_, a1_, n_]\ := \ Flatten[Table[Hx[a], {a, a0, a1, \((a1 - a0)\)/n}], \ 1]\), FontVariations->{"CompatibilityType"->0}]], "Input"], Cell[BoxData[ \(\(\(pts = bifurcation[1.05\ , 1.1, 300\ ]\ ;\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(\(ListPlot[ pts, \[IndentingNewLine]PlotStyle \[Rule] AbsolutePointSize[1.4], \[IndentingNewLine]AspectRatio \[Rule] 1, \[IndentingNewLine]Ticks \[Rule] \ {{}, Automatic\ }];\)\)], "Input"] }, Closed]] }, Closed]] }, Closed]], Cell["5.3 Fractals", "Section"], Cell["Overview of Fractals", "Subsubsection"], Cell[CellGroupData[{ Cell["Problem 1: Mandelbrot Set ", "Subsection"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ \(Clear["\"]\)], "Input"], Cell[CellGroupData[{ Cell["Part a ", "Subsubsection"], Cell[BoxData[ \(\(MandO = Compile[{{c, _Complex}}, \ FixedPointList[#^2 + c &, 0, 69, SameTest -> \((Abs[#2] > 2.0 &)\)]]\ ;\)\)], "Input"], Cell[BoxData[ \(Take[MandO[1/10], \(-1\)] // Chop\)], "Input"], Cell[BoxData[ \(\(\(\ \)\(MandO[\ 1\ ] // Chop\)\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part b", "Subsubsection"], Cell[BoxData[ \(Mandelbrot[c_] := Length[MandO[c]]\)], "Input"], Cell[BoxData[ \(\(Plot3D[ Mandelbrot[x + I\ y], \[IndentingNewLine]{x, \(-2.0\), 0.5}, {y, \(-1.1\), 1.1}, \ \[IndentingNewLine]AspectRatio -> Automatic, \ \[IndentingNewLine]ColorFunction -> Hue, \ \ \[IndentingNewLine]PlotRange \[Rule] All\ , \[IndentingNewLine]PlotPoints \[Rule] 100];\)\)], "Input"], Cell[BoxData[ \(\(DensityPlot[\ Mandelbrot[ x + I\ y], \[IndentingNewLine]{x, \(-2\), .5}\ , {y, \(-1\), 1}, \ \[IndentingNewLine]Mesh -> False, \ \ \[IndentingNewLine]AspectRatio -> Automatic, \[IndentingNewLine]Frame \[Rule] True, \[IndentingNewLine]ColorFunction -> Hue, \[IndentingNewLine]PlotPoints \[Rule] 100\ ];\)\)], "Input"], Cell[BoxData[ \(\(\(DensityPlot[ Mandelbrot[ x + I\ y], \[IndentingNewLine]{x, \(-1.45\), \(-1.25\)}, {y, \ \(-0.12\), 0.12}\ , \ \[IndentingNewLine]Mesh -> False, \ \ \[IndentingNewLine]AspectRatio -> Automatic, \[IndentingNewLine]Frame \[Rule] True, \[IndentingNewLine]ColorFunction -> Hue, \[IndentingNewLine]PlotPoints \[Rule] 100];\)\(\ \)\)\)], "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Problem 2: Julia Set", "Subsection"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ \(Clear["\"]\)], "Input"], Cell[CellGroupData[{ Cell["Part a", "Subsubsection"], Cell[BoxData[ \(\(Juliao = Compile[{{z0, _Complex}}, \ FixedPointList[#^2 + c &, z0, 50, SameTest -> \((Abs[#2] > 2.0 &)\)]]\ ;\)\)], "Input"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(c = \(-1\);\)\ \), "\[IndentingNewLine]", \(Juliao[0.1\ ] // Chop\ \)}], "Input"], Cell[BoxData[ \(Juliao[1.9\ ] // Chop\)], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Part b", "Subsubsection"], Cell[BoxData[ \(\(Julia = Compile[{{z0, _Complex}}, Length[FixedPointList[#^2 + c &, z0, 50, SameTest -> \((Abs[#2] > 2.0 &)\)]]];\)\)], "Input"], Cell[BoxData[{ \(\(c = \ \(-1\);\)\[IndentingNewLine]\), "\[IndentingNewLine]", \(\(Plot3D[ Julia[x + I\ y], \[IndentingNewLine]{x, \(-2.0\), 2}, {y, \(-1\)\ , 1\ }, \[IndentingNewLine]AspectRatio -> Automatic, \ \[IndentingNewLine]ColorFunction -> Hue\ , \[IndentingNewLine]PlotPoints \[Rule] 100, \ \[IndentingNewLine]PlotRange \[Rule] All\ ];\)\)}], "Input"], Cell[BoxData[ \(\(DensityPlot[ Julia[x + I\ y], \[IndentingNewLine]{x, \(-2\), 2}, {y, \(-1\)\ , 1\ }, \ \ \[IndentingNewLine]Mesh -> False, \ \ \[IndentingNewLine]AspectRatio -> Automatic, \[IndentingNewLine]Frame \[Rule] True, \[IndentingNewLine]PlotPoints \[Rule] 100, \[IndentingNewLine]ColorFunction -> Hue\ ];\)\)], "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["5.4 Exercises", "Section"], Cell["Exercise 1: Gaussian Map ", "Subsubsection"], Cell["Problem 2: Return Maps for the Henon Map ", "Subsubsection"], Cell["Exercise 3: Cubic Maps", "Subsubsection"], Cell["Exercise 4: Two Dimensional Map ", "Subsubsection"], Cell["Exercise 5: Tent map", "Subsubsection"] }, Closed]] }, FrontEndVersion->"4.1 for X", ScreenRectangle->{{0, 1024}, {0, 768}}, AutoGeneratedPackage->None, WindowToolbars->"EditBar", CellGrouping->Manual, WindowSize->{842, 688}, WindowMargins->{{0, Automatic}, {Automatic, 0}}, PrintingCopies->1, PrintingPageRange->{1, 9999}, 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", "th", "ii.", "iii.", "Ndata", "Gcobweb", "fd", "quasiperiodic.", "nonchaotic", "Greene", "Chirikov", "Ch", "Chplot", "pb", "Henon", "Henon.", "Hx", "pts", "zo", "Mand", "Juliao", "bdry", "traj", "Lstepsa", "Lsteps", "Osteps", "xf", "yf", "sqdist", "meansqdist", "nstep", "ntrial", "datao", "xo.", "endata", "expr", "superstable", "xmin", "xmax", "ymin", "ymax", "dy", "orbitplot"}}, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False}, Magnification->1, StyleDefinitions -> "Default.nb" ] (******************************************************************* 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, 96, 2, 81, "Title", Evaluatable->False], Cell[CellGroupData[{ Cell[3868, 98, 31, 0, 60, "Section"], Cell[3902, 100, 122, 2, 43, "Input"] }, Closed]], Cell[4039, 105, 35, 0, 40, "Section"], Cell[4077, 107, 50, 0, 45, "Subsection"], Cell[CellGroupData[{ Cell[4152, 111, 45, 0, 45, "Subsection"], Cell[CellGroupData[{ Cell[4222, 115, 33, 0, 42, "Subsubsection"], Cell[4258, 117, 54, 1, 27, "Input"], Cell[CellGroupData[{ Cell[4337, 122, 31, 0, 42, "Subsubsection"], Cell[4371, 124, 89, 1, 27, "Input"], Cell[4463, 127, 122, 2, 27, "Input"], Cell[4588, 131, 113, 2, 24, "Input"], Cell[4704, 135, 58, 1, 27, "Input"], Cell[4765, 138, 58, 1, 24, "Input"], Cell[4826, 141, 89, 1, 24, "Input"], Cell[4918, 144, 667, 12, 136, "Input"], Cell[5588, 158, 105, 2, 27, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[5730, 165, 31, 0, 42, "Subsubsection"], Cell[5764, 167, 246, 5, 59, "Input"], Cell[6013, 174, 112, 2, 24, "Input"], Cell[6128, 178, 154, 3, 28, "Input"], Cell[6285, 183, 243, 5, 56, "Input"], Cell[6531, 190, 111, 2, 24, "Input"], Cell[6645, 194, 108, 2, 28, "Input"], Cell[6756, 198, 239, 5, 56, "Input"], Cell[6998, 205, 113, 2, 24, "Input"], Cell[7114, 209, 109, 2, 28, "Input"], Cell[7226, 213, 138, 3, 24, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[7425, 223, 54, 0, 29, "Subsection"], Cell[CellGroupData[{ Cell[7504, 227, 33, 0, 42, "Subsubsection"], Cell[7540, 229, 54, 1, 27, "Input"], Cell[CellGroupData[{ Cell[7619, 234, 89, 2, 42, "Subsubsection"], Cell[7711, 238, 134, 3, 27, "Input"], Cell[7848, 243, 84, 1, 24, "Input"], Cell[7935, 246, 156, 2, 24, "Input"], Cell[8094, 250, 71, 1, 24, "Input"], Cell[8168, 253, 395, 7, 82, "Input"], Cell[8566, 262, 201, 3, 43, "Input"], Cell[8770, 267, 147, 3, 28, "Input"], Cell[8920, 272, 163, 3, 28, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[9120, 280, 89, 2, 42, "Subsubsection"], Cell[9212, 284, 435, 8, 75, "Input"], Cell[9650, 294, 554, 10, 88, "Input"], Cell[10207, 306, 164, 3, 27, "Input"], Cell[10374, 311, 77, 1, 27, "Input"] }, Closed]], Cell[10466, 315, 103, 2, 27, "Input"], Cell[CellGroupData[{ Cell[10594, 321, 89, 2, 28, "Subsubsection"], Cell[10686, 325, 331, 5, 75, "Input"], Cell[11020, 332, 189, 4, 27, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[11270, 343, 73, 1, 29, "Subsection", Evaluatable->False], Cell[CellGroupData[{ Cell[11368, 348, 33, 0, 42, "Subsubsection"], Cell[11404, 350, 54, 1, 27, "Input"], Cell[CellGroupData[{ Cell[11483, 355, 31, 0, 42, "Subsubsection"], Cell[11517, 357, 657, 12, 123, "Input"], Cell[12177, 371, 83, 1, 27, "Input"], Cell[12263, 374, 180, 3, 24, "Input"], Cell[12446, 379, 69, 1, 27, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[12552, 385, 31, 0, 42, "Subsubsection"], Cell[12586, 387, 91, 1, 27, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[12738, 395, 54, 0, 29, "Subsection"], Cell[12795, 397, 54, 1, 27, "Input"], Cell[CellGroupData[{ Cell[12874, 402, 33, 0, 42, "Subsubsection"], Cell[12910, 404, 184, 4, 27, "Input"], Cell[13097, 410, 133, 3, 27, "Input"], Cell[13233, 415, 53, 0, 27, "Input"], Cell[13289, 417, 462, 9, 107, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[13800, 432, 73, 0, 29, "Subsection"], Cell[CellGroupData[{ Cell[13898, 436, 35, 0, 42, "Subsubsection"], Cell[13936, 438, 54, 1, 27, "Input"], Cell[CellGroupData[{ Cell[14015, 443, 33, 0, 42, "Subsubsection"], Cell[14051, 445, 88, 1, 27, "Input"], Cell[14142, 448, 127, 2, 27, "Input"], Cell[14272, 452, 279, 6, 43, "Input"], Cell[14554, 460, 331, 7, 91, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[14922, 472, 33, 0, 42, "Subsubsection"], Cell[14958, 474, 106, 2, 27, "Input"], Cell[15067, 478, 112, 2, 27, "Input"], Cell[15182, 482, 74, 1, 27, "Input"], Cell[15259, 485, 47, 1, 27, "Input"], Cell[15309, 488, 162, 3, 24, "Input"], Cell[15474, 493, 146, 3, 27, "Input"], Cell[15623, 498, 348, 7, 91, "Input"], Cell[15974, 507, 209, 4, 56, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[16222, 516, 33, 0, 40, "Section"], Cell[16258, 518, 44, 0, 45, "Subsection"], Cell[CellGroupData[{ Cell[16327, 522, 45, 0, 45, "Subsection"], Cell[CellGroupData[{ Cell[16397, 526, 33, 0, 42, "Subsubsection"], Cell[16433, 528, 54, 1, 27, "Input"], Cell[CellGroupData[{ Cell[16512, 533, 31, 0, 42, "Subsubsection"], Cell[16546, 535, 75, 1, 27, "Input"], Cell[16624, 538, 197, 3, 27, "Input"], Cell[16824, 543, 74, 1, 27, "Input"], Cell[16901, 546, 304, 5, 91, "Input"], Cell[17208, 553, 143, 3, 27, "Input"], Cell[17354, 558, 155, 2, 24, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[17546, 565, 31, 0, 42, "Subsubsection"], Cell[17580, 567, 124, 4, 42, "Input"], Cell[17707, 573, 145, 4, 42, "Input"], Cell[17855, 579, 56, 0, 27, "Input"], Cell[17914, 581, 238, 5, 59, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[18189, 591, 33, 0, 42, "Subsubsection"], Cell[18225, 593, 226, 4, 59, "Input"], Cell[18454, 599, 213, 4, 27, "Input"], Cell[18670, 605, 209, 5, 59, "Input"], Cell[18882, 612, 58, 1, 24, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[18977, 618, 85, 1, 44, "Subsubsection"], Cell[19065, 621, 115, 1, 25, "Input"], Cell[19183, 624, 58, 1, 27, "Input"], Cell[19244, 627, 130, 1, 24, "Input"], Cell[19377, 630, 52, 0, 27, "Input"], Cell[19432, 632, 472, 7, 155, "Input"], Cell[19907, 641, 560, 10, 136, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[20528, 658, 48, 0, 29, "Subsection"], Cell[20579, 660, 54, 1, 27, "Input"], Cell[CellGroupData[{ Cell[20658, 665, 33, 0, 42, "Subsubsection"], Cell[CellGroupData[{ Cell[20716, 669, 75, 1, 42, "Subsubsection"], Cell[20794, 672, 160, 3, 27, "Input"], Cell[20957, 677, 659, 12, 123, "Input"], Cell[21619, 691, 73, 1, 27, "Input"], Cell[21695, 694, 138, 3, 24, "Input"], Cell[21836, 699, 87, 1, 24, "Input"], Cell[21926, 702, 370, 6, 88, "Input"], Cell[22299, 710, 105, 2, 27, "Input"], Cell[22407, 714, 109, 2, 24, "Input"], Cell[22519, 718, 135, 3, 24, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[22691, 726, 33, 0, 42, "Subsubsection"], Cell[22727, 728, 444, 8, 107, "Input"], Cell[23174, 738, 190, 3, 27, "Input"], Cell[23367, 743, 145, 4, 19, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[23549, 752, 32, 0, 42, "Subsubsection"], Cell[23584, 754, 403, 7, 91, "Input"], Cell[23990, 763, 409, 7, 91, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[24460, 777, 93, 1, 29, "Subsection"], Cell[CellGroupData[{ Cell[24578, 782, 33, 0, 42, "Subsubsection"], Cell[24614, 784, 54, 1, 27, "Input"], Cell[CellGroupData[{ Cell[24693, 789, 31, 0, 42, "Subsubsection"], Cell[24727, 791, 180, 3, 27, "Input"], Cell[24910, 796, 111, 2, 27, "Input"], Cell[25024, 800, 445, 7, 107, "Input"], Cell[25472, 809, 350, 6, 75, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[25859, 820, 31, 0, 42, "Subsubsection"], Cell[25893, 822, 105, 2, 27, "Input"], Cell[26001, 826, 383, 6, 91, "Input"], Cell[26387, 834, 66, 1, 27, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[26490, 840, 32, 0, 42, "Subsubsection"], Cell[26525, 842, 568, 9, 123, "Input"], Cell[27096, 853, 392, 6, 91, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[27549, 866, 43, 0, 29, "Subsection"], Cell[CellGroupData[{ Cell[27617, 870, 33, 0, 42, "Subsubsection"], Cell[27653, 872, 54, 1, 27, "Input"], Cell[CellGroupData[{ Cell[27732, 877, 31, 0, 42, "Subsubsection"], Cell[27766, 879, 120, 2, 31, "Input"], Cell[27889, 883, 305, 5, 91, "Input"], Cell[28197, 890, 132, 2, 24, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[28366, 897, 33, 0, 42, "Subsubsection"], Cell[28402, 899, 174, 3, 27, "Input"], Cell[28579, 904, 189, 3, 27, "Input"], Cell[28771, 909, 87, 1, 27, "Input"], Cell[28861, 912, 252, 5, 75, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[29152, 922, 31, 0, 40, "Section"], Cell[29186, 924, 45, 0, 42, "Subsubsection"], Cell[CellGroupData[{ Cell[29256, 928, 49, 0, 45, "Subsection"], Cell[CellGroupData[{ Cell[29330, 932, 33, 0, 42, "Subsubsection"], Cell[29366, 934, 54, 1, 27, "Input"], Cell[CellGroupData[{ Cell[29445, 939, 33, 0, 42, "Subsubsection"], Cell[29481, 941, 176, 4, 27, "Input"], Cell[29660, 947, 66, 1, 27, "Input"], Cell[29729, 950, 67, 1, 24, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[29833, 956, 31, 0, 42, "Subsubsection"], Cell[29867, 958, 67, 1, 27, "Input"], Cell[29937, 961, 359, 6, 107, "Input"], Cell[30299, 969, 413, 8, 120, "Input"], Cell[30715, 979, 436, 9, 120, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[31212, 995, 43, 0, 29, "Subsection"], Cell[CellGroupData[{ Cell[31280, 999, 33, 0, 42, "Subsubsection"], Cell[31316, 1001, 54, 1, 27, "Input"], Cell[CellGroupData[{ Cell[31395, 1006, 31, 0, 42, "Subsubsection"], Cell[31429, 1008, 179, 4, 27, "Input"], Cell[CellGroupData[{ Cell[31633, 1016, 109, 2, 43, "Input"], Cell[31745, 1020, 54, 1, 27, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[31848, 1027, 31, 0, 42, "Subsubsection"], Cell[31882, 1029, 184, 4, 27, "Input"], Cell[32069, 1035, 422, 7, 139, "Input"], Cell[32494, 1044, 397, 7, 123, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[32952, 1058, 32, 0, 40, "Section"], Cell[32987, 1060, 51, 0, 42, "Subsubsection"], Cell[33041, 1062, 66, 0, 28, "Subsubsection"], Cell[33110, 1064, 47, 0, 28, "Subsubsection"], Cell[33160, 1066, 57, 0, 28, "Subsubsection"], Cell[33220, 1068, 46, 0, 28, "Subsubsection"] }, Closed]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)