(* Content-type: application/mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 6.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 145, 7] NotebookDataLength[ 36054, 1077] NotebookOptionsPosition[ 31914, 937] NotebookOutlinePosition[ 32324, 955] CellTagsIndexPosition[ 32281, 952] WindowFrame->Normal ContainsDynamic->False*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Sine Map", "Title"], Cell["\<\ Here we consist a map which is similar to the logistic map, but the \ mathematical function is different. Rather than f(x) = 4 \[Lambda] x (1 - x) \ we take\ \>", "Text", CellChangeTimes->{3.482971092002324*^9}], Cell[BoxData[ RowBox[{ RowBox[{"f", RowBox[{"(", "x", ")"}]}], " ", "=", " ", RowBox[{"\[Lambda]", " ", "sin", " ", RowBox[{"(", RowBox[{"\[Pi]", " ", "x"}], ")"}]}]}]], "DisplayFormula", CellChangeTimes->{{3.452350690152471*^9, 3.452350695576173*^9}}], Cell[BoxData[ RowBox[{"Clear", "[", "\"\\"", "]"}]], "Input", CellChangeTimes->{3.420506414679352*^9}], Cell[BoxData[ RowBox[{ RowBox[{"f", "[", "x_", "]"}], " ", ":=", " ", RowBox[{"\[Lambda]", " ", RowBox[{"Sin", "[", RowBox[{"Pi", " ", "x"}], "]"}]}]}]], "Input"], Cell["\<\ We plot the function for \[Lambda] = 1.\ \>", "Text", CellChangeTimes->{{3.4205067147064543`*^9, 3.4205067217256413`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"f", "[", "x", "]"}], "/.", "\[InvisibleSpace]", RowBox[{"\[Lambda]", "\[Rule]", "1"}]}], ",", "x"}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "1"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4205063777278957`*^9, 3.420506398155867*^9}, { 3.420506433430821*^9, 3.420506435903562*^9}}], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.67, 0.6, 0.6], PointSize[Large], Thickness[Large], LineBox[CompressedData[" 1:eJwd2Hc4le8fB3C0JCniKzQopCiUL1F5K0qFEIUySouGlaIhDQ1CoaTMUl8V kqwUGaHIjIzjjOcce51HZSThd/f761yv67rPec49Pu/PfT0Kzu67jwgJCAhM FxQQ+Pu580h3XWHPHn2BApHqtn899acbynpwZLRwTa60Z3GEOdbFR8VkyBhB nm2xqDncCSZVTW9iZawR/G6iOT3cHTaHR/PDZQ4j0mHKKCzcHyz1m4YhMt7g xX7XNAm/gwQp8xtBMgGYaSM7yzIsHleEM1YEytxDOHZG+YSkwdbucdrg96cY yXpQnHKsEHOmrtgbL0nD6J2WB4U7P0PJkt/98XYmhoprvxfxa+BTrYuooVx8 D1IcYog0QDpTnC0oWABKSXvTkZImZPMMK2s2FqMoMs3TJKMVxcdj5ez6S2DO 2m1V6sHBsPKmeamnPiEx89zhDce4EBpLni+nVAG/+SYetivaoD11INvqVSVa fj7wE8tuR2WAVnXZqhp0Mc7oCKzsxNK7fWMv+LUYVBMdDU7sQt8oh/1N4ysE 5subt/V342nv+wqx0Hr85BucsNXuhdjiJLq9vQHT317ad9O+D8GuWUcTFBvR yny87qlVP0YMkttd/Jsw8kI3rsFgAHlP+6J9Aprw0jpEUtRoAFeF1axuBDah fb98/mbjAYjVphQlRjRBT1TvaZLZAJSdXsWxk5owPiO3xGHfAPb6pdta1zZh xWXV5adPDyArN6cSCs2I6R+cMHg6AO+1JZn/fGwGij+UOwrwcVRLPiHsczMm uAt22k/jw1b74m3R6mYEnXGJs5nJxwY9LWehlmZkqq0rNhblQ2jL03l8fjMe yu4anLuQjzuWAcdLZVvQrbMwR1Odj5ceRvLeXi1IktK98G0/H5xXJbfrFBjQ F8orufqKj9qB6f1rVzAgHSds0f2aj0K1rab31Bi4Fb8jxySDj4SXpaI2Ogxc c55cKPqWD+f/ykKYpgz80AxXPF3ER2fs5ztdPgxc5DJ0GPV8DARXRkxUMTAV H7J2zigf7C+iQ471DOzcldKvOsZHtYiZdWEzAyfGMv12jvPx6laV5LU2Bl6J DCy/MsWHR0D1feExBhR6WRcbZtEYulD7YIFiK/K63A0WLKQxfrwheuX5Vqi+ eLVgUJuGtbZD2Br/Vqx8XhiWvJ5GimDnjXUBrdj7NmbVET0ajlGjnptCW2HO N075uolGUansdssnrbCyvNYfaUTjpvzBId+KVqS8y9hRYkljQeOA6WdZJnJO 65SlH6dx8vHZLVVLmai51nhC4ySNkpNTOl8VmTgysWRl6ikaZ6eJL2euYeJM o3lvggeNFg2tMXoLEy/00wM8z9KIv33+mfQJJiJ1v83IuUJDdfOsyaPvmTg6 8eXJ10gar18mr2guZEJbdXiuehQNLUkLyx1lTMxRo3UCH9LY2BX1VLWOCRuB n5+0Y2jsClllMtjJBMP17rezj2l4tZhFnZNg4YGOQ3hQMo2RLT+KeqVZoI/b cYpTaFxIiezbv5gFkRuven6l0gjw5+jrq7DQv2iOtuNrGpFKnh1C+iyo+aol z82iket5b22wKwus+uChqXwa+q3r7SfcWIjvlpgrWUCj2Ih13c2bhVKjRK5S IY0KaeUWC38W8r/e+7ClmAYzP8df6j4LYhZPth4soyEg0loZV8gCe/YKX81q GsZPFI6lS7NxeI3d8GImmW+UmHLZImK1f6daieVDx9sZCmysiXs2N4pF4/e5 b87T1djYpym1XoRDI9Uy0NHGgI1UE7qokUv2S/D7ngkXMj7mV/z8LvK8UZak hBsbA1IdA6+I+/sr6pVPs9GYmAuTbhplzU8tLfzYmKc9xPfroXHuta1ZYhgb 3Rn/nf/SR4PjVGi04x0bwfWKmDVIo3JP6jTHAjZGq7d/uk781uRRsVcJG5tk P+8W+k4jXMfbIKaajYPFuaeHibfOU9lI89jwWBfF/PiTxtoZUuPTutl4+LLk 0tohGkvGBd8tHGAjoF9cMZ74V2erzpZRNny7fvp4DdNI/nBn3f05HDzfJm8k OEojKvPijxfzOZD7GDPpRBzw0jX9gxQH6u6z8vKIHSMN1buXcmDsfBcev2iI u42u2qDFgeFIo0vBGI3JQ+095rocSFqv0hP7TaPXru75YX0OlmluFttPXLI1 WTl0OwfRx//7wCf2Wey0jGvPQVJDLSbHaThbaOxlHuTgUqU7veEPOX/XBIOa jnKwIvtSlg+xck/i9yqS48ka7IAeYolFZ5TKz3Bw9+eK0KUTNCZ2bbMrOc+B vWhDqhVxQ2Z34bsADvI6tmlkExd25Q5lBXJwu3hWRDtxsuxtlfRQDjJXLxUV n6Rx9fLqu0lRHESsNN58mNgtY/Ljk1gO3hbunggituusGY19wsE/P1/WpBFr mHo53Uvh4JTv+pyfxIv8DSPupHMwL8+1UmKKxqw3kp+CsjnQv8gZVSf+0d7x +/p7Dq7+fqBrQsyWzllzpZDM535Y2GHiip23nC+WclBXXjF1gTjLzy7Sp4ID a40tAWHECa9XVXjVcNDqP7LkGXFw2/jEqQYObIM7a7KJff+p0nRt4UDIWPxB GfGhHXFHDrPJenw4491AvOui+0OnNg7WLFngQhHrpRlU7evmICit27OXWJkn Lrh3gIMvzcNhP4jFpdq0LH+Q9Vis9/kX8R/jTBfTUQ5qlmRJThB3n78eY/yH g4xHR32miHv3qro8FqDw7uSuwb8+MLhAaOk0CikhJ/0niRsD/0THzKAQuaBI cZzYZHnHv7LCFKo1Talh4sK8qpoHIhR+rhd7wyfW3pvtKjWXAh0561EHcQod Ny1iHoXvjeujGMTLAm/Gzpeg4Pn4SUoVcdQyD51QSQrr8rY2fSAWy7OtmyNN ASLLF74iDtiz+USgDIXu2xvco4nH+CtnzFpEodzxLvMGsdstifiAJRRK85cd 8CBuVxhfL6RAYabg0JgNca115ckJJQruK+w8FIi38TNnXlChsMds0HQacd7N 2IRfqyhMMCvRRs5D0ju3hp/qFFYKOrrE/j0f1jZunmspvCj+J86HOHwAwrQW hTbjxb3mxJfkxTf26lII111c+pucz6HcsW/HNlLYlC9nXUV83Irn3qFPQWyd 11gs8Z4bGYmUIYXoI2tv6hKr9e+Z02RG4deBvWl2pD7eWpsWBFlQCPXwyJAm NszfclrfiqznyEGfelJv+0LVW5/ZUlAvZesbEQdqzE72PkThfV1NpQipT8mH U44qRyl0dmjVZpP6ThAckWC6UJDcERNxgPjtV955QzcK2ceD9qWSPOj0ztsp cY6CwZ8HPaokL7xYbyZLL1AYNiseKB0h9bn1xZtzlyh86V7+xoFYUjpSlnuN Qpnvyws3SB4Z5rr3poWS37eJkcgneZYwsSzI7CmFa7G7bT7QZH5HZfQFkygo bXrnrEWcUz3vR+YLCj0XuGue82lUx/+xW5RGxp+JnB04QJ63uXFlXy6F8cC3 5eokb/fdCCy/VUNh1nWrS+Kd5P/y/f02fqXw2zv10aEOGp42ZzUHGyioNPj4 ZrTTuKVy6KENg5yP6Du+pm00sis2uip3kP3arhF8iCL9YN6gcMlvCq/P8USV GTS+5gfd3DFB4bP3t/3OLWR/TyrNrJki369RyYlpJnlVsW8aYzoXM7UVIuY0 EV8vnaDFuOhxyeDW1dOYP/7oh9xyLsr+RLYLVNEQ7drKPG3CxQqBU9xu0h8r 71P7xsy4OFS3rrEzj9S/0YWWSxZc/K6TaeG9pzHnyevGwD1cpOpem/0tl4aI g1xdvBMXfnph/zwh/Va4frD0y2kufpWtGmSTfj29IDpteQwXhrdlFrWT/s/Y aLSdE8eF2mYVkUByP0h71089esyF29mpdNUHZP2yN0lIJHHhsOSk+vF7NNJT Od4Cb7jIKhdu/xJK+kPMcj3WJy6my6uZLLtGzse55JLIn1zILouolSP3m9BR K4fdI2T+v+6p+rqQfDrzZ3juGBe6074Zfj1K6tXTbMX1SS4o+8AU/0M0jrjQ gadn8+CavtS5wJ6sl806c4ulPESJepz7uovGCa33LbNNeFhbEbpxuybJj9pv KW/NeBh+/9/FI+o0pE4N+h+z4EGtlBd+eTWNgmdKyqV7eDD9Zrbl9Uqyf9J3 vS4f4MF6b9LrYQUa78cOzxk9w4Pmwsc9CyXIehaIbWpP4EFq7Z6yokE+knc4 J3wY4eGmk8GZZ0l8aKkp6GOMh8rZ91QOPePjgxjVWjDOg3vHYaGlieS+W+8g XSTQhlZ7kVVhcXwMOdiFfhRpw+8CmDnd50Pfy+Li5yVtKI0MEUq8SsY/0rf9 uq0N6ay9KuXk/jzcJzu/M7INq+iSd1HCfGRZGU+7Z9QOjdLVpQ4bBuC//Xp8 Zmc7itQtjtY59EOBtbM58XoHRiaz5Q659kFPJ+CezNpO2NFnN2du6YX9kpox wfpO5Gf5eetK9WC4IoTncaULnQKCiQ1vuhA13dF7t2I3zhif2Ohk3okF7Kwn QiXd2LHNvEef1Y4ZflesdT17oOgkz1P7tw0CLxzTeBK98In+1f3pPhdej9JC JIp7UW7emW1+mYN81VvC4m596Pr3fFVRcSvEd3qpXRXrx6eTbRfDVjaDubq2 /lxeP4TkOioOqjTgdRwU2x0HEJnnEOW9txYOadriiycHYNKwtGd0XjkuX398 hfmSj8vppxc9f1OI1O7F0WKmNOpGu36z/0uHpbjY+k8kt8rSHQ/GHTuAoBlC ckxivVAlHwHlAygZG54Y/JtrgpYypZ+doM1jfZQluZcsWX3KrNgRshmp5m7E F3zK5ztm2YNnbXZMiuRmk9JzA/9oW3hHBUceIjnrflPOpuiYBVKDL5/zJRZ8 mtsnUm6Ozsve9iHEVyOyVSKKd8HW1X5ZDvGfAo3HiVmm2KSn9kqE5Pyptrjg kujtmMn8UppOPBilYjnTxQCoLXheRiyzLWX+4o/68C3JuN1KPFPoxqXV2RvR mxJtOYP0mcyBJttdMetR7XeCZUt8h9UpfNdFA7O8nApPEUtrWnYb5KjB4KhV 4lXi4z37PxyMVcGbXRtcU4jjGSauia7y6NuiblpEfCkh6eKt+IVQ1Fmu3kh8 cpqFcsWJ+XBUlZboIw7NOhIv7SGAB0vnDP/t6+qaIf9/X/A/lYecCQ== "]]}, {Hue[0.9060679774997897, 0.6, 0.6], PointSize[Large], Thickness[Large], LineBox[CompressedData[" 1:eJxNxX0s1GEcAPBzEWU7jsl+Z8eOUyuaJiNKp9iU13lbbNdp8hJGstvQZpzR C661Zrp1yetW4lzc0ZpEXGySlwjlXnJd13FCW8eOuOoP3+f547MPI+V6bBqZ RCJF/fP/sDTd1MBSwtm9zYNpeSrCh7X3yXrBYwkRAod/mOuqI+LhS6mbfQ+I VFjhdTuYT3DhBofoW5VEOcyzkhy5S9TAiUmN4vVfLbC1iccOdRbD7jGruqEq KVww7s8S/H4FO0qpSjOzfrhHHTw2cWYQHsyqc0pakcGGw4E2opwRmGxss3Vy H4V9TVd64jrG4LFyn/HhYxOwy329sXV1EtZvqpSfTnyEW5Z7Ryn3pmEK/ema RjMDV2d2pzcwZ+GNoDbNtZI5mOstkx4amodVHbKqKcYXeDtrRnj05gLscc5y N71XDoc2MTI6HZVwAT3ZdZGtgj1XEqznIr/C9jbrVrIttHm/UOz2eBHO9un9 fCBcDbddTGl4s4E26Gm22tpvcHdc6L6aEA1ccqGiXqpFMxRh880V3+EAv/Ia wlsLs50njGbTaMMoX53H+wELzDncWKYOtld2N5FlaItiXrz/jSWY1MoRq+2W 4fxHYr7dILrP444VNVcPU8PyPcsoK7D8+OR00Wv0iycspobzE74s9qXSd9Gl FY08+fNVWKSjCykRa3AMlXJqZAtdaUF2kmPLjIaddWxftWKIto2mSUTRudjq +MgMhz9orqC69uoOWlRdWlSIrS3lsvnYiZls15fYgQGeHQd30fvl7991YrMm +58NYxfKJFUL2MvtwhgLE3q8OFuRiG2ZnzyQgx2UHtdcht0VdTqzHVt/3ivi LTbTz81rFpvj4Winx37oYm0wYf8FVp6K0A== "]]}}, AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesOrigin->{0, 0}, AxesStyle->Thickness[Large], BaseStyle->{15, FontFamily -> "Times", Bold}, FrameStyle->Thickness[Large], PlotRange->{{0, 1}, {0., 0.9999999795918367}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{{3.420506384339645*^9, 3.420506401103258*^9}, 3.4205064373978987`*^9, 3.4518362876247797`*^9, 3.452350454286478*^9, 3.483191897391563*^9, 3.5147228761046753`*^9}] }, Open ]], Cell["\<\ We find the value of the fixed point at non - zero x for this value of \ \[Lambda]:\ \>", "Text", CellChangeTimes->{{3.42050674922876*^9, 3.4205067826432858`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"fp", " ", "=", " ", RowBox[{"x", " ", "/.", " ", RowBox[{"FindRoot", "[", RowBox[{ RowBox[{"x", " ", "==", " ", RowBox[{"(", RowBox[{ RowBox[{"f", "[", "x", "]"}], " ", "/.", " ", RowBox[{"\[Lambda]", " ", "\[Rule]", " ", "1"}]}], ")"}]}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "0.7"}], "}"}]}], "]"}]}]}]], "Input", CellChangeTimes->{{3.420506791885913*^9, 3.420506793061378*^9}, { 3.452350723713167*^9, 3.452350725646359*^9}}], Cell[BoxData["0.7364844482415167`"], "Output", CellChangeTimes->{ 3.420506569945998*^9, 3.4205067935489273`*^9, 3.451836287671273*^9, 3.452350454453684*^9, {3.452350705914483*^9, 3.452350726240274*^9}, 3.452359018181591*^9, 3.483191897483222*^9, {3.514722869898567*^9, 3.514722878343484*^9}}] }, Open ]], Cell["This fixed point is unstable since", "Text", CellChangeTimes->{{3.452350759196745*^9, 3.452350768397826*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"f", "'"}], "[", "fp", "]"}], " ", "/.", " ", RowBox[{"\[Lambda]", " ", "\[Rule]", " ", "1"}]}]], "Input", CellChangeTimes->{{3.4523507091061573`*^9, 3.452350747957685*^9}}], Cell[BoxData[ RowBox[{"-", "2.125144410891521`"}]], "Output", CellChangeTimes->{{3.452350712389374*^9, 3.45235074899021*^9}, 3.483191897530058*^9, 3.514722881335335*^9}] }, Open ]], Cell[TextData[{ "i.e. the magnitude of the derivative is greater than 1.\n\nAs for the \ logistic map we will be interested in the range 0 < x < 1, and 0 < \[Lambda] \ < 1.We will find that the values of \[Lambda] where period doubling occurs, \ ", Cell[BoxData[ FormBox[ SubscriptBox["\[Lambda]", "k"], TraditionalForm]]], ", will be different from those of the logistic map, but the Feigenbaum \ constant defined by" }], "Text", CellChangeTimes->{{3.4523507835693703`*^9, 3.452350812533903*^9}}], Cell[BoxData[ RowBox[{"\[Delta]", " ", "=", " ", RowBox[{ RowBox[{ SubscriptBox["lim", RowBox[{"k", " ", "\[Rule]", " ", "\[Infinity]", " "}]], SubscriptBox["\[Delta]", "k"]}], "=", " ", RowBox[{ SubscriptBox["lim", RowBox[{"k", " ", "\[Rule]", " ", "\[Infinity]", " "}]], FractionBox[ RowBox[{ SubscriptBox["\[Lambda]", "k"], "-", " ", SubscriptBox["\[Lambda]", RowBox[{"k", "-", "1"}]]}], RowBox[{ SubscriptBox["\[Lambda]", RowBox[{"k", "+", "1"}]], "-", " ", SubscriptBox["\[Lambda]", "k"]}]]}]}]}]], "DisplayFormula"], Cell[TextData[{ "will be the same. This provides evidence that the Feigenbaum constant is \ ", StyleBox["universal", FontWeight->"Bold"], ", i.e. the same for all maps (with a quadratic maximum). (Universality of \ the Feigenbaum constant can be proved mathematically using ideas from \ statistical mechanics called the ", StyleBox["renormalization group", FontSlant->"Italic"], ".)" }], "Text", CellChangeTimes->{ 3.420223126268404*^9, {3.452350819878441*^9, 3.452350831276969*^9}}], Cell["\<\ We find where the fixed point at the origin becomes unstable.\ \>", "Text", CellChangeTimes->{{3.420506590731062*^9, 3.4205066038046303`*^9}, { 3.4205066623157463`*^9, 3.420506663475494*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"rt0", " ", "=", " ", RowBox[{"FindRoot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"x", " ", "\[Equal]", " ", RowBox[{"f", "[", "x", "]"}]}], " ", ",", " ", RowBox[{ RowBox[{ RowBox[{"f", "'"}], "[", "x", "]"}], " ", "\[Equal]", " ", "1"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "0"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"\[Lambda]", ",", "0.3"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"x", "\[Rule]", "0.`"}], ",", RowBox[{"\[Lambda]", "\[Rule]", "0.3183098861837907`"}]}], "}"}]], "Output",\ CellChangeTimes->{ 3.420506572229394*^9, 3.45183628776123*^9, 3.452350454613063*^9, 3.452350919105337*^9, 3.452359021810649*^9, 3.483191897671259*^9, { 3.514722866217306*^9, 3.514722887264801*^9}}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"l", "[", "0", "]"}], " ", "=", " ", RowBox[{"\[Lambda]", " ", "/.", " ", "rt0"}]}]], "Input"], Cell[BoxData["0.3183098861837907`"], "Output", CellChangeTimes->{3.42050657438344*^9, 3.451836287780349*^9, 3.4523504547566967`*^9, 3.452350922167973*^9, 3.483191897701068*^9, 3.514722891381456*^9}] }, Open ]], Cell["\<\ As is easy to show analytically, the solutions is \[Lambda] = 1/\[Pi]. The \ above result is indeed the numerical value of 1/\[Pi]:\ \>", "Text", CellChangeTimes->{{3.420506617710362*^9, 3.420506650020237*^9}, { 3.45235107918232*^9, 3.452351093932691*^9}, {3.4523511382331753`*^9, 3.452351143064556*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"N", "[", RowBox[{"1", "/", "Pi"}], "]"}]], "Input", CellChangeTimes->{{3.5147228940640583`*^9, 3.514722895216724*^9}}], Cell[BoxData["0.3183098861837907`"], "Output", CellChangeTimes->{3.4205065764755287`*^9, 3.451836287873239*^9, 3.452350454833725*^9, 3.483191897746335*^9, 3.514722895772016*^9}] }, Open ]], Cell["\<\ Then we find where the fixed point at non-zero x becomes unstable.\ \>", "Text", CellChangeTimes->{{3.4205066690021048`*^9, 3.420506690005045*^9}, { 3.451836186889954*^9, 3.4518361887428713`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"rt1", " ", "=", " ", RowBox[{"FindRoot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"x", " ", "\[Equal]", " ", RowBox[{"f", "[", "x", "]"}]}], " ", ",", " ", RowBox[{ RowBox[{ RowBox[{"f", "'"}], "[", "x", "]"}], " ", "\[Equal]", " ", RowBox[{"-", "1"}]}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "0.6"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"\[Lambda]", ",", "0.7"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"x", "\[Rule]", "0.6457736765434056`"}], ",", RowBox[{"\[Lambda]", "\[Rule]", "0.7199616829795352`"}]}], "}"}]], "Output",\ CellChangeTimes->{3.4205065805098267`*^9, 3.451836287969678*^9, 3.452350454905287*^9, 3.452359053547933*^9, 3.4831918977796392`*^9, 3.514722898293034*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"l", "[", "1", "]"}], " ", "=", " ", RowBox[{"\[Lambda]", " ", "/.", " ", "rt1"}]}]], "Input"], Cell[BoxData["0.7199616829795352`"], "Output", CellChangeTimes->{3.4518362879895763`*^9, 3.452350455001565*^9, 3.452359058916769*^9, 3.483191897812549*^9, 3.514722902665224*^9}] }, Open ]], Cell[TextData[{ "Next we compute the twice iterated function ", StyleBox["f2", FontWeight->"Bold"], " and see where the fixed point of this (which is also a period - 2 limit \ cycle of ", StyleBox["f", FontWeight->"Bold"], ") becomes unstable :" }], "Text", CellChangeTimes->{{3.420506816563129*^9, 3.4205068900116043`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"f2", "[", "x_", "]"}], " ", "=", " ", RowBox[{"f", "[", RowBox[{"f", "[", "x", "]"}], "]"}]}], ";"}]], "Input"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"rt2", " ", "=", " ", RowBox[{"FindRoot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"x", " ", "\[Equal]", " ", RowBox[{"f2", "[", "x", "]"}]}], " ", ",", " ", RowBox[{ RowBox[{ RowBox[{"f2", "'"}], "[", "x", "]"}], " ", "\[Equal]", " ", RowBox[{"-", "1"}]}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "0.8"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"\[Lambda]", ",", "0.83"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"x", "\[Rule]", "0.8207653517515063`"}], ",", RowBox[{"\[Lambda]", "\[Rule]", "0.8332663537456853`"}]}], "}"}]], "Output",\ CellChangeTimes->{3.451836288180421*^9, 3.452350455135467*^9, 3.452359087666329*^9, 3.483191897863564*^9, 3.514722911396974*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"l", "[", "2", "]"}], " ", "=", " ", RowBox[{"\[Lambda]", " ", "/.", " ", "rt2"}]}]], "Input", CellChangeTimes->{3.5147229137492113`*^9, 3.514722994633902*^9}], Cell[BoxData["0.8332663537456853`"], "Output", CellChangeTimes->{3.514722995204359*^9}] }, Open ]], Cell[TextData[{ "Repeat for the fourth iterated function ", StyleBox["f4", FontWeight->"Bold"], "," }], "Text", CellChangeTimes->{{3.4205069109196377`*^9, 3.4205069323241987`*^9}, { 3.420506973868335*^9, 3.420506976739555*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"f4", "[", "x_", "]"}], " ", "=", " ", RowBox[{"f2", "[", RowBox[{"f2", "[", "x", "]"}], "]"}]}], ";"}]], "Input"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"rt3", "=", " ", RowBox[{"FindRoot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"x", " ", "\[Equal]", " ", RowBox[{"f4", "[", "x", "]"}]}], " ", ",", " ", RowBox[{ RowBox[{ RowBox[{"f4", "'"}], "[", "x", "]"}], " ", "\[Equal]", " ", RowBox[{"-", "1"}]}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "0.85"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"\[Lambda]", ",", "0.88"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.514722926199625*^9, 3.514722927691661*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"x", "\[Rule]", "0.8565947693642522`"}], ",", RowBox[{"\[Lambda]", "\[Rule]", "0.8586090599021189`"}]}], "}"}]], "Output",\ CellChangeTimes->{ 3.4518362883159533`*^9, 3.452350455336422*^9, {3.4523590993056498`*^9, 3.452359107733447*^9}, 3.483191897946122*^9, 3.514722929003828*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"l", "[", "3", "]"}], " ", "=", " ", RowBox[{"\[Lambda]", " ", "/.", " ", "rt3"}]}]], "Input"], Cell[BoxData["0.8586090599021189`"], "Output", CellChangeTimes->{ 3.4518362884169207`*^9, 3.452350455419998*^9, 3.452359112262617*^9, 3.483191897980363*^9, {3.5147229233491173`*^9, 3.514722931895455*^9}}] }, Open ]], Cell[TextData[{ "the eight iterated function ", StyleBox["f8,", FontWeight->"Bold"] }], "Text", CellChangeTimes->{{3.420506940921535*^9, 3.420506984827416*^9}, { 3.5147229355300198`*^9, 3.51472293677949*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"f8", "[", "x_", "]"}], " ", "=", " ", RowBox[{"f4", "[", RowBox[{"f4", "[", "x", "]"}], "]"}]}], ";"}]], "Input"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"rt4", "=", " ", RowBox[{"FindRoot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"x", " ", "\[Equal]", " ", RowBox[{"f8", "[", "x", "]"}]}], " ", ",", " ", RowBox[{ RowBox[{ RowBox[{"f8", "'"}], "[", "x", "]"}], " ", "\[Equal]", " ", RowBox[{"-", "1"}]}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "0.87"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"\[Lambda]", ",", "0.89"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"x", "\[Rule]", "0.8533522344284757`"}], ",", RowBox[{"\[Lambda]", "\[Rule]", "0.864084173708717`"}]}], "}"}]], "Output",\ CellChangeTimes->{{3.51472294276548*^9, 3.514722950755248*^9}}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"l", "[", "4", "]"}], " ", "=", " ", RowBox[{"\[Lambda]", " ", "/.", " ", "rt4"}]}]], "Input"], Cell[BoxData["0.864084173708717`"], "Output", CellChangeTimes->{3.4518362886474*^9, 3.452350455642445*^9, 3.452359125274835*^9, 3.4831918981131973`*^9, 3.5147229535742273`*^9}] }, Open ]], Cell[TextData[{ "the sixteenth iterated function ", StyleBox["f16,", FontWeight->"Bold"] }], "Text", CellChangeTimes->{{3.420506940921535*^9, 3.4205070029566183`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"f16", "[", "x_", "]"}], " ", "=", " ", RowBox[{"f8", "[", RowBox[{"f8", "[", "x", "]"}], "]"}]}], ";"}]], "Input"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"rt5", "=", " ", RowBox[{"FindRoot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"x", " ", "\[Equal]", " ", RowBox[{"f16", "[", "x", "]"}]}], " ", ",", " ", RowBox[{ RowBox[{ RowBox[{"f16", "'"}], "[", "x", "]"}], " ", "\[Equal]", " ", RowBox[{"-", "1"}]}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "0.86"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"\[Lambda]", ",", "0.866"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.5147229584142036`*^9, 3.5147229618625307`*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"x", "\[Rule]", "0.8517267882163257`"}], ",", RowBox[{"\[Lambda]", "\[Rule]", "0.8652589606966344`"}]}], "}"}]], "Output",\ CellChangeTimes->{3.451836288844029*^9, 3.452350455871882*^9, 3.452359130675942*^9, 3.483191898164081*^9, 3.514722963083415*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"l", "[", "5", "]"}], " ", "=", " ", RowBox[{"\[Lambda]", " ", "/.", " ", "rt5"}]}]], "Input"], Cell[BoxData["0.8652589606966344`"], "Output", CellChangeTimes->{3.451836288951447*^9, 3.452350455957026*^9, 3.452359134336273*^9, 3.483191898196569*^9, 3.514722966359535*^9}] }, Open ]], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ "We", " ", "now", " ", "print", " ", "the", " ", "list", " ", "of", " ", "the", " ", SubscriptBox["\[Lambda]", "k"], "for", " ", "k"}], " ", "=", " ", "0"}], ",", " ", "1", ",", " ", "...", " ", ",", " ", "5."}]], "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Table", "[", RowBox[{ RowBox[{"l", "[", "i", "]"}], ",", " ", RowBox[{"{", RowBox[{"i", ",", " ", "0", ",", " ", "5"}], "}"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{"0.3183098861837907`", ",", "0.7199616829795352`", ",", RowBox[{"l", "[", "2", "]"}], ",", "0.8586090599021189`", ",", "0.864084173708717`", ",", "0.8652589606966344`"}], "}"}]], "Output", CellChangeTimes->{3.452359145279229*^9, 3.483191898230404*^9, 3.514722972618062*^9}] }, Open ]], Cell["and estimate the Fiegenbaum constant", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"Print", " ", "[", " ", RowBox[{"k", ",", " ", "\"\< \>\"", ",", " ", SubscriptBox["\[Delta]", "k"]}], "]"}], ";"}], " "}], "\[IndentingNewLine]", RowBox[{ RowBox[{"Do", "[", " ", RowBox[{ RowBox[{"Print", "[", RowBox[{"n", " ", ",", " ", "\"\< \>\"", ",", " ", RowBox[{ RowBox[{"(", " ", RowBox[{ RowBox[{"l", "[", "n", "]"}], " ", "-", " ", RowBox[{"l", "[", RowBox[{"n", "-", "1"}], "]"}]}], ")"}], "/", RowBox[{"(", RowBox[{ RowBox[{"l", "[", RowBox[{"n", "+", "1"}], "]"}], " ", "-", " ", RowBox[{"l", "[", "n", "]"}]}], ")"}]}]}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", " ", "1", ",", " ", "4"}], "}"}]}], "]"}], " "}]}], "Input"], Cell[CellGroupData[{ Cell[BoxData[ InterpretationBox[ RowBox[{"k", "\[InvisibleSpace]", "\<\" \"\>", "\[InvisibleSpace]", SubscriptBox["\[Delta]", "k"]}], SequenceForm[$CellContext`k, " ", Subscript[$CellContext`\[Delta], $CellContext`k]], Editable->False]], "Print", CellChangeTimes->{ 3.451836288992427*^9, 3.4523504561275806`*^9, 3.483191898264122*^9, { 3.5147229827682257`*^9, 3.514722999493061*^9}}], Cell[BoxData[ InterpretationBox[ RowBox[{ "1", "\[InvisibleSpace]", "\<\" \"\>", "\[InvisibleSpace]", "3.544882960956793`"}], SequenceForm[1, " ", 3.544882960956793], Editable->False]], "Print", CellChangeTimes->{ 3.451836288992427*^9, 3.4523504561275806`*^9, 3.483191898264122*^9, { 3.5147229827682257`*^9, 3.514722999514484*^9}}], Cell[BoxData[ InterpretationBox[ RowBox[{ "2", "\[InvisibleSpace]", "\<\" \"\>", "\[InvisibleSpace]", "4.470898650947183`"}], SequenceForm[2, " ", 4.470898650947183], Editable->False]], "Print", CellChangeTimes->{ 3.451836288992427*^9, 3.4523504561275806`*^9, 3.483191898264122*^9, { 3.5147229827682257`*^9, 3.514722999551736*^9}}], Cell[BoxData[ InterpretationBox[ RowBox[{ "3", "\[InvisibleSpace]", "\<\" \"\>", "\[InvisibleSpace]", "4.62870856234855`"}], SequenceForm[3, " ", 4.62870856234855], Editable->False]], "Print", CellChangeTimes->{ 3.451836288992427*^9, 3.4523504561275806`*^9, 3.483191898264122*^9, { 3.5147229827682257`*^9, 3.5147229995708513`*^9}}], Cell[BoxData[ InterpretationBox[ RowBox[{ "4", "\[InvisibleSpace]", "\<\" \"\>", "\[InvisibleSpace]", "4.660516215202685`"}], SequenceForm[4, " ", 4.660516215202685], Editable->False]], "Print", CellChangeTimes->{ 3.451836288992427*^9, 3.4523504561275806`*^9, 3.483191898264122*^9, { 3.5147229827682257`*^9, 3.514722999600144*^9}}] }, Open ]] }, Open ]], Cell["\<\ The Feigenbaum constant seems to go to a value of about 4.66 (which is \ correct). \ \>", "Text", CellChangeTimes->{{3.514723007556067*^9, 3.514723013114064*^9}}], Cell[CellGroupData[{ Cell["Logistic Map", "Subsection"], Cell[TextData[{ "For comparison we give the corresponding results for the logistic map. The \ ", Cell[BoxData[ FormBox[ SubscriptBox["\[Lambda]", "k"], TraditionalForm]]], " for k = 0, 1, ... 6 are" }], "Text"], Cell[BoxData[ RowBox[{"Clear", "[", "l", "]"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"l", "[", "0", "]"}], " ", "=", " ", "0.25"}], ";", " ", RowBox[{ RowBox[{"l", "[", "1", "]"}], " ", "=", " ", "0.75"}], ";", " ", RowBox[{ RowBox[{"l", "[", "2", "]"}], " ", "=", " ", "0.862372"}], ";"}]], "Input",\ CellChangeTimes->{{3.4523503303286247`*^9, 3.452350366409514*^9}, { 3.452350499817135*^9, 3.452350511535255*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"l", "[", "3", "]"}], "=", "0.886023"}], ";", " ", RowBox[{ RowBox[{"l", "[", "4", "]"}], " ", "=", " ", "0.891102"}], ";", " ", RowBox[{ RowBox[{"l", "[", "5", "]"}], " ", "=", " ", "0.89219"}], ";", " ", RowBox[{ RowBox[{"l", "[", "6", "]"}], " ", "=", " ", "0.892423"}], ";"}]], "Input",\ CellChangeTimes->{{3.452350371009654*^9, 3.45235043849109*^9}, { 3.452350514902811*^9, 3.4523505337867117`*^9}}], Cell[TextData[{ "which are ", StyleBox["different", FontSlant->"Italic"], " from the values for the sine map. However, successive estimates of the \ Feigenbaum constants are" }], "Text", CellChangeTimes->{{3.482971170237159*^9, 3.4829712090214863`*^9}}], Cell[CellGroupData[{ Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"Print", " ", "[", " ", RowBox[{"k", ",", " ", "\"\< \>\"", ",", " ", SubscriptBox["\[Delta]", "k"]}], "]"}], ";"}], " "}], "\[IndentingNewLine]", RowBox[{ RowBox[{"Do", "[", " ", RowBox[{ RowBox[{"Print", "[", RowBox[{"n", " ", ",", " ", "\"\< \>\"", ",", " ", RowBox[{ RowBox[{"(", " ", RowBox[{ RowBox[{"l", "[", "n", "]"}], " ", "-", " ", RowBox[{"l", "[", RowBox[{"n", "-", "1"}], "]"}]}], ")"}], "/", RowBox[{"(", RowBox[{ RowBox[{"l", "[", RowBox[{"n", "+", "1"}], "]"}], " ", "-", " ", RowBox[{"l", "[", "n", "]"}]}], ")"}]}]}], "]"}], ",", " ", RowBox[{"{", RowBox[{"n", ",", " ", "1", ",", " ", "5"}], "}"}]}], "]"}], " "}]}], "Input", CellChangeTimes->{{3.452350441691637*^9, 3.452350444603423*^9}, { 3.452350559344302*^9, 3.452350578925029*^9}}], Cell[CellGroupData[{ Cell[BoxData[ InterpretationBox[ RowBox[{"k", "\[InvisibleSpace]", "\<\" \"\>", "\[InvisibleSpace]", SubscriptBox["\[Delta]", "k"]}], SequenceForm[$CellContext`k, " ", Subscript[$CellContext`\[Delta], $CellContext`k]], Editable->False]], "Print", CellChangeTimes->{3.451836289306967*^9, 3.4523504569052277`*^9, 3.452350545930502*^9, 3.4523505811405907`*^9, 3.483191898331402*^9, 3.5147230364987593`*^9}], Cell[BoxData[ InterpretationBox[ RowBox[{ "1", "\[InvisibleSpace]", "\<\" \"\>", "\[InvisibleSpace]", "4.449506994624994`"}], SequenceForm[1, " ", 4.449506994624994], Editable->False]], "Print", CellChangeTimes->{3.451836289306967*^9, 3.4523504569052277`*^9, 3.452350545930502*^9, 3.4523505811405907`*^9, 3.483191898331402*^9, 3.5147230365010233`*^9}], Cell[BoxData[ InterpretationBox[ RowBox[{ "2", "\[InvisibleSpace]", "\<\" \"\>", "\[InvisibleSpace]", "4.751257874931298`"}], SequenceForm[2, " ", 4.751257874931298], Editable->False]], "Print", CellChangeTimes->{3.451836289306967*^9, 3.4523504569052277`*^9, 3.452350545930502*^9, 3.4523505811405907`*^9, 3.483191898331402*^9, 3.5147230365032988`*^9}], Cell[BoxData[ InterpretationBox[ RowBox[{ "3", "\[InvisibleSpace]", "\<\" \"\>", "\[InvisibleSpace]", "4.656625319944918`"}], SequenceForm[3, " ", 4.656625319944918], Editable->False]], "Print", CellChangeTimes->{3.451836289306967*^9, 3.4523504569052277`*^9, 3.452350545930502*^9, 3.4523505811405907`*^9, 3.483191898331402*^9, 3.5147230365056953`*^9}], Cell[BoxData[ InterpretationBox[ RowBox[{ "4", "\[InvisibleSpace]", "\<\" \"\>", "\[InvisibleSpace]", "4.668198529411332`"}], SequenceForm[4, " ", 4.668198529411332], Editable->False]], "Print", CellChangeTimes->{3.451836289306967*^9, 3.4523504569052277`*^9, 3.452350545930502*^9, 3.4523505811405907`*^9, 3.483191898331402*^9, 3.514723036508049*^9}], Cell[BoxData[ InterpretationBox[ RowBox[{ "5", "\[InvisibleSpace]", "\<\" \"\>", "\[InvisibleSpace]", "4.669527896997539`"}], SequenceForm[5, " ", 4.669527896997539], Editable->False]], "Print", CellChangeTimes->{3.451836289306967*^9, 3.4523504569052277`*^9, 3.452350545930502*^9, 3.4523505811405907`*^9, 3.483191898331402*^9, 3.5147230365102654`*^9}] }, Open ]] }, Open ]], Cell[TextData[{ "which tend towards about 4.669, consistent with the estimate from the sine \ map of about 4.66. Hence we have provided numerical evidence that the \ Feigenbaum constants for the logistic map and the sine map are ", StyleBox["equal", FontSlant->"Italic"], ", implying the ", StyleBox["universality", FontWeight->"Bold"], " of the Feigenbaum constant. More accurate calculations give \[Delta] = \ 4.6692... ." }], "Text", CellChangeTimes->{{3.420223220530241*^9, 3.420223246189253*^9}, { 3.482971212702928*^9, 3.482971218189995*^9}, {3.482971260726658*^9, 3.482971328567553*^9}, {3.482971376579557*^9, 3.482971393097426*^9}}] }, Open ]] }, Open ]] }, WindowSize->{841, 715}, WindowMargins->{{293, Automatic}, {Automatic, 22}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, Magnification->1.5, FrontEndVersion->"6.0 for Mac OS X x86 (32-bit) (May 21, 2008)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[590, 23, 25, 0, 114, "Title"], Cell[618, 25, 222, 5, 62, "Text"], Cell[843, 32, 272, 7, 30, "DisplayFormula"], Cell[1118, 41, 115, 2, 40, "Input"], Cell[1236, 45, 177, 5, 42, "Input"], Cell[1416, 52, 133, 3, 39, "Text"], Cell[CellGroupData[{ Cell[1574, 59, 426, 11, 40, "Input"], Cell[2003, 72, 6939, 122, 364, "Output"] }, Open ]], Cell[8957, 197, 174, 4, 39, "Text"], Cell[CellGroupData[{ Cell[9156, 205, 532, 14, 40, "Input"], Cell[9691, 221, 307, 5, 40, "Output"] }, Open ]], Cell[10013, 229, 116, 1, 39, "Text"], Cell[CellGroupData[{ Cell[10154, 234, 223, 5, 40, "Input"], Cell[10380, 241, 175, 3, 40, "Output"] }, Open ]], Cell[10570, 247, 506, 11, 131, "Text"], Cell[11079, 260, 615, 18, 55, "DisplayFormula"], Cell[11697, 280, 496, 13, 84, "Text"], Cell[12196, 295, 204, 4, 39, "Text"], Cell[CellGroupData[{ Cell[12425, 303, 502, 15, 40, "Input"], Cell[12930, 320, 371, 9, 40, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[13338, 334, 131, 3, 40, "Input"], Cell[13472, 339, 205, 3, 40, "Output"] }, Open ]], Cell[13692, 345, 320, 6, 62, "Text"], Cell[CellGroupData[{ Cell[14037, 355, 146, 3, 40, "Input"], Cell[14186, 360, 181, 2, 40, "Output"] }, Open ]], Cell[14382, 365, 209, 4, 39, "Text"], Cell[CellGroupData[{ Cell[14616, 373, 521, 15, 40, "Input"], Cell[15140, 390, 341, 8, 40, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[15518, 403, 131, 3, 40, "Input"], Cell[15652, 408, 181, 2, 40, "Output"] }, Open ]], Cell[15848, 413, 334, 10, 62, "Text"], Cell[16185, 425, 167, 5, 42, "Input"], Cell[CellGroupData[{ Cell[16377, 434, 524, 15, 40, "Input"], Cell[16904, 451, 312, 7, 40, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[17253, 463, 197, 4, 40, "Input"], Cell[17453, 469, 88, 1, 40, "Output"] }, Open ]], Cell[17556, 473, 235, 7, 39, "Text"], Cell[17794, 482, 169, 5, 42, "Input"], Cell[CellGroupData[{ Cell[17988, 491, 586, 16, 40, "Input"], Cell[18577, 509, 344, 8, 40, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[18958, 522, 131, 3, 40, "Input"], Cell[19092, 527, 211, 3, 40, "Output"] }, Open ]], Cell[19318, 533, 215, 6, 39, "Text"], Cell[19536, 541, 169, 5, 42, "Input"], Cell[CellGroupData[{ Cell[19730, 550, 520, 15, 40, "Input"], Cell[20253, 567, 243, 6, 40, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[20533, 578, 131, 3, 40, "Input"], Cell[20667, 583, 180, 2, 40, "Output"] }, Open ]], Cell[20862, 588, 172, 5, 39, "Text"], Cell[21037, 595, 170, 5, 42, "Input"], Cell[CellGroupData[{ Cell[21232, 604, 593, 16, 64, "Input"], Cell[21828, 622, 312, 7, 40, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[22177, 634, 131, 3, 40, "Input"], Cell[22311, 639, 179, 2, 40, "Output"] }, Open ]], Cell[22505, 644, 284, 7, 39, "Text"], Cell[CellGroupData[{ Cell[22814, 655, 184, 5, 40, "Input"], Cell[23001, 662, 324, 6, 40, "Output"] }, Open ]], Cell[23340, 671, 52, 0, 39, "Text"], Cell[CellGroupData[{ Cell[23417, 675, 849, 25, 87, "Input"], Cell[CellGroupData[{ Cell[24291, 704, 416, 9, 30, "Print"], Cell[24710, 715, 360, 9, 30, "Print"], Cell[25073, 726, 360, 9, 30, "Print"], Cell[25436, 737, 360, 9, 30, "Print"], Cell[25799, 748, 360, 9, 30, "Print"] }, Open ]] }, Open ]], Cell[26186, 761, 173, 4, 39, "Text"], Cell[CellGroupData[{ Cell[26384, 769, 34, 0, 51, "Subsection"], Cell[26421, 771, 218, 7, 64, "Text"], Cell[26642, 780, 58, 1, 40, "Input"], Cell[26703, 783, 392, 10, 40, "Input"], Cell[27098, 795, 472, 12, 64, "Input"], Cell[27573, 809, 260, 7, 62, "Text"], Cell[CellGroupData[{ Cell[27858, 820, 964, 27, 87, "Input"], Cell[CellGroupData[{ Cell[28847, 851, 437, 9, 30, "Print"], Cell[29287, 862, 381, 9, 30, "Print"], Cell[29671, 873, 381, 9, 30, "Print"], Cell[30055, 884, 381, 9, 30, "Print"], Cell[30439, 895, 379, 9, 30, "Print"], Cell[30821, 906, 381, 9, 30, "Print"] }, Open ]] }, Open ]], Cell[31229, 919, 657, 14, 107, "Text"] }, Open ]] }, Open ]] } ] *) (* End of internal cache information *)