(* 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[ 284641, 7689] NotebookOptionsPosition[ 262508, 6966] NotebookOutlinePosition[ 262913, 6983] CellTagsIndexPosition[ 262870, 6980] WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell[TextData[StyleBox["Hwk #7 Solution Notebook", "Section"]], "Subsubtitle", CellChangeTimes->{{3.435405637416*^9, 3.435405645512*^9}}], Cell[CellGroupData[{ Cell[TextData[StyleBox["Morin 5.9", "Subsection"]], "Section", CellChangeTimes->{{3.435405653248*^9, 3.4354056723900003`*^9}}], Cell["\<\ If a particle moves in one dimension under the influence of a force F(x) = \ -V'(x), then at any place where the force drops to zero (i.e. any x0 such \ that F(x0)=0) it is a possible \"motion\" for the particle to stay put (i.e \ x(t) = x0). If the particle is displaced a small amount from x0, though, \ what happens? Expanding F(x) in a Taylor series near x0: F(x) = F(x0) + F'(x0)(x-x0) + ... \ = 0 + F'(x0)(x-x0) + ... We obtain the force law of a spring with equilibrium point x0 and spring \ constant -F'(x0). So a very common question to be asked is: given V(x) where are its minima \ (i.e. find the x0 such that V'(x0)=0), and for each minimum what is the \ frequency of small oscillations about that minimum (i.e. what is k_eff = V''(x0), and then \[Omega]=Sqrt[k_eff/m]).\ \>", "Text", CellChangeTimes->{{3.43540569554*^9, 3.435406271113*^9}}], Cell["Here we are asked these questions for", "Text", CellChangeTimes->{{3.4354062879519997`*^9, 3.435406288862*^9}, { 3.435406325376*^9, 3.435406331683*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"V", "[", "x_", "]"}], " ", "=", " ", RowBox[{ RowBox[{"-", " ", "C"}], " ", RowBox[{"x", "^", "n"}], " ", RowBox[{"Exp", "[", RowBox[{ RowBox[{"-", "\[Alpha]"}], " ", "x"}], "]"}]}]}]], "Input", CellChangeTimes->{{3.435406294366*^9, 3.435406320164*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"-", "C"}], " ", SuperscriptBox["\[ExponentialE]", RowBox[{ RowBox[{"-", "x"}], " ", "\[Alpha]"}]], " ", SuperscriptBox["x", "n"]}]], "Output", CellChangeTimes->{3.4354063860480003`*^9, 3.435884468582*^9, 3.43588449915*^9, 3.4667699247490997`*^9, 3.4667699579771*^9, 3.4671149832073536`*^9, 3.4674871295961*^9}] }, Open ]], Cell["First let's plot this thing:", "Text", CellChangeTimes->{{3.435406335159*^9, 3.435406342028*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"p", " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"C", "\[Rule]", "1"}], ",", RowBox[{"n", "\[Rule]", "3"}], ",", RowBox[{"\[Alpha]", "\[Rule]", "1"}]}], "}"}]}]], "Input", CellChangeTimes->{{3.435406343778*^9, 3.435406355039*^9}, { 3.4354064097720003`*^9, 3.4354064100299997`*^9}, {3.435406499882*^9, 3.435406524583*^9}, {3.435407012796*^9, 3.435407012918*^9}, 3.435407077266*^9}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"C", "\[Rule]", "1"}], ",", RowBox[{"n", "\[Rule]", "3"}], ",", RowBox[{"\[Alpha]", "\[Rule]", "1"}]}], "}"}]], "Output", CellChangeTimes->{3.4354070131470003`*^9, 3.435407077758*^9, 3.4358844707130003`*^9, 3.435884500775*^9, 3.4667699248739*^9, 3.4667699601455*^9, 3.467114984470954*^9, 3.4674871305945*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"plotV", " ", "=", " ", RowBox[{"Plot", "[", RowBox[{ RowBox[{ RowBox[{"V", "[", "x", "]"}], "/.", "p"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "10"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.435406361889*^9, 3.4354063963859997`*^9}, { 3.435408158723*^9, 3.435408162152*^9}}], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.67, 0.6, 0.6], LineBox[CompressedData[" 1:eJwV1nc8Vu8bB3DrWValJcnoISWVlkS570ghiRCyQiUNSUgopYEiI9Kg7L1H xZfnsrMzo1AyM7Ke51SIfuf313m9X69zzus6931dn/tI2149eY6Hi4tLj5uL 6//XqNu21J1nH6vdvbTj5OcVlf9Vtknpmkg5IO2NLt/VBqxY/6pZ96SkbqIk 07UJanVPWMKhb7P5u3xQo7hXivBwCiuqNFCSIuWP5v2iqUkvWCyFqbNP/tkH ITvxxksBdY2sXuHXS387Q9FJLpS0IeUzSyaRoTS/EI6IjrKr5ScGWZcPul75 LfkCxfkYJ8/sn2TltffFczQiEXvJoav3OsGav6TbM2P/BkWckcw4dWqRFc3d 4/9bMwbd+5Tb0OzGC4cbQ2R/dcYiiVeBP1R2MuDH86NlHId4JBycjX0ml0HA 2UUL9kICWszocVP7vhIUFfP+zAQmIalaV1/rM6LQtnAhbFoyBbEnFhKP394A bh8kFKdyUpFCjFeXVqw0iD1tr/+pkY68MqxkdL7KAMvqkf1ERwbqaeQT+nhj M9jKY95x+yxk+jBN8PJ1BeBZ8PjI8cpGUr4/p1svKkJ7n/EGjmYOWlIO7XRv 2QXu6QKFs525yNq5TImppQw6ocPU2eg8BNnnzNwsVEHcvcxoxiEfbf9rMj6V qQaTlpGx07sKkM5V7Z2tUoegVOPG9NRCAUJFkrb6AhoQuuWk2lTlW1Szmm1G rNWEs8u2BUwGvkPXX2ocKj16FGjd/XI/JQvRetZfq9xVutBVWuI68aMQuSmd 6q7K04PUxOcV4zlFaNR7dHq8WB/0nPWsxzSK0cHkyFdGYAhSplsyRgVLkGzn vFGktTHMHuRb+NFRgva+c7q9e7UJPGMUPRuxB/TlWch1ofLTkH9Dx/m6aCk6 Y38sT77IAiLH9q1je5Wi8PfopG6tFTg2i9jPapahhXchWZIRNiASWcMz01mO 1mTFXlh6ch4WhN+mOB2oQNNBknbZE/YweDdOfzq6AtGzGDbOJg7w1v726ymH SnS4JMD+q9FlePPlkubVpkpkHlDj1z9yBfyOm01M7qpCXj2/v6f6XYXTu/eo TC5UoYMOEWvFPK6BRqL09ytnqpHf+pjYeGtnUFi3zO9nZTX6zHfkyjnd67C0 NNoxEfgBve8/NvJZ1RVi6t5cG5esRR+i1WPSXG4C53mB/LeAWuTSaBddmOkB R+zrB1rnapHEi5GfnBlPmOD9bVzUVodsElfvOxZ2G5QP6qn4+zagGg/uZBtZ H3gscJbtxWlA52N+jWv+8IGvn2+mO9k0IoldJiUi2ffgvluChKlqEwp4ua/p kd4DaM76yyM39RHpDtcdGPvgByKIYSW0vRlFtbdT+PP8QXVTmIrv2WaU/27f zVNxj+AJJ4Xt0dKMQmbWBj19GgB7QjrO2aa1IOUM7Yt5ZsHgXaegs9O6DQ3r lZTyL4RBcs67TWnhbUhx7tu20Ffh0PpcnVe2oQ1J9C2z+672DGTsTYtF97ej W1fGbfoCI6CO9/52rpUdaKehVUbk8Zew5mC3yMfqT2iS76Jeh3w0YJnzU1qL nxCtK1GjISQaHARm6st3d6IcredTe+ajofgz9cHb6E70Jjs6wPJjDNi67fod 5dGFdgVY1Yo+joPMLP/uy9u/oH6bPFkfrSQYExkL0LH5gu6YzLWaspJAzk1H bXPYFzSwQqzTdW8yRB8QiBmY+4IMAhx++silQGhtwPnTVd3oqtuOkz/E0sBt IGjmqEUv0t7w/V2VWhbkHpmOlQ3qRQnxT/V/12TBVIq+EW95L7p6DzsryWfD BacV71hyX9Eljf2mIe+y4fRiqNde9lfkmGpi3Pk5B94I1N9bodmHFKeMC64f yAe1g54Wd6z60ORGn+mnj/Ohx3Hr3qkbfWjJ9+Ldk935INr6eLghtQ/REXZM 8SqAkOe62n7LvyMeY0O/guq3cE+2Sfhf93eUePqwwNyNQrBHLS8mnAdQxXrb dhtdAK7YX0XdjwcQnEuZjU8HeM4n3lMXP4AYl+zbCqmlUFN7XiLl0wAKkD0y Y3qhFDYb/Y09pzKIHvw9NN2yvQx+XJBL/8o9hDpUFAjXmnK4GHqL1Rw8jBpu RfPGKlSD49CWgfzMUWRWpq4+l9QIfVaf6WW1o6hk3bX37ycawbDLb3vj4CjK PrE4nLezCZTrR24OiY2hqKi0fPPiJuDNSVi+xncMqYXvnzvb/hGee0mr3bAe R/u67xjeprVA2cp1L/Yv/4nu815lhRu3Ab/0fblvytOoU+7Cca3dXfBkeb18 zBk2qpU9VBE52Qe23UbA2/ALrdE1ODynMQzXqu7bXpWbRxcjhNLWqo9DjpOg oaj2Itp+zT9W88YUNLxceTPj1CIS/5Xyx8BvCoYrxd6on11Eagcm9xu+mAKx dVvGL3svorNn8sz2/DcF98s075UVLKKaPU6rnZam4JSId97FjUsI5/kt2h6a hvm8mZUlC0uohmvbB7OyaYjxvDSmaMKFO3TSFASyZkCxlPHH15ILhy4dWPOy YAZK+ZIp3+y48J3QA87M4hnoCxyUCnTiwu+87nnI1s6ARLSlyag/F/boC4wc 7p+Bl5UnKmOKuXDSzAOW+epZCBXa81pkIzc+Wl/jQ3ObhY0nW9McNnPjqZ29 Dd89ZyHnmVNh6XZu7K991PLt3Vlolsxod1TlxkYu24/rBc6C8K5NAvVG3Lgk hXFif/wsPDol6n7Plxvzib1dv9A8Cz5v/hpwJrgxwQ7m3bKJDfqK769tZXOT 3+PSqriVDRJl10Ns57ixklyt4G5FNhT1jzU3U3jwZSK+fJMKG2ZlP5/IkODB 77xVFOqPs8E2veD4eX0ezCvNaqK5sOFQoaN2Vx4PrpDbuHiimA3COvIOy4p4 sJVrN29CKRt6vgz5HSnlwSYWQa6cSja4/7WoyW/gwVqr5176NLIhGx07GjLE g9Wi9/0y/8oGqWo5TZ21vHhDQ6Ya7z82cLX14WIPXnydRreXO8CB+6OsGI+7 vLju5fy9dZgDDK4onv1+vLg5M1iacpgDItvMKgvCefGVRrf+mmMckPVtOZqV zYvth4ae8ZhzQEe1XC92mBcTHSXvkDsHmgyis8785MWRBaLmdZ4cMLxwe7kk hxf30z2C9bw5YBGu0vqKmw/H3tV+q/GQA45Tucbh4ny4SnpoxfenHHgaF2fh d5IPR3QF7R3N4IBo0d2SI2Z82D08KEIohwORzdYSlDN8+IKEU8zWfA4kLq7v u3uFD3+368k1KuLAe5MwO08/PiyR5/37dDUHegQeXHRkkc8/LL+yv5cDm1zO uxvJU3DaiR4eHSoB21S+Gb5RpOBNt06dvE0nYA+X6Y4xJQqOp/w5lsFPgHqA 9rC3BgVPcIkcXhAmwCpewSjNgoJf7GhxMVlLwLP22R08QRTcxOrVFpEjIOrl JYHj4RQs9X4z1+xmAuLPDA5HvKJgHss9ng3yBOROdERtS6bgpZ771de2E9DE VyhgVkbBZt5aA7f2EkDZ6z2Sxabg6Q9m1VHqBAgu/C6fn6PgpwbM1/KHCRAp c3qtyUXFPiL3THI1CZA6bmvcLUjFHc0+brlaBBw4p1lB3UTFVTJnXrrqEaCx lfXaQIGKezRT8z6fIEBnRskjchcVrzn5vkTZgADTW5t37kJUPLuzO23EkACX cIE3lqZUTHMu3cQwI8DT/L5HshUVa4nF/D18mgAf6UVj9lkqTt033uppTkBw xqSg/zUqpgRn+32xJCC9qsUj/xEVO5SsMLCwJWCQiDglUELF1b8Or79+kYDY Q7uv91ZQ8Uiy9tPrlwiwDmwKyqqjYjyrd9LxMgFfZCi1hl1U3FbPm33SkYAW Q2fVSDYV33qyaW/nNQKevBEydZyn4kpCUTHVmQDd8WQXzE3DWy6V+964TkCN z7eMQWEanquxM+F2JYCVoyu1TZ6Gtw5ermq5QYDX4siBf4o0/M/FceaGOwH7 te+Zteyj4Ri+hSDRmwTk9xWGumrSMGvnlx3aHgQ4KxhnHdWl4da6CqXPpHe4 T9evM6ThA/rn/7PzJCB1mRyFdYaGtdTXal/wIuCCebl0sD0Nj/rUmfSTlk2y VLN1pOEzenemTt0iIFot7AbVi4ZP+p6o2nGb7KdHO8K6fGhYhbGeEUZa/FNd dqo/DbvsPf59lnTEFe4xvQiyXmx+OtqbAKPCSKr0axr2+0ZwTZEWoSgz2fE0 HBnlclT5DgHN+m2oKo2G9dOKFL1IP4l0tIjIpWHRd+lQRFr3B+OmQyENK48q /maTZuxJCFctpWHtb9u/yN0loNob5wp9oOGMpKBLp0jfr+9u+tZIw+IlBzO9 SauvvTGe006uN49sQhzpf7Yi9PvdNNxQvMuwnHRxZobMqX4a/hti/F83aY95 rUObR2n44N1bfVOklY8MWs5P0bB636uqJdJEiLdHwy/ye07FXaH7kPPRKxbx epGGl7p8uwVJO215m+fER8dpCWoi//d2V4NmdQE6tkasVVTS46UTE6tE6NjG YWlonnxfsqAfY0SUjuWZf/zGSJ83ZW4qlKRjifgErg7SMvEs9ceb6FjHhEe/ iHT/lJm15TY63tHJ7/GSdLQq4bljDx0/HC2+60ra0jf4ObcqHQt4rr14jLRY 29aCtkN0bPJKTEmcdJfEh5YELTrOcf/wY4Rcz2cXbSdvnKDjcXOpB5mkjd4u 8uucouPD8ZuFnUiL8LyQE7ekY42KwYcKpD8e33N40o6Os5RPzw6Q+6kzdPFW 6DU6vm8UkKFB+sgtZvphdzqODVFN+Un2g/rqni+/btNx4WtmayhpFc3jyuYB dLzRRvpdE9lfSr0Ue6GndJw9Nu9+jvQuV1Y4vKDjq0Nh13+T/SifsIPNTKLj cN1XEkKkNx38If0pg463WbS2B5P9vLEjWt8vn6xX3PrjMtJiFJHMiTI6Nmxc G/WPnA+Bc5wLBT1k/e33JhLJeaIvpkfYD9DxjTd9ayik+cLPVa8bo+PT4/2R Vm4E/K38xLz9m46X/AM/8JLzOCFT+PWICANPPHo2uoac3x/F14TmRBn4tbiS hj4534NG8gfSJBmYRvm97IETAT33X71Yto2Be2wShb+TedAweMuo6ygD+2NL ti2ZHzVeSvce6TGwpUGCsjuZL5WrpnIOGDMwHs2i+zuQ/Xj4zLIYWwaOJ4aN ouzJfIpXr3O4xcCTkpPTwXYEBJ6l4YVcBp5W1mtJJPPt0V9wzChk4H/uSnJu ZP49DHOPsi5l4LDdHvsOmRJwu3J0vqKRgZMDqU/rjAlwlGkoCPjBwDzbBvxT 9QnQGwzeKiHBj+NZ7FWxZD43bB1st5Dhxzm1QXFHyfw+dn3f7Vfy/Ng171r8 KJnvWjxfm0X38eO49eVUJib3V2qr20p9fpy2923IJRUC9lpUldJ9+HHkbol+ Y/K8EG+fM2YPkfeH9blFryTg5frj/3ZO8OPiDwaUzysIWGcXnew0y49PMIcM hZcTsGb2yMLPJX4c+nSL6lVBApYvD4v+sVYA36HJuPFTCODV3T7eqy2AyzZs LUkmODBWYXunJkMAp2ee8A5v54BkSNfFJ/kC2O5DdY5qKweMrPSMjf4TwGEa A5e/fuQA689++b4aASxbfsx/XT0HQretaP89IIBXl3tlny/jgGoEyMmJCeIw hc921uR5HnBR/OODh4I4stjv9TcfDmxf8WmDhrUQzlLlsaqQ4cBw4LBP+Dkh rFZh0dMlzYEo/t8jI5eEsDNF+u+4BAcE+URzA9yFcMAX/S0C68h6f5kd+RQi hJ+lL/PaJsSBhJ5eR4dKIWzlMijMR7BBPHkIgrYI46u6xjKMCjbwI8Kmhy2M 88d7b86asuHoz9O/Nxovx7/EOpcFm89CV/lZ7tMKK7BNqKlt+rEZKPCrtJIi VuCV6c9XrSL/Z89TXPuamkSw6hnpkr27JsHO2bNA8OVKnNrZfSeRNgE77Lc2 6dqswrVO8StqJ0fho4iCgOv+1dgl0zkr6t0I/Jfp80qBdw025mb92lk0BJ7c 8voNvWtwxpniRNP0AeDv8dByzF+L40ZaVv+o+g5DidJhb7xEsfSuUI0Y8T4I 27yOr9B4HZY+l/Fx7GsPBL88/8FGSgyv/nNltdL8ZzgdZtkkOCKGxa9mMhUs OuHP4YS5N6z1WPij4zdU3g4DQ+ru5b7i2OBERr9YQCvEHty5vtFmAw5rydZ8 YN0MGQ9cV9hvk8BWbaFuRasawdfY7hgvIYGD4uTRtY5a2NsTk+LbKIkrFF/3 9aZVw/MtrzIaj0lhlSPz78XoleBdGvj8WKEUPm055ufsWQbH1xsn1MlI4/Q2 C9jqx4JDjh/MV/hL47PR2kce9xTBG3FbmQZCGv9S5i5sOPUOZCqSnumZb8Rv 2TeRoFM+BG8rl29lbcT3uv5kWoznwHk2X0utPBMXHmLYatGywDZnVso/iIl7 NVRY0WvS4LKP4V+dECa+4ZR7WZaaBq6G+Z2CT5lYIvusZx6RCn6E65PgZ0zc 5aCbON6eCpn75xYiopi42uFSev3TVJgr+/cpMY2JO3b7nDyyMhWCWwUDKz8w 8Xn/vF2UdSnwMu7KhYe1THyoW6AqnZECcS5NGlr1THxMXWCj5XwyvF0TPF/f xMR5O5u3dHUnQ8/plRfaOpg4SjN8RulNMsgNrNPoH2DiSn/3a0/lkkEx30Mi foiJ92uXBFeJJoPKg+65cyNMnB/ZsIuLPxl05aKyR8eYuG19xM8nE0ngfElK YmaGiU02mJevyE0CrwN353LZTLyv6LyXb1wSPBDqb3chmNggj/qMEp4Ez7Pi Hv/5w8SzJQGfxNyTIPYOn33RPBOzhYo5OQ5JkGZwTt3rLxMrKInYGJgnQf7G 6g1qS0y8I1h57ZxuErDYm+b+/WPiz6ZfRFLUkuB/JFCXlA== "]]}}, AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesOrigin->{0, 0}, PlotRange->{{0, 10}, {-1.3442505431572154`, 0.}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{{3.435406371349*^9, 3.435406419602*^9}, {3.435406457591*^9, 3.435406465039*^9}, {3.435406502132*^9, 3.435406526381*^9}, 3.435407019458*^9, 3.435407079902*^9, 3.435408164177*^9, { 3.435884472443*^9, 3.435884501817*^9}, 3.4667699251078997`*^9, 3.4667699622047*^9, 3.4671149860777535`*^9, 3.4674871322949*^9}] }, Open ]], Cell["Next locate the minimum:", "Text", CellChangeTimes->{{3.4354065373310003`*^9, 3.435406542933*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqn0", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"V", "'"}], "[", "x", "]"}], "\[Equal]", "0"}]}]], "Input", CellChangeTimes->{{3.4354065518599997`*^9, 3.435406569027*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ RowBox[{"-", "C"}], " ", SuperscriptBox["\[ExponentialE]", RowBox[{ RowBox[{"-", "x"}], " ", "\[Alpha]"}]], " ", "n", " ", SuperscriptBox["x", RowBox[{ RowBox[{"-", "1"}], "+", "n"}]]}], "+", RowBox[{"C", " ", SuperscriptBox["\[ExponentialE]", RowBox[{ RowBox[{"-", "x"}], " ", "\[Alpha]"}]], " ", SuperscriptBox["x", "n"], " ", "\[Alpha]"}]}], "\[Equal]", "0"}]], "Output", CellChangeTimes->{3.43588450391*^9, 3.4667699251858997`*^9, 3.4667699640611*^9, 3.4671149877937536`*^9, 3.4674871375209*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"soln0", " ", "=", " ", RowBox[{"Solve", "[", RowBox[{"eqn0", ",", "x"}], "]"}]}]], "Input", CellChangeTimes->{{3.4354065440550003`*^9, 3.43540657613*^9}, { 3.435406607365*^9, 3.435406611039*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{"{", RowBox[{"x", "\[Rule]", FractionBox["n", "\[Alpha]"]}], "}"}], "}"}]], "Output", CellChangeTimes->{{3.43588448758*^9, 3.435884512177*^9}, 3.4667699254199*^9, 3.4667699657146997`*^9, {3.467114989197754*^9, 3.4671149968885536`*^9}, 3.4674871389873*^9}] }, Open ]], Cell["And compute the 2nd derivative there:", "Text", CellChangeTimes->{{3.435406592815*^9, 3.4354066013190002`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"V", "''"}], "[", "x", "]"}], "/.", " ", RowBox[{"soln0", "[", RowBox[{"[", "1", "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.43540661971*^9, 3.435406648854*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"-", "C"}], " ", SuperscriptBox["\[ExponentialE]", RowBox[{"-", "n"}]], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "n"}], ")"}], " ", "n", " ", SuperscriptBox[ RowBox[{"(", FractionBox["n", "\[Alpha]"], ")"}], RowBox[{ RowBox[{"-", "2"}], "+", "n"}]]}], "+", RowBox[{"2", " ", "C", " ", SuperscriptBox["\[ExponentialE]", RowBox[{"-", "n"}]], " ", "n", " ", SuperscriptBox[ RowBox[{"(", FractionBox["n", "\[Alpha]"], ")"}], RowBox[{ RowBox[{"-", "1"}], "+", "n"}]], " ", "\[Alpha]"}], "-", RowBox[{"C", " ", SuperscriptBox["\[ExponentialE]", RowBox[{"-", "n"}]], " ", SuperscriptBox[ RowBox[{"(", FractionBox["n", "\[Alpha]"], ")"}], "n"], " ", SuperscriptBox["\[Alpha]", "2"]}]}]], "Output", CellChangeTimes->{{3.435406626354*^9, 3.435406649199*^9}, 3.435884479505*^9, 3.4358845177460003`*^9, 3.4667699254667*^9, 3.4667699672747*^9, 3.4671149982457533`*^9, 3.4674871404381*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"keff", " ", "=", " ", RowBox[{"Simplify", "[", "%", "]"}]}]], "Input", CellChangeTimes->{{3.435406650626*^9, 3.435406659453*^9}}], Cell[BoxData[ RowBox[{"C", " ", SuperscriptBox["\[ExponentialE]", RowBox[{"-", "n"}]], " ", SuperscriptBox[ RowBox[{"(", FractionBox["n", "\[Alpha]"], ")"}], RowBox[{ RowBox[{"-", "1"}], "+", "n"}]], " ", "\[Alpha]"}]], "Output", CellChangeTimes->{3.4354066598719997`*^9, 3.435884519859*^9, 3.4667699256226997`*^9, 3.4667699690687*^9, 3.467114999665354*^9, 3.4674871432773*^9}] }, Open ]], Cell["\<\ So to answer the question posed, the (angular) frequency of small \ oscillations is\ \>", "Text", CellChangeTimes->{{3.43540669998*^9, 3.435406779191*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[Omega]0", " ", "=", " ", RowBox[{"Sqrt", "[", RowBox[{"keff", "/", "m"}], "]"}]}]], "Input", CellChangeTimes->{{3.4354067437609997`*^9, 3.435406757602*^9}}], Cell[BoxData[ SqrtBox[ FractionBox[ RowBox[{"C", " ", SuperscriptBox["\[ExponentialE]", RowBox[{"-", "n"}]], " ", SuperscriptBox[ RowBox[{"(", FractionBox["n", "\[Alpha]"], ")"}], RowBox[{ RowBox[{"-", "1"}], "+", "n"}]], " ", "\[Alpha]"}], "m"]]], "Output", CellChangeTimes->{3.43540678154*^9, 3.435884521993*^9, 3.4667699256851*^9, 3.4667699715491*^9, 3.467115001053754*^9, 3.4674871449153*^9}] }, Open ]], Cell["And the period would then be", "Text", CellChangeTimes->{{3.4354067859309998`*^9, 3.435406792743*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"T0", " ", "=", " ", RowBox[{"2", " ", RowBox[{"\[Pi]", " ", "/", " ", "\[Omega]0"}]}]}]], "Input", CellChangeTimes->{{3.435406794361*^9, 3.435406809535*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"2", " ", "\[Pi]"}], SqrtBox[ FractionBox[ RowBox[{"C", " ", SuperscriptBox["\[ExponentialE]", RowBox[{"-", "n"}]], " ", SuperscriptBox[ RowBox[{"(", FractionBox["n", "\[Alpha]"], ")"}], RowBox[{ RowBox[{"-", "1"}], "+", "n"}]], " ", "\[Alpha]"}], "m"]]]], "Output", CellChangeTimes->{{3.435406806258*^9, 3.435406809775*^9}, 3.4358845240629997`*^9, 3.4667699257319*^9, 3.4667699733587*^9, 3.467115012847354*^9, 3.4674871464597*^9}] }, Open ]], Cell["\<\ So let's choose parameters and actually find the motion. First atttempt:\ \>", "Text", CellChangeTimes->{{3.435406840538*^9, 3.435406856124*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"p", " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"C", "\[Rule]", "1"}], ",", RowBox[{"n", "\[Rule]", "3"}], ",", RowBox[{"\[Alpha]", "\[Rule]", "1"}], ",", RowBox[{"m", "\[Rule]", "1"}]}], "}"}]}]], "Input", CellChangeTimes->{{3.435406343778*^9, 3.435406355039*^9}, { 3.4354064097720003`*^9, 3.4354064100299997`*^9}, {3.435406499882*^9, 3.435406524583*^9}, {3.435407012796*^9, 3.435407012918*^9}, 3.435407077266*^9, {3.435407403113*^9, 3.435407405824*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"C", "\[Rule]", "1"}], ",", RowBox[{"n", "\[Rule]", "3"}], ",", RowBox[{"\[Alpha]", "\[Rule]", "1"}], ",", RowBox[{"m", "\[Rule]", "1"}]}], "}"}]], "Output", CellChangeTimes->{{3.4354074092469997`*^9, 3.435407420369*^9}, 3.435884539745*^9, 3.4667699257943*^9, 3.4667699748719*^9, 3.4671150147505536`*^9, 3.4674871480821*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnFma", " ", "=", " ", RowBox[{ RowBox[{"m", " ", RowBox[{ RowBox[{"x", "''"}], "[", "t", "]"}]}], "\[Equal]", RowBox[{"-", RowBox[{ RowBox[{"V", "'"}], "[", RowBox[{"x", "[", "t", "]"}], "]"}]}]}]}]], "Input", CellChangeTimes->{{3.435406866618*^9, 3.4354069035360003`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"m", " ", RowBox[{ SuperscriptBox["x", "\[Prime]\[Prime]", MultilineFunction->None], "[", "t", "]"}]}], "\[Equal]", RowBox[{ RowBox[{"C", " ", SuperscriptBox["\[ExponentialE]", RowBox[{ RowBox[{"-", "\[Alpha]"}], " ", RowBox[{"x", "[", "t", "]"}]}]], " ", "n", " ", SuperscriptBox[ RowBox[{"x", "[", "t", "]"}], RowBox[{ RowBox[{"-", "1"}], "+", "n"}]]}], "-", RowBox[{"C", " ", SuperscriptBox["\[ExponentialE]", RowBox[{ RowBox[{"-", "\[Alpha]"}], " ", RowBox[{"x", "[", "t", "]"}]}]], " ", "\[Alpha]", " ", SuperscriptBox[ RowBox[{"x", "[", "t", "]"}], "n"]}]}]}]], "Output", CellChangeTimes->{{3.435406869701*^9, 3.4354069038389997`*^9}, 3.435407091322*^9, {3.4354074163780003`*^9, 3.435407421682*^9}, 3.435884541762*^9, 3.4667699259191*^9, 3.4667699767283*^9, 3.4671150160765533`*^9, 3.4674871494393*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnFma", "/.", "p"}]], "Input", CellChangeTimes->{{3.435406992192*^9, 3.435406994382*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ SuperscriptBox["x", "\[Prime]\[Prime]", MultilineFunction->None], "[", "t", "]"}], "\[Equal]", RowBox[{ RowBox[{"3", " ", SuperscriptBox["\[ExponentialE]", RowBox[{"-", RowBox[{"x", "[", "t", "]"}]}]], " ", SuperscriptBox[ RowBox[{"x", "[", "t", "]"}], "2"]}], "-", RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"-", RowBox[{"x", "[", "t", "]"}]}]], " ", SuperscriptBox[ RowBox[{"x", "[", "t", "]"}], "3"]}]}]}]], "Output", CellChangeTimes->{{3.435406994656*^9, 3.435407023877*^9}, 3.43540709312*^9, 3.435407425816*^9, 3.435884543807*^9, 3.4667699259814997`*^9, 3.4667699780543003`*^9, 3.467115017792554*^9, 3.4674871506092997`*^9}] }, Open ]], Cell["\<\ Wait as long as you like for this one to come back, then hit Alt-plus to \ abort the calculation:\ \>", "Text", CellChangeTimes->{{3.435407096014*^9, 3.435407142598*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"DSolve", "[", RowBox[{ RowBox[{"{", RowBox[{"eqnFma", "/.", "p"}], "}"}], ",", RowBox[{"x", "[", "t", "]"}], ",", "t"}], "]"}]], "Input", CellChangeTimes->{{3.435406905392*^9, 3.4354069139110003`*^9}, { 3.435406946609*^9, 3.4354069474849997`*^9}}], Cell[BoxData["$Aborted"], "Output", CellChangeTimes->{3.435406943792*^9, 3.435406985508*^9, 3.435407065632*^9, 3.4667700092499*^9}] }, Open ]], Cell[TextData[{ "Even when the differential equation is too hard for ", StyleBox["Mathematica", FontSlant->"Italic"], ", we can get a numerical solution.\nLet's launch the motion from the \ equilibrium point with some choice of initial velocity:" }], "Text", CellChangeTimes->{{3.435407147145*^9, 3.435407165087*^9}, {3.435407221848*^9, 3.435407258954*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"x0", " ", "=", " ", RowBox[{ RowBox[{"x", "/.", " ", RowBox[{"soln0", "[", RowBox[{"[", "1", "]"}], "]"}]}], " ", "/.", "p"}]}]], "Input", CellChangeTimes->{{3.4354071944960003`*^9, 3.4354071954630003`*^9}, { 3.435407262218*^9, 3.4354072862539997`*^9}}], Cell[BoxData["3"], "Output", CellChangeTimes->{3.4667700153027*^9, 3.467115023252554*^9, 3.4674871574265003`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"sN", " ", "=", " ", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"eqnFma", "/.", "p"}], ",", " ", RowBox[{ RowBox[{"x", "[", "0", "]"}], "\[Equal]", "x0"}], ",", RowBox[{ RowBox[{ RowBox[{"x", "'"}], "[", "0", "]"}], "\[Equal]", ".1"}]}], "}"}], ",", RowBox[{"x", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", RowBox[{ RowBox[{"2", "T0"}], "/.", "p"}]}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.4354071715369997`*^9, 3.435407185417*^9}, { 3.435407291157*^9, 3.43540734659*^9}, {3.435407468494*^9, 3.4354075548599997`*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{"{", RowBox[{ RowBox[{"x", "[", "t", "]"}], "\[Rule]", RowBox[{ TagBox[ RowBox[{"InterpolatingFunction", "[", RowBox[{ RowBox[{"{", RowBox[{"{", RowBox[{"0.`", ",", "18.77285527873031`"}], "}"}], "}"}], ",", "\<\"<>\"\>"}], "]"}], False, Editable->False], "[", "t", "]"}]}], "}"}], "}"}]], "Output", CellChangeTimes->{ 3.435407349149*^9, 3.4354074361280003`*^9, {3.435407469316*^9, 3.4354075552200003`*^9}, 3.435884552659*^9, 3.4667700241479*^9, 3.4671150251089535`*^9, 3.4674871678473*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"x1", "[", "t_", "]"}], " ", "=", " ", RowBox[{ RowBox[{"x", "[", "t", "]"}], "/.", RowBox[{"sN", "[", RowBox[{"[", "1", "]"}], "]"}]}]}]], "Input", CellChangeTimes->{{3.435407817275*^9, 3.435407830974*^9}}], Cell[BoxData[ RowBox[{ TagBox[ RowBox[{"InterpolatingFunction", "[", RowBox[{ RowBox[{"{", RowBox[{"{", RowBox[{"0.`", ",", "18.77285527873031`"}], "}"}], "}"}], ",", "\<\"<>\"\>"}], "]"}], False, Editable->False], "[", "t", "]"}]], "Output", CellChangeTimes->{3.435407832926*^9, 3.435884554367*^9, 3.4667700276735*^9, 3.4671150292741537`*^9, 3.4674871712481003`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"x1", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", RowBox[{ RowBox[{"2", "T0"}], "/.", "p"}]}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.435407440118*^9, 3.435407460817*^9}, {3.435407836571*^9, 3.435407840126*^9}}], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.67, 0.6, 0.6], LineBox[CompressedData[" 1:eJwd2Xc81V8fAHDzDkTIvkbWtV1XZRT3EyUkRCRpKaNEdpKyMjKylYwkEkmS FVGUPX6ytxAZGQnJfM59/qnX+3VO33vvOd/zGaf91rdMbOhoaGhK0R/Uv7vv 6Vj9Lk7SvHNVnJGGBgd7q64lv064TemR/TcmT4uDQMYARa+EEEpB5dvK83Q4 0MiJvnMx4TElvZjZsZQBB/ybj9NOJ2RTKnYCw53wOMBlCiidTCil6DV41g9w 4MDX68LGiYR6ig6p8OgLCRxUWO9c1EnopUxw75Er1seBEB7frRA3TSHrvLQM ScTBf2eaIuZrpin+xQ+bYh7jwC89/Fje8jRFvHfzZfITHIyrsBZJm8xQenvS nr95ioNsW844cfZZyjZnbEBTGg5IXwVP80fNUSJkZAV+vsSBli+5lTF8gVKy 6MKQVYKDP01/HnwtX6B4f5+QTS7FQSZ38ZHA2QVKUFbF8+gyHGDzVfJo9Bcp Kl0YjzvlOLB1Squ9x7BEcT5IeK5VhQOZ1BeZXl+WKKt5YvqFtTh4v/HG2uno MuWrls8QTRf6PfeFh7stlimVGzn1A8ihtDFnNZyXKUw8f+bfd+PACuduwPJs mXL4WOf01V4cMHCrH8rdWqbIneoJKB/AgZlSHX6q9A/F4kRsxtExHPy1Gym4 oLBKOdkt/KhwHgfWc0aytcdXKfIn37u7LuCgxak6S+7CKqXt0DtfpUUcpHtk Pt0MX6U8wpykebOEA93AGw+SZtD8n6VJSX9wkJS2drY7c41ylo8zTfcfDg53 s+4aCKxTzHumUv/R4wHXijUoOLBOiUsZy8plwEPXV5okTsN1ipiDb7wlIx6c ipbJA37rFK7K/0RLMXhIj+uxtZtap5xQUVyyxuMBY5LW5v/uH+WBh2nxA1Y8 dOg9Fphs+kdJ08d2i7Hh4dnRaHvdH/8otxWftFcjqyoF0LHxbFDGypotNvbi wWGv7aEUnw2KgSlvygVOPLS3yaeVnNikFNySt/vFg4fUOsk5viublGTmqE0v XjzcqBJWvee9SUkd0rJm4MMDfT57h/abTUr8um0mDz8eDkWuMn7j2KLIcuj9 UiTgIflkpePc8Bblkv0YJ1EED/baJeWGf7coHonCkenIBw6/xRbu3aYUiJ9r 592PhzaZ58+9tLcpm3E9hYyieKBhCupmzNmmUHbnBtrF8GDbYKAh4r5DufZD 0VSOiAcrk8G2b+E7lBGWQddwZJOh65cDX+xQBjOt788gaywFB0517FAo+eVn M6TwsI+3ujFPaZfyQCKHCSuDhxq7g+Zqi7uU5bIr8ilyeBhaH3PzoKcB/z2N kzPIPRo5RwzZaEBQSy/okDweWupV2nYlaWBgI9irBbls8Mxva3MaeGzcKTWn gIco+igV6WIayLnR5f2HhIcwXXMaumoa0NhnGKKohIcHkYKNAy000LwidPsG sjdPnmXEDxoo+fl3dwjZVrbx3iInLajMcL0rIuPhinO0ToMwLXiufuv4iWxV fJbtuSwtHA673MOnjH4vZSrdRJsWBu2PBXgja5jSfy12pYW6Z0H2CgfQfj9p inh0nxa2mBTjLZDJwzFmdmG0cIH5aro/spSdyE/eDFpY/DBwrh1ZLO/n299v aCFspw+zhiz0O9+r6QMt1ND1xvEfROt3V4PJ5xstlE+ZnLqMzPaZofPMMC0o vIq744/MxNiSLD9DC7qz54KeI9NEWcqP0tCB1SL28AjyZuf+tVIWOtD9UP5j A3mNd6YqmheNsz105D6Eh7mM28ZaJDrY48FH0EfmzQig49Ogg6ECXvVryMee RxYt6tHByb4rDPeQndOf2NaZ04F84qB3PHLKsxe8qVfpoHPeMTUXuSEtv8nN mQ6Oq9Hd/IS8kvrBR/8eHdwjotcC2SDlv+9/E+lAQmdrZBXZK3kgtu0FHag6 tlsxquAh8+nksawCOqgT0QvmRG5PWlq7W0kH7alnz4sgbz/ZfGXSRAdPHRYG ZZFlnmDOS/fSwc9ztLhDyOaP2ffQ/KADZd+gUU3kgETCp54lOpg55GKtg5yf QHR5s00HB8U+RhsgD8STxR4w0YOE/qUbp5Ex8Rrdljz0UChntngGmRynG6Ik Tg9+dUnCZ5Evxpqq4ZTogSFCZpPqsJiLcyMa9PDBHhNAdUn09dRifXqgVMoX mSGPR7kbRZylh/gLGTEmyGxRvrRXr9EDOcqO3xD5yKOw92ou9KCDDTDURbaP TLDZe58eOqf/yh9Fjo9I5/kZRg8/atrLVJE/h79urHxMDwWPuBYVkH+FldyN z6SH1jft7WLIvGHV8g7v6MFies9FHuRjD1tGj1bRg7DDQCIe2Tm0N4a3mR7a ao/d3aDuX8i49mIvPQjMWDHPUvcveH619gc9/BY/cKKPun9B69kpv+khRXJY oRZZJIje0m0Hja851BRQ9/MBK4s+MwPcX1+lTabuZyBflQgvAxRNxswHIn/z VxRtU2IAA74rjaeRd/zUuzI1GSDgbsOHQ8gyfseD755kgEvbOeb8yAH3z89K 2TDAY4xJ4jB6X8l3QwoDnzBAjVQl6QzyRe/Ya5ZZDHDN0C1UATnsTiq3UiED ECwLI7HI47ffe480M8DXdofnxeg8xbmPaqntMoA5e+AyLfJnt9kVNhZGGOyQ q/iGzu8v19WXU7yMUFBeR05HPubCzBxPZoT0hSRFNeQVR5XOBRtGmNQrtjmP 4sHMYFj8Q1dGYE3e/LwfeURvxEzclxF4otj7p1A8aZAI6jv3hBHwjE/BETll uGP4axMjiLWO/7mB4lPMSclnl3oZ4clv6yNE5OAPdy5vTDCC5sV87XFFtD8J IhOK2+j5ih+jziBrn3KafqqIgYS0MAkZFO9UK6pzDh7BgICj8s0hFA/lpLkc 2nUxsPh+yS0SmZvx4zyjNQaUn0zUz6F4OvsR/8c5HgOnIqPCkmTxECuXta3z DwNNx4PrPqD4HPJ0vWqMEQs9m9w6Fsg+OAM/Hw4szApBxCqK57Y/lukKZbFA aJxxpMZ/tRTACV7EQtp8TUy4BB6+Mw9x/KnBQnFQSxkbyh+KcxxSzyJwYONv lkdG+UlV9B3zFVTXHGPG0xah/KV1zmhRNBMHXNje0weQz9SHl7yswEHVSOCM Esp33i8YjufP4uCZ17NtEW481J1fu1Kpi4fnXxuE/2NH+9/SnzzIwARcAWMF Tjh0Xui9fFP3MoHY0HW3diweXNS5r14iMMGtd/VHlZAfvDKRmVBmggomFYYl lN9zHzSXzVozQcG++4rWqB5YPVLZ/e8zEwxJ2zzj28FBxJt0Nt57zICnn2Tt X8ZBfVrAUO9DZggl/nu0B5ku+lrO40RmuGKTjjn6Gwe3XaW0eQqYYf0yzfdM VJ9YqxR4ck8wg0dmkcnlXzhQrf40vE+PBW4HGPx7OYmDia6R1+xce6CG3izm DqqP1LcIusxvWEGHEhN3HdVnD0v0VJbLWIEvKqbYHdVvfc6ekv1fWYH0SZjo i+q725P/MWQPsULYtudWTBEOitoCqrVY2GDfW5WHbwtwoPh8Wt3bgQ38rDvW ml7hgENsIHFl314gDHlkP0T7gGnIeni1cy+sNRQ9s/JE9eycvsUXXQ6Q6TL0 z1TAAfmMndH3YU54ON0QOTqMhfnRoaixs1wQK7lGjo7HwoE4v4e6F7lAeieq 7kIcFnx0xAPfXuMCDXmWftlYLLC8cfC858IFqtHn/BqjsCDjvWHFF86Fnre4 yxSOBdt9vDKnq7jA0OHpTrY/FkZ1Tb9+FucGdm69D6a3sPDtXeP6s9/cMHbU kL3KAD0/hX1j+i83iLn/2y0/iQWpkHObSjvcwKrRXVGmjwU/q5ntL0w8cO9Q z7MSXSyQsHj6aTEeEGnuVPt4DAvRVrp7SOY88Dz3yYfFI1gwxtbv/1zOA/yt TD278ljY+s0qhq/mgflTHzN4kV8NmYub1PPAt77ky2Q5LNAUTkn+6OQBn02x InsZLBRYYeRw8zzwqrur97skFtgKjx8yFuaFR0Xz/3aFsdBm9VX/eyAvlKrl v6XhxAJDntLwx4e8UCwfsa2DzpX6ZtqtpCheuG72TfUROxayk+7EmyTzAp1c pLfwXvR7ehRGvhai+VpelFN7sEA2TnLJGeOF353nXHqwWEjQdnriSuEDw+Cr ZzK3MdASOyhjdJwPzlRO5uOR6cZ1K2VP8sHfpW4W5y0MOPmJjf8w54ON0vvd lE0M6FT2yZ514kP5WO713DoG1g9pfzqcygc2+ecX3FcwYCXDO8WwyQdEz/v/ nf6FgdfmRMfLtPzwj4sY0jaHgY2AQysVWH54wykaZID8ZPAMnds+fjijEGlu MIuBzogYoTF5fmi3Mr18fhoD+otMZysv88MWo0Vc6Q8MJAnwj/Da8cP9j2// 6iJPn5C2cXfkh5McKa8HJzAQnH7CTdabHxKenWRgRK4+/SAqKY4fcv3Ph9iN YUC1aLveow59H8u0ozdHMBDyncXoWws/mIj2D3Ag97AQeuQ6+WEs5HRz+TAG 3G3Uf0yMos/3y3vPivyW+zaNyT9+iKcJeVM3iIEdreCQN7v8YH/kEIsXssGt BFY8RgDUz1nWyiDP1r8nfOYQgE/C93TjBzAgeWdJVUFOAPZWk1Nu92PAI2v3 00OyAEDC0z5l5K/fWE9MqgpAwTtt1999GLgiI2+WclwAFNTSq5yRUwavuzBd EoCz4hxffXsxMIe9s25jIwD6j4T/6CCrHwj1rXYQgN2S//zZkPsiXkZ6eQnA MK/0p8weDHBqTuRMxQjAEY7uz6PdGPjVxlPT/VgAeNm114qQ6y4ZDHxNFYAT lR8uhSN7+RczvcgRAD9ut/8OI5/mmBWNfSsAUQHMPVzIMi+EDvsXC8ATPgv2 310YGPoa4nCpWgAkaV9LvkYuNvsYaFgvALn5WzRhyI+mlpI1WgWgHpL23kAG nGWLQL8AUHwPt8sj8yU9+sE0KgDvRQL82JGXpb9s/fshAInRCbZrnRjIOikn 37eE1tc5sesL8v2hy8fr1wTglF25VR6yhWPChZItARA4zCuQiKy00+iRRUeA kLl6Nn9kpqidyHgcAb5Jf1d3RJ4QVn4ZyEoAWwvPFEvkjwV2Va77CFAYlnZA D9mpo33BWIQAgV8WcDLIJ66iZCdJABov1eMEZJEVNWFFOQIYB54tY0P+98BJ RYhMAC33c9YMyB1cL4z2qBKANlRfe6MDnYeXvXZbGgQ4mnvw/G/kByosfnPa BPDxEM+dQb7YAE8G9AggqixMmkBWOedR0GhEgI5Buflh5L2zOQ1lZgQI5zEd 60ee9R75nn2eAOMaiSy9yF+YOf8lXiHAEfN/Tt3IKSkn2IPtCLDJcx9HtYe8 j7SHIwHKZ8X7qTasKjh6zY0AvlO/vlP/PdFo8pzpHQIsdnYKDyLTfOdz1fJF 6yfXkzCK3O9sGKYURIBW/kWtSeRC2sAMkXA07s1L/IUcHltazhZDgN99+lor yNfEfnXsJKLnud+L30bWKBKZm08hwAnKS0EcWh/u42b0wxkEaB/4MMyJvNT9 UKDlFQHyUl53iSA32lYpV+QT4G6EI50icsbf5ZO5RQSIvbZkq4nsE0q8llRO ANlYMTojZDM+K5/QzwTIOLjaeRlZITc6/nYdARRETYbckLGHa/NsWwhQ2yMh EIr8vfnfV7MOAkjet4xORY6dt15VHkGfVxcq2ILscP/xHrEfBMAdMD44iXyM rUWCY5YA8/L7AneR10gHzZdWCXCNUfizCnpfz7tjS/P2CIIObdfHEmSD8eEv /PsEYbJ83nMIWdO4qD2UXxAeOdUm06PzIyp3ZfYaURCyuqbEzZFnJsoFBY8K Qv4slyILOq8Dp2Nkwk8IQu0pYzUN5JZPdir/TgkCg1lY3i3kguR9p7stBUFU c6ulD/m2qdODSHdByDt9c6ECnX/76mMxm96C4Kp4XG0d2VJRIO26vyDcvDA/ exDFE03mhtLjjwThzZCLfzEy45f9c9vZghD53dS1FsWjOHL3aadBQeDM2+CS GkLva/rri0NjgqAcdCHLG9mTNcBBf1oQUt8MJbQhW84qBEmuCsJrieAn3ihe 7s8ILRthFYKSOD/eCRRf37IfETbSEgLPouOpqygep/tyyFXqCkFBz1/cxXHq +k+ryhoJgejU2bZ6ZM/GBBOslRA0ZTNde4biuYb/YtAnDyGwfqOed3ESA81L Gb8Uc4TALF+PLDiD1jNRkNbvrRDYN3vkPEH2OvyEq71YCBTT2Wy4UH4RD47U dK4RgrFs+WwOlH98BLyiCwaFQK1NUocwj94XnVMHlFiFQVOu2trhNwaik//e JbsJw5fAAduVDQxMgWt0wB1hwKRVSz9G+fDI1K/MDl9hIE8aCRxG+XKaNN7q GiEM/ou6IcEonx6taxF+nyUMrK8LbsrSYGF56fkX5T5h2N+xWZaHQomM2Mug p0IiYPzHyikE5XN+KU+LiP0iEHVyBH8U5XsmeR3Z++IikGbElLCJPHdoqv2K jAg0PDK/7bYPC3n6kgTpQyKw956auRMPFuRdXxaWnhKBF3YrrVGCqJ6pfjna 5SMCZtGBW3dR/aFyKVuNbVAEHtmN6jXqYKHIpCEYRkTgrLnHzZYTaL7OTKfL mAhwuETbtaN6SEZe1qnrpwjovb05PoDqJcJmfkbSCnIEseGfIapvHpcwi7Pu B+0o3JGLZ7HQ0FY7rHp0PxjFNw6W2WPhnOYPf+vs/eDjvibjEImFL/mtC0Rb Uei1r01d7cFCObOmscJ+MZjQaqqJ24+DWubZ45y/xOCryeVpSWccMDmZZuAW xWATs/YNXHBg3P5xZ/u3GGS8jzW0dMWh/juqdPqvGBykrdgKd8fBkuBB6Sp6 cXBc7Geb9cIBP8mP5bqAOCirJMpG++PA6Qx3Z5W+OKxc9yTei8UBb6rW5Rs5 4mB/1SDyRSEOZue3Dj3LEwcat3W2t+9xUKFZuqfrrTgoLnQ3fkD18sXvshUa JeJw7kXGSAuqp7PEuLjZv4jD+Syi40w5qn9zfzaXDolDUKmm5GYNDgxKI1QY 90rAqfRIvzsdOBDCnWBV55QAnerNluudOFi0oJ104paAzllnhXNdOIjd8Ijt I0hAra6z3MEeHPRrXJp/LS0BZa0762P9OLD9qvTCRFsC3Dzr/u0Zw4Hftx7W dE8JaDnlv/tqAQcMmldnau9IwLBpvZYn6idCcxe/zPlIwL3chmCtJRxEBeLu qARKQKvYxz19qP9IO6g+0RYlASsvBmj+ruCgMim1dPuVBGT4SDfTb+Jg48q1 y+cHJUBtK+yFKQYP99uW1P1HJOC64XnfXWS6w/e4ssck4Pn1v9q5qF/C70ts Wv4pAT553x9sof6Kt67+QNiKBIwr9nXEMeNBRUYW/2GPJDwTV2aN3IsH9+Xf 77hBEo5GuZVkoX5Og53dDKMtCbiuUUtx1P9hSKT11eOS8JMpafM58hNHJ83u k5Kw/vEw6akAHj5OzzbFnZUEVbnblvcF8UA/OjGx95YkeHQ5nuXaj4eWbboQ GldJ8OKUigpEjieIyiy5S4KvwKePS8iSlped//OWBK6P2PV61H/qdw9tRQZL Quynrh/XxVG/29zNxZwmCV1/lnTvov71/OxK2Ua6JGBivr/vQxbH77OafSEJ yiRptoOo/y3RMclozJGE57ighFnkgeo2hdBiSdB/2NenK4MH0bL6E4ytksBL iFz/hvrruZ6p2ZX/0HpEOh8XQv130Srjox8dkhDGxnv/OrKO8rGuL32SYPE3 /90W8o38z5cDfkiCozynADfq799lfrizuykJNoshNfuU0HoVSj9W2JWE9DhI OYNs9Smp6AIdEexc2+XiqOMDdxYrcESolfJyYaHeT7Kp23hxEeGe0tGAReR3 hNyAbF4i3OJmYJFQRvNl+NN7BIhQt/JV/xzyu2MbAwdEiaDL7DhVSR33Ljf+ rUCEjrre6NsH0PqEyDiJkIkQZElXmYFcEP803OggEQrJL1NaqONvveveHCZC YmCBB+EgGv84OzGkSUR9a62TFjKmyZKWRYsIkRnv+O2o4z/Uj9zQJULruzth eciMy7nnkk4SwVKOzbAV2XKX/3aDIREqWBe+/KKO82++kzQjwpYpvo54CI0T Hf4zsyCC4Ru8iTZywYHBXw/OE8Hn/GDUBeq4UQVx4goR/OChyCPkt1ayxzls iLDOesAtE5nhRrL1UXsivLty6vYH6vzbzH7ODkS40PtJrpU6/8Hd1GdORJC8 ejtulDo/dq68zYUInwyuvF6izn92vm/bnQhupJvuNCpofl7zqpwXEQ7uhiyw IjOUH+a0ukuEop0sPgLyufrXpPD7RLBtLFslUu8buwQMy/2JkGJYFECmzh8P d5h5QITYjsjPh6nzFzdDeUOJcH/h8Ftt6vwth5cnwomQEV1iqE+dzzT0xfMR Eay21tKMqPN5DMayYtDnN/19ZkqdL/5xpyueCHE/i06bI9OT5QgMT4hQECNb RL2PtKCkqCknE+HDWct6qvMNWM5apxFBU/ho+P/nW/q4xzwnwiHxsV3q8yzs fsV8ziTC+PoRCWPqfHert4vZRMgPstikfh/6gJYWoddE4MKrBRyjzo86Mnsq H70vPJMfjiC/ScnD3nuHnp98LUMZmS6XIJFXRAT1rs+HpanzSyO0BkuJwGzB ECxInf916xJTBRE+sx/230ud33HznloVERqPusrTUeePDj21ryZCz72ysGW0 H3QbH7vr6olgzf/e4j/q/eWHTxWfmoiQ+3tDpBJZ5U7N87JWImyQM2pzkG+u 1zvmdhLB/+WZTF9kTFmT6YseIiSpBo3YI6ffblVL6SeCycqlVWPk7rUOxkej RBD5cv2DIPW+u6R7LnicCEJ6dbZ0yEyefd98J4lwdYT4exK9r5qrw6kuc0T4 qHw5NQf51Z/pg2Z/iRA8km0uhqz1fk7AcIMIWeJSizvo/Ay7LtCe2CZCc0ac TT8yx/KfVlV6KXh2p/BXGLLP0o4NgU0Kjqv+sfuOzid3Aa0BF4cUcA7m/Cmk nt9bDGRWLimoVXW9+AB5agG/s8svBRivkW9iyEbz+xInJKXg3H8zB8xQPJjN 4/EZkpaCdOyvSiHkBzf5rbvlpECi35b4E8WTsjlhhXoyet7niBR3ZNFZmbpc TSk42KbJFUBC8TlHPu/FUSlQpsnM1kI+e50Um3JMChrypAh0yBHTBy8+0peC yH7PvHsonq1NwZqLuRTQc7x2tlPAQ/RL7aEb56RAMf8hvzCyrK1OzVUrKfDw cnrVjeLh5cmTj8yspeDWmLELBblxwlxSzUkKXPqHqhhRfE35ftOcJlgKXD87 hVyQxsN0xVGYDZWCts0iS0bkg4+5ZbrCpSC0zGV/HorXbac+b2fHSMGQsX/Y GorvtBWcWUapUvBn76PO+5J4sE0o/5NWJAUz0juhF8TwUOgcNRxaKgXuDt4f VlD+2D15rd61XAqMbqWPhyE/oWNN1vksBdabZiJFKN803bqitdAsBSaEKNMN YTwo6uNiNCbQ70m6Pm9GQPsnMexNnJICGRxL9xDKbw00hdfYZ6SAPO9cYY1s XXpedXJBCpovEYMdUD6MF387GrEhBXjZbSEXXjys75gpDLFLw2XN71UG+/BQ 8/5FszdIgwDTwowuyr/J9xoVM7Wlwe6wZeALJpR/TyzGtepIg/IN290tPMqH g+pWIqek4etlbEYeyt8P6Tp+1Z6Thq1GvcwdRjwYn6ZhZXeThi+pCSpONHgY XbAyzs6ShjU52Tw/VD9sSXN3dzLJwD2FD3zPUL3C/7KNtn6PDNR57W+p78OB qmiIQvleGWBJaS5c7MWBO/96SDq3DNznXxHWQPXOL6YBdUdRGQgDqag2VC8N z6WmY9RloDjwkHNLMw6q3kjcVLsuA+yrF4fVKnHgq3SQ/lm9DHTV3WxiSsMB 91BUrW68LGy3WO9jNsXBGs/jvGumciDV8jooC4sDa5AIrWaVh/2dLFKUSixM MC/+3eqXh9EjyTTgggXzScj/MyQPpb1pTgecsdBUFXttdlQeXnpdc5S+hYUC l0PfeiflgZTrt5/LEQs+vfdyC3/LQ5fKL/8/qN7lfsFywR6vADmlRuytl7Gg qy5T06mqAKGunhUbxlio4PTxajqsAHbWbSfpkRXmWxWqNRWAuVPpEYsRFval uyTnH1MAW1qC/P5TWBhj/OD+0FgBnnpfXDTRw4L3txNEir0CSN90t+4/iup/ e5uI3McKkBDLXOuljEzCVX5/qgClnkrdwWQsvF7PnedOU4Ct95EDCUpYyA1d MgzMVICmfWGNJYpYePXqLrvVOwXYSK2wYJDDQuZ0TOKeZgWQuVyg9p84FpLt q9KddxQg5URisSzqL56Srnx7SasIW67j8ZbcyOv0dMMMipCyoRwRxoWFJ6F6 V/WYkasW6uY5sZD4qktClFcRTtAUhlbvxULs9Gxup5IiPOi4xvuMCQth9jzF h2wUYZ77xl/VXdRPGUTMXLBXhEc0tzuidjAwr0grFOSgCL6oe/2J+injv7PB nS6KgG28b5OM+i2e4CoL5/uKcOfKpfS9qD/LfGGzlfNYEfY3/tI8sIoB85AB 0renyJfmCWkrGMA5GNmspyrC93wrJTyyA1mtTSdTEVpnzWgmljFArmZJnyhA 33eRST9rCQOfRt5rCzYpQpW7oajNLww410h5HWtVhI1Sm7Jx1D+KvkzNc2hX hIO5d6KuIAc7hnCV9yjCa8DQX0X9psGW5U/zCUUo2GO712Ma9fN8dOHRW4qw u4fneM8PDIRve34q3VWELw+nSfbIaUurd27RkuBVW53tJup3jbtu5CcykKC5 ubRQArko+QzPJBMJVl3c+h+i/tlbRmrGn4cExhSz1mjUX3uuvrbb4CXBUuJA iAayy2fFKVd+EoxZ7bOfQ/24vbnKxFVBEsxF7j7VRzYL0Bk+LkYCtZr5Tm7U vxufajpfJU6CVKuztS3U+0xew4FDkiSwpGEZDUTWyjfrJUqToGL7YcTqAAZI A9e+4RVJQGr51zvVjwG5rGmjABIJng5Ocr5EJjrfbNtQIkFJr7W3LbIQxr15 7gAJbB7xN8z2YYCZHFjbqk4Cq4ZQR1pkzDbmmM4REuzvYWFs6sUAXUNYTZUG Cb7+4WmMQ16/EPvpLaDnx2T3yiBPPXz+IUaHBO6Mr/bZ9WBg/IyEKpMuCU4l 2XOrIQ8L55QE6JFAdL+lDvU+pau44L2bAQnsH0QqlXRj4D+/A+Rfp0jwu19m PgK56WRZwTUjErjyFfReQ64e+/TGzIQEJngBdV7kj3nacm2mJNAeOF34pwsD Zbfrc3XMSLC3j8OyHTl/z3/ZKhZo//zqVSORU9RGnvNdJAGTTvUhLuQnDNYi sZdIgFHnVdzoxEDcf5NpTFdIcCebxuI7cpjNfPLmVTQ/8/fhAuRgkgu/uw0J hBfl/iYh+2+uPPlli/ZD/tLEA2SvmK2E4eskWDClMbqI7G7lt8/cgQSFrE/a DJBvERni2m6i/bnq5XsE+cZyCPsJJxJkvCq8Io9sW8kc/ekWCZy2zT2Eka+E RrGqupAAp+tezoFsZcoZWeBKQvGNVwlLvV8Vesws7U6CfVpG/VsdGDCd4Q97 7kGCXQvx93+Q42Xra9Vuk0BAc05kDrnH0Y22w4sEgQO8a9T7TN4CYY0b3iTQ XSwmjyBbLjd70fmQIC6ysYd6n5lywKvo6T0SyHOdG+9BHvYUXyL7koBR2d6M el8p9KFdttmPBG9H1xWpvrzpY3c1AO3fBWZX6vwMDekXm4EkOKqWJkB93oRv 90hcEAkMjuXLUe9PxWv8+eVCSOD7+FDWOLItg4L511D0/aJIQdT711c6AzFW YdTzFtdCvZ+dCQ1uXQknAYe8+d1NZJlmMj4ykgSTnQ4xGLQeN/eMHpOIIoGY cD0r9f4y3yjcrzKaBMG5Fn+o95eLMSofzWJJIHmKjUJCJnVN/J2PI8E2T99v QHbljlYOTkDrfyaN2RS5yOLILaHHJKgLOBlhi7z6dDq35AkJ6i3q3e5S91v4 qOjPZBLwdn/2zEEuvzJ/wTeVBE0/GGJrkDdfJCXxPEPxwSGTc5h6Py61vFc3 A+3fsJMeN3r/Pt9IM/j+Ar0P/CbbB5Bp3+iHemWR4PstWh4z5AdKL3ZfvULv r4Po3STkOjejw0dzUTxo0aytRMaWbHr2vybBTIWP+wRymPqZBfxbEqyPPqNV RucjWptx+EYxCby0VtvHkTuC3vHSl5LgPV+KJgf1/x8aLpxJLiNB7s5HNm3k RIOS5uYKEnC5eQ2+Qk41syuXqyHBSFktexA63yOPOde+fiEB8atq/CdkkYFP ShdqSaA/yua1iZx5kTcnsgF9vnGV9W0UP3LtGh8vtJHAgzekwhfFm5I7sh4F gyToD4wgdaD4xc+1P0F+GJ2fbU0QRPHufgF3ce4ICc7aq/leR9b5SbuaOUaC Uqfyh4woPvae6XNP+kmC0w/i60+ieLquGOQe8IcE9z9/eLwXxV+rZu/43RUS vHFzdHVC/mzrXOSzhtbPP9uzFTk09fyK5z8ShElwbDwaxwAfM9ndYZcE3+DA mDCK9+pTI25nmJUg9/uhdq+fKP77d8V9Y1ECs+rre2eQ6QSb3huyKsHv1f1u lih/NJkW/9FlVwIra5U0mMHA+epwNw0eJWD7d/weP/U+M0XVTVJMCf4t+83T L2Kg0iTWdV1dCZqralpy/mJgY9N5n9MRJWDIFXFWX8eAapZRyYSGEgQptvG1 IBf+ZdloAyWI5Ki8t/wPAy9TQvyzdJQg7ovy7ZMo30ZP+USbmKDPz/bIlqfF wjVvu/y860rgi+Xwy2fGwnMxHWNRByUwVVcuuciChZEW8eXHN5VAumN8mG0P Fs4Jjx8MvKUERL19u+6sWDD8alV5zkMJdn+muuuzY0GF1aQF468EE7bk0P2o 3mDKODJ7+YkSXJq3p70rhoVHNdp6a0lKqI/XuXEO1SfsE/qvwpOVgGlvbIeq BBZ4xc/ZlqQpwVkR7dQNSSxIvPQYZ85SggN9N7YfymABcvMHSt4pQcawzHoP qoc8C0WaWZqVUJ3Kzi+K6qnxGoa8sm30/OT1mcPWWLgoJ+anZ0WGiw0y/NzZ WLhbZF+9eIEM0u5uNudeoXrnSD5d4iUynNzHL5iag4VOA7WgcWsyEJRkmiXy UP3naBR29zoZzvePrh5+hwXl/LvxbzzJ8IqrQ8S7Ags4Utcr9hgyTOsqPiG3 Y0GyjG+2NJYM3t16Z/2+YUEbLslejCfDHVF/o7YOLNw3nn2T+5gMZsvtP250 Y+GPM8177TQyfEuq8ng5gNb7nVylx2syaF3/XScxiYVNNdcdgTdkOEFhMPec QutTU0qpySfDAN6Sof4nFkw7tGpYC8mwkXy2zH4WCw3LFvXZZWSYI1sZv1nE wpR3Gs6wnAwLcrp5O0tYoKf/obdSQQaX62H8xstY0OS81QKfyCCcnEL8s4KF 88lFe35+JoPDSfKXY2tY8BLbMIysIUPBh5wbiX9RPfiaEq38lQyN7LaE6XUs vFcO+tZfS4awF009ahtY+B8vYEcS "]]}}, AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesOrigin->{0, 2.85}, PlotRange-> NCache[{{0, Rational[4, 3] E^Rational[3, 2] Pi}, {2.8529453910332427`, 3.1520232794150633`}}, {{0, 18.77285527873031}, {2.8529453910332427`, 3.1520232794150633`}}], PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{{3.43540746101*^9, 3.435407556948*^9}, 3.43540784116*^9, 3.435884556071*^9, 3.4667700289059*^9, 3.4671150306781535`*^9, 3.4674871728549*^9}] }, Open ]], Cell["\<\ So for a \"small\" velocity (.1) this looks pretty much like a sine. Let's find the exact period and compare\ \>", "Text", CellChangeTimes->{{3.435407563876*^9, 3.4354076253380003`*^9}, 3.435407755917*^9}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"FindRoot", "[", RowBox[{ RowBox[{ RowBox[{"x1", "[", "t", "]"}], "\[Equal]", "x0"}], ",", RowBox[{"{", RowBox[{"t", ",", "9"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.435407979576*^9, 3.435407993105*^9}, {3.4354080234*^9, 3.4354080236610003`*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{"t", "\[Rule]", "9.40052505933113`"}], "}"}]], "Output", CellChangeTimes->{3.4354079934379997`*^9, 3.435408024475*^9, 3.4358845608129997`*^9, 3.4667700334299*^9, 3.4671150360757537`*^9, 3.4674871812945004`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"T0", "/.", "p"}], "//", "N"}]], "Input", CellChangeTimes->{{3.435408011219*^9, 3.435408034514*^9}}], Cell[BoxData["9.386427639365156`"], "Output", CellChangeTimes->{{3.435408013058*^9, 3.435408034789*^9}, 3.4358845623050003`*^9, 3.4667700349431*^9, 3.4671150374641533`*^9, 3.4674871831977*^9}] }, Open ]], Cell["\<\ For larger energies, the motion will not look so much like a sine:\ \>", "Text", CellChangeTimes->{{3.43540804569*^9, 3.435408059906*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"sN2", " ", "=", " ", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"eqnFma", "/.", "p"}], ",", " ", RowBox[{ RowBox[{"x", "[", "0", "]"}], "\[Equal]", "x0"}], ",", RowBox[{ RowBox[{ RowBox[{"x", "'"}], "[", "0", "]"}], "\[Equal]", "1"}]}], "}"}], ",", RowBox[{"x", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", RowBox[{ RowBox[{"2", "T0"}], "/.", "p"}]}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.4354071715369997`*^9, 3.435407185417*^9}, { 3.435407291157*^9, 3.43540734659*^9}, {3.435407468494*^9, 3.4354075548599997`*^9}, {3.435408078186*^9, 3.435408082426*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{"{", RowBox[{ RowBox[{"x", "[", "t", "]"}], "\[Rule]", RowBox[{ TagBox[ RowBox[{"InterpolatingFunction", "[", RowBox[{ RowBox[{"{", RowBox[{"{", RowBox[{"0.`", ",", "18.77285527873031`"}], "}"}], "}"}], ",", "\<\"<>\"\>"}], "]"}], False, Editable->False], "[", "t", "]"}]}], "}"}], "}"}]], "Output", CellChangeTimes->{ 3.43540808277*^9, 3.435884564487*^9, 3.4667700411519003`*^9, { 3.467115039320554*^9, 3.4671150488833537`*^9}, 3.4674871851008997`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"x2", "[", "t_", "]"}], " ", "=", " ", RowBox[{ RowBox[{"x", "[", "t", "]"}], "/.", RowBox[{"sN2", "[", RowBox[{"[", "1", "]"}], "]"}]}]}]], "Input", CellChangeTimes->{{3.435407817275*^9, 3.435407830974*^9}, {3.435408095385*^9, 3.435408116668*^9}}], Cell[BoxData[ RowBox[{ TagBox[ RowBox[{"InterpolatingFunction", "[", RowBox[{ RowBox[{"{", RowBox[{"{", RowBox[{"0.`", ",", "18.77285527873031`"}], "}"}], "}"}], ",", "\<\"<>\"\>"}], "]"}], False, Editable->False], "[", "t", "]"}]], "Output", CellChangeTimes->{3.4671150532825537`*^9, 3.4674871867857*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"x2", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", RowBox[{ RowBox[{"2", "T0"}], "/.", "p"}]}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.435408100148*^9, 3.435408110242*^9}}], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.67, 0.6, 0.6], LineBox[CompressedData[" 1:eJwV2Hk8VF8UAHD7NpaZebbIMoNimLGVLNU72UIlW6JFWSokUUKKLGUJEUKW EtqEhDYkhOzZImsq+YlQZBtLv9s/fL6fx3v33nfOue8eitNZqxNsLCws9ujH v98fA42P/H5+e+frr6c1WVh4gFjpkv7klh9uFPC9q4nAA2Gcoar+tyJwH6fv rrfEeGDH4/iLDrdS8JAfk/o0VR6QWEm5Y3nrId4QeivA0oEHeHIl1ffceonP Bi9ui6nggSv+R5m7b73HiWewM6f8eaHcad3B+FYvrtBO1g6d5ANpXt6PjMRx XGoxgGz+QwBKmAVOnrtm8e2eYeavtIggHSQz9NFuFr909birrR4RIllvHtzh NYs/Cg+c/o0T4QiPz17+u7P4F/+9uhRTInCI6mrlrc7isao9+ccPE+GAej3v 2Ms5nN313pTjFSIsnhouOsqYx48fVuU7WUcEvY+Cf/dKLuEHFWh9uCkJeFq5 9xZtWcJTvx3TCt9Hgu5altuY+RKOp3YbNVqSwLN0VqM/eAnvdL3gb3SIBFmJ PSdPjS3hHI8FxUVPk4DL6k5byLNlvO5P432xGBK0t9HvvNi9ggdOZT5NaSZB Zv2myQ2OK7iifwbp/AcSuFfKaAcGrOCiY5XkPV0kYC8kdRoUrOApjU9+/eon gVbsPGcHeRX/RQUh4QkSpO95c2ZyaBVPnnoW9JKbDCcb9u6Q9VnHzS5X13oB GY5YDbR1RK/j/1Fa2nINyGA16HY8LGcd76p2Hf5oTIYdv8LDxjrX8fo7WQKq +8ggLF7dmK/+F29sMHz4xp4MNae22urM/MWVbmfn7jlHhjj2uG1Kz1kg7BPn d6V7ZLhuYsvCVs0Ci3ceHF7PIcPVWKnG/hYWoLutdX14QIYAsfxDMaMs8JAQ 3eiWj8an3Bg4g7GCqXpI/cWX6PnW7LXPz7GCQtHCKm8rGSaz/Sz01dig1P/C psl5Mohnh7Jt2MEGrwoddyYtkcHwXmzpjCkbjDTYdeiskCHjbo54pjMb9Jr6 uAawYLA348PIYjIbVIgPHO7gw6Dw1mbvgjU2OPBU5miPNAZekb03xZvZgfRr lLTDEIOMiK8GM73scEA1OP2CMQYN4VPzdaPs8FPy2r08Ewxkr7EfOr/ODldn yHJ8+zDoCFGltqlzwF0nfP3OAQw0LkUUh6VyQKv2GwXZkxj8ObOta/oEJ6gw 05uDr2LwY+B6UtQ5TpiyhbcQjsGw6fAB+SuccFn2sNVaBHqewrVP9qmc8CV6 70GPaDSeoc6h2iZO6OiKGaYkYGCwz3M8TZULpKTYFybuYKBdXv1463YuePQs cNInCwMVJZHT7SZc4LWpO2TlHgainBVTnE5cYNfjeXM9F4OJCt45ryQuyHHo 2DmYh0GCyv0142UuEP6v5/v8cwwi0pYqv3BywwvZmDnTlxhc5tkbfJnMDfWK wTlprzA4OTrLVqzMDXsoARPq5RjoZACPlAM3JKdzimlXYTBCGCTP1XBDjvDr 1exGDD5eVO2O/cANB6UY2tVNGDT9F3pLcZAb5SldbLAZg9J3SuIO89zQrCdW xd2GQeQlP6nGzTywPFvxVqsTA9VJsuLdGB7o2/wifK4PzZf6jOCYiupOY2xQ Sz8G+vb7Z6i5PEBhfX49ewADm/fRLx6U84DnA8URoyEMAnI4jAoneKDxm0SI 2wgGV/uzFb0WeGCn7NhG5S8YxJJ28Wuw8YLoRffWH8hZVwK7nm/ghYa77R4O 3zCoP7zg+MaEF06Kuz2QH8OgPSHJ6IoNL5TdsPnRhtzXqKG06zgvnLKy3+X7 HwY/t539VevHC99fDahVjGNAFh4PannAC4sNfwQVJjHYuCfc6UYxL2TcGVx5 iawQKm9sUckL2X801nf/RPP7dVyg+yMvzEhaGRybwsChpS99gIMP/OuPtbvP YODK7n8lk8gHwlE1bmPI3rqizsc28oFZ5qD4sV9ofo+saN80+cCr4uCr3b8x uPH5l8B9nA/InxoevUROEY37fXIPHxSdID2Vn8Ug72rzqwknPrj413htHrm0 3C0j35MPHuTpGx2aw+DNLHewZwAfdHFo5pQjtx833D17kw92z/Pfu/AHg/nt bz4uV/FB5x77+/XzGKyfP/y6vIUPtPWfZmILGPA8Wc4I/MQHv7WU848iS2zQ cmH9xQdii48JP5DlLbp3v1vhA578F0doixjQI84pX+MmgLX62jtXZJgvnOWR IUArw/TjILKZyr6eJhoBIodtr5CXMLB2nnwdo0WAkpZC3Aj5SFpUprk+Abyj bEQvIJ/s2BxCNCeAvMce9mxkL556l057AkwkJHO1IF/EXUySThAg+pu27Bxy qC+biq03AVhEt1qILWMQU5AlJB5IAI+S2GRt5Pd3Qgd7owiAXxw6bo/MFu/y OCWZADK65yt9kbeHGPsezCHA+VOWT+OR/c4pGogVEWBcOUDzIXKxMx+xt4IA yqdnzMqQf9r8HExuJEBqdfF8I/Jm47bHtj0EmA+r0+xBdtpW5Cv6jQCb3ipy fkbOVEww6JkhwJdtQ26jyJ82+BCTVwng7P7NcQyZTLAdOsDLDyrX9ab+Xd+3 ui1PRJQf8kO+E0aQI6c2+H2k8sPa75E3vcg1wysGt1T54bYGnb0Fee3DEPHA dn4QtGwcqEDWrn47JGzKD8+JpbvzkM8X38vrPsAPJycmjZOQC3PC/JKc+EGV /2xfAPJ40glDm7P8wG2v9/coslz4bpLwZX6IcjV/tQPZwU9puCuSH7LD73NI IKe6Ep4k3uIH85Ido7No/QX3fDDEnvLD+zK5o2nIJtufkbrK+UFBzH3BFTmM njic0IDmd+0rdQvyktBBf/JXfthw4+DWKhQfmqw6Rp3T/EAKNpMMQfaclSAn rPDD7KYjSTuRv3UPPyGJCICTQh3+FMWfdH2VfwdFAJQTiOeckO1eZhvdZAjA 6LDTNjJy2+2Tn4kmAjCsznrpFIpvnmiT/HYbARAXxpf5kQ0u0y7GOwpA3Y1T fE9RPrxymCYTLwnAVlb77+MoX+b2t3/+ECEAbbmkp8HIjF3F+XFJAiCqk0QQ Qc6R8zUWKhSA54ldlzVR/t0YX7so+EUAKFUa+G6Uz419n43bpgRg5+Utd96h fOdorsZuMAUgh7U4bjvyxYJrBQLCgnD94B8l+WkMXM4JfOHfLQgbTa11m1B9 ues8U9BiLQgr22eVlZH7bToCYo4LQpNm4dPICQz2b7slzB8gCEvBpmd0fmCg u7rRhFAgCJqet956o/oW9cJ02+wrQcA+bK169x3Fm5fvpr5a5M6j78jIft8/ cDwcFIQtG4U7HqJ6WdoWWq3PLwSKauU8hajeqt4b1w04LQQ1WmeHaKheBx0W oTn6CcHnTwEs+1A9bxPR32ASJgQGy9sUPD5h4HE9fVEkXQj4e6LP3+tB9em8 eemzJiFQu7FAGUf7AVmuP/mPMBH62W1efUf7iW6wl+C4BBFOdO2b6UX7jeMQ V/iALBEma9Y3vW/AoChF80KNChHk+vRTM+rRfPljreMNiRCO+wXL1aD8nseJ Kj5E2ES3sbuH9jeuhvtRzl1ESEx88fBIDtofj4zw6PQR4c0+UYEFtJ9K/5aI FPxMhODHYzdi0H6rJREf/nqCCDgx4b+iTFRvPALChNhIoC4qO9mTgvYP4v7A cjUScM75K6ei/TzCfskLu0GCm/bmIjNeGAhPa/waT0TfbbXnxpTPov0n9MzZ ytskqLr/qePEGRRPT76ecbtPgjR882K7G8qvtRb3txXoO/ALX8BVJ5Qf2fdc Tk+SIN9Q2fq4NYrPSTO7dyZkIDkITU1oYJB/ZHOL2H4yiNX6R2aoYWDZxg4e B8hwnjfjlRkDg7RnFZtFnMjw5OxAT4YSqr/+jMWTl8jga/OFV1wWAytOcjJf IRnkAoPAnR/VH5m+LksMgwGf9xWBX8mgf/P57gcbMAicMx2u/kyGMbaEcqYM BgceNCSyDZFBbcwsJ0cFgyfTTWUXe9H3Y37FuXkjDI6WXl7e2UKGcZ0s0m1/ DPiPDIHCczJo2JzaPzL07zthh4PjVTI40txsGlBcmX3vtfMMIUM8y2n7IhSn +zcnHfIPIsN0vqdzMMrDyAMj58P8yZDH6esnKyAMU3tnWXw9yEB5efXu8e3C wNJoc6/FmgxEieyZkTRhOGQrRt4lS4apz4NxXw6KQL+ygLZ1EQm2JAZHmTiI wD7FxY02+SS4bCwf9tRFBPwlDiRbPiIBf8Fp30BvEbDbkWmin0UCWgDzyIZo EXizY3s5M44EJ4XFaZaVImChz3K8wZMEn02sa6vkRUGJq9p7QIkEHc8al+7+ FoUtESYapGQitB2pNRsJEweeknxJybuCcIQmPsaxsgGaNygpnJojALbz2+Ox m5Jw44bGZsleHjjsw/0yX0AKxnZVfXj1lROaf2X/VH0sDVJJ5ncZ/WxATZZi DX4qDfabDzQttLGBv16qSPtzaSiSvlZb944N5MNjd3rVSIPxQtVJ/wI2uCzp H180IA3VO5zkNELYgGG8b4u6oAwosV1y4aSxQXz64iWN8zKgYHGVNTWEFcbg XHzoRRmwiKm8YufHCtvHfuZ2XpEBrUsXyylnWGFc7WvruRgZUCysvt9mxwq7 6ltkSu7LgLumbX+iGivM/rr3TvOTDCwbJGp++sICNLkH19KkZYHXk/Xmoz0s IKHoaxdDkYWf0gNDWgYswEc3Vg6Sl4V1sv/ONl0WmNQaa3ekycI3rnkncRoL 5Jtt2qikJQv1Kx77JHnROePcg+KX+2RB2ldEveHmX1yt+sHn7suysNXjfXDY 3XVctt63uP6KLGgkyJzlvbmOE5uNr70KlQWnDQ3vc0LX8d/dY7SMSFloHGhf FDm5jhePb/J1TpKF5vo+3ln6Or6F+JB/9oksTDca6idXr+Hbjj3UERqQhUC3 gezZpVW81KohHIZlIf3gpvvyP1dxNeMfXd5fZOGACOcLr8+rOI2u7Nn9nyzs ce/ED9av4htXCrNv/5GFiHTr+GO3VnGWlBcEeUEKeHu5XHbTXsUvX++1O0Ci QFtTt4wBfRVfDly6Hy5MgerK9KfbqKv4rIsu/JCggOvevjpv/lV8VKPSp3Az BUb8a2SUv67gDW11Q9q7KKCV6ZhWkbCCG9aM0dwNKcBq5RhiFrWCVz/n9k/f TQFDbRrvnysreFmGKXl9HwV21/VR086s4PnurcbvDlFASKMkRtNsBY/n+vh0 nw8Fpi/xqefwrOD8zPnVID8KvKvFg2dYVvCoKVGzogAK1MlFrx9cZuKh3Xaj 5BAKlK+QHwZOMHGf7EHxT7EU2PBcyW9jGxO33zka4vSQAjszRGUK05i4xGhK ytE8Cjh32vnL32Lig1F7CuwK0P1906pK4pj48Y/Fn8xLKCB6z11N6hoTP+kR oqr3lgKbPmzh2ejNxBXJW420aiignkg6cMiDiU+8HD+kXkeBYJFNJc9OMfEz 7Bbhm5spYPXtYPETBzSeNOkhrJcCk/ej5Vr3MXEt6JwV7EfrWX7BsduUiS9+ v8bDN0QBWxmB1j9GTDxAfUqT5RsFppR7dEJ2MvHtvVmmK98pkGEksWtKl4mv X7Y5tjBOgc8f1ELPbWPiIQ3l139OU2ApnvCmQY2J63uezfrvNwV21G2puE1n 4hzCci++/qHAXDDzbxiNiUceu/7lE5MCAve0j+XKM/EbC3badVxUKP3ztUJY golbZPCbV/FSwb5nglIkxsRJ+lXO5fxU2N9IHXIRYeJJsZvjnpGp0KJw7KgE iYnbag7k5otQ4aBem4KkEBMX77tR9lCcCuMT+nu2CjDxdPmF75nSVKB9Uy95 zsvEjzQ9XkmlUOH1ifNLkjxMXNrrKClJngph7SZZ6VxMfESEtDluMxX6z3x9 soWTiWeX126/TqPC7g1HNv7HzsRdHP2trtHReMzfzBazMXEFbhXXYDUq6G5b Vk1lZeJj+Z8DL2mi/y+f7k5mYeKPrBITfbWoYBnv+rXw7zLuvmT82FuHCj0G UvYj68u4yh1mpcd2KgTtf6qjjDxtUNh9CqfCunzB1bi1ZfzpD8cJJ30qXNhx U1cA2StOhMXBiAoaijWHc1eXcY2tjSL2JlTwv50wboP8p/+yss0eKhhd3PVF GvlFsNqu/eZU6BhbNmJD9t80amtmSQWTxU7RvyvLuE5LioeRDRXO3vhgLYKu M733hMJBKsw5Dq8aIleI/U3RO0QFwbU+0g3koDfFBVpHqaBdG5nwCxmcT75T P06F7qWMIA80PjZeiT4VZyoMVJR+ZEXzeVfYOr35JBWiRQ+lFCFreVnzCLtR wdRXLNkHrUeeeh+FxQONtx1ntUTrJT3noPfTkwru75U/GaH1TCgdtfnkTYV5 f4qENVpvLl93z1ofKtRfsan3R+8jYNuviCI/KrxY/D7wgoOJO5WtlEUGUkHF YC9+mZuJ91wK6fYJpkLsZ65odvT+zXZwTx8Po4K55KReDh8TV68iU3SiqJB8 VqVBWZCJ54ak6irEUKHhR2+WMBHFk4G0DSmOCh6vTftEyEycpV4p4kcSFQL5 9jg7iqL8inia9TGFCokc8c+eiDPxcZOtZdVpVFDU5rIXlGTi7c0wdTuLCmzc 0vkbZZm4YWw9V3gOFU4dHbBuoDLxV+Z7Zc89oIK+Leu+GAUmfrfjoLVZPhX0 9kzQjiozcXLikIfWU/T3XgyCO4OJh9s4h1OLqfD5/pBmnDoT9+z1fM18SQWX tTwbqjYT3zl0TebJOxQPt9qvnzZm4sV3CDop9VQIZm08oWvGxDcdv2kV1kiF EQXf8xRzJi74LePa4Q9UIHTHSmjbMvGh8ZJJwgAVyvwjt0egemKRp8O5NESF AK0YKzFUb2pPv5UeHaFC9X+uwW+9mHj+dJNlxRgVKkRKhe0CmPjlP19eesxS IY5HsfjxDSb+6/mpDrt5KvB7iUowE1H++E1NGC5RwU3s7UWn20x8L3NJSmqd CiXT0YKXcpm4JAvxaiuvHLB66gk0lzPxMsJOCwZFDrwXtAS+TiOXC4/ay8tB XZxhrOEC8ulJv2ub5YB//OjXmjUmXt6ceneQLgeeFrlTZIEVvCJ6bvq6rhy0 S0UX/lVZwd8QHsf+Zy0HrXmxKRznVvDK8isU7KAcNL0LTpO9hHza9vnOQ3Ig HeM6cfAqcjP70K3jciBWomomnoIc7aBieEYObs5s/z38ZgWvIgg3Z4Wj8eqo ZAYQV/Gq8gmHlig5cBvHE4wlkU9Xzy7GyAH5sedm+ibkZk+J/Yno+W/jWc22 r+LV0Y1ua3fR/ZctxKvdVvEawhWeQ6/lwDRo14nbjat4HWHCCPspByapAXE3 MtZwPk/rbJ4ZOSBeP+Ga83gNt2ivWF/7LQdLd4v6W1+s4f1JcS/HF+WgLKLG yrljDf8ltVWpkl0ezp1aW73BvY5LqAXzu0nKQxVHosqg3zruaSPaVWmGrnOk 3h0+9RcXz9Q/7v5YHnzLgnJbq1hgYmpV626+PLh9bBO83sQC5TtfCnQ/lYfF s00BFt0s4DCiXL7jhTxEZwrLrPzHAvflRERJ7+Thid9X7nohVtDI+6/55aA8 qP+4kKjgyAp7X8Zs4yQqgLZAde09PjYI7ugRzPJVAGm2EF2hC+zgM/v7mShs gocCkbZyl7jgWe7ri39XNoGamevcsCsvsDErPta/3wz2Xhat7UH8kDHiYcsS rgg88sLkD5vQOawkpzkAlOBbfg2mX06E9MBG1VwDJTinE9o+8ZYIPrtnEluN lWChRtElvhadiwZ0j8juUwKCZyihs5UIUWydP+vslcCwOVdXdYQIFpYsgqTz SuBY/07RggN9704fsXh4XwlyzgScUTAjwaqS6McuPhp8tsza+ruZBBIP2ljf C9Bg6sWl/vAPJNCmRjDKiDTIPkdI2tBFAh+JpYgsURoMVA4aaPWT4Cdfv+4Z Kg041Iti9o6TYGgyM4tLlwah3xwu/WQnQ2WBgoeOGw2ELLX6FrXJMKg0nKri QQOreNtg1e1kYN5PrpM5S4PBgQhNF5wMWne4Zbgu0EBYx+FNrREZCm/86OgM psGS1KC9kxUZ7pwt2OaRSgOn5Ps3hU6T4Yr6Vva772lQy5XFr55GBlrGzryO JhosPtYX3J1Jhm4uE0uONhrIhr9OsM8ig+Lgobtu3TS4uPhezucBGTrDg/W2 fKFB5k0plyvFZJAfbD7fyKQB78E48+lGMjSFO43O0ZVB8qVOMH2BDD6/T0dv UlcG/7mz1V1LZJA5ckHDfosyxHqaX/VdQdfVI4MrdZVBrZsY94wFA6nBgo1R u5Xh0pzC6zU+DLzUl22kHZXhzetdJ6alMRAdjKszSVIGwbfLLuqG6Hy7rLzV KEUZHq/RQvWNMZgXacjdlaYMLIXlSRYmGHTvZ7mqm6UM0g5b0pz3ovPvOy99 lXxlSBKSVjxhg4HgE8u3QrXKUM9hc7THGd0vAHvdM6cMi1YC2d7BGCwkP1Xs WlAGvv261ymhGHwv2ZP6YVkZZJ6PuLWFYVA7FebX8FcZtt0dFZKJwCDU8c/W MoIKzKz2LqXHYrBu8rE4U04Fdotz7edIQ/cTS8l3sVaBoxmyCXFFGKRacMpa 2aqg8eZyfHqGzv9R5xNxexVQHBWMkypB51Dm/gCJYyqg2j8wefc5BhxDPCbt 7ioQYYe/DynDgJQd8E0vVAXOblcVLnuHQXH/uK3SNRUgkGgC3bUY2GAHm0Qj VeCPn6TMZB163lXNZ79jVaBZR+4GsQGd/0/9DHp4WwUUyqLStFswUFFxkMCe qYDETa+AtS4M2lxaYllKVcAxZRffj270PjJ1WadfqMAnX9bSjo8YlAiKjTdU qEBoWsSBtF40/t8fngc1qMARpm4nzwCG4nenkkezCghtIWkOIQc65WfYt6nA VIBxYeEgBlVdkWFbulUg7wH7H5NhDHa/2GU58VkF2q9rVR76gsH49NPa3q8q YLnDZ07sKwbXN0tr131H8xH0N+hEbktlSmdNqoDJA7YtO0fRfC+V/DywiMZT 7Gk3N4aBEyhEVgvSoWDs7KvOSQziT41emCbR4VfBr5QzPzGovJHjLClCBwcb BSLnFAYSQxT8giQdrtv0NylNY9B5UXpBUZEOn/4+dzf7hQHLvaFvB5TpUBcm QWpCZjRkdIQy6HB+NMbC+Dcan6hkweAWOhRfeZe2ZRYD/RIxl/hddEg0CT36 r3/m1d9j+caQDkofHVv3/sHgDmsyPrGbDvnBqT0FyMz9wpKG5nTYc532/MQ8 Bop+XTzelnTo+JJ0vQLZ9k7CQqYNHUz3+CwLLaD3/ZPYuXiIDuN6BTn5yCNY +1t5Bzq4h2Of55EF9eIKLB3pUO/GU6q3iIF7lEDUk1N0GA4opb1BTi1q8f3k Toev2r4tS8j1vdEunJ50CCwa4FZfwoC6iQ+O+dBBdyJnTwqyxb5GeowfHaL4 hWzqkIN8IiVfB9Bh4RFjYQY5P30371ggHfbu4tL412/ur+FaJIfQoZV0m1sP mWeibhS/SgcgTfgeRtYiXev0iKCD6O+VK/7ILtqGVbev0+GCVAc1ATnhGHth fSwdDr05fewRclV4TfpcPB3yilu3liNPF4REySbRYV/a0v0m5I0fwW9fCh2M W6ae/us3m63+dQlIo0Pj4ULrf/1mf7m3Vg8z6WAtpnfzXz/5gVkQdGeh9YlM cv3Xb+723sFgzaVDHLOs7991tturkoyHaD0CC0f//b9aVTnv4Tw6vO72jPrX b3b4L2AxooAOp86tvG/+118X1P1eWkQHA3/rrH/95rKty51fSuiw7dUF8r9+ 8/iRV1WCL+mwXHpc+l+/WfSqX6FeGR3uZ5Nr//WbDZ9oZbi+ocOBU1HsDsjn OuejblXR4W16zeC/fnPWcqlfzTs6tESX7//Xb26T9TkxU0+Hrdu8j/zr96/u 1rTe2EQHSasRtkZk2tlZMG2lQ7YRp0E6sl3yM4ZvO5qf2uBGd+TwN14bc7ro MPjf8fityN8IM4urfej9ZDsa1qB4sP0OhXODdLC4uONDBHJTZYLLxGc6FBGm nc2Qi7y1Onq/02FNrjyvHsWb3J7IiLZxFI+cbUeCkZPl+3fUTdKBeThbfBvy 5d7AvOLfdHAbuliQjuJ5pujD8cd/6PCw1jvcFNnpOkUsa5EOj1KF3f6gfDDd URcWu0aHw1b6e3Yhi+bwH3XlZQD3nvDQlyi/oi47YMf4GcChK/NoH/LqgaLG A0IMyC1R6R1B+fiVx0bLQIQBNlHhlusoX596pgtJUxiQFGTzQmQGxbfJVJ2w PANkWp9tSkL5nkzBLxM2M2AkaFeWEPLl7q/jSyoMMDXtKlxD9cJEl1bTpc2A ecsS7RcTGJRjl/2b9BgQJZn6eyMyY6qVUb2TAd72x0uCf2AgnOWdXmjIgPs/ zlri4xh84XztE2XBALEqy4XU7xgEdOzejLsywMSq/NObzxhM5d0e2nqaAawd zhLzqB4evzqZqOLJAK0uuosSsvG2OBYJHwZ0yvwSikL1E8vs6ftzhQF6Hx/X y/eh/HM9EZOXwoD9z47mtnYgq/G8GUljwEr+g4tV7Rg8WcqbEr3DgA0O4R1P P2CQF/nLPCyXAU7mZTxXWzF49OgS6cgzBoTerUhga8Qgd/xmskAzA2ZetbPZ vUUu2vLeoI0BDy59WCRXYpDj37t4sYMB1uMkz6YKDLJ5pOzHehlQUc49zED7 U5biI8m3owx4xqfX2FqKQbprZZbXOgOChRJeOT/GIE3NseMBqyrIBvG/HHuI vMTONsShCo/P2m09+QDVp0hTZ1OCKhQ6cT07lIPez6NuBaq4KrS6ymdvyET1 YXwir0tdFTY+f2U7E4fqr6vYc60TqhCqvuy8fA6D7Xtjfhx1VYXBU+pbRLzR +qqySl87rQq11xru0c+ierY4Ed7lrQrOZW9tbE5jIBZeaecVpAqVX+LFLqLv gdycE6uPU1RhNsDyr4w1Bm+HSwykmlSBEtjf+1UV1fMaRX/DVlVY2K2vmkBH 8fQgM/90uyqI/+ih7FRG+XUmQqSsRxViK6w/RW/CYO/qof9sv6kC0W1f1PpG VB83sEXHr6qCurveLPCieKAp/ggRU4MDUvLFOp/J4Dv/5BRTXA2a8k/fejJI Bu8q1bFzEmowKS9xVaKfDK622745S6nBldmysJluMhwINR4yklODIK0kft8m Mqj1u3TwqqrBh/QGs/lSMoxF3Xt901gN8vm6misiyGD9Q+L6vQtqoGMouegj T4Yk5fd1On5qcPTpQ+ybLBl6zpxn7fRXA3PTe5X7pMhwaLbZn+2yGshc5a0W FyXD8ZXLp5xD1WAx3jz4GjcZPAQ+GyrEqUH0QrZm2Q8SXFXP+fvoERpfnx0t 8QkJXlxUvlA0oAaXZbRvyiqg72cRyi36kBocHhMUYaWQIKhI9HnesBroH+x8 ObyRBMb/sc7nflGDW0aiR28Kk6DX5pPP7f/Q89hG9brZSbCkes0ndE4NTK/c Wmz/QgTdseHzNgR1iOlQfZ2fToQ3VgnnlnTV4WifS74iNxH4srdPHE9Vh9Za xWCtWAH4WsOR/2pNHcTj8lhbbvCBg4pcsOkRDZBT2KcqeZcbLpW6Vs8c1YDS HHmJyZvckLq9kC35mAbo5cfHll/lhq69Ote+OmlAtN2khYM7N5ic2X/9khvy t1TZgq3coFl4KanAVwM4JNTbglq4gEet+xHppgZoyx185LHCCZtebZh4maAB A8ZGYmenOcEAjik7JGnAbJ8D+HzhhCCLiYK8FA1o6PThi3jPCXNeLCUGdzTA jf1jSHsiJww/U3lz4YkGRHZ5arHTOWFF59y6ZIEGVJ4zmNOR5QTxmpd4TaEG tFGuJvpgnGDdqV8jWKwBdc0RjfPLHNAwa/f+4SsN0NpmL0l7zwFjAXd4zMs0 ICN9M3toGQews4+a/ilH68FtfWK4gAN2Ymdb4K0GjDQEjeYmccDh9FKB/6o0 4KG/y2ahSA60vzLNY2s0QPagt1rQJQ5IfoLHa9ZqAJdxJnnWkwNKNK919NVp QFfllxF3Jw74H9Wocnw= "]]}}, AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesOrigin->{0, 2.}, PlotRange-> NCache[{{0, Rational[4, 3] E^Rational[3, 2] Pi}, {1.6240225688520287`, 4.99404300123769}}, {{0, 18.77285527873031}, {1.6240225688520287`, 4.99404300123769}}], PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{{3.435408110611*^9, 3.435408118575*^9}, 3.435884568568*^9, 3.4667700447243*^9, 3.4671150609733534`*^9, 3.4674871891569*^9}] }, Open ]], Cell["\<\ Let's animate the 1D motion on top of the graph of the potential. For maximum artistry, let's choose to draw this motion at the appropriate \ energy level:\ \>", "Text", CellChangeTimes->{{3.435408198698*^9, 3.435408254377*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"E0", " ", "=", " ", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"V", "[", "x0", "]"}], " ", "+", " ", RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], "m", " ", RowBox[{ RowBox[{"x2", "'"}], "[", "0", "]"}]}]}], ")"}], " ", "/.", "p"}]}]], "Input", CellChangeTimes->{{3.4354082562390003`*^9, 3.4354083317530003`*^9}}], Cell[BoxData[ RowBox[{"-", "0.8442508459323266`"}]], "Output", CellChangeTimes->{{3.435408284118*^9, 3.435408294343*^9}, 3.435408332117*^9, 3.435884571271*^9, 3.4667700488115*^9, 3.467115065372554*^9, 3.4674871949445*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"plotE0", " ", "=", " ", RowBox[{"Plot", "[", RowBox[{"E0", ",", RowBox[{"{", RowBox[{"x", ",", "1", ",", "9"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.43540848712*^9, 3.43540853367*^9}}], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.67, 0.6, 0.6], LineBox[CompressedData[" 1:eJxTTMoPSmViYGAwAWIQvaTxsjYDwwd7jVNzIqVYXu+P+piyYobjRzhfIPGb imHzJzg/LOyFdo3NVzj/cL3C9YnHv8P5kzTKvzx0/QXnWz+fI+/z6w+cz32L 431Dw38k+xSfpcsxOsD4iVvP9eqUMcH51ZPntV/bxgznN/0J7egVYoXz59Qb 3NYMZ4PzM5yk0pOnssP5ihNe/1z5jgPOf/v9/r2rBlxw/rJXu0/x9XHD+QKy y98/ecID5/dlbk1boMIH5/9wWP0ko54fzreWTIrqThSA8wvCHx19ISAI59eZ vjorshfBn7aAuX5zrBCcr3JxwuYb3MJw/p4+/YkF6xB83Teh3Nd9ReB8Ef4P HEd+Ifis+2evV54jCufnmOy+yektBuev8UxasO8bgv/ttZTAs2nicP62YHfm KS4ScH6DR+v8Lc8QfKW7XjcWt0oi/GveMkXSSArOj5U7/5PxMoL/7VTvo4JG aTh/JktcSZCKDML997YuYjqC4LPVNoZYFsrC+Ywr49Y/EpKD84tnre8VOoTg 79Pu4BDMk4fzOVUtxRzZFeD8d2IvXtrEIfgR5+WFitYj+OvDZ3fw/UfwDx66 4JAXqohQ/6XPl30Zgi/kxLWE+TKCf6a/9df//wg+AEZnc70= "]]}}, AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesOrigin->{2., 0}, PlotRange->{{1, 9}, {-1.6885016918646532`, 0.}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{3.435408535683*^9, 3.4358845734040003`*^9, 3.4667700505899*^9, 3.4671150668077536`*^9, 3.4674871964733*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Animate", "[", RowBox[{ RowBox[{"Show", "[", RowBox[{"plotV", ",", "plotE0", ",", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"{", RowBox[{"{", RowBox[{ RowBox[{"x2", "[", "t", "]"}], ",", "E0"}], "}"}], "}"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"Red", ",", RowBox[{"PointSize", "[", ".02", "]"}]}], "}"}]}]}], "]"}]}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", RowBox[{ RowBox[{"2", "T0"}], "/.", "p"}]}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.435408340047*^9, 3.435408436264*^9}, {3.43540854131*^9, 3.435408542601*^9}}], Cell[BoxData[ TagBox[ StyleBox[ DynamicModuleBox[{$CellContext`t$$ = 12.417117226557265`, Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{ Hold[$CellContext`t$$], 0, Rational[4, 3] E^Rational[3, 2] Pi}}, Typeset`size$$ = {360., {105., 110.}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = True, $CellContext`t$1058$$ = 0}, DynamicBox[Manipulate`ManipulateBoxes[ 1, StandardForm, "Variables" :> {$CellContext`t$$ = 0}, "ControllerVariables" :> { Hold[$CellContext`t$$, $CellContext`t$1058$$, 0]}, "OtherVariables" :> { Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> Show[$CellContext`plotV, $CellContext`plotE0, ListPlot[{{ $CellContext`x2[$CellContext`t$$], $CellContext`E0}}, PlotStyle -> {Red, PointSize[0.02]}]], "Specifications" :> {{$CellContext`t$$, 0, Rational[4, 3] E^Rational[3, 2] Pi, AppearanceElements -> { "ProgressSlider", "PlayPauseButton", "FasterSlowerButtons", "DirectionButton"}}}, "Options" :> { ControlType -> Animator, AppearanceElements -> None, SynchronousUpdating -> True, ShrinkingDelay -> 10.}, "DefaultOptions" :> {}], ImageSizeCache->{417., {146., 157.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, SynchronousInitialization->True, UnsavedVariables:>{Typeset`initDone$$}, UntrackedVariables:>{Typeset`size$$}], "Manipulate", Deployed->True, StripOnInput->False], Manipulate`InterpretManipulate[1]]], "Output", CellChangeTimes->{{3.435408398185*^9, 3.4354084743900003`*^9}, 3.4354085435299997`*^9, 3.4354085871070004`*^9, {3.435408912242*^9, 3.435408924335*^9}, 3.435884577102*^9, {3.4671150742645535`*^9, 3.4671150777121534`*^9}, {3.4674872013873*^9, 3.4674872048349*^9}}] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[TextData[StyleBox["Morin 5.15 and 5.16", "Subsection"]], "Section", CellChangeTimes->{{3.435405653248*^9, 3.4354056723900003`*^9}, { 3.435408771718*^9, 3.4354087758459997`*^9}, {3.435748918571662*^9, 3.4357489209036617`*^9}, {3.435884582712*^9, 3.435884588876*^9}}], Cell["\<\ Between time t and time t+\[CapitalDelta]t a snowball of mass \ \[CapitalDelta]m==\[Sigma]*\[CapitalDelta]t moving at velocity u collides \ with a car of mass M moving at v(t). In the car frame the speed of the incoming snowball is u-v. Assuming the \ collision is elastic (not so realistic for a snowball), the outgoing speed is (v-u) in the car frame, and therefore 2v - u in the \ ground frame. Conservation of momentum then reads:\ \>", "Text", CellChangeTimes->{{3.435411048521*^9, 3.435411285934*^9}, { 3.4354113204309998`*^9, 3.4354113462609997`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[CapitalDelta]p", " ", "=", " ", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"M", " ", RowBox[{"(", RowBox[{"v", "+", "\[CapitalDelta]v"}], ")"}]}], " ", "+", " ", RowBox[{"\[CapitalDelta]m", " ", RowBox[{"(", RowBox[{ RowBox[{"2", "v"}], " ", "-", "u"}], ")"}]}]}], ")"}], " ", "-", " ", RowBox[{"(", RowBox[{ RowBox[{"M", " ", "v"}], " ", "+", RowBox[{"\[CapitalDelta]m", " ", "u"}]}], ")"}]}]}]], "Input", CellChangeTimes->{{3.435411348323*^9, 3.435411435783*^9}, {3.435411773352*^9, 3.4354117849300003`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"-", "M"}], " ", "v"}], "-", RowBox[{"u", " ", "\[CapitalDelta]m"}], "+", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"-", "u"}], "+", RowBox[{"2", " ", "v"}]}], ")"}], " ", "\[CapitalDelta]m"}], "+", RowBox[{"M", " ", RowBox[{"(", RowBox[{"v", "+", "\[CapitalDelta]v"}], ")"}]}]}]], "Output", CellChangeTimes->{3.435411439245*^9, 3.4354117926949997`*^9, 3.435495996816*^9, 3.4358489443050003`*^9, 3.4358845915620003`*^9, 3.4667701827063*^9, 3.4671150822829533`*^9, 3.4674872096709003`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"s", "=", RowBox[{ RowBox[{"Solve", "[", RowBox[{ RowBox[{"\[CapitalDelta]p", "\[Equal]", "0"}], ",", "\[CapitalDelta]v"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.435411447521*^9, 3.435411464895*^9}, {3.435411534263*^9, 3.4354115345109997`*^9}, {3.435411604993*^9, 3.4354116069890003`*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{"\[CapitalDelta]v", "\[Rule]", FractionBox[ RowBox[{"2", " ", RowBox[{"(", RowBox[{ RowBox[{"u", " ", "\[CapitalDelta]m"}], "-", RowBox[{"v", " ", "\[CapitalDelta]m"}]}], ")"}]}], "M"]}], "}"}]], "Output", CellChangeTimes->{{3.435411454361*^9, 3.4354114659370003`*^9}, 3.435411534847*^9, 3.435411607153*^9, 3.43541179405*^9, 3.435495998892*^9, 3.435848946492*^9, 3.435884593358*^9, 3.4667701844535*^9, 3.467115083780554*^9, 3.4674872108409*^9}] }, Open ]], Cell["\<\ Next divide by \[CapitalDelta]t to get the equation of motion:\ \>", "Text", CellChangeTimes->{{3.4354117051870003`*^9, 3.435411720472*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"\[CapitalDelta]v", "/", "\[CapitalDelta]t"}], " ", "/.", " ", "s"}]], "Input"], Cell[BoxData[ FractionBox[ RowBox[{"2", " ", RowBox[{"(", RowBox[{ RowBox[{"u", " ", "\[CapitalDelta]m"}], "-", RowBox[{"v", " ", "\[CapitalDelta]m"}]}], ")"}]}], RowBox[{"M", " ", "\[CapitalDelta]t"}]]], "Output", CellChangeTimes->{3.4354116919779997`*^9, 3.435411726043*^9, 3.435411796763*^9, 3.435496000262*^9, 3.435848948683*^9, 3.435884595451*^9, 3.4667701882443*^9, 3.4671150873841534`*^9, 3.4674872121201*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqn", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"v", "'"}], "[", "t", "]"}], "\[Equal]", RowBox[{"(", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{"\[CapitalDelta]v", "/", "\[CapitalDelta]t"}], " ", "/.", " ", "s"}], "/.", RowBox[{"{", RowBox[{ RowBox[{"\[CapitalDelta]m", "\[Rule]", RowBox[{ RowBox[{"(", RowBox[{"\[Sigma]", RowBox[{ RowBox[{"(", RowBox[{"u", "-", RowBox[{"v", "[", "t", "]"}]}], ")"}], "/", "u"}]}], ")"}], " ", "\[CapitalDelta]t"}]}], ",", RowBox[{"v", "\[Rule]", RowBox[{"v", "[", "t", "]"}]}]}], "}"}]}], "//", "Simplify"}], ")"}]}]}]], "Input", CellChangeTimes->{{3.435411511052*^9, 3.435411615627*^9}, {3.435411653542*^9, 3.435411679617*^9}, {3.435411735127*^9, 3.435411742288*^9}, { 3.435495979974*^9, 3.4354959934119997`*^9}, {3.4674872145849*^9, 3.4674872235549*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ SuperscriptBox["v", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], "\[Equal]", FractionBox[ RowBox[{"2", " ", "\[Sigma]", " ", SuperscriptBox[ RowBox[{"(", RowBox[{"u", "-", RowBox[{"v", "[", "t", "]"}]}], ")"}], "2"]}], RowBox[{"M", " ", "u"}]]}]], "Output", CellChangeTimes->{{3.435411524764*^9, 3.435411558133*^9}, {3.435411590474*^9, 3.435411616283*^9}, 3.4354116564379997`*^9, 3.435411743084*^9, 3.435411803269*^9, {3.4354959947650003`*^9, 3.4354960018710003`*^9}, 3.435848951116*^9, 3.435884597082*^9, 3.4667701898199*^9, 3.4671150889597535`*^9, 3.4674872248653*^9}] }, Open ]], Cell["And now we can ask for the general solution:", "Text", CellChangeTimes->{{3.435411813289*^9, 3.435411820572*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"DSolve", "[", RowBox[{"eqn", ",", RowBox[{"v", "[", "t", "]"}], ",", "t"}], "]"}]], "Input", CellChangeTimes->{{3.4354117475699997`*^9, 3.435411752635*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{"{", RowBox[{ RowBox[{"v", "[", "t", "]"}], "\[Rule]", FractionBox[ RowBox[{ RowBox[{ RowBox[{"-", "M"}], " ", "u"}], "+", RowBox[{"2", " ", "t", " ", "u", " ", "\[Sigma]"}], "+", RowBox[{"M", " ", SuperscriptBox["u", "2"], " ", RowBox[{"C", "[", "1", "]"}]}]}], RowBox[{ RowBox[{"2", " ", "t", " ", "\[Sigma]"}], "+", RowBox[{"M", " ", "u", " ", RowBox[{"C", "[", "1", "]"}]}]}]]}], "}"}], "}"}]], "Output", CellChangeTimes->{3.4354117530220003`*^9, 3.435411807858*^9, 3.435496005651*^9, 3.435848959977*^9, 3.435884599196*^9, 3.4667701937199*^9, 3.4671150994429536`*^9, 3.4674872279853*^9}] }, Open ]], Cell["\<\ And specifically if we start from rest at time t=0 here is the velocity:\ \>", "Text", CellChangeTimes->{{3.4354118327019997`*^9, 3.4354118581070004`*^9}, { 3.435411897883*^9, 3.435411901664*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"sv1", " ", "=", " ", RowBox[{ RowBox[{"DSolve", "[", RowBox[{ RowBox[{"{", RowBox[{"eqn", ",", RowBox[{ RowBox[{"v", "[", "0", "]"}], "\[Equal]", "0"}]}], "}"}], ",", RowBox[{"v", "[", "t", "]"}], ",", "t"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.435411863572*^9, 3.435411895349*^9}, 3.435749943279662*^9}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"v", "[", "t", "]"}], "\[Rule]", FractionBox[ RowBox[{"2", " ", "t", " ", "u", " ", "\[Sigma]"}], RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}]}]]}], "}"}]], "Output", CellChangeTimes->{{3.435411891033*^9, 3.4354118955039997`*^9}, 3.435496009804*^9, 3.43584896235*^9, 3.4358846010360003`*^9, 3.4667701960755*^9, 3.4671151016581535`*^9, 3.4674872300289*^9}] }, Open ]], Cell["And position:", "Text", CellChangeTimes->{{3.435411912401*^9, 3.4354119143050003`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"x1", "[", "tf_", "]"}], " ", "=", RowBox[{"Integrate", "[", RowBox[{ RowBox[{ RowBox[{"v", "[", "t", "]"}], "/.", "sv1"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "tf"}], "}"}], ",", RowBox[{"Assumptions", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"M", ">", "0"}], ",", RowBox[{"tf", ">", "0"}], ",", RowBox[{"\[Sigma]", ">", "0"}]}], "}"}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.435411915691*^9, 3.4354120027209997`*^9}, { 3.4354960694630003`*^9, 3.435496081691*^9}, 3.435749950207662*^9, 3.435849485475*^9}], Cell[BoxData[ RowBox[{ RowBox[{"tf", " ", "u"}], "+", FractionBox[ RowBox[{"M", " ", "u", " ", RowBox[{"Log", "[", FractionBox["M", RowBox[{"M", "+", RowBox[{"2", " ", "tf", " ", "\[Sigma]"}]}]], "]"}]}], RowBox[{"2", " ", "\[Sigma]"}]]}]], "Output", CellChangeTimes->{{3.43541195477*^9, 3.435412005064*^9}, { 3.4354960609230003`*^9, 3.435496084297*^9}, 3.435848972651*^9, 3.435849488748*^9, 3.435884605031*^9, 3.4667702024559*^9, 3.4671151087093534`*^9, 3.4674872340537*^9}] }, Open ]], Cell["Choosing numerical parameters we can plot:", "Text", CellChangeTimes->{{3.43541201349*^9, 3.435412018967*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"p", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"u", "\[Rule]", "1"}], ",", RowBox[{"M", "\[Rule]", "1"}], ",", RowBox[{"\[Sigma]", "\[Rule]", "1"}]}], "}"}]}]], "Input", CellChangeTimes->{{3.435412020317*^9, 3.435412038002*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"u", "\[Rule]", "1"}], ",", RowBox[{"M", "\[Rule]", "1"}], ",", RowBox[{"\[Sigma]", "\[Rule]", "1"}]}], "}"}]], "Output", CellChangeTimes->{ 3.435412038469*^9, {3.435496061127*^9, 3.435496090594*^9}, 3.435749852966662*^9, 3.4358489787869997`*^9, 3.435884605146*^9, 3.4667702043903*^9, 3.4671151156981535`*^9, 3.4674872383125*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{" ", RowBox[{"Plot", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"v", "[", "t", "]"}], "/.", "sv1"}], "/.", "p"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "3"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.435412039248*^9, 3.435412070957*^9}, 3.435749953649662*^9, {3.435750208988662*^9, 3.435750210875662*^9}, { 3.435849493992*^9, 3.435849499567*^9}}], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.67, 0.6, 0.6], LineBox[CompressedData[" 1:eJwVzXk41HkABvBx5NejdDK5KleTqJ1WWLYn75d2qTTpWESaGiKJMUkHcpZW MnJsWwh5ylPi6VB0yZE70WUTLYrBzPw6ZIo0mJ39433e5/PH+7zGvqFb/VUZ DIaXMv/3d1d+7uZQgcPQxLWozaFxDif3LDV/xtqEmpsRPgW6XLR+EgUJWVzw Dm7LgyYfw7fXpgSz+BjMlu3S+BSNBKbM0IcVg3aWQTmvXIiWxg0D21ipaB5f FZa5PhehFw83u7HyYCHun8uMKEFNSspDDus6Hqm0rtIef4BKaefTGUXX8XZv mc4p3kNUrFva02x5AyF5Z7vymh9ihyqPcUn3JuQV0+ffOF8B90q5yeJFtxB1 0MlaYFWJDbY/By5Ydhtj7AVTgmvVWMW6MELhLhrHPN5wS2oxTSOMkgRVwTbi Xtw/9s0Qr4+dLbtSBW63ylYjXjOeCFMWTIqqMIxwU05SMxqTX2UmsasRHvLG jfO6Gafnfbp0oaga6xwCEmjBE2ibmNbV5dags/GOc8XFFrAcheo6J2vRuDbZ SEi3Yn0sL7HMoxF6HN9SM/0XuBvh3134og358zX6XVrb0em9nx125BVq93XE a9q8wVwXYUAN6cBWJ2628ecuzGn3L/1lx1vMs6kQGMR2w9QouCjRtxdlcU+s Y2/2wq47pMUx4z2qqC1fyqveoeZH3Mb2nH6s0Q1z1s9/j8CqpqbKhAHM7J4j q/TqQ5bfFX2d3UOILWXRtoo+rNj+fnTKXwLTiY6M/oJ+9Mjc2sh6GmN9W1+M Woow0qu3kun+EafrXccv3xEhrThyr6fnZzz7ZK7qzh4Aa/Z0ztGcYfgXr2i5 f34A5YK44tT8L9j98djKbaqDaF+SSW3JGIHcSuyYvXMQZsdfme/MkiHsRF9y yP1B2G/utc7P+YoIe0tVC60hdAsSHYQp35BBdUYaeQyh1N5Lqz59FHrns3ab XxwC06Ox82riGERBaxNk74aAPkb64/DvsKjMKmg0FCOLGajFOjqOlpCca2Iv MRLy9v1pE/QDBtDRLTsjRm7b+YZUgRzDs+pG6xvEiOZnDi8Mm8DyiRrXl+Ni 0DxzXS/fSaxb3h34jSXB6Umpek/AFLQPROsFuUvw4IPL51neCkSZrii+ECPB 6yV2fb+aMUhyEq/MsFCCwGV+7MxCBhGf88768FSCGo8dUY6LVEjGc2t172EJ Vm2XFmkXqJDhN/Os1XSkCD7u3LHGQJXsijymfddGiqSA6T9UMlXJs17KIfQP KR4t5Cmk2mrklOFlLa9wKe5PnVSzSFUjsfr9QaI0Kdpur5UK56oTwjE7mnpd inqjgIaUDHVSp1gWF/FEihN33Qvea04jbYcENvH9UviY/MvdIZxGuiztbmdP SiEvZxtYUhqkmGPhPlOHxjE1ydOzMRokxu7jPVtLGkwze94SBkWWyqt2+zvR OML3+KoZQZHM5XbfHD1pGNruaWJFUUTmOz0qV+nqyQMXnKIpMkPROvJdaU2h 8LfIeIpwtjnfu7GdRl5x3V+SUxSxKvg9x9CbRoPYyqYpmyKLCadO5kND22/2 4cQKihQ/rr53zpfGfYuFGwoqKfL39+DjX5TmjlgselRNEf7scOLqR+NqvHPD 1zqKMNzy06eUXn0xmrmnlSKrpdVpe/xp+HbT5U49FAk3Fqn/FEiDKhxP5r5T /h29NXpS6ZJgaldkH0XYCs23vUqPyk2o0kGKtL3gR6Xvo5Gs7+1p/Jki6RWb DL4G0WD37bVc80X5//xlwcb9NNqLDim2yyji7yfXL1R6kX36lbQxipwxdB5w D6ZRy8iPKhmnyBFXvu11pQObStya5BTp0XSJ1AihMTPtgalokiIdPq9ucpW+ 5dk0plAo907MrnKl/wMA4q3A "]]}}, AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesOrigin->{0, 0}, PlotRange->{{0, 3}, {0., 0.8571428546438983}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{{3.435412047302*^9, 3.435412071385*^9}, 3.435496092074*^9, {3.435848966248*^9, 3.43584898092*^9}, 3.4358495099309998`*^9, 3.435884606186*^9, 3.4667702059347*^9, 3.4671151171489534`*^9, 3.4674872401377*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{ RowBox[{"x1", "[", "t", "]"}], "/.", "p"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "3"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.435412082021*^9, 3.4354120900220003`*^9}, { 3.435412120506*^9, 3.435412124626*^9}, 3.4667702310663*^9}], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.67, 0.6, 0.6], LineBox[CompressedData[" 1:eJwVUX081XcD/RF+plcWSjIvubtSQ/JW657vTFotixrykt2LzKTcLCFvN6F2 uSa3TLlcpia9yFsplRDXNdW0LCFaUkK43otxH88f53PO+Zy/zjkGviG79ytS FHVyHv/nD98eynYO4bLmZdSFh7Ivk/w/Z/7F+A4Ue6OnGvsq69FQT5CA4QPq VoL6VbeHrCuaHbltogBQXcyfvVpfsmRlX6cEMw6B8jdfeNfhPUvH5NkdeWso qPGzw5Ilk6wtEXyLRtFRUKu5bSG35Sx2A6sgnXMMvErxBe80ZcRrjel6M2LB YzGUThgswt+lexrTJ3jgldxsKGpQh3/7+oSp1njw9lHjv77XxISCKrwrE8AT +u2Xx+ogyaT7Y7UoCby6aZXM2M+g7XK33DjuFHg5tQXHwgxxKSIjhM/ho1rR MreNY4ymhh1v9jBSUf1uupfzwhRF4RrO3kppoPI6UplBZghPjruWOjHvz1K6 1zIsoFrmETjWmg4izlLPKbRCs0RSb9woBNU+3FffboNz7ZZGeyvPgApNKrFn bMJaxSVdd0UZ4EXZ9HQsBEY1ozYPC36DPmN3Ys/fBHdM3mUaxGWCvcn+22fr 7LHTpXZPEuc8yJ4NbdH0VoTkHm3cxcgB4b/bIXT7Frblrxnx2mIQC/Pd+mpO 8zsz7T2VcsE+9GBk55/foTH8rDhlIhfUCJuxztYFnuIQz5HW36HfOzVFmbiC ZcL4he+cD56jeu/ljW4wLHtRYdSYD33yXVmEozsGJNs13Sov4F8jlSNB0R6I HjJqrhT9ASqqTEPDwgfsiPa5PZoFYPdxrBwP/gAHxdPrBwXzPvgH5Up3NhZr zfE/i7uEZUPXdVt+5yBny/OtCZzLWNaRrhzq7Y+alJQ7TowiNG9NGV7jFYSq /raHCwuLkLv+FcPW7gDufvN5V6PpdVSrNP0o1gmGlyKHyl9RDGc72eC+3oNw rZox/EyvBLk2Q78btXCxw9oiUNukDFT+rsXZ3UfwzZtW7tGgMqS1WpWePRCG bWdiI/+5Mp8H79YwmAyDw2gTX/hFOYq9FML6l4aDVRRwbenGGyiWxxADt0hY MkSjNCrQrJRXKjONxYZ/7GcCeBWQFY3NHn4UC/OEvgWSmgqwjUsyuNw4fNFt rZngcAuBphnfcPfxwMx5YkPtuI0VyoWa5cXHoatFx3z4/g5uJTzPk0cmQFkl lO4Lug/pjU7WESEf77bHLR0ruA9b2Rf8mTE+/hSkaM/23Mep07rxK1yT0cB/ KjxlVo29d1Kuq69MQbLGUL6osBrExyd/vECA5YZGdXXZNdCfuPy3gJsGxlcC Jc2kB2DeS4+c6xJiexwn8YZbA7jZHYdnE7Ow4dcax7wjDcjU/WirIcmCrthA VZDeAJ54w5Cvigiyqld8/8cNuDUSEldxUoSMOU7ap45SFJ858IgpyEZPjG/W YatGEOsY/U/yxeBF+5WsX94Ehy12Sc//y0NF5P7Oi08eI1MUeMHp4h9o8zxg Fhr+FM57ivxOqZVAfZsgoIa0QqZ+I+f8ygosa9lfauPVgXVOnyQv2VsFI/3g wkTflxh3MLlcq/IAtp0Hm75KfwX22NcJeh0S1EzzdrZkvUaGnlaF9pdNCLwv lVbFv8H4YJKZ+Ym/cM6vQEeT3Qvhtejm9qEnWL/31eTc/j7sKt0wsJndgq6x XY/J9gFM5rJ6w28/w+jLleZaroNwFsW8rHFrQ9qVYz+6uw9Dcb9cpP6hA4yl qk4RWTLwpWWRrpFduMnlXUkVj8BdO/eMvvhftBgLaZf0UbAk9bKm4VdYc+Ip c9+5MSR8qvciyvc17JxfbhRnjWOTYJFw7GkPOrmJLEHKBFY2HcZmi7cotfNY XH96EvJPP78vKu6FlltD26XEKfi5hvkV6/QB3dTp2iMfsEo457XjeD/OaQUu ZkR8hDbLqYqh9h7xOT+dtAqaxp26R2+Z0YPIfpwpSeXOwHTg0vTlZcOIOSSU rQ79D+X9IVppzjIMcJgrPHxnkfRCW1q5aATJs/1KXQFzuBpan8lqH0Hl+23D SzzlyOleWOuXNYpnxrbdm9ZQhK/a1/PaYwyBJn5mwosUURlx6nlmMo4aN6+o r/QUyJOG+Nip9+Ow3NtfuDxPgZjELf/zYs0Egk84tm5ZpUh8yvO6HX+ZxKkA 1WkFoSL5/uCzsAGnKdxbzZH3L19ArOeaLazXfMDtuaQFa1MXkDCHN4xVgx/w uOzrfoG6EmmPjVKoaviIev0ASUq6EmEHv5TuFE8jocI175WaMql1XW/M/GkG 3oYvfLwEyuRW9BP35w7/Yeam2SpTWoX4/vootEhjFtEL+h6ejVUh0lUVTYad s9BaY8cxpmjCYOUePX57DuGH3MbVImlSd93jn8aTcuha+0sZUTSJPbrZxT9Z jurZwyL7GJro261rm0uVQ00gcDh2nCaHdlou3pgxv9uVujN9v9BENp2vLL4g h+TdBivpeZrUevxsHV4jx3K/pUcT79KkC3K++Ywct9eu3pFXRRNVG8vEh3Ny +Iyu1btXTRNJT/bWjQoUuXTcUTJeRxNLKWdfsxJFNufGaPk/oontjXtPVRdR xLdz4KZ9F01+6p1tP6ZDEfriR77PvzT5xM3FersuRa4G0z8c66ZJSCPvN209 ikzOGNKlb2kSbMk9UG4w/6uOp7vBME28XCI8hpgUMev+0XTLCE0UDYWv766l SEthmHzvGE2838b/nLyOInp2pwvSpmgSVN95gWlOkQeUOOrqR5qw9LY5TllQ JFB6dZd0hiYqvccH6y0psiit0qhnlia7IDh/xooiJe7SKbl8vr9joJOfDUX+ BzUN6XE= "]]}}, AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesOrigin->{0, 0}, PlotRange->{{0, 3}, {0., 2.0270448729942094`}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{ 3.435412090278*^9, 3.435412125476*^9, 3.435496094814*^9, 3.435848984428*^9, 3.435884608683*^9, {3.4667702071203003`*^9, 3.4667702315499*^9}, 3.4671151215169535`*^9, 3.4674872418069*^9}] }, Open ]], Cell["\<\ In problem 5.16 we open the window and let the snowballs accumulate.\ \>", "Text", CellChangeTimes->{{3.435748934092662*^9, 3.4357489582516623`*^9}, { 3.4357492737006617`*^9, 3.4357492859696617`*^9}, {3.4358489919700003`*^9, 3.4358490067980003`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[CapitalDelta]p", " ", "=", " ", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"m", RowBox[{"(", RowBox[{"v", "+", "\[CapitalDelta]v"}], ")"}]}], " ", "+", " ", RowBox[{"\[CapitalDelta]m", " ", RowBox[{"(", "v", ")"}]}]}], ")"}], " ", "-", " ", RowBox[{"(", RowBox[{ RowBox[{"m", " ", "v"}], " ", "+", RowBox[{"\[CapitalDelta]m", " ", "u"}]}], ")"}]}]}]], "Input", CellChangeTimes->{{3.435411348323*^9, 3.435411435783*^9}, {3.435411773352*^9, 3.4354117849300003`*^9}, {3.435749068823662*^9, 3.435749071654662*^9}, { 3.435749868925662*^9, 3.435749872904662*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"-", "m"}], " ", "v"}], "-", RowBox[{"u", " ", "\[CapitalDelta]m"}], "+", RowBox[{"v", " ", "\[CapitalDelta]m"}], "+", RowBox[{"m", " ", RowBox[{"(", RowBox[{"v", "+", "\[CapitalDelta]v"}], ")"}]}]}]], "Output", CellChangeTimes->{3.435749261665662*^9, 3.435749349381662*^9, 3.435749874005662*^9, 3.4358490505810003`*^9, 3.4667702374467*^9, 3.467115145197754*^9, 3.4674872437101*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"s", "=", RowBox[{ RowBox[{"Solve", "[", RowBox[{ RowBox[{"\[CapitalDelta]p", "\[Equal]", "0"}], ",", "\[CapitalDelta]v"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.435411447521*^9, 3.435411464895*^9}, {3.435411534263*^9, 3.4354115345109997`*^9}, {3.435411604993*^9, 3.4354116069890003`*^9}, { 3.4358490109820004`*^9, 3.435849022099*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{"\[CapitalDelta]v", "\[Rule]", FractionBox[ RowBox[{ RowBox[{"u", " ", "\[CapitalDelta]m"}], "-", RowBox[{"v", " ", "\[CapitalDelta]m"}]}], "m"]}], "}"}]], "Output", CellChangeTimes->{ 3.4357490750936623`*^9, 3.435749263438662*^9, 3.435749352323662*^9, 3.435749876049662*^9, {3.435849015094*^9, 3.4358490522469997`*^9}, 3.4667702387103*^9, 3.467115146570554*^9, 3.4674872481092997`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnv", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"v", "'"}], "[", "t", "]"}], "\[Equal]", RowBox[{"(", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{"\[CapitalDelta]v", "/", "\[CapitalDelta]t"}], " ", "/.", " ", "s"}], "/.", RowBox[{"{", RowBox[{ RowBox[{"\[CapitalDelta]m", "\[Rule]", RowBox[{ RowBox[{"(", RowBox[{"\[Sigma]", RowBox[{ RowBox[{"(", RowBox[{"u", "-", RowBox[{"v", "[", "t", "]"}]}], ")"}], "/", "u"}]}], ")"}], " ", "\[CapitalDelta]t"}]}], ",", RowBox[{"v", "\[Rule]", RowBox[{"v", "[", "t", "]"}]}], ",", RowBox[{"m", "\[Rule]", RowBox[{"m", "[", "t", "]"}]}]}], "}"}]}], "//", "Simplify"}], ")"}]}]}]], "Input", CellChangeTimes->{{3.435749296681662*^9, 3.4357493123446617`*^9}, { 3.4357498789956617`*^9, 3.435749885059662*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ SuperscriptBox["v", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], "\[Equal]", FractionBox[ RowBox[{"\[Sigma]", " ", SuperscriptBox[ RowBox[{"(", RowBox[{"u", "-", RowBox[{"v", "[", "t", "]"}]}], ")"}], "2"]}], RowBox[{"u", " ", RowBox[{"m", "[", "t", "]"}]}]]}]], "Output", CellChangeTimes->{ 3.435749265595662*^9, {3.435749300331662*^9, 3.435749354690662*^9}, 3.4357498864546623`*^9, {3.435849043361*^9, 3.435849054008*^9}, 3.4667702404263*^9, 3.467115148255354*^9, 3.4674872494509*^9}] }, Open ]], Cell["\<\ Now the mass is a function of time, which obeys the differential equation:\ \>", "Text", CellChangeTimes->{{3.435749363597662*^9, 3.435749379973662*^9}, 3.4358490624440002`*^9}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnm", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"m", "'"}], "[", "t", "]"}], " ", "\[Equal]", " ", RowBox[{"\[Sigma]", " ", RowBox[{ RowBox[{"(", RowBox[{"u", "-", RowBox[{"v", "[", "t", "]"}]}], ")"}], "/", "u"}]}]}]}]], "Input", CellChangeTimes->{{3.435749382128662*^9, 3.435749403722662*^9}, { 3.435749889780662*^9, 3.435749890095662*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ SuperscriptBox["m", "\[Prime]", MultilineFunction->None], "[", "t", "]"}], "\[Equal]", FractionBox[ RowBox[{"\[Sigma]", " ", RowBox[{"(", RowBox[{"u", "-", RowBox[{"v", "[", "t", "]"}]}], ")"}]}], "u"]}]], "Output", CellChangeTimes->{3.435749410217662*^9, 3.4357498937456617`*^9, 3.435849057017*^9, 3.4667702424543*^9, 3.4671151526077538`*^9, 3.4674872530389*^9}] }, Open ]], Cell["Solving for M[t] and v[t] together:", "Text", CellChangeTimes->{{3.4357494125166616`*^9, 3.4357494274876623`*^9}, { 3.435849064493*^9, 3.4358490656280003`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"soln", " ", "=", " ", RowBox[{"Simplify", "[", RowBox[{ RowBox[{"DSolve", "[", RowBox[{ RowBox[{"{", RowBox[{"eqnv", ",", "eqnm", ",", RowBox[{ RowBox[{"m", "[", "0", "]"}], "\[Equal]", "M"}], ",", RowBox[{ RowBox[{"v", "[", "0", "]"}], "\[Equal]", "0"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v", "[", "t", "]"}], ",", RowBox[{"m", "[", "t", "]"}]}], "}"}], ",", "t"}], "]"}], ",", RowBox[{"Assumptions", "\[Rule]", RowBox[{"u", ">", "0"}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.435749429691662*^9, 3.435749483677662*^9}, { 3.4357496374296618`*^9, 3.4357496541926622`*^9}, {3.4357496914546623`*^9, 3.4357497058376617`*^9}, {3.4357498971606617`*^9, 3.435749914047662*^9}, { 3.435749988223662*^9, 3.435749990485662*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"m", "[", "t", "]"}], "\[Rule]", RowBox[{"-", SqrtBox[ RowBox[{"M", " ", RowBox[{"(", RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}]}], ")"}]}]]}]}], ",", RowBox[{ RowBox[{"v", "[", "t", "]"}], "\[Rule]", FractionBox[ RowBox[{"u", " ", RowBox[{"(", RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}], "+", SqrtBox[ RowBox[{"M", " ", RowBox[{"(", RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}]}], ")"}]}]]}], ")"}]}], RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}]}]]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"m", "[", "t", "]"}], "\[Rule]", SqrtBox[ RowBox[{"M", " ", RowBox[{"(", RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}]}], ")"}]}]]}], ",", RowBox[{ RowBox[{"v", "[", "t", "]"}], "\[Rule]", FractionBox[ RowBox[{"u", " ", RowBox[{"(", RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}], "-", SqrtBox[ RowBox[{"M", " ", RowBox[{"(", RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}]}], ")"}]}]]}], ")"}]}], RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}]}]]}]}], "}"}]}], "}"}]], "Output", CellChangeTimes->{{3.435749464997662*^9, 3.435749484547662*^9}, 3.435749640720662*^9, 3.435749706799662*^9, 3.435749914887662*^9, 3.4358490681879997`*^9, 3.4667702475867*^9, 3.4671151582081537`*^9, 3.4674872583117*^9}] }, Open ]], Cell["\<\ Plainly we are interested in the solution with positive mass. To get the \ position,\ \>", "Text", CellChangeTimes->{{3.435749743800662*^9, 3.435749753821662*^9}, { 3.435749832170662*^9, 3.435749834558662*^9}, {3.435749974518662*^9, 3.4357499780936623`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"sv2", " ", "=", " ", RowBox[{"soln", "[", RowBox[{"[", "2", "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.435749994364662*^9, 3.4357499989096622`*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"m", "[", "t", "]"}], "\[Rule]", SqrtBox[ RowBox[{"M", " ", RowBox[{"(", RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}]}], ")"}]}]]}], ",", RowBox[{ RowBox[{"v", "[", "t", "]"}], "\[Rule]", FractionBox[ RowBox[{"u", " ", RowBox[{"(", RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}], "-", SqrtBox[ RowBox[{"M", " ", RowBox[{"(", RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}]}], ")"}]}]]}], ")"}]}], RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}]}]]}]}], "}"}]], "Output", CellChangeTimes->{3.435749999144662*^9, 3.435849077766*^9, 3.4667702519547*^9, 3.4671151628257537`*^9, 3.4674872599185*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"pos", "=", RowBox[{"Integrate", "[", RowBox[{ RowBox[{ RowBox[{"v", "[", "t", "]"}], "/.", "sv2"}], ",", "t"}], "]"}]}]], "Input", CellChangeTimes->{{3.435750078488662*^9, 3.4357501011126623`*^9}}], Cell[BoxData[ RowBox[{"u", " ", RowBox[{"(", RowBox[{"t", "-", FractionBox[ SqrtBox[ RowBox[{"M", " ", RowBox[{"(", RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}]}], ")"}]}]], "\[Sigma]"]}], ")"}]}]], "Output", CellChangeTimes->{{3.435750079611662*^9, 3.4357501047266617`*^9}, 3.435849083638*^9, 3.4667702537487*^9, 3.4671151644949536`*^9, 3.4674872628824997`*^9}] }, Open ]], Cell["Starting from x=0 at t=0:", "Text", CellChangeTimes->{{3.435750169595662*^9, 3.435750177150662*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"x2", "[", "t_", "]"}], " ", "=", " ", RowBox[{"pos", " ", "-", " ", RowBox[{"(", RowBox[{"pos", "/.", RowBox[{"t", "\[Rule]", "0"}]}], ")"}]}]}]], "Input", CellChangeTimes->{{3.4357501061466618`*^9, 3.435750130011662*^9}, { 3.435750161183662*^9, 3.435750161801662*^9}}], Cell[BoxData[ RowBox[{ FractionBox[ RowBox[{ SqrtBox[ SuperscriptBox["M", "2"]], " ", "u"}], "\[Sigma]"], "+", RowBox[{"u", " ", RowBox[{"(", RowBox[{"t", "-", FractionBox[ SqrtBox[ RowBox[{"M", " ", RowBox[{"(", RowBox[{"M", "+", RowBox[{"2", " ", "t", " ", "\[Sigma]"}]}], ")"}]}]], "\[Sigma]"]}], ")"}]}]}]], "Output", CellChangeTimes->{3.435750130840662*^9, 3.435750162206662*^9, 3.435849085211*^9, 3.4667702569154997`*^9, 3.4671151701421537`*^9, 3.4674872646765003`*^9}] }, Open ]], Cell["\<\ And finally plotting both 5.15 and 5.16 together, we see that for the same \ parameters, the superballs make a better propellant:\ \>", "Text", CellChangeTimes->{{3.435849114773*^9, 3.435849124818*^9}, {3.435849579823*^9, 3.435849608998*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"v", "[", "t", "]"}], "/.", "sv1"}], ",", RowBox[{ RowBox[{"v", "[", "t", "]"}], "/.", "sv2"}]}], "}"}], "/.", "p"}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "3"}], "}"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"Red", ",", "Blue"}], "}"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{"0", ",", "1"}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{{3.43584935601*^9, 3.435849433245*^9}, {3.435849555513*^9, 3.4358495671619997`*^9}}], Cell[BoxData[ GraphicsBox[{{}, {}, {RGBColor[1, 0, 0], LineBox[CompressedData[" 1:eJwVzXk41HkABvBx5NejdDK5KleTqJ1WWLYn75d2qTTpWESaGiKJMUkHcpZW MnJsWwh5ylPi6VB0yZE70WUTLYrBzPw6ZIo0mJ39433e5/PH+7zGvqFb/VUZ DIaXMv/3d1d+7uZQgcPQxLWozaFxDif3LDV/xtqEmpsRPgW6XLR+EgUJWVzw Dm7LgyYfw7fXpgSz+BjMlu3S+BSNBKbM0IcVg3aWQTmvXIiWxg0D21ipaB5f FZa5PhehFw83u7HyYCHun8uMKEFNSspDDus6Hqm0rtIef4BKaefTGUXX8XZv mc4p3kNUrFva02x5AyF5Z7vymh9ihyqPcUn3JuQV0+ffOF8B90q5yeJFtxB1 0MlaYFWJDbY/By5Ydhtj7AVTgmvVWMW6MELhLhrHPN5wS2oxTSOMkgRVwTbi Xtw/9s0Qr4+dLbtSBW63ylYjXjOeCFMWTIqqMIxwU05SMxqTX2UmsasRHvLG jfO6Gafnfbp0oaga6xwCEmjBE2ibmNbV5dags/GOc8XFFrAcheo6J2vRuDbZ SEi3Yn0sL7HMoxF6HN9SM/0XuBvh3134og358zX6XVrb0em9nx125BVq93XE a9q8wVwXYUAN6cBWJ2628ecuzGn3L/1lx1vMs6kQGMR2w9QouCjRtxdlcU+s Y2/2wq47pMUx4z2qqC1fyqveoeZH3Mb2nH6s0Q1z1s9/j8CqpqbKhAHM7J4j q/TqQ5bfFX2d3UOILWXRtoo+rNj+fnTKXwLTiY6M/oJ+9Mjc2sh6GmN9W1+M Woow0qu3kun+EafrXccv3xEhrThyr6fnZzz7ZK7qzh4Aa/Z0ztGcYfgXr2i5 f34A5YK44tT8L9j98djKbaqDaF+SSW3JGIHcSuyYvXMQZsdfme/MkiHsRF9y yP1B2G/utc7P+YoIe0tVC60hdAsSHYQp35BBdUYaeQyh1N5Lqz59FHrns3ab XxwC06Ox82riGERBaxNk74aAPkb64/DvsKjMKmg0FCOLGajFOjqOlpCca2Iv MRLy9v1pE/QDBtDRLTsjRm7b+YZUgRzDs+pG6xvEiOZnDi8Mm8DyiRrXl+Ni 0DxzXS/fSaxb3h34jSXB6Umpek/AFLQPROsFuUvw4IPL51neCkSZrii+ECPB 6yV2fb+aMUhyEq/MsFCCwGV+7MxCBhGf88768FSCGo8dUY6LVEjGc2t172EJ Vm2XFmkXqJDhN/Os1XSkCD7u3LHGQJXsijymfddGiqSA6T9UMlXJs17KIfQP KR4t5Cmk2mrklOFlLa9wKe5PnVSzSFUjsfr9QaI0Kdpur5UK56oTwjE7mnpd inqjgIaUDHVSp1gWF/FEihN33Qvea04jbYcENvH9UviY/MvdIZxGuiztbmdP SiEvZxtYUhqkmGPhPlOHxjE1ydOzMRokxu7jPVtLGkwze94SBkWWyqt2+zvR OML3+KoZQZHM5XbfHD1pGNruaWJFUUTmOz0qV+nqyQMXnKIpMkPROvJdaU2h 8LfIeIpwtjnfu7GdRl5x3V+SUxSxKvg9x9CbRoPYyqYpmyKLCadO5kND22/2 4cQKihQ/rr53zpfGfYuFGwoqKfL39+DjX5TmjlgselRNEf7scOLqR+NqvHPD 1zqKMNzy06eUXn0xmrmnlSKrpdVpe/xp+HbT5U49FAk3Fqn/FEiDKhxP5r5T /h29NXpS6ZJgaldkH0XYCs23vUqPyk2o0kGKtL3gR6Xvo5Gs7+1p/Jki6RWb DL4G0WD37bVc80X5//xlwcb9NNqLDim2yyji7yfXL1R6kX36lbQxipwxdB5w D6ZRy8iPKhmnyBFXvu11pQObStya5BTp0XSJ1AihMTPtgalokiIdPq9ucpW+ 5dk0plAo907MrnKl/wMA4q3A "]]}, {RGBColor[0, 0, 1], LineBox[CompressedData[" 1:eJwV0H8003scx/H5+Skl6WrXz05FI9VxT7vKlN4fdKgU4uZXtdvMZOVXrpsi iVLShujek4Ryb7e6K126cVV+DLHbUKJYYdv3O2Qu8ivZkrv+eJ3nefz7WhUa 48fRplAoezT72k9e0YW+MbHb+nzNzn3t+TBbuxc0b+C+l8+us/SG1lHFET6N CePvF9X4GDPhw0N3XiQtGjwHKsuWfY6CNOqk5QHaaeBa+hqsf5UM4uZd/f60 LBgxp/vNpPAh5sbxf31oRdC4mOUZJL8OQh7vyR5aKWywU3o6VwlATz8ODR2p hRuzLFV3wWPYmcJKfxTQDJm43rEhqh4qT3J6b7W3gSK58JuRN00gCTnqEJfQ AQklHeoWYzEYe/LDhbgLKBkKeuevbbC0k1O+ef87GPQSFltpt4P1ysi76aFS kENWcOn5V+DUGyV2zZWDc4XK0Lq9A4SqM7s7C0hwrp80PGX2GiJqRaKatH54 QKbWXKK/gXz2bfPlhwahad5UPEvvgg1B8o9fOEOgbbS79+Cmbuib9GnDO4fB WyvNapwqgQmp2XfUfSPALcz/LVglgRxB4uHAwDFos5H+YyZ+CzSjBXtOFHyA MnepBy3tHVTEnhFkFY/DyuiGJwyXHuhck4f25k6AUcP9kaVED9ic7bA7mD8J gqvTg5RLvcDwlX5fXDAFL53MDUdt+6A3Nn0bnzcNKmkZS+9hH5Qzgg2fXf4I UXmJL1LdpEANaJbcSZ+Bzmyb9tX1UgCCcrk+/hOUnn5eLreUQT41wpB2YhYq f7JSK0NkkFbEveB4RAXeTy7Q/HJlUNh2tSkrVg3PJF4p3WIZJEfnfbCK+ww6 CeZp41pyGGbZmQaHzsEyrwd5RzfK4dKcUrcv/AvwTE/RP4XJ4fF/nmNLQuYh yCNm2yHN72/WOBHONhTsni0k91bLIWIt2yHvFgX7517pclfKQRiwP8l1hRau LUjKerqMAHqQ8q7JTS089q2ut4ULAZFnPbpcLLTxkoN05wA2ARnhC1RaedrY UGIXV3KBgGor1rzSRAf71/fz6+4TUPXlvI59lg6e82MrHF8S0PbQXck31sVO mwOFnCkCnq0Mb+Ll6mIx03HiJZWEc5X7bsoN9PChzBau2pGEA6t7mPv5enjj oh8SWwJIUFc4WKxD+rj6d/OB7HgSTukMtfxyWh97RHHZ0zkkUG0YrDUUhMvi GEGjpSQkRAdMGZxE2Ij9yIL2nATLTWEiWhLCwxm5i4o0rps7dt0tGWH7xJKR 5WISDPj87YmpCHf7czL0WkgoEjReGbqI8NYXdaaKVhKa3m90FF1DOHvM4nZR OwkmbKPj6U8RdmH+wVsoIaHK3mrXzRqE174ea07RmDlhv6K6DuE/ubXT0xrf SfVommpEOMZWbUe8JWHLjWRqWCvC+vHrR6t6SAjtHa5w60M4cOFf0+EyEtCt 2UymDGGVihfSo/G9SPRjIoFwh8C0fK+chI/q1ah8AGGTAx6MrQQJmeYhgavG EF68w/XOUgUJDsThdS7jCG+/+LYkXePOuz/PB00ivOPaphyVxisYl2/nzCDM sXV1V/ST0EApTro3i/DfxVMLggdIiBDd8xGpEd4iixe2arw457G1Yg7hY5zG SLdBEsoCRTPz8whbC/oNKjX+H59+W00= "]]}}, AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesOrigin->{0, 0}, PlotRange->{{0, 3}, {0, 1}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Automatic}]], "Output", CellChangeTimes->{{3.435849374251*^9, 3.435849433559*^9}, 3.435849568782*^9, 3.4667702625783*^9, 3.4671151759609537`*^9, 3.4674872688417*^9}] }, Open ]], Cell["\<\ Let's take a look at the velocity *difference*, and note it has a max a some \ finite time:\ \>", "Text", CellChangeTimes->{{3.4674872816961*^9, 3.4674873183677*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"v", "[", "t", "]"}], "/.", "sv1"}], ")"}], "-", RowBox[{"(", RowBox[{ RowBox[{"v", "[", "t", "]"}], "/.", "sv2"}], ")"}]}], ")"}], "/.", "p"}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "10"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.467115191467354*^9, 3.467115277407754*^9}}], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.67, 0.6, 0.6], LineBox[CompressedData[" 1:eJwV13s4VNsbB/AJSaUSkiSp6TSSrrrR5btLd7qhkuMofhWVhOgidXRVhMlB johUonJJEppEDGbMzJ4QilAuyS2DMTNIv3X+mufz7L3X7PWsd33fvWY5n7I+ osRgMLRHMRj//W4qWx3sbPUWV+Kn7HeLzkLk2NzI7y7vcJoK951e9RqaMaVK kur3WPAkgmOy9g2GJmYle6wpRPy+7Q8HHr5B8+WHu3viC+GW5alxbiwHWS6X 7v88VgS7CfN0ssQc2JsuM+8e4iL7sKZd8u48PODHeXbM5OG3k+MJs+B89Ee9 Mm64zYPXk9ChX7n52OxS1lSu4OHigYBP89vy0aks25tbwYd5ZeoUIVWAVWt3 mt8KEKDg0caxRzsKIE4bVmL9pBF0vKZDzCqEJsY6TlgoRnmi2l9LdxRi9dxw 84DDYqy3LDxt4FWIkP7kPt8PYgQmp4XF5hZi2Z2PR5yffcDbCgvh0c1F+Jtv sn3JwQo05cWmXN/ORdKL13OfRVTA9P3M/TbHuCiP2qD8h6ACOdYBK4sCuJjj YsfRNauE1GLyx/BCLvjK1xYytD5i3FqtEu2VxdBZW6tJF1dhKIPXfHdiCag5 R39u/VWFuTrBLGOjEhwbLyl7b1oNh9Gh2l7rS8D5pHo9K74aizpjvs09XQLn M0tlsb41WMPvmY6KEqSm3ap1W/gZGVmXk/tulKJds/32dqfP6NZandoaXQrW me3rjMI/g1+lO+txaini14x/0KT4jLqQCuGNj6UI490+as+thW2ulnG3IQ9n mkIlWxy+INLGb1iQykPG5p6EP0K/QLTWpo3zjoefybttld9/wWadSeaXxTy4 ekx+nceqR77fVrVbEh7sf4X5Le+rR+Z89tuEJXzEjS+7OnlTIwS/M24ffsrH urUXHPwdG9F4NyGkPJuPOvf5y3+ebcTiMan6+iV86JYHtQqeNkLtq7GXRRMf d6Kstt3U+ArXwv1lXdPKcPUP0cTftV/xPq9pl/LlMrjgw7+dXk2odK2rvb5K AEbCQG5tUBPcvYIGvmwQIEpFv47/qAnxPM9JM3YIUMo7apBc1YRyUeCqPU4C GNkOJxwxb8bN4n1zo24K0ObKel4/qgUeKV/HVJYL4F9mJRTqtSD++lLD7FoB dBd6dXNMW2CcG191o1mArX2cxfeOtCA6Na27WSpA8kXrV/t5LfBKG3MoeaoQ x8Mu5onZrRheVDH20n4hlKQJDe+SWzHSFrCdeVCI6P2ljLT3rThcKjbOOioE X1/LIri/FVfSRs4+9hFi/pOkkm1237Hs+HB7apgQnW8qxO9ntmEwbeQrmyeE e8u8pszUH9A0l6+Mmi9Co+MntQLeD9SdGTvz9RIRbGpuLhQ2/4B5TWwNd6UI q8q+n2/Ra4fu1uqDLy1EUH7xWEMnoB3pM7K7yu1FiPKbte7swQ4MJ08y3HhD hHED4v9d9e3Acy+nRM8gES6e8r8VGtGB404q6++wRXB2bqh8UtaB1MUGK55E i2CyNfZEzcpOGBT0xS1JFaFAa9q/ZhpdUCv0319bLsKy4NK8TfO74M52KlxV LUKi6rnmPZu7QK0bZgXWinBbUbXouF8XYsQ+28Y2i7CvIbw4uq0LyxgDDRf6 RWh/qtE/lN+Na0cCVbdp0XCYkz9Nra4bw9uu7e7VoUHHnoK2rBti9Rfz7+jR yGSLAk0W/ES8SkFv2iwaf5+5Peuvf39Ce471Bu9FNMbNusZqWNUDb4fpM+Zv o1G65s6iS5t6sDXxxFQVKxo37O6vnGHdgwGJjPVxJw0ldvaWP0/0QJy+RHDQ lsbgSKdLdWwPUjM+1eoepNFRtzeJVpIg3X6HD+s0jady53T3SRKYHHimdcuH hqu2R/YEfQkqlf1yms7SaLYMLLVcLoG+7mSba3406nLz2kpcJAiMsVnjfZ2G IIo1L18ggfZ+D2+9SBqBmcuWHPwkwUSzNqFmFI2t4vVmIy0S1Bs6/1aJplE0 xmHbmt8S+GsG6VXH0uCcYR/LXtILqm3qRdPHNFJsFcnpkb1QS/8qr8qg4eah mrHrYS9cVz1e75VJw/i2Vm53Wi9M+G5T1bJoJBYu4JvwejF36s9/mDk07i91 bk8a6sXttVoSvXc0QjTKjB8c6oNqdatUi08jZ+WMVzvd+yB/ZDPtXBmZn+Mp DF/ow8TaM+wqAY3VKVq2++/2oT39z6QrNI22bQ4XJ4j60BY6Oy+qkoa2Z+qY N7V9aPUJeCf+SANRjDDXH30Iz/nhrlxNI7L1UWKhSj8M474qHfhEw+JqF31+ dT8cDb8YFX+h4f4U9qxt/Uh8ol9UWU8j+sOd5sp9/YgKt3Oqb6DRM3OFYpFX P/TOqvC/fSXz4Vya3ZrUj4m2va4vWmjwmsTP/8nqh5LBpXn/ttLoH8dcub6o H6tMYO73nYblgRLLmIZ+xGQ2ei77QUMuneRjrSPFI8c7q907aTBnOP/+zZQi Zs8O/yVdNHZuzLyVskSKxOG5jj3Ej8Ps7qvtkKLnzHw1J9KnrBc9KMm7KoVm yUTVSb00Lu3r2+N2Rwq7OzUq6cTJFzfVTYuTQlW3sNGqjwZD8KPHO1cK73Wx u337yXq6LtWbL5FiztKhnkcDNGpCrz2qGZHCILUh5w8ZDZXXVQtvqA9gqfh/ cQnE9qMvWHxlDUCjurieLSf1bSIUhiwfQGZg7hYlBY0XNjPt1lgMQFR5tuMU sVpCodtdxwG4nShhUIM0THlTZBvdBiCw7fZPIHbscbnce34Atn+pHRg1ROPV OvXIHREDyPYLX5BJ3HjE0XAoYQAjXTNXqQ3TUA9Of5qUPoCYSx+y7Iida23f KQsGwMhYbvKTeNy9ryc9Pw2gxydEYvqLRoa9u35DK3n/q2pHfYiVPweczx0l Q8yZez7dxM//1TYymiSDeOGSGXNHaNgeeFAVoS/DIa1vt+2JH9XkmnqulEGt ddSXHGKrqC3f6jfKUB8XwGsm7t9fybaylqH4wL5I9d80YqY6IfegDLqB9tuW EG+q7upinZTB18+7zZq4O9I3JsJXhkr3c+c9iSP3jbFUvinDcMpCpWDidTrh Co8IGVZk2Nx8TNz60TCpPkEGvdVRk98Qh0Sk7LNKl+HSiQcPhcQr9pqPzn0r Q12z2sYvxPXaJS9ZZTKEfXOQ/yAOqLRxjqiR4amtYXEf8eLwRg3lVhnCB/kZ g8Q1NiffefTJcPgir3CE2F9r8GQ9Q47GWxdHfhMbVdzQt5ooh0P7Wtf/rovD tMpypsuhEr9P9b/nz1nHn2fNk8NqWK2+l9hQc4FRxAo5anKC+tuIeR9yqpQ2 kvunjN9VR+x1Z/N1jz1ysJuTegXEensqTOsd5Xj+wq85l/i9xqFvlm5yNNP/ zEskPi7uZOecl6PSW1IcQqzJPg9WgBzxdEiBN3HuLtXu8HA51Az/NLAjdp70 T4xSghwewtXfVhGPp2daeqTJce2iuuZU4syQ54ovHDk4xnEZvWT9HHaaJVny 5bhtziktI34utB7NapEjJiPA9cx/9RDc8DK8V470grtDW4iHrdyclRgK1D2T 6kwl3iG4/u6LngKM0Qp5CqmngSBNd0sjBdh0Vul/9XbfMk4/Z7kCHnv7lq4m 7uZnnw/frYDd36/b8ki9RgZuMlJyVKCNq7H2IvG67eVVp06Q+5fdXmtGHMrr MLW8oUD+yYW2T8l+WFxq0D2Ko0D/vAW7PMn+qQl4FnOKp4Dru8YLM4j9t6yy /FKlwKMbrmdKyP4TF+9JypaQ8V6atmgTe3KvOZ9iDYJhxpkWSfazQfNm1QHT QYR7S0ZWEpcpjX3qRw1iTqKjTg3Jgz+oYMmtA4NYM2tHmybxp9wI/0dBg1A5 bO5+muTH+vTE+59+kvGePbn/rYfMT+S64dDwIPSVP2gcI77XZdzaqjaERzN8 mrtIXkmN0xb0zxrCzdPb3/R2k3x6/Joz0XYIPaym0z9I/k2+V/rZInsInQ1j XILbaOTlBF7iFw0hf9Bh2RDJzxM1VrP3fBiCh59fsAsxd8qHY47t/42v0bWa 5O159if5Of1hbHTalVjRROPr9XadVP9h2P2KmVZA8vyFh7qN7rZfoIrXSR9W kP4YrXU+Zd8vuLY5VlSXk/1WpBe34fAv5E95u3scsd60eR1uf/9CUYCH6Qkx jWsFm64WvPqF+Gj7Bn0hjX2af788PnsEpfeiZeuLST9/KdF6OzQC7z6O78PX NB5cONG+eD+DSpeM8je7S9Yvf6w84C8GxeiIUjIj/ThfJWl0w/8YVI3+eu7K CJJ3wc2GwR4Mqk2ir2H6D1mf+L/2/7jFoG4O9TQahpJ+VLSr6AGHXMeD0M83 aIRNWHZfc/Yoqsg3kiMi3wdX4ob39HeOovwriuYo9pC8r2ikOL7KlJqWzc8g VRpzvY+eszUeTXE2XVJ9mCZCs/TuvvFvVSl/MSu7508RtrccvxjmqUaxTwdN G88QYWcze76BwTiKcTRcl/9YiPZCZ//SlPFUjanrvO3WQiycXDXD4uAE6pr2 utZBuQDjIHWq65tIGb7SPDbziQBbuuxls/dqUNc+hzVY7Rag5v3hUfYmk6mN Wdom03+V4dXNIkdD6WRKoyht6MiLMhwd7dMoEmlSVtGi1yedyvA/rwuv1KO1 KI+MysB83TIscpkvsnLSpjpjhQ0HyDmO1jQZ72M2heoJCuvUDeTjTeqVeybK OpRD9fuge1v4uDDKeLfgiw6lXhOVHTCKj3F1vlvdM6dS6ZPOuaTm8dCSOCs8 zk+XOmRRW658hYdwo2kqOXunUZnXQxwZG3hgRx8tcTLUowT+95bXjiHnk/C/ ROrf9ait5ia/d4lLId/4WBGXN506fNpha2xEKZpaNpx7H6BPabjUUpsOlSJh 7ZLpQqcZlLqbz6mfrFKkXPeZ7LLAgPJvs7VI7S9BwN7/WSpLDSgNi6pliYUl WF73IDlAOJMyGpe0oiS0BFHz7qUILQ2p/nE3K4MPleDv/OAoyxxDipNqKohb WIId0/c+5s+ZRbl+8136YaQY691L/px8axZVd9YswqKiGHH6znME0lmU4fEJ frMfF2NO4ZPInX/OptgWw16TLhSDveC9cXnebGrj3NFpr6yLcbRP5QPPmElp h+Ufb2UVw/lFr+GtUCY17MPJrGQUw+2KzfD2O0zK1lJ3thGxj01mtfo/TEpt W37chd9c3JT6hLAjmZSKoL1s9ggXqWaKobuxTCr71OHvnuTcrij4XZX4jEnp Fr0z0hrggl2uHlxUQv6vqK7QqYOL6IcnXW/wmBSjSLr8dTsXD71FFlvLmJSH pXq2OnGWDnuwTMSk9Ncadb5u46LOXsu14iOTav5crTWplQtW0zSLb01MatlY hWN+IxeLM30NHrUwqSjXUlqH2Px6reLIdybVmeW++2QDF1as2PQf7UyqMXDF Zb16LrxOGBpIJEyKo+kR71PLhd+ay4qMPibl/eNlqOAzF9cnfKv0lpL3Z78J YRJHpT0MksuZlH+xOudDDRcJ/iouuYNMyjB8T7sR8bM9Rzb4DTMpu5TdRv7V XGTOLp6xboRJ7c4Yc6a6iou8vrkK8sFH3bbwrlhI/H8LA+5a "]]}}, AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesOrigin->{0, 0.1}, PlotRange->{{0, 10}, {0.08829381109319637, 0.24999999929703076`}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{{3.4671152154289536`*^9, 3.4671152779537535`*^9}, 3.4674872706045*^9}] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[TextData[StyleBox["Falling Chain (Morin 5.28)", "Subsection"]], "Section", CellChangeTimes->{{3.435405653248*^9, 3.4354056723900003`*^9}, { 3.435408771718*^9, 3.4354087758459997`*^9}, {3.435412154159*^9, 3.435412154868*^9}, {3.435412374642*^9, 3.435412376026*^9}, { 3.435745586125662*^9, 3.435745605871662*^9}, {3.435849644663*^9, 3.435849651474*^9}}], Cell["\<\ A chain of length L and mass density \[Sigma] is held vertically with the \ bottom end attached to a support. The upper end is then released and the chain falls. First let's animate the \ motion. Each link is assumed just to fall at g until it reaches its resting place, so at time t a length \ (1/4) g t^2 is at rest:\ \>", "Text", CellChangeTimes->{{3.435849661531*^9, 3.435849673712*^9}, {3.435849710032*^9, 3.4358497412019997`*^9}, {3.435849858725*^9, 3.435849869832*^9}, { 3.435849909745*^9, 3.435849990597*^9}}], Cell["\<\ Here R is a parameter to control the size of the semicircular loop. A fancy \ version would stop drawing this bit at the end of the motion, but we aren't fancy.\ \>", "Text", CellChangeTimes->{{3.43585073506*^9, 3.4358507771359997`*^9}, { 3.435850940168*^9, 3.435850940427*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"p", " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"L", "\[Rule]", "1"}], ",", RowBox[{"g", "\[Rule]", "1"}], ",", RowBox[{"\[Sigma]", "\[Rule]", "1"}], ",", RowBox[{"R", "\[Rule]", ".02"}]}], "}"}]}]], "Input", CellChangeTimes->{{3.435850119317*^9, 3.435850135016*^9}, {3.435850926545*^9, 3.43585093142*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"L", "\[Rule]", "1"}], ",", RowBox[{"g", "\[Rule]", "1"}], ",", RowBox[{"\[Sigma]", "\[Rule]", "1"}], ",", RowBox[{"R", "\[Rule]", "0.02`"}]}], "}"}]], "Output", CellChangeTimes->{3.4667703770511*^9, 3.467115604602154*^9, 3.4674873420952997`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{" ", RowBox[{"tf", " ", "=", " ", RowBox[{"t", " ", "/.", RowBox[{ RowBox[{"Solve", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"1", "/", "4"}], ")"}], " ", "g", " ", RowBox[{"t", "^", "2"}]}], "\[Equal]", "L"}], ",", "t"}], "]"}], "[", RowBox[{"[", "2", "]"}], "]"}]}]}]}]], "Input", CellChangeTimes->{{3.435850568568*^9, 3.435850607835*^9}, {3.435852965844*^9, 3.435852966716*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"2", " ", SqrtBox["L"]}], SqrtBox["g"]]], "Output", CellChangeTimes->{{3.435850595366*^9, 3.4358506081029997`*^9}, 3.435852967381*^9, 3.4667702751363*^9, 3.4667703885327*^9, 3.4671156111853533`*^9, 3.4674873442012997`*^9}] }, Open ]], Cell["Here y(t) is the length which is currently dangling:", "Text", CellChangeTimes->{{3.435851859477*^9, 3.435851878421*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"y", "[", "t_", "]"}], " ", "=", " ", RowBox[{ RowBox[{"(", RowBox[{"1", "/", "4"}], ")"}], " ", "g", " ", RowBox[{"t", "^", "2"}]}]}]], "Input", CellChangeTimes->{{3.4358517588719997`*^9, 3.435851788343*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"g", " ", SuperscriptBox["t", "2"]}], "4"]], "Output", CellChangeTimes->{3.435851788876*^9, 3.4667702801751003`*^9, 3.4667703911847*^9, 3.4671156131821537`*^9, 3.4674873460109*^9}] }, Open ]], Cell[BoxData[ RowBox[{ RowBox[{"draw", "[", "t_", "]"}], " ", ":=", " ", RowBox[{"Show", "[", RowBox[{ RowBox[{"ParametricPlot", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"R", RowBox[{"{", RowBox[{ RowBox[{"Cos", "[", "\[Alpha]", "]"}], ",", RowBox[{"Sin", "[", "\[Alpha]", "]"}]}], "}"}]}], "+", RowBox[{"{", RowBox[{"0", ",", RowBox[{"-", RowBox[{"y", "[", "t", "]"}]}]}], "}"}]}], ")"}], "/.", "p"}], ",", RowBox[{"{", RowBox[{"\[Alpha]", ",", "0", ",", RowBox[{"-", "\[Pi]"}]}], "}"}], ",", RowBox[{"Axes", "\[Rule]", "False"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "L"}], ",", "L"}], "}"}], "/.", "p"}], "]"}]}]}], "]"}], ",", RowBox[{"Graphics", "[", RowBox[{"{", RowBox[{ RowBox[{"Line", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"R", ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"R", ",", RowBox[{"-", RowBox[{"y", "[", "t", "]"}]}]}], "}"}]}], "}"}], "/.", "p"}], "]"}], ",", RowBox[{"Line", "[", RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "R"}], ",", RowBox[{"L", "-", RowBox[{"2", " ", RowBox[{"y", "[", "t", "]"}]}]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "R"}], ",", RowBox[{"-", RowBox[{"y", "[", "t", "]"}]}]}], "}"}]}], "}"}], "/.", "p"}], "]"}], "]"}]}], "}"}], "]"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.435849994271*^9, 3.435850008826*^9}, {3.435850053611*^9, 3.435850112303*^9}, {3.435850142656*^9, 3.435850228652*^9}, { 3.4358503520369997`*^9, 3.435850388276*^9}, {3.4358504609309998`*^9, 3.43585051319*^9}, {3.435850658078*^9, 3.4358507107*^9}, {3.435850792289*^9, 3.435850916211*^9}, {3.4358509566219997`*^9, 3.435850957082*^9}, { 3.435851372451*^9, 3.4358513779849997`*^9}, {3.435851408398*^9, 3.4358514513129997`*^9}, {3.435851498722*^9, 3.4358515984519997`*^9}, { 3.435851798019*^9, 3.43585184123*^9}, {3.4358518897650003`*^9, 3.435851893977*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Animate", "[", RowBox[{ RowBox[{"draw", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", RowBox[{"tf", "/.", "p"}]}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.435850151174*^9, 3.435850157403*^9}, {3.435850401459*^9, 3.435850401776*^9}, {3.4358504689779997`*^9, 3.435850469267*^9}, { 3.435850530935*^9, 3.435850536535*^9}, {3.435850613126*^9, 3.4358506135030003`*^9}, {3.4358529809379997`*^9, 3.4358529815889997`*^9}}], Cell[BoxData[ TagBox[ StyleBox[ DynamicModuleBox[{$CellContext`t$$ = 0.8548799514770508, Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{ Hold[$CellContext`t$$], 0, 2}}, Typeset`size$$ = {360., {178., 182.}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = True, $CellContext`t$2471$$ = 0}, DynamicBox[Manipulate`ManipulateBoxes[ 1, StandardForm, "Variables" :> {$CellContext`t$$ = 0}, "ControllerVariables" :> { Hold[$CellContext`t$$, $CellContext`t$2471$$, 0]}, "OtherVariables" :> { Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> $CellContext`draw[$CellContext`t$$], "Specifications" :> {{$CellContext`t$$, 0, 2, AppearanceElements -> { "ProgressSlider", "PlayPauseButton", "FasterSlowerButtons", "DirectionButton"}}}, "Options" :> { ControlType -> Animator, AppearanceElements -> None, SynchronousUpdating -> True, ShrinkingDelay -> 10.}, "DefaultOptions" :> {}], ImageSizeCache->{417., {219., 230.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, SynchronousInitialization->True, UnsavedVariables:>{Typeset`initDone$$}, UntrackedVariables:>{Typeset`size$$}], "Manipulate", Deployed->True, StripOnInput->False], Manipulate`InterpretManipulate[1]]], "Output", CellChangeTimes->{{3.435850152273*^9, 3.435850157758*^9}, 3.435850216335*^9, {3.435850392199*^9, 3.4358504021800003`*^9}, { 3.4358504672390003`*^9, 3.435850553127*^9}, {3.435850614157*^9, 3.435850620976*^9}, {3.435850675343*^9, 3.435850685443*^9}, { 3.4358516087019997`*^9, 3.435851630734*^9}, {3.435851896601*^9, 3.435851911807*^9}, 3.435852982068*^9, 3.4667702890827*^9, { 3.4667704171743*^9, 3.4667704252239*^9}, 3.4671156362233534`*^9, { 3.4674873521105003`*^9, 3.4674873542945004`*^9}}] }, Open ]], Cell["\<\ The homework question is to find the force on the chain applied at the fixed \ support. Obviously part of this is the force needed to hold up a chain of length y(t), \ namely \[Sigma] y g. The other part is the impulsive force needed to stop the next little bit of \ chain. Between time t and t+\[CapitalDelta]t a length\ \>", "Text", CellChangeTimes->{{3.435851701424*^9, 3.435851746874*^9}, {3.435851917436*^9, 3.43585194367*^9}, {3.435852591291*^9, 3.435852658009*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[CapitalDelta]y", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "t", "]"}], " ", "\[CapitalDelta]t"}]}]], "Input", CellChangeTimes->{{3.435852659767*^9, 3.435852671472*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"g", " ", "t", " ", "\[CapitalDelta]t"}], "2"]], "Output", CellChangeTimes->{3.43585267334*^9, 3.4667704370018997`*^9, 3.467115657938554*^9, 3.4674873594581003`*^9}] }, Open ]], Cell["\<\ comes to rest. Since it was moving at speed g*t, the momentum change is:\ \>", "Text", CellChangeTimes->{{3.4358527016099997`*^9, 3.435852755112*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[CapitalDelta]p", " ", "=", " ", RowBox[{ "\[Sigma]", " ", "\[CapitalDelta]y", " ", "g", " ", "t"}]}]], "Input", CellChangeTimes->{{3.435852756918*^9, 3.43585277876*^9}}], Cell[BoxData[ RowBox[{ FractionBox["1", "2"], " ", SuperscriptBox["g", "2"], " ", SuperscriptBox["t", "2"], " ", "\[CapitalDelta]t", " ", "\[Sigma]"}]], "Output", CellChangeTimes->{3.435852781392*^9, 3.4667704383903*^9, 3.4671156604033537`*^9, 3.4674873606281*^9}] }, Open ]], Cell["And the impusive force is", "Text", CellChangeTimes->{{3.435852787933*^9, 3.435852803152*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"Fimp", "[", "t_", "]"}], " ", "=", " ", RowBox[{"\[CapitalDelta]p", "/", "\[CapitalDelta]t"}]}]], "Input", CellChangeTimes->{{3.435852804932*^9, 3.435852813552*^9}, {3.435852873051*^9, 3.43585287409*^9}}], Cell[BoxData[ RowBox[{ FractionBox["1", "2"], " ", SuperscriptBox["g", "2"], " ", SuperscriptBox["t", "2"], " ", "\[Sigma]"}]], "Output", CellChangeTimes->{ 3.435852814865*^9, {3.435852874757*^9, 3.435852880883*^9}, 3.4667704400439*^9, 3.4671156671269536`*^9, 3.4674873619073*^9}] }, Open ]], Cell["which makes the total force:", "Text", CellChangeTimes->{{3.435852823716*^9, 3.4358528330290003`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"F", "[", "t_", "]"}], " ", "=", " ", RowBox[{"Piecewise", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"Fimp", "[", "t", "]"}], "+", RowBox[{"\[Sigma]", " ", RowBox[{"y", "[", "t", "]"}], " ", "g"}]}], ",", RowBox[{"t", "<=", "tf"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"\[Sigma]", " ", "L", " ", "g"}], ",", " ", RowBox[{"t", " ", ">", " ", "tf"}]}], "}"}]}], "}"}], "]"}]}]], "Input", CellChangeTimes->{{3.435852834024*^9, 3.435852868957*^9}, {3.435852904066*^9, 3.435852945099*^9}}], Cell[BoxData[ RowBox[{"\[Piecewise]", GridBox[{ { RowBox[{ FractionBox["3", "4"], " ", SuperscriptBox["g", "2"], " ", SuperscriptBox["t", "2"], " ", "\[Sigma]"}], RowBox[{"t", "\[LessEqual]", FractionBox[ RowBox[{"2", " ", SqrtBox["L"]}], SqrtBox["g"]]}]}, { RowBox[{"g", " ", "L", " ", "\[Sigma]"}], RowBox[{"t", ">", FractionBox[ RowBox[{"2", " ", SqrtBox["L"]}], SqrtBox["g"]]}]}, {"0", TagBox["True", "PiecewiseDefault", AutoDelete->False, DeletionWarning->True]} }, GridBoxAlignment->{ "Columns" -> {{Left}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, "RowsIndexed" -> {}}, GridBoxItemSize->{ "Columns" -> {{Automatic}}, "ColumnsIndexed" -> {}, "Rows" -> {{1.}}, "RowsIndexed" -> {}}, GridBoxSpacings->{"Columns" -> { Offset[0.27999999999999997`], { Offset[0.84]}, Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> { Offset[0.2], { Offset[0.4]}, Offset[0.2]}, "RowsIndexed" -> {}}]}]], "Output", CellChangeTimes->{{3.435852932745*^9, 3.4358529454630003`*^9}, 3.4358529974*^9, 3.4667704416819*^9, 3.4671156700129538`*^9, 3.4674873637792997`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{ RowBox[{"F", "[", "t", "]"}], "/.", "p"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", RowBox[{ RowBox[{"1", "+", "tf"}], "/.", "p"}]}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.435853020462*^9, 3.435853036266*^9}}], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.67, 0.6, 0.6], LineBox[CompressedData[" 1:eJxF03k01QkfBvBr/RklJa4ySlku2ihL6c19fkXrFBqSrXKzjJGRjGwp+5Jc 6d404SLZUpOyRJZCiDuiBd0poiyhBSk04v7eed8/ut9znvOcz7/POd+VR4// 7CZOo9EK/83/+utP3ulWx32Y1M3AsFM/j2yJcdXWecywwN5y1/Qyi1xm6+iA J5txGIxFcqX2Fo3MG0pdV17w3PEliFws/lXAHC8xS/BieCPG6CZWWwwyVXSf V1ECX0zRk2Nlc8eZpoHx6/k8fyzlztvSOz3NdG5i5nNYwUgm0nv4ljRE0D+r OjHOgLs9SUrRQgrPiq35nMkwxEX2KrRNycL15dqoaUEEqp23S8zmLMSkmAyc KqPwJ7VrvFlDETG6ff/U8mKQmhH8pHVaGcr7q0u1QuMQbvoyW3alKq4FXjoe z4rHhlGDOzWWK9DStGfQmpGIhewYDxkLLRQGKFg5SSYhxIlzly6ng4BzoTcT J5MwuNpIvG5qFWRK7D0+CziwG1Sr+5KjjycPHzZq8bmQabXuLrHfgJSXBhp2 lRdRYWj9pVbDEKvEF/RU8y5BKapUpXF6IyaUTv1njP0Hao7RdavFNqNKd/jy ytDL8Go3MxRbuQV79z+wjmGl4siFsCuVliSOX/HnWzIy8Odr8VRxi+3YVNrP iFDORGgHS9H42g7QXHW2OUhegWUcg71Qbhf4AcmZCZNX8EnvTVDl1B44ZB53 +CS4iuQauRWfcqzA1GWcjbfKRohJx/O8kP1QL+ku1+Bng8VtnX/b/me8f7hb ybYyB+uG7KaqNWwQMqrxpJKXh7oFz2pqpw/COfCl0FopHzlxej4KM3YwF7+w 9iM7H3F9NZnlYg6Qowvj1UKvwco4KGR2hRMyTP/eHsW6jo/rtOl3LZ1Rl5BQ tY9RCF/bumJqnxvuv3vxaF5BIfojkxxtZdxRvUu7h7/6Fs58Ob6zrdEdjuIs WvaS21ifeWR45R4PHLj/TV1teRFiVcQt7QKPYY/xeg9l3RJEdRQIwoxOYNeg wMffswRxUVzzshsnsPPimaDOGyXQsJWyDtHwhflESzx3XSnoh8NtKpV/B7PQ /aa84R1M0rpG5hROwoDBmyBQDh5H8XC2TRA2dG775h5WjnHHsP6+/iDoR41I PKwrh2CHn2yJXzDW9RkrRZnfhXv4ly1Saaegk/F0I21PBQLP2hqemDkNVTpx +qtNFRp8rcoMIsIhJe1LjHjW4Ip7fri7eiyGd4fKf86vgfPo1b1XQ2LxFztB eW6gBmdNxO4lCGLRFN/OjdOrxXKVt+zfzsfhnMJoNq+gFnaS+8cPE/FQVNdo aEivw2zIjXLaEjYYW9mSSjH1iAk10VnRcwHK/VyZ1Jx6qAX3u+jQOZCJTp2v Vl8P7+fMiVgLDt415yvq0hqgX/oDsa+Wg1tWDzRNgxuwWXJ84Vg+F5ucp83d vBvhOiXM5cQmY3coK/qObROWaDA6D8alYMP5uh1Zfk1IX2B85B9+ClQzV8qw OU1oVE8QjM5Lxfj9N/GubU2YaZDldial4pKQlbR4RzOGx/cbcTLSMHD6aNoJ Iz6m3hLazfx0hIW4FK1VbMFbrbNHuHpZ8Eyo9126oQUVuZ9lsg9kwYanYShl 1YJuk/CC7lNZ0K7uL+s+1wLFTKknrc1ZaPvmUn1O4hF2Hyopzne9CtVTrk0j E4/Qcu1qm0lONsqD3F7lPm2DdsgTZ8G2POQxjwlUJtrg63gqtv1EHi5JnHh6 XuExQsuS5cWy8uDPDmkMsn6M571LzMepPBhncW/u63yMSMqOqVabD8eB1/eD vZ7gmW9tQM3uArycJ39e3efpv3+2RigT8SdeOBzT8w1oxx3PqjXO9UWI79vp 9UdMO7jLrLsW9BZhs6dmQXVyO7bNas9rnykCL+iVOlHaDlXTs6NpG4rhfNmS zhtvR/Ej3Qa97GIMdRrMNf7aATeN/utH4kowaTX711KnTgwXGru/PnoHi3ay 3etIAVhM1kU3uwos7HAr3ujYhdTzeeFG8XXQWOFVEH20F9tXPK+Qozdh06vf WrZy3kB1SFOD+HenupmwvR1p/QhSP/OrpPQzeNQ0N9+PGMRPAZpDcbc7keKS r6LkPITuotPo4b3AWrs3U0K3EbgK726a3NKDns+WbeTu91iUspVv8PsbTPQu 1acf+AjbQ88F1qsGkHQj+JeDB8eQYBHZmi41BIa8zL7AtHHMv5X9YVvXCMp8 wm4kZn6CO9s/dGTZR3RocYn9nAn41S8261g1Ds3Idp1DKZ9RvfqCf4jYBEys eg0z075AURP3TIY/45VPNJOdMIkmP46iTcMkik3s5RovTCEwY//J+NfToNs2 vbgWPY2Wm7phQWP/AH20Cw/8vqLhl6VPDX+YRQrdQ44R+A9q8x92mXoIEZHx a6yR5wwUyswzgxxoZHrb5YeJPt+wtZV/NT1XjDztzR1f5jsLfeWOyK9T4uR7 ls4S+6Nz8BsRtHG3SJLn5t5J9rgLscNsctOVAily14mLzdc9hRidseqUvSVF Sg6aJgR4C7Fb7dNy/1Ip8syjpMWL/IVQLRRWWNRIkT5pxurm0ULoD1jIy3RK kbYmEbieLcTi4nrjNJo0qX5yabD/ayFqO4SBZnbSZO/wA1OzASEG1Ifv1R+S JnlOXmILh4WofqV029xFmlQyr4krGBMiJoXJ2+UtTcosdvujWyjEWd1Grl2U NDl6+3bptmUU9tzIoy7fliYrP+wcW+BAodio6q+0HwjSOJEX33yIAsvWlq0k T5DFep+0IlgUfpr7feq8IkEW+KY6TXpQ6HhlXB2jRpCXv37gdwVQuDvyUinE iCD9JTk515IpPFrDE4thEeRE7lscTaFgWnRkjewvBOm98z9dP6ZTeF+VO5fo RZBu8QOLzudQmHGp4KYGEKTNwo2hJ0sofBAK2RVsgjRQ7bbf9pSCqrNEFb2S IAvv6U9+66BgtWtsX24NQa46Ep10528KD8oOxRo2EqT61XVNOq8p2DMefLR5 QpAZZpFH+/ophGrfVXnbSZAqg4K5tCEKbwr1RwO6CFJBJ9xQfoyCo1VBXPpb gkzkdz5unqDg61lguf4DQcoeW3UsYopCo+yae42fCDJmfqj0lhkKNuvXP3WY JkixwvasyTkKy3vunhufJcj72hczBDQaSfv/jSMkkOlVKi7yZv6wyQVJkb8u 5RLe0iIPZQ762SiJ/FxrU99mTZEz81tlhlxF9tB10ePmilxn63hq63Kx7zaw e1egmCWyV+QOgemP4t8d5y4zI8YV+d4yFvVOUeK7K4QxEqsSRW4rMXvHXiT5 3Y0r3B8mcESOKj+Q9UZW6rud1LsPO7JF/lam9+NqQlq0j8TIo+QzItM1TVha NOK7A7xtv8gGiazoIu8fXS1y0cHmaYoS+b9QCeHZ "]]}}, AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesOrigin->{0, 0}, PlotRange->{{0, 3}, {0., 2.9985056796829346`}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{{3.4358530304820004`*^9, 3.435853036797*^9}, 3.4667704436631002`*^9, 3.4671156716509533`*^9, 3.4674873651677*^9}, ImageCache->GraphicsData["CompressedBitmap", "\<\ eJztXAu4VFUVPtyZuY9Aw4gEI7tGGsK9iJqp1/CBhhC+MCUfWV7R+91rIYT4 SO0TrSRNc9JK6TOofOWjgMyhfOSrUsrEF4oMRViK+YmUZF/0muZf65yzZ59Z e5+zTnx+fn2i98ycddb6/73XWnvtffacmcN75/WfNqt33sDM3s5D5/bO6R+Y eWbn5Nlz66LCoCAY1B8EwYudAd7X6m/DQ63+f20AB0jS30+il/ag0hfQv55y lSS1WiXoq/9Xqb+vlnta6GIh6KvUwsu1YBwdB8emddugmjCFRiN0d4JOsnHQ jaXjEGMa/mMdJ2UXCTpSzeqsQTbanqBcrTU5KUFbYPceRC+loIZLfZVQixFa 6axQPzcI40JZrVYNyj0sL3owugT9NidukXrJIa4E5aiVPugmE6nVViv6OKI+ 6BbbOWCIXV5XB1tEUy33xe72OUfC8DmnEbcrlpXjLhU8uN2CvtRew2/SxIeb cAs7zlYpRZDVcj0PGVLqZtGDIem3Crjdjc0PI1jw4Er6vvbCBeFQ9LY3Q7YU wlxlGsIEVbfHM1kTpihD7xYPA1MOWjzQ4536TdDjG3xWrqSnY8I/0oArRuzl qNw2hjd/qSkJuF1xU6PRgexnDF9RGOexk9of8dSqVTOF9GQuPpPigJjZqdQU EDKJiif3PI5TSUDo8ql6gNHVGMUPLKi6gWOxEzicqIbypXARESYYjjPemOsd eMGb4GTSaTQ4cOVjL+AvKNKx7bh771k7f/GiR6M/6Nw3+4w7Vs485fagpXbA xIVBG85vvmj+Pbh+1EMPriPLkKG+ZmluTPtWlnW8xfF/w1Fy57CkzhVmMFIu StUl55/3U6QkkhO6y8+aV4F8yopHnh+6efOWaF3ypnXBWxxvLg5PSg5j8DHr 129CeiHNkG6bpk1dvO7jx950zRWXP9S/bOkqXA9GCvZ7bWWZ1Pyxui6NYKDO DRteQ9PRhWdPOvGWDdOPvH7xgkvuP3l5ZfWIjRtfH/4G9EaSeVo+io5taB1a idai1ZiqEJgJ1TWv8Dy4pxujk46t0IUNbBHIK6++6peoMaQ0ocGcrEezEVw2 57Zbn0TxATGMEHky6nZz7sLmaDfM4W384T1kpDTWbb4r+wVMYAQzchDlkLs7 xm0bLuyQu5jBYYtug5Ztd3bb8tq5BF3YRAmyz6qnX2Lb0W7b3elYRJgeHuhf CjfjPV3cyW3GgSshOqBCZGDWvmXLv5hyx2RoOIVKCE1kAb8ai1Futr1NB+HY Ztsd3Lb7cgeTtnRxpNtsv2YzxJEubu82m8hm6CXCCHcipHRxuNvsADaDO5Ex yFu8p4vD3GZ890MLRDChQmBepYvbJQNwMAOglKA3eGXnDXUTHMIEAAU4MgRZ RRe3dZtNZjOowsRq1xC32RTTQgw7OI5bONhtM9XECZ5DasVDtcNtNo1lyFlQ 4ZWp2t02hxlngAZ0MVVr0ttHMAD6AAKsxpnAUzaPNARYOoEkdpvnjmW66UsU IKZqcdsczTKUKtigbLDNILYJp+mUDVJx77BFoDuGZaABHYZH8J+QKfs+oYR8 LMvQaQwB8vO/Y+Ssm2wS8gw7GqgCKDj/jMGzblVR6EqwYchCNDWRG/7hbaxj j6cotPd4wRNbvD6WNhgk5BNY1uiJ4O8hcjGZJ46b84KA+wnbHXRL8Dd3zp7E sqja0Sridbf6J1kGJyPnyB9/dat/imUIMTpJI2JzclT3mjyGEk1Af3FjnsIy UMdp/2e3+kyWoWNQpw5ucqufyjLUILiPyuWrbvXT7ChSydvoVu8z/kAhIn+8 4lbvN56BOp29nHTfgKlUqJ7kvj+5MU8P4hoKf1B+vORW/7RxH/xBS6cNbvXP 2N6m4LzoVp9l0imanoMX3OpnCOp/dKvPNsGJY/mHpPvm2BEkpefdmJ+1M5rU 17vV5wrqv3ernymor3OrzxPUf+dWP0tQ/61b/WxBfW3SfecISlU35rmC+hq3 +ucE9efc6ufZAaf8WM3qAS+RFJ8wSkX7fIHg2ZCgGGrFe9q+LXCpcl9gSk88 dp5JA3fPbzb45+2hQ+Bh7cdUEW2ABrPoSLLYtpTWCGnSNhP0BYYaUwxVnHCW wiZWkppXdVmps/b/QruOUSNONI1IjJGtEM35LEPKxrPaCSmEqR8KSDl5Ectw I4W7Izo73k0kjZuLTSLQOgRnx+kgvoBjCyKYZkh2X2SlaMuFzmboGL/EMsx5 fFNTixeuSgjEBklBi3wlxCWmIiC5aVwdo4NYwLLotoFS82M6iC+zDKu4eA1w tA7iUpZFW0t0Nj1LKC9jpQULr11x7o03rKSzo3TcX2EZ0pf3dWrRfZsWwgql EuJyIZRH6CCuMKEEBMXhcB3EV1mGKoi6QWeH6SCuZBmigajQ2bQsoSwLcfio jrts4hAvt5UQX2NZdI9BS86pOoirWIYsQDZQHKboIK5mWbRJTGeH6iC+zjKU 1Hg+nZwLwkrrNAhC+AYrwXnIRHLiR3Tc32SZVVQO0UFcwzJrYjlYB3GtkJOT ckFYOemBSGzTOB4sy7xNs9Ckc7z8OcjD3rTykJ7Ckoi+xTJMhogXnR2Yh6hp E4eWcQRAM7wKVHoeSFovXccyZHn0CXuwv4bI8XiNtGS6TgiJikt6WkUi+jbL rGI+MYUoy+MekgMXBc3V5sO6gbLIDJS42ighFguu3S8FghC+I7iqR8f9XZZF H0vS2b65IOABNJ8+2VRCfI9l1hpgHx3E9Syz5p69dRA3sAyujG+oPpQLAiHE bjtNIWkQhHAjK2EYI43obC8d9004UrHJY5hI4Q/qIG4WUnhPHcT3WWYtpvfQ QdzCMmve2z0XhLUGSIMghFuFsThBx30by6wbvN1yQVjrcSXE7UImjtdB/IBl VlHpzgVhFRUlxA9ZFn34R2ddWUK5hJWsu7NxOu4lQvOVEEuF5o/VQSwTOrKr G0L/eL80fy8Tuu4j5ek68Zy79xlSaSb/keCtMW7WcC2Y+aFzifIOwbsfSKfM +kC32QyUPOohCtua+eFoqW8/Fty5izeI2geOJdY7BY/u7GHN9OyulKN3Ch71 EEljqyJ46P06iOUss8rk6FwQ6AiepaDpKg2CEH7CStaNz/t03DzH2bPtTrkg rNlWCXEXy6xlQ6cO4m6WWbui780FgfkW6z5awCoheBfavu/fMUso72Wl+KNo nL1Hxx1CwJwe484B8TOWWbdSo3JBWMmshLiPZdbG/rt1EPcL2bBDLggrG9Ig COEBvKMlvJLxAeO6uKCN1EE8yDJr3TdCB8F3XXZF2D4XBGIP19GNhBLi58JA elcW7/9CGEjDddwhhDUrKCG4wfZdwDtzQVhOVEI8zDLrdnqYG+J/+IqntC33 iBCJd3jY5TVk1ke3Qjar+nnYpLWj81kuWsCFzrQm+u3SCdK+yictoVaY0Mcz qofKvVbMtCn4KyFLhrrZFN8vk9h+LWTF2z1sWb+vJfkx5LKqoYdLGkKPssza Tto2F4Q1kaRBEMJvWMmajbfRcYcQ1myshHhMSI8hOoiVQswH54KwQqmEeFwI 5dtyQVihTIMghCeEUHbouEMIa1dSCcG89sKqXQfxlBDKtlwQViiVEE8LoWzN BWGFMg2CEFYJoSzpuEMIq74rIfj5KHt9VMwFYdUGJQQ/AmbvlxZ0EKuFhGrJ BWHdBqdBEMJzHDwrjep/ZHSOmy80s5YaGcz4cb9i45oQJukWiAwihEilWFTt 5Gxskv4HOKTpOyRAFUKTGgnMiifbT1hIM/Zak9Zx6M5Owmf7KQiz9bbGJDp/ NcGAhgnf8DsKqY/2JVpMxxmJJmb82YE0vBxfzU+FzPSNdinyjSj0XvgpnGDQ fwEtWfnY\ \>"]] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[TextData[StyleBox["Speedy Travel (Morin 5.63)", "Subsection"]], "Section", CellChangeTimes->{{3.435405653248*^9, 3.4354056723900003`*^9}, { 3.435408771718*^9, 3.4354087758459997`*^9}, {3.435412154159*^9, 3.435412154868*^9}, {3.435412374642*^9, 3.435412376026*^9}, { 3.435745586125662*^9, 3.435745605871662*^9}, 3.4358496431210003`*^9}], Cell["\<\ Take an idealized spherical planet of uniform mass density \[Rho]. Drill a \ straight tube through and make it frictionless. Drop a mass down the tube. Describe the motion, and find out how long you \ have to wait for the mass to come back.\ \>", "Text", CellChangeTimes->{{3.435745617724662*^9, 3.435745794196662*^9}}], Cell["\<\ Soln: Let's use {x,y} coordinate system and orient our tube at constant y(t) \ = y0. Our goal is then to find x(t), starting from rest at x0=sqrt[R^2-y0^2]. Note that the problem statement \ didn't specify y0 or R---they had better not matter in the end, or the problem was not well-posed. We'll find it useful along the way to introduce these two functions of x: r \ = Sqrt[x^2+y0^2] and \[Theta] = ArcSin[x/r] There are two forces acting on our mass: gravity and a normal force which \ enforces the constraint y=y0. The y-component of F=ma tells us what N needs to be, while the x-component \ reads:\ \>", "Text", CellChangeTimes->{{3.4357458000276623`*^9, 3.4357459662186623`*^9}, { 3.435746016563662*^9, 3.435746224381662*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"m", " ", RowBox[{ RowBox[{"x", "''"}], "[", "t", "]"}]}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"-", " ", "Fg"}], " ", "Sin\[Theta]"}]}]], "Input", CellChangeTimes->{{3.435746228089662*^9, 3.435746287424662*^9}, { 3.435746736188662*^9, 3.435746737274662*^9}}], Cell["\<\ Here Fg is the magnitude of the gravity force when the mass is at location x, \ i.e. at radius r. To nail that down, recall Gauss's law for gravity, in particular that for a hollow spherical \ shell of radius R the gravitional field on the exterior is the same as that from a point mass, while the field inside \ vanishes. Building our uniform sphere out of a collection of hollow spheres, we see that the gravity force at radius r is \ that due to a point mass of size\ \>", "Text", CellChangeTimes->{{3.435746316899662*^9, 3.435746439366662*^9}, { 3.435746744621662*^9, 3.435747027682662*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"M", "[", "r_", "]"}], " ", "=", " ", RowBox[{"\[Rho]", " ", RowBox[{"(", RowBox[{"4", "/", "3"}], ")"}], " ", "\[Pi]", " ", RowBox[{"r", "^", "3"}]}]}]], "Input", CellChangeTimes->{{3.435747029802662*^9, 3.435747045552662*^9}}], Cell[BoxData[ RowBox[{ FractionBox["4", "3"], " ", "\[Pi]", " ", SuperscriptBox["r", "3"], " ", "\[Rho]"}]], "Output", CellChangeTimes->{3.435747046298662*^9, 3.435884668949*^9, 3.467115710182954*^9, 3.4674873719069*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"Fg", "[", "r_", "]"}], " ", "=", " ", RowBox[{"G", " ", RowBox[{"M", "[", "r", "]"}], " ", RowBox[{"m", " ", "/", RowBox[{"r", "^", "2"}]}]}]}]], "Input", CellChangeTimes->{{3.435747054996662*^9, 3.435747070111662*^9}}], Cell[BoxData[ RowBox[{ FractionBox["4", "3"], " ", "G", " ", "m", " ", "\[Pi]", " ", "r", " ", "\[Rho]"}]], "Output", CellChangeTimes->{3.435747071255662*^9, 3.435884670392*^9, 3.4671157117585535`*^9, 3.4674873732173*^9}] }, Open ]], Cell["\<\ Since sin(\[Theta]) = x/r, our equation of motion is:\ \>", "Text", CellChangeTimes->{{3.435747077621662*^9, 3.435747108455662*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqn", " ", "=", " ", RowBox[{ RowBox[{"m", " ", RowBox[{ RowBox[{"x", "''"}], "[", "t", "]"}]}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"-", " ", RowBox[{"Fg", "[", "r", "]"}]}], " ", RowBox[{ RowBox[{"x", "[", "t", "]"}], "/", "r"}]}]}]}]], "Input", CellChangeTimes->{{3.435747109964662*^9, 3.435747137846662*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"m", " ", RowBox[{ SuperscriptBox["x", "\[Prime]\[Prime]", MultilineFunction->None], "[", "t", "]"}]}], "\[Equal]", RowBox[{ RowBox[{"-", FractionBox["4", "3"]}], " ", "G", " ", "m", " ", "\[Pi]", " ", "\[Rho]", " ", RowBox[{"x", "[", "t", "]"}]}]}]], "Output", CellChangeTimes->{3.4357471381796618`*^9, 3.435884672191*^9, 3.4671157184197536`*^9, 3.4674873773669*^9}] }, Open ]], Cell["which we regcognize as good old simple harmonic motion:", "Text", CellChangeTimes->{{3.435747144130662*^9, 3.435747165207662*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"DSolve", "[", RowBox[{"eqn", ",", RowBox[{"x", "[", "t", "]"}], ",", "t"}], "]"}]], "Input", CellChangeTimes->{{3.4357471665676622`*^9, 3.4357471713186617`*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{"{", RowBox[{ RowBox[{"x", "[", "t", "]"}], "\[Rule]", RowBox[{ RowBox[{ RowBox[{"C", "[", "1", "]"}], " ", RowBox[{"Cos", "[", RowBox[{"2", " ", SqrtBox["G"], " ", SqrtBox[ FractionBox["\[Pi]", "3"]], " ", "t", " ", SqrtBox["\[Rho]"]}], "]"}]}], "+", RowBox[{ RowBox[{"C", "[", "2", "]"}], " ", RowBox[{"Sin", "[", RowBox[{"2", " ", SqrtBox["G"], " ", SqrtBox[ FractionBox["\[Pi]", "3"]], " ", "t", " ", SqrtBox["\[Rho]"]}], "]"}]}]}]}], "}"}], "}"}]], "Output", CellChangeTimes->{3.435747171912662*^9, 3.4358846742019997`*^9, 3.4671157330681534`*^9, 3.4674873789737*^9}] }, Open ]], Cell["with frequency", "Text", CellChangeTimes->{{3.435747177592662*^9, 3.435747180017662*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[Omega]0", " ", "=", " ", RowBox[{"Sqrt", "[", RowBox[{ RowBox[{"(", RowBox[{"4", "/", "3"}], ")"}], " ", "\[Pi]", " ", "G", " ", "\[Rho]"}], "]"}]}]], "Input", CellChangeTimes->{{3.4357471825946617`*^9, 3.435747212708662*^9}, 3.435747624276662*^9}], Cell[BoxData[ RowBox[{"2", " ", SqrtBox[ FractionBox["\[Pi]", "3"]], " ", SqrtBox[ RowBox[{"G", " ", "\[Rho]"}]]}]], "Output", CellChangeTimes->{3.435747214644662*^9, 3.435747624848662*^9, 3.43588467526*^9, 3.4671157359697533`*^9, 3.4674873803933*^9}] }, Open ]], Cell["and thefore period", "Text", CellChangeTimes->{{3.435747225599662*^9, 3.435747242048662*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"T", " ", "=", " ", RowBox[{"2", " ", RowBox[{"\[Pi]", " ", "/", " ", "\[Omega]0"}]}]}]], "Input", CellChangeTimes->{{3.435747243806662*^9, 3.435747248187662*^9}, 3.4357476275546618`*^9}], Cell[BoxData[ FractionBox[ SqrtBox[ RowBox[{"3", " ", "\[Pi]"}]], SqrtBox[ RowBox[{"G", " ", "\[Rho]"}]]]], "Output", CellChangeTimes->{3.435747249347662*^9, 3.435747627885662*^9, 3.435884677266*^9, 3.4671157384657536`*^9, 3.4674873821717*^9}] }, Open ]], Cell["\<\ Note that indeed the period doesn't depend on the details such as the \ planet's radius, or even where we drill the tube. Numerically,\ \>", "Text", CellChangeTimes->{{3.435747254452662*^9, 3.4357473025346622`*^9}}], Cell[BoxData[ RowBox[{"Needs", "[", "\"\\"", "]"}]], "Input", CellChangeTimes->{{3.435622893804*^9, 3.435622913704*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[Rho]0", " ", "=", " ", RowBox[{"EarthMass", " ", "/", " ", RowBox[{"(", " ", RowBox[{ RowBox[{"(", RowBox[{"4", "/", "3"}], ")"}], " ", "\[Pi]", " ", RowBox[{"EarthRadius", "^", "3"}]}], ")"}]}]}]], "Input", CellChangeTimes->{{3.435747435762662*^9, 3.435747459776662*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"5496.788221366487`", " ", "Kilogram"}], SuperscriptBox["Meter", "3"]]], "Output", CellChangeTimes->{3.435747460221662*^9, 3.4671157480597534`*^9, 3.4674873902525*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"T", " ", "/.", " ", RowBox[{"{", RowBox[{ RowBox[{"G", "\[Rule]", "GravitationalConstant"}], ",", " ", RowBox[{"\[Rho]", "\[Rule]", "\[Rho]0"}]}], "}"}]}], " ", "/.", " ", RowBox[{"{", RowBox[{"Newton", "\[Rule]", RowBox[{"Kilogram", " ", RowBox[{"Meter", "/", RowBox[{"Second", "^", "2"}]}]}]}], "}"}]}]], "Input", CellChangeTimes->{{3.4357473048696623`*^9, 3.435747333581662*^9}, { 3.4357474660096617`*^9, 3.4357474824366617`*^9}}], Cell[BoxData[ FractionBox["5068.492989278671`", SqrtBox[ FractionBox["1", SuperscriptBox["Second", "2"]]]]], "Output", CellChangeTimes->{ 3.435747421052662*^9, {3.435747464406662*^9, 3.435747482913662*^9}, 3.435884693288*^9, 3.4671157501033535`*^9, 3.4674873903461*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Convert", "[", RowBox[{ RowBox[{"5068.49", "Second"}], ",", "Hour"}], "]"}]], "Input", CellChangeTimes->{{3.4357474919176617`*^9, 3.435747503360662*^9}}], Cell[BoxData[ RowBox[{"1.4079138888888887`", " ", "Hour"}]], "Output", CellChangeTimes->{3.435747503791662*^9, 3.435884693381*^9, 3.467115754346554*^9, 3.4674873904241*^9}] }, Open ]], Cell["\<\ which is indeed a speedy trip to the other side of the world and back. (We note that the book problem asks for the one-way time, i.e. half of this). Amusinly, this is the same period one find for a satellite orbiting just \ above the atmosphere:\ \>", "Text", CellChangeTimes->{{3.4357475185426617`*^9, 3.435747552427662*^9}, { 3.435747771455662*^9, 3.4357477814686623`*^9}, {3.4357478569176617`*^9, 3.4357478957196617`*^9}, {3.4671157887445536`*^9, 3.4671158281813536`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnFma", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"-", " ", "m"}], " ", RowBox[{"\[Omega]", "^", "2"}], " ", "R"}], " ", "\[Equal]", " ", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"-", " ", "G"}], " ", "M", " ", RowBox[{"m", " ", "/", RowBox[{"R", "^", "2"}]}]}], " ", "/.", " ", RowBox[{"M", "\[Rule]", RowBox[{ RowBox[{"(", RowBox[{"4", "/", "3"}], ")"}], " ", "\[Pi]", " ", "\[Rho]", " ", RowBox[{"R", "^", "3"}]}]}]}], ")"}]}]}]], "Input", CellChangeTimes->{{3.435747555913662*^9, 3.435747592707662*^9}, { 3.435747661830662*^9, 3.4357476832306623`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"-", "m"}], " ", "R", " ", SuperscriptBox["\[Omega]", "2"]}], "\[Equal]", RowBox[{ RowBox[{"-", FractionBox["4", "3"]}], " ", "G", " ", "m", " ", "\[Pi]", " ", "R", " ", "\[Rho]"}]}]], "Output", CellChangeTimes->{3.435747597137662*^9, 3.435747643032662*^9, 3.4357476844686623`*^9, 3.4358846935880003`*^9, 3.4671157634881535`*^9, 3.4671158304433537`*^9, 3.4674873940901003`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Solve", "[", RowBox[{"eqnFma", ",", "\[Omega]"}], "]"}]], "Input", CellChangeTimes->{{3.435747597905662*^9, 3.435747603963662*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"\[Omega]", "\[Rule]", RowBox[{ RowBox[{"-", "2"}], " ", SqrtBox["G"], " ", SqrtBox[ FractionBox["\[Pi]", "3"]], " ", SqrtBox["\[Rho]"]}]}], "}"}], ",", RowBox[{"{", RowBox[{"\[Omega]", "\[Rule]", RowBox[{"2", " ", SqrtBox["G"], " ", SqrtBox[ FractionBox["\[Pi]", "3"]], " ", SqrtBox["\[Rho]"]}]}], "}"}]}], "}"}]], "Output", CellChangeTimes->{3.435747604610662*^9, 3.435747646635662*^9, 3.4357476882006617`*^9, 3.435884693679*^9, 3.4671158324401536`*^9, 3.4674873952289*^9}] }, Open ]], Cell["\<\ Displaying the motions together. Choose a planet of radius 1 and y0=1/2\ \>", "Text", CellChangeTimes->{{3.435747902103662*^9, 3.435747914026662*^9}, { 3.435748239017662*^9, 3.4357482749506617`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"circle", "=", " ", RowBox[{"ParametricPlot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Cos", "[", "\[Alpha]", "]"}], ",", RowBox[{"Sin", "[", "\[Alpha]", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"\[Alpha]", ",", "0", ",", RowBox[{"2", "\[Pi]"}]}], "}"}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.4357479771866617`*^9, 3.435748022334662*^9}, { 3.4357482526196623`*^9, 3.435748257465662*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"y0", " ", "=", " ", RowBox[{"1", "/", "2"}]}]], "Input", CellChangeTimes->{{3.4357483032856617`*^9, 3.435748317272662*^9}}], Cell[BoxData[ FractionBox["1", "2"]], "Output", CellChangeTimes->{3.435748334655662*^9, 3.435884693848*^9, 3.4671158384149537`*^9, 3.4674873976781*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"x0", " ", "=", " ", RowBox[{"Sqrt", "[", RowBox[{"1", "-", RowBox[{"y0", "^", "2"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.435748319532662*^9, 3.435748332460662*^9}}], Cell[BoxData[ FractionBox[ SqrtBox["3"], "2"]], "Output", CellChangeTimes->{{3.435748332743662*^9, 3.435748336503662*^9}, 3.4358846939440002`*^9, 3.4671158396629534`*^9, 3.4674873988949003`*^9}] }, Open ]], Cell[BoxData[ RowBox[{ RowBox[{"tube1", " ", "=", " ", RowBox[{"Graphics", "[", RowBox[{"Line", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"x0", ",", "y0"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "x0"}], ",", "y0"}], "}"}]}], "}"}], "]"}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.4357480269286623`*^9, 3.435748040213662*^9}, 3.435748127677662*^9, 3.4357482628446617`*^9, {3.435748339824662*^9, 3.4357483796206617`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"tube2", " ", "=", " ", RowBox[{"Graphics", "[", RowBox[{"Line", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"x0", ",", "y0"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "x0"}], ",", RowBox[{"-", "y0"}]}], "}"}]}], "}"}], "]"}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.4357480269286623`*^9, 3.435748040213662*^9}, 3.435748127677662*^9, 3.4357482628446617`*^9, {3.435748339824662*^9, 3.435748392547662*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Show", "[", RowBox[{"circle", ",", "tube1", ",", "tube2"}], "]"}]], "Input", CellChangeTimes->{{3.4357483953256617`*^9, 3.435748403500662*^9}, { 3.435748448222662*^9, 3.4357484484096622`*^9}}], Cell[BoxData[ GraphicsBox[{{{}, {}, {Hue[0.67, 0.6, 0.6], LineBox[CompressedData[" 1:eJw1m3c41f///42KyChKpaKFFBWl3aOiYWRENLyzUkJmkbJSUih7ZCayZWbz sHf23hzjHM45rxSlUL/X5/pdX/8ct+vFuc7r+Xw8Hs/77bpeZ6eh5TVjNhYW lkfsLCz/e/3/P9/g/34zPHBAePkfAS/XNCgE+OuBaFym+TeSn49ceujjbwms EDA/SLLXZ7+qqTR7WCnoyion+dX6M3yu/i5wMs8lIYrkDw9su14XvQDO0vft tiQ7raF1NaV5wMRJ6SPnSd4vtEuA+4MXWLsoNq0h2bXwQsgFfx9wqPgdVvWX AKGbx+VOVPjBhIjah6ckK7c8aFYpCoCi0NuDEiRrRCq9v50TBDsEZNVaVgio bfwmbJwWAhduzS4+JPluqu2ASfx7MN0R0beK5KFfs7r3osNhWUftnPAyAekm 4oUqftHAnuBZE7ZEQBvHBvWt1R9ATuzQyw0kn8hQkPYsj4Gas+fiZ34TULja K1e3MBbE+r5zKZNcYVw5WZobB6mfohNiFwlwjnLg2pb9CXaner8584sAnk25 Z2tSEsCMZ0+L808CtHpNOzYkJsJDwuhq/gIB20P/3L8ZlwRPdT7MC8wT0FUq FN4RkQJaHxt/PPxGQD2+t3n8Nh2Usm+usiYIuNWfm1CtkAFE8WU1cyYBaYa+ H5oqMsDGRD5ImU7AmvMTcs2lmWBfJ0pLnSbgtalHeERuNvzhXNtpPUXAY5cR t5dHcqC25vmS9CQB5QP3XO5n5cDJSX1W/3ECBNufnNnx+QsURU/M/Rkk4Ffb 3kfKn/LA1O1aw/MBAnC9eQrn7nx4q/FnjKWfgPdUBlvZh3woVrRqne4mQOWZ Qui2iAJYVk/JudFKgKjRHLunfxEoeJ78WVNOQICz8C5hZ4TvHMG2CUjA0kcU WGIrgxUTmUHnEgI8J9jZJi6VQXBiovWGAnJ/rP07EprLIPHSE2xKJ2CK//T+ haFy+LDk4/wunAALA74vQUuVUP+g5N9QKAF/3/L3HYIquNMrb78nmIBSu1cy NW5V4HPbUSXYl4AH91yOj6ytBp296+N53Ml6UvtqWydUAyWxM23K5uT+PqPU 3JOpgybdDmHuBwSImKnLRTyug6u0igflxgSwPCmOb8ivg3Iex40CegQ003LP bIB6oF68WqukQcDbmGRJJeUGkDP0erTuCAHvwsRPqRg2gdCqHMfR70ygvQ0s W3uxFQ6U301pYjIhmNad/c2oFepvau7OnGECh3GRb4dbK/yYW/XDcJwJn2Ii qN5lrXBu35i0aRsTXEx1Tnw91QbyTqs4OT8zQZ4YjXc63A7xBl6ibwyY0P26 W8pkSyfofN0V6qrLBHbaH6eSY51gXmjrZKXDhKPFppU82p1wpV89+MRVJjRs nuOL9u+E7YL1e6yPM+E/m7ODL7i7QHS7cZ8dDxPU9iilqC13QYzspX1TmQww v/4vp6ivBxKGZZa4UxnAyLTQaPrZA19vWGVIxjNA3fzhwR6BXmj96NZwLYwB shIXAgeu9sLZ41MTV90YcLw592xUeS9Ydl359U2dAefkh9esTuyD//aI8S9Q 6XAzqv+QhNUA6JeslTg5TodYbZkoW+8BcOqN1HwyQAfpv3ut8xMH4Em+Jn3k Kx1Y/qs7ID02AF978zR0s+iQ6fzpTL3GIMwG9+txP6VDbaDlaN7hITi0ye2Z 6io6nKD5a1+hD8Ot2u12gsuzoMQlzb2GawRy/0h4t/+YBUOjz38LxUegcHFU 4BhlFjYGD7lyGY3AW7H3HTHls9B89DcH9I1AoOezfSxOs3Agrcx8yWAUxLVH VOYYM1AwSKXJKo7BZ4qiEU7MgFSgWpqzzhjctaZT3AdmoDUpxLvKeAwe9MpL L9fNwAbx7Hfn3cbIegs/9C52Bn6l5h1iKRoDV8rYGSWdGZDZGPDQe/847Iln czhaQAOC58Wuak4K8PWdPVKZToNq6vInt40U2PpT5INSPA24+685nNpFAa0p 0YBLATTQWhBgjz5FAfMfseI/zGmQFpqlLGVBAWokQ3inCA3Yr9osGbVT4HWk F/eYMxU6IkuN9oRMgF71umdJj6jwr8J89mLsBFyJCqOamVKhu+2cgWH6BNj0 MWqHr1PBRO8xt3ftBEzwwbDjASqskV7P8fHXBHwyKI2L6J2GO9VnOLq1JyH1 fmWp44FpiDFqaVFcPwUc64+xRotOw5Ug5u6C7VMgJeoeUig4DbdH3m/aJTkF pl/Mvg4tT4HsFYX60QtTsJ+VUdrZNAV/a7axrH80BbM3r1V6mJHXJcPDT3RN QZz9d07huEno5W+UDPCfhkoDMT+LkEl4tjL08mDUNIhQ4oaLPCdBT9ePtzpp GvRHJHvlrSchdqNT7EDZNMjq6KWuPTsJnx3U7XKZ09AQbChk1T0Bjd3JQyKK VHgRaSlfwTYBKo2FXCmLVNgjPPYgcIECv8XrFo+w02BQxYbdgEqBO6Envufx 0ODntbgo2lcKuJi8X0rcRYMcf6vB/FAK9N9hbjqmQoP8vT+zr0mR607Tn2WJ okGZZ67Au2vjsPDXXPXY6Rlos9/d+0VhHK6ab987dHEGpJ/zve6VG4dt95+k PVObgU1X2wt4hceBl+5Y99FwBsr3q7WdpYxBc8StodDXZN3pbTmWaTMG/Rt/ HN3VMQMf0qT++/N2FCjDSikhhrPQFcZNdXEdhV81A0v5prOgX1DxiNV2FB7I HkrusJkFemfTh0WdUbCQv7p5wW0WbNQXo/J2joLHShc79eMsXL6xXuKnyQi8 ENB94D02C/E3w/fd+TwEIrfuX624SQeuY0xXO/8haHwjm8RtQIcd29wzPOyG QD5jn7iqCR0sXN9kB54dgrXd79xK7egw+iJ4za3mQXB+aPdKJYAOeeofO0Lo A2DTverCtkby/20DfvHt6Qfp3x/6nY8yIOyBkTVlVT+Y7BK3sD3NALND+16m T/ZB9rBWhp48AxSit4YeTuiDtKC64yIa5HVqos3wvj7Yb+y6+6Q5OYdOt5aP S/VCF8fT7KEPDPic35HSeagbUhtvdzWzM2H/+fyoJv5uMC0QDv+ylglpJS+U Sr91QU3O9q4APibAaZW5dxldEJd7OlpOmAljHRbPpg52wT3b8v82yjAhwX7N Kzspcg67Fm+Vu8MEvbPe9Ft72sm5M9n4O50JkV9YFutWt0N/X4Ha0xwmsL6w 95KZbgPli15yP/KZ0P+40mQxqQ30X+VLNJczwevq4za1g23wY2eCq0QHE1Lp texHTrRCoN8dfot5JizU9Ijc2doK1Te3yj9aZMLFfPdnnL9aoCthsdZmmQmK aW9OvXnWArJhElU3VhHQytn4RuplM+yf32BWJ0CAu6ViE29gE/waPxN99DAB h0ymLGeuN0GIpd3zMvIci7CfWodCTfBHcDhe/jgB3q6FVprhjUBpLsuTAQKi 4op9JD82gNObmb5sFTLn+H7PiP5cB7Yh7ffO3yPAzOu4xAarOuiuShdSJ8/V xAMqvs6H66A6P/uvNnnuKu1hWl3MqQVW7cPmV20I6EybFXtbUANNyg4Zg04E mKcRLBsqq+BQiMK5lwEEZNirx913r4Kdg6Gia8lznt+w3yj/chU8Stn89BWZ A3qM5WyUmyqh88iZYNNIAr69pt4/0VUBr14wDXvjyes2Rq8fhFSAqcj9ZdEk AvIvlZ4MulkBvJ7OXIYpBAhksPuOkDkjx9fY7SuZO1iOhbw/P1UGXm7P2hXz CTD42DGpllgGKTsusmkXkrlKY+bELdMyEBoM+HirmIBiffMHNYMIklu7Za6W EaCe2r7Hl14Cv6WpL3tqCdApvlrcyVUIGhpsb127yPULvL/f9V0BWK697SPQ Q8D0E8cXezcUQPUnvaWoXgKCHUSN72zJh+22C7zRZA5bEdA74C2eCzKs9lsV xsj1S9HayZXyBRw6L+qHkTlOh/mU7ib9BRrusvLQKATM1K9zND6aA1u9WcMs yRx4b8IC5y5kgQ7viMPOWQL4tnB9UqzJhEq5MuZJMkce0bmlGqmYCZs7L9Sp MAjYZvHN8Lh6Brgd25d4k8yh56cuC7AkpAN9hu+zFplT50NaujzSPsMaZqTQ lTkCOhq5E58XpoJvRr3g5h8E6HMkS8+XpYDbyGLCPMnj505v1q9NBvkz3yPr ydw71beTbW9nIojdfJqpS+bkK+/MHJz7EyCCK6l5K5mj9zQHnW8fjYe4trGr bSRbUTyyHjDiYJVztbU4mcPvsR/ntB2OBaFtR1U7Sc4o52i0a/kIfw+qyzz5 Q+bi6qVLj8ti4B9StwuQuX5RemudReYHCNLu4P9E8jhP15FahWhwZ5vmkia9 4LrirECiWCRMaK9wfya56HzjmMZMKEgMxO0KID2Cn6WKZVtTMByqXTi2SPLG Xz6FI2mBsLqzTlOL9JLlJ8oJkT7+QJNcZZdA8rUngnra1r6Q6uAbNUeySLHg vGC8NyR8v/FVhvSegeJw0ccPXkOTijKbGck24ayPmg+8hE+VOmfCSPbtEzqj MOoCt4SsnctIvpfPHjN+zx5yvb2rh0h+ciOdOt//ECQYMRu+k2we9P7O8dab UPMqxXiF5BbW8ViW/edQ/UB86T+S/9T9uhO+chcPHvXb/ptkUfWqG8cXbdDO ycKNRvLFnRXpkdbPcNT4AqOV5LCCuSSnhefY0SFwJ53kdRdVbMRlXuHNw/TO lyT3nU1mabTwxJ0PezQ0SF77vWbP/ZR36PCH0ilIsubIQZ0VWz9Ubtt1p4W8 /0a5MLkL/gG41SKB4Ury08oXoc8zgvBPm8eLfSQf02qZKGwOQS+3QZF6cn09 zQ1eMOjvce5NWYUeyeGWooObuSOwxU7DnEHuz2DDvPbpfVF4Sjd9mw3JN30n 0lJ2f8CCtuUOBrm/GScuJuXIxKD0jzv++iQ/FQ9syz//EXv0V3QayPqQfdrQ n6ceiwBse/eTHLSxT++TxSdMfjzf1UZ6XfnuFPkAp3jsSrlQKETyJ5UbvU+9 SYPhLYjXIuvRVldp4mhyEm6pXgrNJr1OfELsmOZkGn5OtaWt/k7AKVO9a2vm PyPDxHvjKrI/ruvd0rvBmoEnXteTGknOj2pXqQW+TFRpHe6pI/stqsBIcv5A NloYytsvUwl4MVDcJZaTjTxPT61kkV6nd0jgj+apHKRzLvjok/3sHca1KVLx C1Y0Sw59IPudwlrzeMo4Dx1vxuzMHSIgVmf8xCglD90ERo6eI73ulrW8RKdB PvJv5narID1OPLCOM/m/AmRpiatMJ+ePx57xZ1zXi3DP8uufB9oI4DLacbS9 vQhbKrs6n7QQoLozY1eAejGu7TrILP5K9mfrHxEWlRJ8YowdUg3/8/qIyy8u IFpYRttlVRCQs5Z6eX0ZoolZxIkych5KHXerbNxRhsI74VRNKQExFh67L0WU 4bMfxsuF5DwNyTxduDakHAe/Hnl5OYucv8EzQ6Velci6mybCiCbA0UA94VxD Japf1OR2Iec7R6J2eAlnFc6Y/zuzlvTCc34nahLdq/DA4qtna8jz4exfVccL LtUoVxZhEudFgE/l64121rVom38n3OIxWW+9JjG2Go043FKieF6egKQXVRsf BjaiiInSkUDyfLux82f0nZ5G3BiwT3z4FNkPmquT9v3XhOWVeyR1yPPxMZ/j o/9MviKLk1vl0B6y/mNGpfY7teAd/mk4S563XG+t2SOxBb8SHEfZWMj6t1Me ZmNtxVURBQolS0xovJJd8598K2o55edv/sGEd+brlQZqW/HtXoFNxmNM6DgX 30hvacNi13U1WsVMmNnqd6f3Wxsmsrcve+YxIV/wUWPp+nZs5Z03zM9iwr4m PR5HzXYMsu+rWExkwsCvln153e3Iv+fNIl8QE858F/cUH+zAIodS5/dmTFhm O2OcPt6F48Hmgbs3MOHjYTntq2zduCS4IH1nHROuz48cmtzZjTS5RQffNUyg Kmm6shl0o4b2oPjgHwYE7X0W8H24G7W2RPHzUxgwK/2O+aGvB9Ntwt/Mkt6o u63gx+/6Psxl5kg5KTLgx+oJ1SpqHz6vnhfJvMCA2JFQFw+OfuQJtvszeIoB 42vDYFGhHzVut1puk2aAa+MZFTfsx28Cyn4nNzBgq3nrocPZA6hyaafhQi8d hELab2HgELaXZ1601afDk1jGZ7+MIeRQ9q6TJvNoaFL6sG7TEHpJJjpQNOhw kd08d4h9GEU0kh8el6eD5ZO/Xq9thlE9Wb/Zdy8d3FV5/jmqjuDLJNlVK9RZ uH3X3PKm6ygulbjubiXzMrv1/Ez921GMkNCZzyHz9Ink9WZy4aPIuFkgHXBr FlS+7TRnzx3Fg5UL06eUZmF+2kzo4ewoTgg/iT27bxZuKJooOF4fw0H1LStc U2Te7z9UaCs2ju+eB7p+vTUDz2ruSNkdGUfJFQbPLo0Z8HpU5GB7geSDzRKW l2fgb8uBd3fujKPSeZENP2RnIDXN9tjPoHH8G2zA8nHdDAzS3m2TWEXBldSD JVHFpDeuW8X5bJCC1uMs2eJCNBgyt9nQRqPgJmaXacA6Guy7qvJ05y8KrvJa u26RlQaa22U0M9dPoBqv76ZUOhX64lLLvC9NYMSl2A9YToUq6dFLB9MnkP1Y pmwI6YXKuh4n1zpOYtbL/QI78qbh4Gmlv00ekxhAqClZpU7Dk1WnbL0CJrFr Qj+lOGYamiY3GC8mT2LUo54Fee9psE8YEvLvm8TtUeo/1xlMg851heMVR6fw 6UH6kufaaZhV7YtknZnC6ou+QkraU8B7S3j1poUp5Nh6rWpKaQrGQ50q97BM o3KJxHcnmAKDT8UnD2+axjx+7cFwiSlg27CvdvWFafw9UHsi+M8kMMyeLYeF TmNz6d5gj8hJOPW0S9HoPBWFr8qxW49MwPdb6ZFhKlRseOcmb9A+ARJSBLVB h4qK9ymOytUT8Evj841NFlQMEuCe4UmZgKHi5Qs3wqh4gP/hZmW7CRCX2PfE fY6Km3/+2pHMPQGihgqOlmE0jNq3bnGjDAVSi15GYRwNv3Mnt6vsocA3t7da nOk0XDXXt8t5EwXeX9xg9aKShm+YDNnWP6QHFm7aIEqnIUVW9o1M5Tg8Lg6x +XZqBksO1nj8IL3x0cu4iL6uGbz9StTohcUYKBk0cXGPzOBf+aCDWvpj8OVC xO8j1Bn095ncJXptDM4tL6na/JnBiIPzb5OOjkHF9kQ//x2zKGctOOm2PAo6 i2wX7xvPYoTCxk2ab0Zh05u8i+qMWQyiX37KDSMQ8CVxxXthFm/e0rjxaucI 2HZ5U8tXZvGcT9mrRfYREDXgUBXkpWOdf/NCRd0wHCMOb74tTUfVwN2r5jSG ofsMM9viIR1jn17bW2A4BPZXFNuiJuk4yR7Jf8R5AA6/crM0oNNxSezkvy8G A3DDo5Rj+w86npfPuHz44gA8MMoVcWFhoPblQVbBdQOwsE2pjLmVgbPKLkOe 7/thU271naeqDBQ94qKokN0Hm9uizx/PYOCvkU+sQuM9EGXmu0kol4EyetY5 bVU9cLnodQ6ziIEfC1NjXiX0wEn3yYuvaxn47yb18oh5DzhrrQ65O8zA4nM/ PVV+kV7YpVZaxsXEvzEsB7Zzd0OrtGHfyn9MLHRc2F0v3QlXuzfhf0ZMpHgf eKjJ2wkf3I4u5pgwcc3ztuUeRgcMaoTdUbRlYpOok2BragfceMZsW/uaiTjz 3z4nyQ6I/XSVi5rOxD2OnrwdpDdKse58XJzDxPHZwq1rVrVD3I09214XMNF+ 2ZLtCKUNflXLb1ldyUTb9vE3rjFtoGd2MDmoi4l6W0Ndhra3wfA7BVb+30yc /aJ0Ln1jK9Qz1X11Vph40FWuV4LWArzpHZeCWQl0b1kRmIlvgWM89/b+Xkug Jj3uhcauFpBcsPTQ2krgqwXz67mbm6Fncn5Q/wSBXP3Nt6nsTTBevnS+zopA k8E1x2w7a2EL4/f2ElsCn73ZoZcTVAtXlGzEku0IzJ3sSSS0a8F09UyBuSOB DzOTR7T6amDcm6cnwIPAxg4n34GhakAJFY0HEQRedWjKmJ6shKP5HTGjUQSG rlO50h5fCVbPtwiqxxD4xX1xKe9+JfhKP74tFE+gpWjiz0e0CjD+9O3u5XQC f0lozeXSy0Ev+eXkgTICXftuOLdNIBjFP+cRqyBQIfnRt833EJT57FSFqgh8 Gmvpf2O6FPwO39gyXksgT5TURBmtBD6LL1RvbiFwDd9/MieYRRB2LCCxvZVA x+RfwRcti6B17vmHl+3k9aCf4srfCoHrYWxzaxeBibbuVy98L4CiDbGbuQYJ vNHwT3hiIQ/egnHYyyECDxyrv1Filwdl99Skfw0T6NFKLfX9lQs7qg94VY0R WKhV5i72+wvYSdvwsUyT+7Pj2KP1y9kw19i0+RSVwJ+cvDbomA3ji3GHLWgE Zvx6E2yykgUlGlG+xbMEqjsdak/9mwlBQ11LZM5EpucXLxbWDDDvfxbx7RuB N23G2DdzpkP+kaD3I3MEfmp7+lKc9zP4yEFi/A8CZ38cOnx4ayrMrjUqcJ4n sHzXSOd+0RR44i8qprZA4CW+jiURsWQQORq7vu8ngW0PyyoWDifChq1cvv6/ CFz3Rae/51gCsCmpPlBYJJDzitXdnDPxMHy6Zr/fbwKD/ljif4pxsMUsWfDA HwJZff5x7FeLhaXCJh0kefVpg6wfWh/hRs45evMSgeaai8JP9D9AhanGGeVl Asf5Sz+ZNEVBpe4OKpI8FTn/pa8nAkJivegHVsj7Oa40Kk8Jg/YDLkr+JGfZ 2EUkMEPBrHCU9RvJqvdlDFf/CYaS8fcbLv0lsCHqeNJ/q4PAnz/YMZDk8TkF WgZ/AOx6UQEDJIeZC4b9E/aDbaq8ulv/EXjyXsO9QNV3EH/TtI30HpSto9/c ZewJxob10c9JPvuTbyXp2Stw/i1Sm0Qy0/QLHPB3g9CXdy83kCzUibu0NJxg 9IyPKIVkn3dilVecHwPHkbBr8yR3Zau7WGmbgbLS8yHS45CXF4b89HXA6viF ctLjMCjL6SF3OmC15+AK6XG4Nd69hyvCCPd81Aig/+/9g43rhGKskZkd97yH 5OrdXxh7HzkgX0N/XSHJA6Waf4NjXXGp4o9JMMnbebZyC719ickaPIamJFvv T5byt3uNYSvbcuRIdv/53I5D3xsbd8npLZHrEanDv1S4xxfz5+4Z5ZP8I+zF HYst/njbEssektyya/Dhdt5A3P1Yw16Y5NPXdTNr2YLxR8Yhj3Jy/ekllzPN f4Xgtk8230ivw25JygI36XlVk04t7uR+fj+nYHGsKxKHdJ9d5CFZuiMsq6I+ Gh+NyW98S9YDFBpI7x75gN89sioek/WS9GvkeVjHR5yzC/8wTNZXRtT71y1f Y9GHp6sXSI4fHmj/VxuH4jMdN2bJ+oxO/3RBozgeC6JmPhwlOYrr1Tfr3ARc 3Tsv/4Ss56nPH757ZyRiWntY+BRZ/zyEwqrMuGQ02xoYfJ/sl43nBtuTvUmv 26tco0f2EzQ/FWsKT8fz/qmLqmS/3ZglJ9/1DHx4LO7eBgaBC4NPax3vZmIt q7mVFNm/GsH67dfdsnEu+UHp0BRB5n+RwtK1pNc1lK53nySwmZ37706/HNzB /rM+f5wg33eZtSf6C5b1dXjlkPPEuCSv5WdxHnLx5PFtHyDnSe9ZC2mFfJT2 Ohfh2Edgq/eV43qN+cjesL1NtJvAd76ZuSl9BXhOwSZvpZnAGeaMLH2hCK2u qM+sRQJ3/qj89WhTGXoxeI5Sigl06b95su1mGRLVP3yzC8n1udIwLhFZhhOf MpxP5JLzt9t0S8Pucmz5Vivfn0rgKbNL3O2HKnCbgBW3VSjZfyyjNtOKVfhJ e3V+YRCB3IoxsnPeVWioVue67E/g7YmY/QstVbja/tsD47fkfiDxePZ6NVrI r85sek5g7zG2uz4GNbhtXq1pzoSs/9wuqTj7OtzB4pQ+ZUygfJeEQNeXOqQK Ph3tMCRQTPg77d+POnRNpEmH6JL9PDsvLW9VjyOyUgHlagQOb7M2dzZpwAIB 2v74I+R8vsVrUqjThIO8EUqihwlstw+RfxHUhHEfeav8pQh8w/dy+8WOJvx+ OKNBX4xAo+Rln2zVr5i/pQRihAjUP81Sd+JiM7K2jwXlLDLxC6e5uOXmVmzm EfuaM89Esyv/VoSOtaK++O+Had+YeKl400Dx9VYsXXX+mweVidux1vOPfyv2 0mwExnuYeGK1KFOBpw2rH2sU7f/CRMb0g2N8rO14blfIvm2mTMx/2BVzcbID Lz08fbX8Lvn3he4+U6s7sb8kJuM/PSZGbbpV8FysE392UU47apGsQwmPv9+J zEDtEPWzTOzyWBWcROtE+4j8Yh1+Jn689+qQN70LBfmy/WfTGCi0sp3uxujB aj+n0WcJDNyulK12k6cXfaZfxbHHMNA9waZGQqoX9y42Bv8OYODT/ua6LPNe VH07fsPFgcxPY5w7bWZ70fK0Puv8BQYmwnux4Ok+3MN+o9OnhY4rLklSR/oH 8K/FYO3ROjrec/dY7bU4gBW8SaUdZXS8laW6tX/TIE4Jq5X+yqSjC2OhV19z EB8l5cFoAB3l7dORr2kQj75w3XlUm4577imMzxYNoa/uztcrnbO49N8eC6Og EbR6Y8eR2DSL9g5vKjKzRvBs7HiLUtUsLrvxKf9qGcF1b5UuOmTPYpcZK112 9SgK6g+xP/WbxYslOv8sYBS/PNhPWacyiw9fX8nnzh7FjdNiMm+KZtB7PO1Z ZfAYXs1MejuWNYPOodnTlNgxVPHcZC+bPIN1M07rWTLHcKpp/XJl6Azuepjv t79xDJfPRK4NfTyD2nz36ar/xvCFtw8/r/QMrv8goVx1bxwFJyK5zpN+wEiZ pWnKUPCTc5h6iy8N7Xbzsk6dpWBD6mtTHQ8a8moV2dgqU7D+t97u649o6NYR ctP1LgUlV92krVGlYbdAzahBMAUf2Sk0X2Sh4aLX5iPnf1Mw46eJx3l9Kiq3 yezRLZrAbcqCm2SuU7GtXVZBu24Ck+bFioWVqPhKM8FJqWsC1bOFb/fLUvGM 5mHpncQEPr08fno1BxW3Cp0T8dg1ifQ7cFswdRpNONQ3yLyeRHf/uQrpuSl0 sG7fMas6hUcuXHe6MjmFp3eyWOy8PYWdLkF5t/umkPJV/q7G/SlcsjteYFE+ hRqxx45HuUzhZzZF9ct+U7jlrP722fQpvN0d8rX64BQmx4uPqPJNY7D2JyN+ k0kMPrbqi1j9NDaYTP89rjuJ4pUt3vUd06iSe0VDV30SXUIdXO4NT2Okq7h4 wPFJlGmjJr/7MY0yYp20cs5JvHdxXVvIdtLjJLYaiSVOoG/W3EYvKypyzdTv E6VQcDdbRCplPQ0r99lZf+qmYFi9w1SVMA1V5mNb9zZQUDGXfyZ6Lw172ihj QpkUVMhIVpA/QcP4ua74cmcKftNIZgd9Gu6uc3wsvYWCvsM17zjTaMij7nPq hdI4Uk+t3Oo4P4Pnt8jZZ58Zx8n8apsipRk8KxWmO3KI9HcHBaVIzRns8Gg+ JCk0jn7VPw6qGs+gTY6PljdlDP1Hr4fffT2DzwQ4Tro/G0MHvnlRw68zaKnd elQvcRTfGoil+V2bxTPPnT9xhY9ii5xuedqtWWwTe7Qr6+0oCv+J1qo0nEWX tVT1BZtR7Ar7+K3fZhZZHFf3qZwZxQXYU1/kP4utqjaVrz6O4PbA7OsX2mYx Q21/ZT19COMn+JevK5J9PNjd0N08hEKBjemnNej4/vTlpwMZQ2i2V8RO+CYd F1y5vzc+GsJ7HJWHy03ouF4575DS8iDacPaJp3nQUc2gVrVy7SAO+JlKra6i 44XmC3GUHf3ofNp2dYIcA1dNGAn8/NeHbqP9373OMMg5L3uKdawPrRnZGSYK DDxt793DGtuHPno8wWuvkddZL8ulifVhLduedqo5A7PevN+fc6AXc47EPBQm 5xb1b/GNMtluvKBv+l6BnYk+uQ5twpu6UWWgfaCIk4lx1WpU68UuJEKdm/bz MnGySJaHt6QL79RrZS9sZuJ6++C/ay514ZLbNZvD0kw0VW7vY9XpxGsnxYMv 6zAxaFLuherjdrzcdqR3MpaJinWr+7h12tHcwvuRVSITtf7F51Ydb8eHVadC f6QycdWlSbF9y21IuXfGmkLO+SGLg8klbm345sBj5Qe1pJeJ6ecK+7Tiv9Hf 2etoTPzTn92Pil+Ra9dHtRTyHBJt55hfx/EVtSQCf/pJkp6QKlWiUdWEGgc9 MyylyXP1olFKxdkm1GcXuskvR+ALRzE+BdlGfPJA686UAoG2MuwFXVvrUWSs UXVCn8y5Hi318T11+NW3MP7UXQI/XFcosQqsw874faye98ncPif+nuCpQ1xX UcBtQaDFitK5cJZa/HN6SST2KYEpT79JFU1U4fWbbH9EyXNdWfO27e6YKoyG FR5qIIEl9aqt7v9VYQLb603xIQQedLi040R3Jbo47WfjiCTw3PuN+3RrKzCE XV1aN4FAFiFtxZAXFdhg/l9bfxKBL08f2/YVKvB3/x9DdTJn3LrgLr4vvxyz 9wmpiWYSWC92eT4usQyZX8uOaZI55SyXQ33e3TJMtRQ//YbMMdbNVfRq0TI8 Ylu1L7eUQHtutp7Ew4i2p8RK50kP3N1o3vVkfQkmzxYWrmoksK947I9/Sz7K C152tyRz1DmBkNHT6vloJL9eabGfwJUHa3JGW/Nwk/mjrQ5kDuPXUo7d1J6L Ly57DBqOkPtzWHEHdOZgZWHfQPcEgVL1UfQiLZKNbvwQIXOed6F8gmxXNjYw 4gUMSK/bnjmiL9idhZdGHz1sJD3OPUPPIKonA+uVvJ3OMQn0KxLj/amTgT3C RzoUyVz537HLKgEZ6XiFzfCgMpk7c+zeSjdkpmHksvqfo9/J3Jh3T/9WVip2 PA8xESE9bj9H9X1KVgpK/7MYZCFz7FHrsz9Hs5Ow+fNcRwrpcWFR88vXcxLR 54KMzmMy9w6OGPdW5SSgp5/0iByZixd2la/z+/IJr/GHL8eQHvfQ89ok80sc Wgdk+CmTuVosk+F3OTcWnz9pkmSQPJkUdW8mNwaVV+xNNpM53ULuHu/RvA8Y RCle95Hk7M9HBX5ZROOqApuc3WSur7ly6JCjZSTKbHfQiyT5hv7jH78tw/Hq 50wePtILvL/joJXVexRZy4JPSH6Z1WQ2ZhWCwvWKtv0kO07fFFWxDsKbr+0k j5CeMawq/jTTOgATRiwn3Ek2+ruwuN7GDz3u7YxpIfnqS/4TgxPvUC77if56 0mtcFy7Ue0964pdbxruUSca/3B/lpl5h9bfeKUeSK/8tVPRPueEcR21aPMnR Xlt05pud0PfwXvs6klt9CnP3tz7GmpWZC+Mkj6d0XS76aIavltav/5/HKR3a YX9ISQeD8oPG/udxZ7d4TsgZngfvctuc/3mcmhVbqIz2XeiISXnzP4/j2GR6 mLbPBlIoZw1mSZY5+fltjsRT2M1/+FQXyav8ezOKBZ6DSLqHUB7J5//u79kq 4A7XLiv99CWZsuZioe2GNwB33HoMSbaIDL1Vs/4tyD45VXSA5JYY1cHXr33h yuYXMUxyPaITjE0lX/uDbpmJZyLJv/ybdWo9AoFvbuXxLZKdimv36HkEA+7T vruK5IAqX425V6HgTn11PZ5cfw7R0Ea2VxEgMdN2rp3cv6ITB7WfPosCdxae 6Dskez2ZvPz4+Af4sWVWjULu/xU7zZA+qY/g4cuZ3EV629rEcA13iVgQi3+t KU+y0b1cmwO746DgoJR6EllPB0xw0WxzPHhpOsjfIetPzPfOJLtAAmwwsjqZ RtZnlqTMlWCeROBrk3SfJ+tXsXDKJYktGU4vRGwyJ+vbdMfU7hf0NCByKqX/ kd4m3+AqTZ36DIKSm+r5SfbaodN8cSwdPI9W5G8l+0maSGXOz2RA2+6N74XI /sN6Zc37I1lg8N3n7heyP4tirSee6GZDWpNXxhvS4y5MzLW492XD2RMMTW2y nyNnf5zx68iB8dy1H3vJ/l9aGJEyq82F1FTpu8/J+SCtmK2opZAHbLEttpuH CVT/NdFyrDwPTjXpDCWQ82Tgs1MsozAfnpk/x3Ry/pQ2eYqu/1wIqZG3Gow6 CDzJqXqlQbII1nMpZpe0kfV/u37GMaEIttVt/M3XSqBvyWGJ5g/F8OADNSKy icCee2KwPaAU2g4d1PivmsBjQcs/o/gQcitLDzytJOd9+ZWTW7yRdJr3Jj7l BJ6xHnv87EIZcLFzsMeWEOi8ZcPAvlPlcP3G9laLL+T9/V5/v3h/JYxED596 H0t65bpV4X8sKsH7274KzhgCLRM5rslmVcLPjYM3LaMIrBLRXgk4XgUb194v 2/me9N7U2aP8F6uBMSrvIvyO/PzPLodTdGvBgw0fG9mR8/fb9Pby6FrofsRn pWBL4Daz+PmQ8VooMM1+vc2K5MW/1w6b1IHi39ebsx6QHsy1sZLfth4sqMuN NqT3KR4R+GXt0QjHtVq0lc8RmGvfNzVQ3wg7blTFR50mPc85deXMuiZYDHy2 h3acwEOhztdnfJtArNYozYj0wGPRDjFj77/CpSZuAWIn6Z2rPqidTG6BV+n3 9+qzEtjBz97NOd4GPTK1n7ILmEiNObrgytIOa4Y4gs6R57lsWXX8/I52OHjr xc/qDCYaSq6Nbb7dDntGAwULE5joJRknrdLVDh1vrQYvBzFxeW4z1/3aDvDZ 70+uIxO179KapxO6oJ895nT1NiZOdUY1VVZ3Qcp5zwJDISamRp6zDKN0QcWH Fy2L65l4/jnT/ZhIN5w7t9zIy8FEk72V+w8Fd4PsxfID498Y2E+cmRd80QMm 56zKxStJr7O68t7hRh+oXR4+ctyQgTvtt7RzP+mD5d1blO/eZmDhHfv04JA+ CJe9NeWhxUDhoAeywd19ENU3nP3lEgMdDr4zOKXVD8KZXJQUSQY+SJV5sEl1 AFbPp99aNUdHRpCldOupIUgp9nj0yJ6Od/QuOxrfGgLXa0mHgyzpuOaXhdr3 J0Ow04jIS7tPx2OyRobfvwzBF1OefTU6dMwNNlDwOjgMixTB4cBjdORIWFTZ vHMEOAalolMWZvH8oUCVTOdRePDlgU6L2SyqnqsRE387CiZFG68LGc1icO8h 49DwUWh2isjSIfMvUyT8r3n+KOQV/AkuvzKLHt2OssNzo3DiaI7iyb2zqH34 pfiQ0RhcVet9UT44g7Y/BXwOK4zDppqEHScukR5XoQ3rro3DW9bQRb/TM2jQ ntc1pjcO5/TuvqTIzGBo6cNPTs/GQYJ6u9hKZAYPFIgb22eNw77Ast+yizTc tMuD10qEAmHiHfz6iTRU+BAafnuBAu+O56gYstPwWlCVSBLrBPCnsyl7/6ai 0w72xjmeCWConzidQVBR3bTN85HYBBBVTJapASqWmSbogs4E2HMVaq/NoaLP j8qc6bwJ2P428NphIyoy003bLR5PQtzUmq9CJdP425LiJfx8Evi6L0++zJrG zuVXfJXek3BfIw3oCdNIhVWmbHGTUKpyoDrJfxq34KbtF9onQTryyO3R+9OY dKlmbaXUFAhW1Pw+s34aB41cs/JGp+AU9fyzr3pTmF7y1O0TfQpGLkmZBWpO YaNQdoP34hS8ZJ/7q3V5Cr9ZquVe5p8GDd5FkUrpKcwrLQy3gGmgZYkla65M Ip9iQqZTxDSkXv29cOX9JE40CLF4alDhEtHiEtk0gdka700/6FKBd09FSzRO YMxP94n0+1Qo3xwtF5E1gQoXOP8UOFEhRZTQeRE6gfxvFzSfJlGhNXCHBvfd CXy2c8+6pH9UcPGZurv6DwXPyhw9kxRPg7vpujHFOyl4R072pXQGDc5WScl8 F6Tgm/EHpmkFNGhqFV2zm5OC1l6C3KFNNAjIEHtpxxzHwqd4W/Q7DdSlOWUm C8dxS0OyzNKpGRjt+rR74to4Cggrf61vmIGMt6q8Li5jGLSO/Y1zxwycTBGV 320zhgkPosMPDM6AXBP/7sq7Y7hRjlr8iDEDcx2BcwuKY/hfZEN2Dt8snP9l JiYhOIY5rF9D567NgmZxy2B5wiieCEioVe+cheP59meqQkZQ0mKid9XgLDgs HTrk6ziCVh+vKGRRZqGm2CVay2AEb+Yf2fX7+yzUlw7x1EqOYClnTq3cejoo fPg3cq1kGJ+Hq4pbqdCBdql8w7qxIdxcK7fSXEIHhjatQ2b3IHJF5kwmV9Eh L+jkBmGOQfy3uvubSyMdOPaYfVieGcAbNS4mG/vo8N3nQm1K1gCa/Xcog/GD Dro/eJYKzw9gtab96WsSDHj65tr4xzv9eDCE69moFwPczz8+URfQiyn1te/1 /BnAIrRGw/ZRL4od2WXaHcoAEYPdnkLXe5Gr8eHmlE8MOJF17qXypl58GbzN 4VspAyQ6d/gYhvagccbDMhpB8oBOqVZ4N2ZES/p4KjNhNiqtzyOiE0vZnnsu qzNhn/hDHRPHTpQ0mWG9p80E1YRtgvK6nYisE3dEDJgg+9fUYlq4EzXWOCTs t2OCic2fWHpYB4Zcg/1JUUxyPmaxzoW04/ev5qelaUzIut6rsvNdKwq27Te/ wGCC9UW+p96WrdhLBHCrzTGBq+fExx/qrRh62ixI4zcTPkbfZM0VaMU7dKJg iZOAwXf874VkWtDYRM6GIkbA13XlaqsufcX6npJ9zpIENIVX8RtwfsXjnvPn 10sTUNTJkZ/b0IRdt7/7ih4lICDw44KKWhOmJEr6US4QIL1tuEPsRiN27PDQ /6NLQL6Xh06kST2eHTlYulWfgEv+S34+kvUocMbMUtaIAEOZqrhn9Do0lQus v/qAgJ5IPt/zVnVoJTB3WewxAbL6nOKv7GsxM3L9V2MvAtxDl+P/vazGaDNR Hu53BLjO13kEX6rGw+/dgxJ9CZA46HpEgrMa035VOzYFEcDfUSl92qsKFatT A/KiCZB6/PiahF8l8n3N/W9rFgEd+tsKdkSUY+ZeSv6LHAJWc3+W26Fdjskr 90wpuQQoWsWbbeYvx39KAV/diwg4O7pPY+VFGa458dNVu4qAwuyWsk09pXi3 +fwzmxoCkvtEh6uVSjGx6mHNyzoC/uvlLDMrLUFWdYqKdxMBKlEFjhGfivFR rMZa8U4CTnQueQTbFmLZzVCHhS4CMs9cfcIyXYAbj66WK+whIHU+64XhrQKs vnvAT2yAgI2d+0L4zucjb6hmhecYAXICKgYbeHPxes5Nd24KAZq2X/rPP/+C /ouvfd0myPv1Uaoxnc9B58IIJ81pApglKdFJ/dmoe6sj3pVOQLt5FM9ofCaW Hb4Snc0gYKgxpWFkSya+L4sfHGQSYC3pqNHvnYGvPxTs2TBHwEx0bKvr5Gdk JJVL7/hOwLrUmIgbjaT3DdxyFP1BwA2XdVrimano38g5xrFAgNFH6aFkx2Tk +ff6F51kzkDilr5hElpctFav+0nAQd1D23ivJKJehHWdwSIBw7p65ZoC8Tgy tm5a5DcBHIKmGvTFOFSL23T5f89VsppJOTkPx6JSTkSDyBIBV7dKsfglxSBl MZuRS3LxqyD2DT4f8GOipYbCMgEPebf/FKZFoVxq3EItyefu3nXgyonAgQnJ /vMrBHwRPn7mm3MYPjgw9DeTZAF6G+OrYijqXX9vtPkvuZ+sFsfiBINxVvIc 52OS1ZqUamxHAvCn1Rd6LckTdYmXziT74YGJEX7S4yAlKLCebeYdrj6Z9Eid ZJmAqffPXTyxTvSv0CuSDXXbtRcFX2EgNP/JJPnaickbJsnP0Vhu3fbO/z2n +FN37pPLUxSKSnOm/+85SGnn7bbJ1viAM0VkieR/qz81P042wP/7vhyHrqCs WHxm8f8DJChnmQ== "]]}}, LineBox[NCache[{{Rational[1, 2] 3^Rational[1, 2], Rational[1, 2]}, { Rational[-1, 2] 3^Rational[1, 2], Rational[1, 2]}}, {{ 0.8660254037844386, 0.5}, {-0.8660254037844386, 0.5}}]], LineBox[NCache[{{Rational[1, 2] 3^Rational[1, 2], Rational[1, 2]}, { Rational[-1, 2] 3^Rational[1, 2], Rational[-1, 2]}}, {{ 0.8660254037844386, 0.5}, {-0.8660254037844386, -0.5}}]]}, Axes->True, AxesOrigin->{0, 0}, PlotRange->{{-0.9999998831351729, 1.}, {-0.9999998592812047, 0.9999998782744886}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{3.435884702766*^9, 3.4671158462305536`*^9, 3.4674874053065*^9}] }, Open ]], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"pt1", "[", "t_", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"x0", " ", RowBox[{"Cos", "[", "t", "]"}]}], ",", "y0"}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"pt2", "[", "t_", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"x0", " ", RowBox[{"Cos", "[", "t", "]"}]}], ",", RowBox[{"y0", " ", RowBox[{"Cos", "[", "t", "]"}]}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"\[Phi]", " ", "=", " ", RowBox[{"ArcTan", "[", RowBox[{"y0", "/", "x0"}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"pt3", "[", "t_", "]"}], " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"Cos", "[", RowBox[{"t", "+", "\[Phi]"}], "]"}], ",", RowBox[{"Sin", "[", RowBox[{"t", "+", "\[Phi]"}], "]"}]}], "}"}]}], ";"}]}], "Input", CellChangeTimes->{{3.4357479158186617`*^9, 3.435747918689662*^9}, { 3.4357484981536617`*^9, 3.435748556503662*^9}, {3.4357486015286617`*^9, 3.435748679043662*^9}, {3.435748826491662*^9, 3.435748829547662*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Animate", "[", RowBox[{ RowBox[{"Show", "[", RowBox[{"circle", ",", "tube1", ",", "tube2", ",", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"pt1", "[", "t", "]"}], ",", RowBox[{"pt2", "[", "t", "]"}], ",", RowBox[{"pt3", "[", "t", "]"}]}], "}"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"Red", ",", RowBox[{"PointSize", "[", ".02", "]"}]}], "}"}]}]}], "]"}]}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", RowBox[{"2", " ", "Pi"}]}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.435748689431662*^9, 3.435748745633662*^9}, { 3.435748778772662*^9, 3.435748793188662*^9}, {3.435748845955662*^9, 3.4357488472186623`*^9}}], Cell[BoxData[ TagBox[ StyleBox[ DynamicModuleBox[{$CellContext`t$$ = 1.3028817885007071`, Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{ Hold[$CellContext`t$$], 0, 2 Pi}}, Typeset`size$$ = { 360., {177., 180.}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = True, $CellContext`t$33766$$ = 0}, DynamicBox[Manipulate`ManipulateBoxes[ 1, StandardForm, "Variables" :> {$CellContext`t$$ = 0}, "ControllerVariables" :> { Hold[$CellContext`t$$, $CellContext`t$33766$$, 0]}, "OtherVariables" :> { Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> Show[$CellContext`circle, $CellContext`tube1, $CellContext`tube2, ListPlot[{ $CellContext`pt1[$CellContext`t$$], $CellContext`pt2[$CellContext`t$$], $CellContext`pt3[$CellContext`t$$]}, PlotStyle -> {Red, PointSize[0.02]}]], "Specifications" :> {{$CellContext`t$$, 0, 2 Pi, AppearanceElements -> { "ProgressSlider", "PlayPauseButton", "FasterSlowerButtons", "DirectionButton"}}}, "Options" :> { ControlType -> Animator, AppearanceElements -> None, SynchronousUpdating -> True, ShrinkingDelay -> 10.}, "DefaultOptions" :> {}], ImageSizeCache->{417., {217., 228.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, SynchronousInitialization->True, UnsavedVariables:>{Typeset`initDone$$}, UntrackedVariables:>{Typeset`size$$}], "Manipulate", Deployed->True, StripOnInput->False], Manipulate`InterpretManipulate[1]]], "Output", CellChangeTimes->{{3.435748736005662*^9, 3.435748758768662*^9}, { 3.435748794136662*^9, 3.4357488046416616`*^9}, {3.435748836713662*^9, 3.435748847841662*^9}, 3.435748880892662*^9, 3.4674874112345*^9}] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[TextData[StyleBox["Morin 5.73", "Subsection"]], "Section", CellChangeTimes->{{3.435405653248*^9, 3.4354056723900003`*^9}, { 3.435408771718*^9, 3.4354087758459997`*^9}, {3.435412154159*^9, 3.435412154868*^9}, {3.435412374642*^9, 3.435412376026*^9}}], Cell["\<\ A one dimensional collision: a mass 2m moves to the right at v and a mass m \ move to the left at v. They collide elastically. Find the final velocities (a) working in the lab frame and (b) in the CM \ frame.\ \>", "Text", CellChangeTimes->{{3.435412168401*^9, 3.435412180033*^9}, { 3.4354123816549997`*^9, 3.435412521849*^9}, {3.4357448808036623`*^9, 3.435744881908662*^9}, {3.435745186282662*^9, 3.435745213143662*^9}}], Cell["\<\ Soln: in the lab frame we write the two relations coming from momentum and \ energy conservation:\ \>", "Text", CellChangeTimes->{{3.435744921347662*^9, 3.435744927609662*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnP", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"2", "m", " ", "v"}], " ", "+", " ", RowBox[{"m", " ", RowBox[{"(", RowBox[{"-", "v"}], ")"}]}]}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"m", " ", "v1"}], " ", "+", " ", RowBox[{"2", "m", " ", "v2"}]}]}]}]], "Input", CellChangeTimes->{ 3.4354124734779997`*^9, {3.4354125250369997`*^9, 3.4354125420179996`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"m", " ", "v"}], "\[Equal]", RowBox[{ RowBox[{"m", " ", "v1"}], "+", RowBox[{"2", " ", "m", " ", "v2"}]}]}]], "Output", CellChangeTimes->{3.435412543425*^9, 3.435885195199*^9, 3.4671158683981533`*^9, 3.4674874150253*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnK", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "2", "m", " ", RowBox[{ RowBox[{"(", "v", ")"}], "^", "2"}]}], " ", "+", " ", RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "m", " ", RowBox[{ RowBox[{"(", RowBox[{"-", "v"}], ")"}], "^", "2"}]}]}], " ", "\[Equal]", " ", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "m", " ", RowBox[{"v1", "^", "2"}]}], " ", "+", " ", RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], "2", " ", "m", " ", RowBox[{"v2", "^", "2"}]}]}]}]}]], "Input", CellChangeTimes->{{3.435412544421*^9, 3.4354125801949997`*^9}, { 3.435412615907*^9, 3.435412630192*^9}}], Cell[BoxData[ RowBox[{ FractionBox[ RowBox[{"3", " ", "m", " ", SuperscriptBox["v", "2"]}], "2"], "\[Equal]", RowBox[{ FractionBox[ RowBox[{"m", " ", SuperscriptBox["v1", "2"]}], "2"], "+", RowBox[{"m", " ", SuperscriptBox["v2", "2"]}]}]}]], "Output", CellChangeTimes->{ 3.4354125815290003`*^9, {3.43541261702*^9, 3.4354126311730003`*^9}, 3.435885196435*^9, 3.4671158715337534`*^9, 3.4674874163045*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Solve", "[", RowBox[{ RowBox[{"{", RowBox[{"eqnP", ",", "eqnK"}], "}"}], ",", RowBox[{"{", RowBox[{"v1", ",", "v2"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4354125865480003`*^9, 3.43541263829*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", RowBox[{"-", "v"}]}], ",", RowBox[{"v2", "\[Rule]", "v"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", FractionBox[ RowBox[{"5", " ", "v"}], "3"]}], ",", RowBox[{"v2", "\[Rule]", RowBox[{"-", FractionBox["v", "3"]}]}]}], "}"}]}], "}"}]], "Output", CellChangeTimes->{{3.4354125953190002`*^9, 3.435412639156*^9}, 3.4358851978929996`*^9, 3.467115877898554*^9, 3.4674874178489*^9}] }, Open ]], Cell["\<\ As always we get two solutions to our quadratic, where here the first \ solution corresponds to nothing happening, i.e. the particles sliding right through each other with unchanged \ velocities. We are interested in the nontrivial 2nd solution.\ \>", "Text", CellChangeTimes->{{3.435412707748*^9, 3.4354127774820004`*^9}}], Cell["\<\ To work in the center of mass frame we first need to find the velocity of the \ CM. Since Ptot = Mtot vcm,\ \>", "Text", CellChangeTimes->{{3.435412784085*^9, 3.435412802158*^9}, { 3.4357449562456617`*^9, 3.4357449780866623`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"vcm", " ", "=", " ", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"2", "m", " ", "v"}], " ", "-", " ", RowBox[{"m", " ", "v"}]}], ")"}], " ", "/", RowBox[{"(", RowBox[{ RowBox[{"2", "m"}], "+", "m"}], ")"}]}]}]], "Input", CellChangeTimes->{{3.4354128031289997`*^9, 3.435412831484*^9}}], Cell[BoxData[ FractionBox["v", "3"]], "Output", CellChangeTimes->{{3.435412820074*^9, 3.43541283177*^9}, 3.4358851995550003`*^9, 3.4671158881945534`*^9, 3.4674874210157003`*^9}] }, Open ]], Cell["\<\ The initial state CM velocities are then obtained by subtracting off vcm\ \>", "Text", CellChangeTimes->{{3.435412836123*^9, 3.435412848174*^9}, 3.435412890715*^9, {3.4357449951056623`*^9, 3.435745038663662*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"v2cmInit", "=", " ", RowBox[{"v", " ", "-", " ", "vcm"}]}]], "Input", CellChangeTimes->{{3.435412849617*^9, 3.435412884328*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"2", " ", "v"}], "3"]], "Output", CellChangeTimes->{{3.435412881913*^9, 3.4354128845880003`*^9}, 3.435885201597*^9, 3.4671158898949537`*^9, 3.4674874224353*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"v1cmInit", " ", "=", " ", RowBox[{ RowBox[{"-", "v"}], " ", "-", " ", "vcm"}]}]], "Input", CellChangeTimes->{{3.435412897623*^9, 3.4354129054189997`*^9}}], Cell[BoxData[ RowBox[{"-", FractionBox[ RowBox[{"4", " ", "v"}], "3"]}]], "Output", CellChangeTimes->{3.435412906374*^9, 3.435885202615*^9, 3.4671158950897536`*^9, 3.4674874237457*^9}] }, Open ]], Cell["\<\ As a cross check, note that in the CM frame the total momentum is zero:\ \>", "Text", CellChangeTimes->{{3.435412910505*^9, 3.435412925164*^9}, { 3.435745045207662*^9, 3.435745055269662*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"m", " ", "v1cmInit"}], " ", "+", " ", RowBox[{"2", " ", "m", " ", "v2cmInit"}]}]], "Input", CellChangeTimes->{{3.4354129288859997`*^9, 3.435412972898*^9}}], Cell[BoxData["0"], "Output", CellChangeTimes->{{3.435412953672*^9, 3.4354129732060003`*^9}, 3.4358852043050003`*^9, 3.4671158964781537`*^9, 3.4674874259921*^9}] }, Open ]], Cell["\<\ If the collision is elastic, then the final state consists of both masses \ just reversing their directions. To show this the long way, though:\ \>", "Text", CellChangeTimes->{{3.435413017316*^9, 3.4354130724440002`*^9}, { 3.4357450738846617`*^9, 3.4357450813516617`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnPcm", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"m", " ", "v1cmInit"}], " ", "+", " ", RowBox[{"2", " ", "m", " ", "v2cmInit"}]}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"m", " ", "v1cmFinal"}], " ", "+", " ", RowBox[{"2", "m", " ", "v2cmFinal"}]}]}]}]], "Input", CellChangeTimes->{{3.435413074903*^9, 3.435413103852*^9}}], Cell[BoxData[ RowBox[{"0", "\[Equal]", RowBox[{ RowBox[{"m", " ", "v1cmFinal"}], "+", RowBox[{"2", " ", "m", " ", "v2cmFinal"}]}]}]], "Output", CellChangeTimes->{3.435413106356*^9, 3.435885205822*^9, 3.4671159012049537`*^9, 3.4674874310933*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnKcm", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "m", " ", RowBox[{ RowBox[{"(", "v1cmInit", ")"}], "^", "2"}]}], " ", "+", " ", RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "2", " ", "m", RowBox[{ RowBox[{"(", " ", "v2cmInit", ")"}], "^", "2"}]}]}], "\[Equal]", " ", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "m", " ", RowBox[{ RowBox[{"(", "v1cmFinal", ")"}], "^", "2"}]}], " ", "+", " ", RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "2", "m", RowBox[{ RowBox[{"(", "v2cmFinal", ")"}], "^", "2"}]}]}]}]}]], "Input", CellChangeTimes->{{3.4354131069049997`*^9, 3.435413174576*^9}, { 3.435413212304*^9, 3.435413214758*^9}}], Cell[BoxData[ RowBox[{ FractionBox[ RowBox[{"4", " ", "m", " ", SuperscriptBox["v", "2"]}], "3"], "\[Equal]", RowBox[{ FractionBox[ RowBox[{"m", " ", SuperscriptBox["v1cmFinal", "2"]}], "2"], "+", RowBox[{"m", " ", SuperscriptBox["v2cmFinal", "2"]}]}]}]], "Output", CellChangeTimes->{{3.4354131633459997`*^9, 3.435413174984*^9}, 3.435413215126*^9, 3.435885207426*^9, 3.4671159024685535`*^9, 3.4674874323413*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"s", "=", RowBox[{"Solve", "[", RowBox[{ RowBox[{"{", RowBox[{"eqnPcm", ",", "eqnKcm"}], "}"}], ",", RowBox[{"{", RowBox[{"v1cmFinal", ",", "v2cmFinal"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.435413179492*^9, 3.435413198943*^9}, {3.435413262152*^9, 3.4354132625360003`*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"v1cmFinal", "\[Rule]", RowBox[{"-", FractionBox[ RowBox[{"4", " ", "v"}], "3"]}]}], ",", RowBox[{"v2cmFinal", "\[Rule]", FractionBox[ RowBox[{"2", " ", "v"}], "3"]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1cmFinal", "\[Rule]", FractionBox[ RowBox[{"4", " ", "v"}], "3"]}], ",", RowBox[{"v2cmFinal", "\[Rule]", RowBox[{"-", FractionBox[ RowBox[{"2", " ", "v"}], "3"]}]}]}], "}"}]}], "}"}]], "Output", CellChangeTimes->{{3.435413199455*^9, 3.43541321656*^9}, 3.435413263672*^9, 3.43588520931*^9, 3.4671159042469535`*^9, 3.4674874340261*^9}] }, Open ]], Cell["\<\ Which again has the two solutions: pass on through w/o interaction, or bounce \ off backwards. Back in the lab frame we then find final velocities:\ \>", "Text", CellChangeTimes->{{3.435413221899*^9, 3.4354132569440002`*^9}, 3.435413393407*^9}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"v1labFinal", " ", "=", " ", RowBox[{ RowBox[{"(", RowBox[{"v1cmFinal", "/.", " ", RowBox[{"s", "[", RowBox[{"[", "2", "]"}], "]"}]}], ")"}], " ", "+", " ", "vcm"}]}]], "Input", CellChangeTimes->{{3.435413269166*^9, 3.435413288526*^9}, {3.435413359134*^9, 3.435413360571*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"5", " ", "v"}], "3"]], "Output", CellChangeTimes->{3.435413289249*^9, 3.435413360991*^9, 3.4358852111280003`*^9, 3.4671159090829535`*^9, 3.4674874393768997`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"v2labFinal", " ", "=", " ", RowBox[{ RowBox[{"(", RowBox[{"v2cmFinal", " ", "/.", " ", RowBox[{"s", "[", RowBox[{"[", "2", "]"}], "]"}]}], ")"}], " ", "+", " ", "vcm"}]}]], "Input", CellChangeTimes->{{3.435413363659*^9, 3.435413377245*^9}}], Cell[BoxData[ RowBox[{"-", FractionBox["v", "3"]}]], "Output", CellChangeTimes->{3.435413377664*^9, 3.435885212895*^9, 3.4671159105181537`*^9, 3.4674874406561003`*^9}] }, Open ]], Cell["which happily enough agrees with the result above.", "Text", CellChangeTimes->{{3.435413395625*^9, 3.435413418125*^9}}], Cell[CellGroupData[{ Cell["Morin 5.80", "Subsection", CellChangeTimes->{{3.4354143398459997`*^9, 3.435414350514*^9}}], Cell["\<\ A 2D elastic collision: mass m2=2m collides with m1=m, and after the \ collision the two head off at angles +\[Theta] and -\[Theta]. Find \[Theta]..\ \>", "Text", CellChangeTimes->{{3.435414356699*^9, 3.435414422256*^9}, { 3.4357452520356617`*^9, 3.435745296059662*^9}}], Cell["\<\ Soln: write the three conservation law (for px, py and kinetic energy), then \ solve for the three unkowns (v1, v2 and \[Theta])\ \>", "Text", CellChangeTimes->{{3.435745301665662*^9, 3.4357453384436617`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnpx", " ", "=", " ", RowBox[{ RowBox[{"2", " ", "m", " ", "v0"}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"2", "m", " ", "v2", " ", RowBox[{"Cos", "[", "\[Theta]", "]"}]}], "+", " ", RowBox[{"m", " ", "v1", " ", RowBox[{"Cos", "[", "\[Theta]", "]"}]}]}]}]}]], "Input", CellChangeTimes->{{3.435414425663*^9, 3.4354144879300003`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"2", " ", "m", " ", "v0"}], "\[Equal]", RowBox[{ RowBox[{"m", " ", "v1", " ", RowBox[{"Cos", "[", "\[Theta]", "]"}]}], "+", RowBox[{"2", " ", "m", " ", "v2", " ", RowBox[{"Cos", "[", "\[Theta]", "]"}]}]}]}]], "Output", CellChangeTimes->{{3.435414462302*^9, 3.435414488284*^9}, 3.435885216407*^9, 3.4671159151825533`*^9, 3.4674874446497*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnpy", " ", "=", " ", RowBox[{"0", " ", "\[Equal]", " ", RowBox[{ RowBox[{"2", "m", " ", "v2", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}], " ", "+", " ", RowBox[{"m", " ", "v1", " ", RowBox[{"Sin", "[", RowBox[{"-", "\[Theta]"}], "]"}]}]}]}]}]], "Input", CellChangeTimes->{{3.435414463517*^9, 3.435414512915*^9}}], Cell[BoxData[ RowBox[{"0", "\[Equal]", RowBox[{ RowBox[{ RowBox[{"-", "m"}], " ", "v1", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}], "+", RowBox[{"2", " ", "m", " ", "v2", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}]}]}]], "Output", CellChangeTimes->{3.43541451492*^9, 3.4358852185299997`*^9, 3.467115916539754*^9, 3.4674874457261*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnK", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "2", "m", " ", RowBox[{"v0", "^", "2"}]}], " ", "\[Equal]", " ", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "2", "m", " ", RowBox[{"v2", "^", "2"}]}], " ", "+", " ", RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "m", " ", RowBox[{"v1", "^", "2"}]}]}]}]}]], "Input", CellChangeTimes->{{3.435414517157*^9, 3.435414536495*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"m", " ", SuperscriptBox["v0", "2"]}], "\[Equal]", RowBox[{ FractionBox[ RowBox[{"m", " ", SuperscriptBox["v1", "2"]}], "2"], "+", RowBox[{"m", " ", SuperscriptBox["v2", "2"]}]}]}]], "Output", CellChangeTimes->{3.435414536899*^9, 3.435885219844*^9, 3.4671159184585533`*^9, 3.4674874470209*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Solve", "[", RowBox[{ RowBox[{"{", RowBox[{"eqnpx", ",", "eqnpy", ",", "eqnK"}], "}"}], ",", RowBox[{"{", RowBox[{"v1", ",", "v2", ",", "\[Theta]"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.435414538269*^9, 3.435414565145*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Solve", "::", "\<\"ifun\"\>"}], RowBox[{ ":", " "}], "\<\"\\!\\(\\*StyleBox[\\\"\\\\\\\"Inverse functions are being \ used by \\\\\\\"\\\", \ \\\"MT\\\"]\\)\[NoBreak]\\!\\(\\*StyleBox[\\!\\(Solve\\), \\\"MT\\\"]\\)\ \[NoBreak]\\!\\(\\*StyleBox[\\\"\\\\\\\", so some solutions may not be found; \ use Reduce for complete solution information.\\\\\\\"\\\", \\\"MT\\\"]\\) \\!\ \\(\\*ButtonBox[\\\"\[RightSkeleton]\\\", ButtonStyle->\\\"Link\\\", \ ButtonFrame->None, ButtonData:>\\\"paclet:ref/message/Solve/ifun\\\", \ ButtonNote -> \\\"Solve::ifun\\\"]\\)\"\>"}]], "Message", "MSG", CellChangeTimes->{3.435414565689*^9, 3.435885221797*^9, 3.4671159239653535`*^9, 3.4674874486745*^9}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", "0"}], ",", RowBox[{"v2", "\[Rule]", RowBox[{"-", "v0"}]}], ",", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"-", "\[Pi]"}]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", "0"}], ",", RowBox[{"v2", "\[Rule]", RowBox[{"-", "v0"}]}], ",", RowBox[{"\[Theta]", "\[Rule]", "\[Pi]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", "0"}], ",", RowBox[{"v2", "\[Rule]", "v0"}], ",", RowBox[{"\[Theta]", "\[Rule]", "0"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", RowBox[{"-", FractionBox[ RowBox[{"4", " ", "v0"}], "3"]}]}], ",", RowBox[{"v2", "\[Rule]", RowBox[{"-", FractionBox["v0", "3"]}]}], ",", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"-", "\[Pi]"}]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", RowBox[{"-", FractionBox[ RowBox[{"4", " ", "v0"}], "3"]}]}], ",", RowBox[{"v2", "\[Rule]", RowBox[{"-", FractionBox["v0", "3"]}]}], ",", RowBox[{"\[Theta]", "\[Rule]", "\[Pi]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", FractionBox[ RowBox[{"4", " ", "v0"}], "3"]}], ",", RowBox[{"v2", "\[Rule]", FractionBox["v0", "3"]}], ",", RowBox[{"\[Theta]", "\[Rule]", "0"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", RowBox[{"-", FractionBox[ RowBox[{"2", " ", "v0"}], SqrtBox["3"]]}]}], ",", RowBox[{"v2", "\[Rule]", RowBox[{"-", FractionBox["v0", SqrtBox["3"]]}]}], ",", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"-", FractionBox[ RowBox[{"5", " ", "\[Pi]"}], "6"]}]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", RowBox[{"-", FractionBox[ RowBox[{"2", " ", "v0"}], SqrtBox["3"]]}]}], ",", RowBox[{"v2", "\[Rule]", RowBox[{"-", FractionBox["v0", SqrtBox["3"]]}]}], ",", RowBox[{"\[Theta]", "\[Rule]", FractionBox[ RowBox[{"5", " ", "\[Pi]"}], "6"]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", FractionBox[ RowBox[{"2", " ", "v0"}], SqrtBox["3"]]}], ",", RowBox[{"v2", "\[Rule]", FractionBox["v0", SqrtBox["3"]]}], ",", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"-", FractionBox["\[Pi]", "6"]}]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", FractionBox[ RowBox[{"2", " ", "v0"}], SqrtBox["3"]]}], ",", RowBox[{"v2", "\[Rule]", FractionBox["v0", SqrtBox["3"]]}], ",", RowBox[{"\[Theta]", "\[Rule]", FractionBox["\[Pi]", "6"]}]}], "}"}]}], "}"}]], "Output", CellChangeTimes->{3.435414565729*^9, 3.435885221807*^9, 3.4671159239809537`*^9, 3.4674874487057*^9}] }, Open ]], Cell[TextData[{ "Note how ", StyleBox["Mathematica", FontSlant->"Italic"], " gives us the same physical solution multiple times with differing values \ of the angles.\nBut there really are only four physically distinct solutions \ here: (1) nothing happens (stated 3 times), \n(2) particles continue along \ the x-axis at appropriate speeds (stated 3 times as well), \n(3) mass 2 \ scatters at \[Pi]/6 (stated twice) and (4) mass scatters at -\[Pi]/6. These \ last two are the ones we want." }], "Text", CellChangeTimes->{{3.435414886974*^9, 3.435414976924*^9}, {3.435415020954*^9, 3.4354151916540003`*^9}}], Cell["Now repeat, allowing the m2 to be more general:", "Text", CellChangeTimes->{{3.4354146279700003`*^9, 3.435414640955*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnpx", " ", "=", " ", RowBox[{ RowBox[{"\[Alpha]", " ", "m", " ", "v0"}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"\[Alpha]", " ", "m", " ", "v2", " ", RowBox[{"Cos", "[", "\[Theta]", "]"}]}], "+", " ", RowBox[{"m", " ", "v1", " ", RowBox[{"Cos", "[", "\[Theta]", "]"}]}]}]}]}]], "Input", CellChangeTimes->{{3.435414425663*^9, 3.4354144879300003`*^9}, { 3.435414649642*^9, 3.435414664481*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"m", " ", "v0", " ", "\[Alpha]"}], "\[Equal]", RowBox[{ RowBox[{"m", " ", "v1", " ", RowBox[{"Cos", "[", "\[Theta]", "]"}]}], "+", RowBox[{"m", " ", "v2", " ", "\[Alpha]", " ", RowBox[{"Cos", "[", "\[Theta]", "]"}]}]}]}]], "Output", CellChangeTimes->{3.4354146656289997`*^9, 3.435885224859*^9, 3.4671159366013536`*^9, 3.4674874520441*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnpy", " ", "=", " ", RowBox[{"0", " ", "\[Equal]", " ", RowBox[{ RowBox[{"\[Alpha]", " ", "m", " ", "v2", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}], " ", "+", " ", RowBox[{"m", " ", "v1", " ", RowBox[{"Sin", "[", RowBox[{"-", "\[Theta]"}], "]"}]}]}]}]}]], "Input", CellChangeTimes->{{3.435414463517*^9, 3.435414512915*^9}, {3.435414675876*^9, 3.435414678487*^9}}], Cell[BoxData[ RowBox[{"0", "\[Equal]", RowBox[{ RowBox[{ RowBox[{"-", "m"}], " ", "v1", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}], "+", RowBox[{"m", " ", "v2", " ", "\[Alpha]", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}]}]}]], "Output", CellChangeTimes->{3.4354146805620003`*^9, 3.4358852266809998`*^9, 3.4671159408759537`*^9, 3.4674874531829*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnK", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "\[Alpha]", " ", "m", " ", RowBox[{"v0", "^", "2"}]}], " ", "\[Equal]", " ", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "\[Alpha]", " ", "m", " ", RowBox[{"v2", "^", "2"}]}], " ", "+", " ", RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "m", " ", RowBox[{"v1", "^", "2"}]}]}]}]}]], "Input", CellChangeTimes->{{3.435414517157*^9, 3.435414536495*^9}, { 3.4354146887530003`*^9, 3.435414696457*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ FractionBox["1", "2"], " ", "m", " ", SuperscriptBox["v0", "2"], " ", "\[Alpha]"}], "\[Equal]", RowBox[{ FractionBox[ RowBox[{"m", " ", SuperscriptBox["v1", "2"]}], "2"], "+", RowBox[{ FractionBox["1", "2"], " ", "m", " ", SuperscriptBox["v2", "2"], " ", "\[Alpha]"}]}]}]], "Output", CellChangeTimes->{3.4354146967469997`*^9, 3.435885228516*^9, 3.4671159423743534`*^9, 3.4674874543373003`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"s", "=", RowBox[{"Solve", "[", RowBox[{ RowBox[{"{", RowBox[{"eqnpx", ",", "eqnpy", ",", "eqnK"}], "}"}], ",", RowBox[{"{", RowBox[{"v1", ",", "v2", ",", "\[Theta]"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.435414538269*^9, 3.435414565145*^9}, {3.435414744234*^9, 3.435414744454*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Solve", "::", "\<\"ifun\"\>"}], RowBox[{ ":", " "}], "\<\"\\!\\(\\*StyleBox[\\\"\\\\\\\"Inverse functions are being \ used by \\\\\\\"\\\", \ \\\"MT\\\"]\\)\[NoBreak]\\!\\(\\*StyleBox[\\!\\(Solve\\), \\\"MT\\\"]\\)\ \[NoBreak]\\!\\(\\*StyleBox[\\\"\\\\\\\", so some solutions may not be found; \ use Reduce for complete solution information.\\\\\\\"\\\", \\\"MT\\\"]\\) \\!\ \\(\\*ButtonBox[\\\"\[RightSkeleton]\\\", ButtonStyle->\\\"Link\\\", \ ButtonFrame->None, ButtonData:>\\\"paclet:ref/message/Solve/ifun\\\", \ ButtonNote -> \\\"Solve::ifun\\\"]\\)\"\>"}]], "Message", "MSG", CellChangeTimes->{3.435414704896*^9, 3.435414745126*^9, 3.4358852305*^9, 3.4671159466487536`*^9, 3.4674874568645*^9}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", "0"}], ",", RowBox[{"v2", "\[Rule]", RowBox[{"-", "v0"}]}], ",", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"-", "\[Pi]"}]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", "0"}], ",", RowBox[{"v2", "\[Rule]", RowBox[{"-", "v0"}]}], ",", RowBox[{"\[Theta]", "\[Rule]", "\[Pi]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", "0"}], ",", RowBox[{"v2", "\[Rule]", "v0"}], ",", RowBox[{"\[Theta]", "\[Rule]", "0"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", RowBox[{"-", FractionBox[ RowBox[{"2", " ", "v0", " ", "\[Alpha]"}], RowBox[{"1", "+", "\[Alpha]"}]]}]}], ",", RowBox[{"v2", "\[Rule]", FractionBox[ RowBox[{"v0", "-", RowBox[{"v0", " ", "\[Alpha]"}]}], RowBox[{"1", "+", "\[Alpha]"}]]}], ",", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"-", "\[Pi]"}]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", RowBox[{"-", FractionBox[ RowBox[{"2", " ", "v0", " ", "\[Alpha]"}], RowBox[{"1", "+", "\[Alpha]"}]]}]}], ",", RowBox[{"v2", "\[Rule]", FractionBox[ RowBox[{"v0", "-", RowBox[{"v0", " ", "\[Alpha]"}]}], RowBox[{"1", "+", "\[Alpha]"}]]}], ",", RowBox[{"\[Theta]", "\[Rule]", "\[Pi]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", FractionBox[ RowBox[{"2", " ", "v0", " ", "\[Alpha]"}], RowBox[{"1", "+", "\[Alpha]"}]]}], ",", RowBox[{"v2", "\[Rule]", FractionBox[ RowBox[{ RowBox[{"-", "v0"}], "+", RowBox[{"v0", " ", "\[Alpha]"}]}], RowBox[{"1", "+", "\[Alpha]"}]]}], ",", RowBox[{"\[Theta]", "\[Rule]", "0"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", RowBox[{"-", FractionBox[ RowBox[{"v0", " ", "\[Alpha]"}], SqrtBox[ RowBox[{"1", "+", "\[Alpha]"}]]]}]}], ",", RowBox[{"v2", "\[Rule]", RowBox[{"-", FractionBox["v0", SqrtBox[ RowBox[{"1", "+", "\[Alpha]"}]]]}]}], ",", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"-", RowBox[{"ArcCos", "[", RowBox[{"-", FractionBox[ SqrtBox[ RowBox[{"1", "+", "\[Alpha]"}]], "2"]}], "]"}]}]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", RowBox[{"-", FractionBox[ RowBox[{"v0", " ", "\[Alpha]"}], SqrtBox[ RowBox[{"1", "+", "\[Alpha]"}]]]}]}], ",", RowBox[{"v2", "\[Rule]", RowBox[{"-", FractionBox["v0", SqrtBox[ RowBox[{"1", "+", "\[Alpha]"}]]]}]}], ",", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"ArcCos", "[", RowBox[{"-", FractionBox[ SqrtBox[ RowBox[{"1", "+", "\[Alpha]"}]], "2"]}], "]"}]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", FractionBox[ RowBox[{"v0", " ", "\[Alpha]"}], SqrtBox[ RowBox[{"1", "+", "\[Alpha]"}]]]}], ",", RowBox[{"v2", "\[Rule]", FractionBox["v0", SqrtBox[ RowBox[{"1", "+", "\[Alpha]"}]]]}], ",", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"-", RowBox[{"ArcCos", "[", FractionBox[ SqrtBox[ RowBox[{"1", "+", "\[Alpha]"}]], "2"], "]"}]}]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", "\[Rule]", FractionBox[ RowBox[{"v0", " ", "\[Alpha]"}], SqrtBox[ RowBox[{"1", "+", "\[Alpha]"}]]]}], ",", RowBox[{"v2", "\[Rule]", FractionBox["v0", SqrtBox[ RowBox[{"1", "+", "\[Alpha]"}]]]}], ",", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"ArcCos", "[", FractionBox[ SqrtBox[ RowBox[{"1", "+", "\[Alpha]"}]], "2"], "]"}]}]}], "}"}]}], "}"}]], "Output", CellChangeTimes->{3.4354147049370003`*^9, 3.435414745137*^9, 3.435885230509*^9, 3.4671159466643534`*^9, 3.4674874568957*^9}] }, Open ]], Cell["\<\ And we see that the when \[Alpha] exceeds 3 the argument of the ArcCos gets \ larger than 1 and we have no real solution.\ \>", "Text", CellChangeTimes->{{3.435414712664*^9, 3.4354147162980003`*^9}, { 3.435414747698*^9, 3.435414815039*^9}}], Cell["Let's animate!", "Text", CellChangeTimes->{{3.435414822135*^9, 3.43541482549*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"x1", "[", "t_", "]"}], " ", "=", " ", RowBox[{"Piecewise", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", RowBox[{"t", "<", "0"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", " ", "t", " ", RowBox[{"Cos", "[", RowBox[{"-", "\[Theta]"}], "]"}]}], ",", RowBox[{"t", ">", "0"}]}], "}"}]}], "}"}], "]"}]}]], "Input", CellChangeTimes->{{3.435415292401*^9, 3.43541535259*^9}, {3.435415391487*^9, 3.435415391576*^9}}], Cell[BoxData[ RowBox[{"\[Piecewise]", GridBox[{ {"0", RowBox[{"t", "<", "0"}]}, { RowBox[{"t", " ", "v1", " ", RowBox[{"Cos", "[", "\[Theta]", "]"}]}], RowBox[{"t", ">", "0"}]}, {"0", TagBox["True", "PiecewiseDefault", AutoDelete->False, DeletionWarning->True]} }, GridBoxAlignment->{ "Columns" -> {{Left}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, "RowsIndexed" -> {}}, GridBoxItemSize->{ "Columns" -> {{Automatic}}, "ColumnsIndexed" -> {}, "Rows" -> {{1.}}, "RowsIndexed" -> {}}, GridBoxSpacings->{"Columns" -> { Offset[0.27999999999999997`], { Offset[0.84]}, Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> { Offset[0.2], { Offset[0.4]}, Offset[0.2]}, "RowsIndexed" -> {}}]}]], "Output", CellChangeTimes->{{3.435415329738*^9, 3.4354153534110003`*^9}, 3.4354153922139997`*^9, 3.435885233672*^9, 3.4671159644795537`*^9, 3.4674874614353*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"y1", "[", "t_", "]"}], " ", "=", " ", RowBox[{"Piecewise", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", RowBox[{"t", "<", "0"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v1", " ", "t", " ", RowBox[{"Sin", "[", RowBox[{"-", "\[Theta]"}], "]"}]}], ",", RowBox[{"t", ">", "0"}]}], "}"}]}], "}"}], "]"}]}]], "Input", CellChangeTimes->{{3.435415292401*^9, 3.435415390076*^9}}], Cell[BoxData[ RowBox[{"\[Piecewise]", GridBox[{ {"0", RowBox[{"t", "<", "0"}]}, { RowBox[{ RowBox[{"-", "t"}], " ", "v1", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}], RowBox[{"t", ">", "0"}]}, {"0", TagBox["True", "PiecewiseDefault", AutoDelete->False, DeletionWarning->True]} }, GridBoxAlignment->{ "Columns" -> {{Left}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, "RowsIndexed" -> {}}, GridBoxItemSize->{ "Columns" -> {{Automatic}}, "ColumnsIndexed" -> {}, "Rows" -> {{1.}}, "RowsIndexed" -> {}}, GridBoxSpacings->{"Columns" -> { Offset[0.27999999999999997`], { Offset[0.84]}, Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> { Offset[0.2], { Offset[0.4]}, Offset[0.2]}, "RowsIndexed" -> {}}]}]], "Output", CellChangeTimes->{{3.435415329738*^9, 3.4354153534110003`*^9}, 3.435415394469*^9, 3.4358852350220003`*^9, 3.4671159663047533`*^9, 3.4674874626209*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"x2", "[", "t_", "]"}], " ", "=", " ", RowBox[{"Piecewise", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"v0", " ", "t"}], ",", RowBox[{"t", "<", "0"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v2", " ", "t", " ", RowBox[{"Cos", "[", "\[Theta]", "]"}]}], ",", RowBox[{"t", ">", "0"}]}], "}"}]}], "}"}], "]"}]}]], "Input", CellChangeTimes->{{3.435414833488*^9, 3.4354148503529997`*^9}, { 3.435415215745*^9, 3.4354152655220003`*^9}, {3.435415345632*^9, 3.43541534573*^9}, {3.4354154000629997`*^9, 3.435415400176*^9}}], Cell[BoxData[ RowBox[{"\[Piecewise]", GridBox[{ { RowBox[{"t", " ", "v0"}], RowBox[{"t", "<", "0"}]}, { RowBox[{"t", " ", "v2", " ", RowBox[{"Cos", "[", "\[Theta]", "]"}]}], RowBox[{"t", ">", "0"}]}, {"0", TagBox["True", "PiecewiseDefault", AutoDelete->False, DeletionWarning->True]} }, GridBoxAlignment->{ "Columns" -> {{Left}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, "RowsIndexed" -> {}}, GridBoxItemSize->{ "Columns" -> {{Automatic}}, "ColumnsIndexed" -> {}, "Rows" -> {{1.}}, "RowsIndexed" -> {}}, GridBoxSpacings->{"Columns" -> { Offset[0.27999999999999997`], { Offset[0.84]}, Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> { Offset[0.2], { Offset[0.4]}, Offset[0.2]}, "RowsIndexed" -> {}}]}]], "Output", CellChangeTimes->{{3.435415239061*^9, 3.435415245525*^9}, 3.435415348075*^9, 3.435415400686*^9, 3.435885236995*^9, 3.4671159686915536`*^9, 3.4674874636661*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"y2", "[", "t_", "]"}], " ", "=", " ", RowBox[{"Piecewise", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0", ",", RowBox[{"t", "<", "0"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"v2", " ", "t", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}], ",", RowBox[{"t", ">", "0"}]}], "}"}]}], "}"}], "]"}]}]], "Input", CellChangeTimes->{{3.435415247602*^9, 3.435415290406*^9}, { 3.4354153498710003`*^9, 3.435415349976*^9}, {3.435415402266*^9, 3.435415402387*^9}, {3.435415593717*^9, 3.435415600184*^9}}], Cell[BoxData[ RowBox[{"\[Piecewise]", GridBox[{ {"0", RowBox[{"t", "<", "0"}]}, { RowBox[{"t", " ", "v2", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}], RowBox[{"t", ">", "0"}]}, {"0", TagBox["True", "PiecewiseDefault", AutoDelete->False, DeletionWarning->True]} }, GridBoxAlignment->{ "Columns" -> {{Left}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, "RowsIndexed" -> {}}, GridBoxItemSize->{ "Columns" -> {{Automatic}}, "ColumnsIndexed" -> {}, "Rows" -> {{1.}}, "RowsIndexed" -> {}}, GridBoxSpacings->{"Columns" -> { Offset[0.27999999999999997`], { Offset[0.84]}, Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> { Offset[0.2], { Offset[0.4]}, Offset[0.2]}, "RowsIndexed" -> {}}]}]], "Output", CellChangeTimes->{3.435415290785*^9, 3.435415350333*^9, 3.435415402888*^9, 3.435415601182*^9, 3.435885238301*^9, 3.4671159703139534`*^9, 3.4674874652261*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"p", " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"v0", "\[Rule]", "1"}], ",", RowBox[{"\[Alpha]", "\[Rule]", "1"}]}], "}"}]}]], "Input", CellChangeTimes->{{3.435415406789*^9, 3.435415424632*^9}, { 3.4354154757720003`*^9, 3.4354154788050003`*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"v0", "\[Rule]", "1"}], ",", RowBox[{"\[Alpha]", "\[Rule]", "1"}]}], "}"}]], "Output", CellChangeTimes->{3.435415479355*^9, 3.435885240006*^9, 3.4671159724979534`*^9, 3.4674874692977*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Animate", "[", RowBox[{ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"x1", "[", "t", "]"}], ",", RowBox[{"y1", "[", "t", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x2", "[", "t", "]"}], ",", RowBox[{"y2", "[", "t", "]"}]}], "}"}]}], "}"}], "/.", RowBox[{"s", "[", RowBox[{"[", "10", "]"}], "]"}]}], "/.", "p"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"Red", ",", RowBox[{"PointSize", "[", ".03", "]"}]}], "}"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2"}], ",", "2"}], "}"}]}], "}"}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", RowBox[{"-", "2"}], ",", "2"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.435415493968*^9, 3.435415572705*^9}}], Cell[BoxData[ TagBox[ StyleBox[ DynamicModuleBox[{$CellContext`t$$ = 1.1449600219726563`, Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{ Hold[$CellContext`t$$], -2, 2}}, Typeset`size$$ = {360., {113., 117.}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = True, $CellContext`t$3070$$ = 0}, DynamicBox[Manipulate`ManipulateBoxes[ 1, StandardForm, "Variables" :> {$CellContext`t$$ = -2}, "ControllerVariables" :> { Hold[$CellContext`t$$, $CellContext`t$3070$$, 0]}, "OtherVariables" :> { Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> ListPlot[ ReplaceAll[ ReplaceAll[{{ $CellContext`x1[$CellContext`t$$], $CellContext`y1[$CellContext`t$$]}, { $CellContext`x2[$CellContext`t$$], $CellContext`y2[$CellContext`t$$]}}, Part[$CellContext`s, 10]], $CellContext`p], PlotStyle -> {Red, PointSize[0.03]}, PlotRange -> {{-2, 2}, {-2, 2}}], "Specifications" :> {{$CellContext`t$$, -2, 2, AppearanceElements -> { "ProgressSlider", "PlayPauseButton", "FasterSlowerButtons", "DirectionButton"}}}, "Options" :> { ControlType -> Animator, AppearanceElements -> None, SynchronousUpdating -> True, ShrinkingDelay -> 10.}, "DefaultOptions" :> {}], ImageSizeCache->{417., {154., 165.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, SynchronousInitialization->True, UnsavedVariables:>{Typeset`initDone$$}, UntrackedVariables:>{Typeset`size$$}], "Manipulate", Deployed->True, StripOnInput->False], Manipulate`InterpretManipulate[1]]], "Output", CellChangeTimes->{{3.4354155732390003`*^9, 3.435415628759*^9}, 3.435885241416*^9, {3.467115973979954*^9, 3.467116002871154*^9}, { 3.4674874705457*^9, 3.4674874745236998`*^9}}] }, Open ]], Cell["\<\ And finally give the parameter \[Alpha] a knob:\ \>", "Text", CellChangeTimes->{{3.4354156429560003`*^9, 3.4354156545030003`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"Animate", "[", RowBox[{ RowBox[{"Show", "[", RowBox[{ RowBox[{"ListPlot", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"{", RowBox[{ RowBox[{"x1", "[", "t", "]"}], ",", RowBox[{"y1", "[", "t", "]"}]}], "}"}], "}"}], "/.", RowBox[{"s", "[", RowBox[{"[", "10", "]"}], "]"}]}], "/.", RowBox[{"{", RowBox[{ RowBox[{"v0", "\[Rule]", "1"}], ",", RowBox[{"\[Alpha]", "\[Rule]", "q"}]}], "}"}]}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"Red", ",", RowBox[{"PointSize", "[", ".03", "]"}]}], "}"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2"}], ",", "2"}], "}"}]}], "}"}]}]}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"ListPlot", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"{", RowBox[{ RowBox[{"x2", "[", "t", "]"}], ",", RowBox[{"y2", "[", "t", "]"}]}], "}"}], "}"}], "/.", RowBox[{"s", "[", RowBox[{"[", "10", "]"}], "]"}]}], "/.", RowBox[{"{", RowBox[{ RowBox[{"v0", "\[Rule]", "1"}], ",", RowBox[{"\[Alpha]", "\[Rule]", "q"}]}], "}"}]}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"Blue", ",", RowBox[{"PointSize", "[", ".04", "]"}]}], "}"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "2"}], ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2"}], ",", "2"}], "}"}]}], "}"}]}]}], "]"}]}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", RowBox[{"-", "2"}], ",", "2"}], "}"}]}], "]"}], ",", RowBox[{"{", RowBox[{"q", ",", "0", ",", "3"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.435415493968*^9, 3.435415572705*^9}, { 3.4354156563059998`*^9, 3.4354156826470003`*^9}, {3.4354157399379997`*^9, 3.435415747785*^9}, {3.435415792118*^9, 3.435415807252*^9}, { 3.4354158411619997`*^9, 3.4354159206029997`*^9}, {3.4354159722799997`*^9, 3.435415996148*^9}}], Cell[BoxData[ TagBox[ StyleBox[ DynamicModuleBox[{$CellContext`q$$ = 0.365, Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{ Hold[$CellContext`q$$], 0, 3}}, Typeset`size$$ = {832., {331., 342.}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = True, $CellContext`q$3186$$ = 0}, DynamicBox[Manipulate`ManipulateBoxes[ 1, StandardForm, "Variables" :> {$CellContext`q$$ = 0}, "ControllerVariables" :> { Hold[$CellContext`q$$, $CellContext`q$3186$$, 0]}, "OtherVariables" :> { Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> Animate[ Show[ ListPlot[ ReplaceAll[ ReplaceAll[{{ $CellContext`x1[$CellContext`t], $CellContext`y1[$CellContext`t]}}, Part[$CellContext`s, 10]], {$CellContext`v0 -> 1, $CellContext`\[Alpha] -> $CellContext`q$$}], PlotStyle -> {Red, PointSize[0.03]}, PlotRange -> {{-2, 2}, {-2, 2}}], ListPlot[ ReplaceAll[ ReplaceAll[{{ $CellContext`x2[$CellContext`t], $CellContext`y2[$CellContext`t]}}, Part[$CellContext`s, 10]], {$CellContext`v0 -> 1, $CellContext`\[Alpha] -> $CellContext`q$$}], PlotStyle -> {Blue, PointSize[0.04]}, PlotRange -> {{-2, 2}, {-2, 2}}]], {$CellContext`t, -2, 2}], "Specifications" :> {{$CellContext`q$$, 0, 3}}, "Options" :> {}, "DefaultOptions" :> {}], ImageSizeCache->{889., {389., 400.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, SynchronousInitialization->True, UnsavedVariables:>{Typeset`initDone$$}, UntrackedVariables:>{Typeset`size$$}], "Manipulate", Deployed->True, StripOnInput->False], Manipulate`InterpretManipulate[1]]], "Output", CellChangeTimes->{ 3.435415921171*^9, 3.435415998692*^9, 3.435416093623*^9, {3.435885247657*^9, 3.435885273909*^9}, {3.467116091853554*^9, 3.4671161495891533`*^9}, { 3.4674874775345*^9, 3.4674874867229*^9}}] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Whirling mass", "Subsection", CellChangeTimes->{{3.435662926495*^9, 3.435662932759*^9}, { 3.4358530939370003`*^9, 3.435853105792*^9}}], Cell["\<\ A couple of weeks ago we found the motion of a mass at the end of an \ ever-shortening rope:\ \>", "Text", CellChangeTimes->{{3.435853108775*^9, 3.435853154759*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"r", "[", "t_", "]"}], " ", "=", " ", RowBox[{"r0", " ", "-", " ", RowBox[{"v0", " ", "t"}]}]}]], "Input", CellChangeTimes->{{3.435853157851*^9, 3.435853164898*^9}}], Cell[BoxData[ RowBox[{"r0", "-", RowBox[{"t", " ", "v0"}]}]], "Output", CellChangeTimes->{3.4358531653599997`*^9, 3.435885276613*^9, 3.435885332764*^9, 3.4674874898740997`*^9}] }, Open ]], Cell["\<\ Since the force was purely in the radial direction the \[Theta] component of \ F=ma reads:\ \>", "Text", CellChangeTimes->{{3.4358531792200003`*^9, 3.435853191401*^9}, { 3.435853234356*^9, 3.435853251959*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqn\[Theta]", " ", "=", " ", RowBox[{ RowBox[{"m", " ", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"r", "[", "t", "]"}], " ", RowBox[{ RowBox[{"\[Omega]", "'"}], "[", "t", "]"}]}], " ", "+", " ", RowBox[{"2", " ", RowBox[{ RowBox[{"r", "'"}], "[", "t", "]"}], " ", RowBox[{"\[Omega]", "[", "t", "]"}]}]}], ")"}]}], " ", "\[Equal]", "0"}]}]], "Input", CellChangeTimes->{{3.435853194032*^9, 3.435853254668*^9}, {3.435853340727*^9, 3.4358533412279997`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"m", " ", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"-", "2"}], " ", "v0", " ", RowBox[{"\[Omega]", "[", "t", "]"}]}], "+", RowBox[{ RowBox[{"(", RowBox[{"r0", "-", RowBox[{"t", " ", "v0"}]}], ")"}], " ", RowBox[{ SuperscriptBox["\[Omega]", "\[Prime]", MultilineFunction->None], "[", "t", "]"}]}]}], ")"}]}], "\[Equal]", "0"}]], "Output", CellChangeTimes->{3.4358532578129997`*^9, 3.435853347323*^9, 3.4358852786549997`*^9, 3.435885334125*^9, 3.4674874909037*^9}] }, Open ]], Cell["\<\ which we DSolve, starting with angular speed \[Omega]0:\ \>", "Text", CellChangeTimes->{{3.4358532640179996`*^9, 3.435853278698*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"s", "=", RowBox[{ RowBox[{"DSolve", "[", RowBox[{ RowBox[{"{", RowBox[{"eqn\[Theta]", ",", RowBox[{ RowBox[{"\[Omega]", "[", "0", "]"}], "\[Equal]", "\[Omega]0"}]}], "}"}], ",", RowBox[{"\[Omega]", "[", "t", "]"}], ",", "t"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.4358532798129997`*^9, 3.435853305415*^9}, { 3.435853344349*^9, 3.43585334501*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"\[Omega]", "[", "t", "]"}], "\[Rule]", FractionBox[ RowBox[{"2", " ", SqrtBox[ FractionBox["\[Pi]", "3"]], " ", SuperscriptBox["r0", "2"], " ", SqrtBox[ RowBox[{"G", " ", "\[Rho]"}]]}], SuperscriptBox[ RowBox[{"(", RowBox[{"r0", "-", RowBox[{"t", " ", "v0"}]}], ")"}], "2"]]}], "}"}]], "Output", CellChangeTimes->{{3.435853296859*^9, 3.435853305769*^9}, 3.4358533484639997`*^9, 3.4358852807679996`*^9, {3.435885318101*^9, 3.435885335477*^9}, 3.4674874935401*^9}] }, Open ]], Cell["The radial equation tells us what the the tension has to be:", "Text", CellChangeTimes->{{3.4358533185150003`*^9, 3.435853355303*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"T", " ", "=", " ", RowBox[{ RowBox[{"-", "m"}], " ", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"r", "''"}], "[", "t", "]"}], " ", "-", " ", RowBox[{ RowBox[{"r", "[", "t", "]"}], " ", RowBox[{ RowBox[{"\[Omega]", "[", "t", "]"}], "^", "2"}]}]}], ")"}]}]}]], "Input", CellChangeTimes->{{3.435853357644*^9, 3.4358534091359997`*^9}}], Cell[BoxData[ RowBox[{"m", " ", RowBox[{"(", RowBox[{"r0", "-", RowBox[{"t", " ", "v0"}]}], ")"}], " ", SuperscriptBox[ RowBox[{"\[Omega]", "[", "t", "]"}], "2"]}]], "Output", CellChangeTimes->{{3.4358533776280003`*^9, 3.435853409975*^9}, { 3.435885308046*^9, 3.435885337116*^9}, {3.4674874967848997`*^9, 3.4674875029313*^9}}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"T", "/.", "s"}]], "Input", CellChangeTimes->{{3.435853397776*^9, 3.4358533989040003`*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"4", " ", "G", " ", "m", " ", "\[Pi]", " ", SuperscriptBox["r0", "4"], " ", "\[Rho]"}], RowBox[{"3", " ", SuperscriptBox[ RowBox[{"(", RowBox[{"r0", "-", RowBox[{"t", " ", "v0"}]}], ")"}], "3"]}]]], "Output", CellChangeTimes->{{3.4358533992939997`*^9, 3.435853412119*^9}, 3.435885339065*^9, 3.4674875047253*^9}] }, Open ]], Cell["\<\ Notice that these expressions are all written as functions of time, but we \ can also think of them as functions of the radius:\ \>", "Text", CellChangeTimes->{{3.43585353491*^9, 3.435853569549*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"\[Omega]", "[", "r_", "]"}], " ", "=", RowBox[{"\[Omega]0", " ", RowBox[{ RowBox[{"r0", "^", "2"}], "/", RowBox[{"r", "^", "2"}]}]}]}]], "Input", CellChangeTimes->{{3.4358535713789997`*^9, 3.435853594183*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"2", " ", SqrtBox[ FractionBox["\[Pi]", "3"]], " ", SuperscriptBox["r0", "2"], " ", SqrtBox[ RowBox[{"G", " ", "\[Rho]"}]]}], SuperscriptBox["r", "2"]]], "Output", CellChangeTimes->{3.435853598795*^9, 3.435885292849*^9, 3.435885340616*^9, 3.4674875062541*^9}] }, Open ]], Cell[BoxData[ RowBox[{"T", "=."}]], "Input", CellChangeTimes->{{3.4674875205125*^9, 3.4674875209493*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"T", "[", "r_", "]"}], " ", "=", " ", RowBox[{"m", " ", RowBox[{"r0", "^", "4"}], " ", RowBox[{ RowBox[{"\[Omega]0", "^", "2"}], "/", RowBox[{"r", "^", "3"}]}]}]}]], "Input", CellChangeTimes->{{3.435853599811*^9, 3.435853623137*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"4", " ", "G", " ", "m", " ", "\[Pi]", " ", SuperscriptBox["r0", "4"], " ", "\[Rho]"}], RowBox[{"3", " ", SuperscriptBox["r", "3"]}]]], "Output", CellChangeTimes->{{3.4358536184709997`*^9, 3.435853642763*^9}, 3.4358852977279997`*^9, 3.4358853429379997`*^9, {3.4674875156453*^9, 3.4674875230865*^9}}] }, Open ]], Cell["\<\ Now suppose we reel in the mass from r0 to a smaller r1. The kinetic energy \ changes from\ \>", "Text", CellChangeTimes->{{3.435853484061*^9, 3.435853498653*^9}, {3.435853664748*^9, 3.435853674933*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"K0", " ", "=", " ", RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "m", " ", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"r", "'"}], "[", "0", "]"}], ")"}], "^", "2"}], " ", "+", " ", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"r", "[", "0", "]"}], " ", RowBox[{"\[Omega]", "[", "r0", "]"}]}], ")"}], "^", "2"}]}], ")"}]}]}]], "Input", CellChangeTimes->{{3.435853501131*^9, 3.43585352698*^9}, {3.435853662535*^9, 3.435853727891*^9}}], Cell[BoxData[ RowBox[{ FractionBox["1", "2"], " ", "m", " ", RowBox[{"(", RowBox[{ SuperscriptBox["v0", "2"], "+", RowBox[{ FractionBox["4", "3"], " ", "G", " ", "\[Pi]", " ", SuperscriptBox["r0", "2"], " ", "\[Rho]"}]}], ")"}]}]], "Output", CellChangeTimes->{3.4358537282469997`*^9, 3.435885300466*^9, 3.435885345082*^9, 3.4674875278289003`*^9}] }, Open ]], Cell["to ", "Text", CellChangeTimes->{{3.435853736271*^9, 3.435853736413*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"K1", " ", "=", " ", RowBox[{ RowBox[{"(", RowBox[{"1", "/", "2"}], ")"}], " ", "m", " ", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"(", "v0", ")"}], "^", "2"}], " ", "+", " ", RowBox[{ RowBox[{"(", RowBox[{"r1", " ", RowBox[{"\[Omega]", "[", "r1", "]"}]}], ")"}], "^", "2"}]}], ")"}]}]}]], "Input", CellChangeTimes->{{3.435853738625*^9, 3.435853771014*^9}}], Cell[BoxData[ RowBox[{ FractionBox["1", "2"], " ", "m", " ", RowBox[{"(", RowBox[{ SuperscriptBox["v0", "2"], "+", FractionBox[ RowBox[{"4", " ", "G", " ", "\[Pi]", " ", SuperscriptBox["r0", "4"], " ", "\[Rho]"}], RowBox[{"3", " ", SuperscriptBox["r1", "2"]}]]}], ")"}]}]], "Output", CellChangeTimes->{{3.4358537593269997`*^9, 3.435853772342*^9}, 3.435885347314*^9, 3.4674875294669*^9}] }, Open ]], Cell["\<\ Notice that the radial velocity is always v0 in this problem, so that piece \ of the kinetic energy is unchanging. Our job is to compare with the work done by the winch reeling in the rope:\ \>", "Text", CellChangeTimes->{{3.435853778829*^9, 3.435853847999*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"work", " ", "=", " ", RowBox[{"Integrate", "[", RowBox[{ RowBox[{"-", RowBox[{"T", "[", "r", "]"}]}], ",", RowBox[{"{", RowBox[{"r", ",", "r0", ",", "r1"}], "}"}], ",", RowBox[{"Assumptions", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"r0", ">", "0"}], ",", RowBox[{"r1", ">", "0"}]}], "}"}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.435853850461*^9, 3.4358538822390003`*^9}, { 3.435853916466*^9, 3.435853935608*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"-", FractionBox["2", "3"]}], " ", "G", " ", "m", " ", "\[Pi]", " ", SuperscriptBox["r0", "4"], " ", RowBox[{"(", RowBox[{ FractionBox["1", SuperscriptBox["r0", "2"]], "-", FractionBox["1", SuperscriptBox["r1", "2"]]}], ")"}], " ", "\[Rho]"}]], "Output", CellChangeTimes->{{3.435853866679*^9, 3.4358538921949997`*^9}, 3.435853939039*^9, 3.435885358123*^9, 3.4674875479529*^9}] }, Open ]], Cell["\<\ Note that relative to the normal positive r directoin the force is -T, and \ the work done is *positive*. Is it the same as the change in kinetic energy?\ \>", "Text", CellChangeTimes->{{3.435854010745*^9, 3.4358540622390003`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"assertion", " ", "=", " ", RowBox[{ RowBox[{"K1", "-", "K0"}], "==", "work"}]}]], "Input", CellChangeTimes->{{3.435853954693*^9, 3.435853985218*^9}, { 3.4358540687139997`*^9, 3.435854075013*^9}, {3.435885356146*^9, 3.435885357664*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ RowBox[{"-", FractionBox["1", "2"]}], " ", "m", " ", RowBox[{"(", RowBox[{ SuperscriptBox["v0", "2"], "+", RowBox[{ FractionBox["4", "3"], " ", "G", " ", "\[Pi]", " ", SuperscriptBox["r0", "2"], " ", "\[Rho]"}]}], ")"}]}], "+", RowBox[{ FractionBox["1", "2"], " ", "m", " ", RowBox[{"(", RowBox[{ SuperscriptBox["v0", "2"], "+", FractionBox[ RowBox[{"4", " ", "G", " ", "\[Pi]", " ", SuperscriptBox["r0", "4"], " ", "\[Rho]"}], RowBox[{"3", " ", SuperscriptBox["r1", "2"]}]]}], ")"}]}]}], "\[Equal]", RowBox[{ RowBox[{"-", FractionBox["2", "3"]}], " ", "G", " ", "m", " ", "\[Pi]", " ", SuperscriptBox["r0", "4"], " ", RowBox[{"(", RowBox[{ FractionBox["1", SuperscriptBox["r0", "2"]], "-", FractionBox["1", SuperscriptBox["r1", "2"]]}], ")"}], " ", "\[Rho]"}]}]], "Output", CellChangeTimes->{{3.435853957191*^9, 3.4358539855179996`*^9}, { 3.435854069973*^9, 3.435854075443*^9}, {3.435885358241*^9, 3.4358853583269997`*^9}, 3.4674875480776997`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Simplify", "[", "assertion", "]"}]], "Input", CellChangeTimes->{{3.4358540778129997`*^9, 3.435854082076*^9}, { 3.435885360807*^9, 3.435885362366*^9}}], Cell[BoxData["True"], "Output", CellChangeTimes->{3.4358540823719997`*^9, 3.435885362745*^9, 3.4674875482337*^9}] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["The Space Elevator (Morin 5.65)", "Subsection", CellChangeTimes->{{3.435662926495*^9, 3.435662932759*^9}}], Cell["\<\ (a) Describing the earth by its radius (R), density (\[Rho]) and angular \ frequency (\[Omega]=2\[Pi]/day), find the radius of *geosynchronous* orbit, \ i.e. that magical *r* at which we \"park\" satellites. More precisely they orbit with with angular frequency precisely \[Omega], so \ they are at rest relative to the spinning Earth. We are asked to express the answer in terms of a dimensionless number \ \[Eta]=r/R.\ \>", "Text", CellChangeTimes->{{3.4356629413529997`*^9, 3.435663155658*^9}, { 3.435663440413*^9, 3.435663471865*^9}, {3.43566350441*^9, 3.435663505568*^9}, {3.435745409775662*^9, 3.4357454102006617`*^9}}], Cell["Well, first let's define the Earth's mass:", "Text", CellChangeTimes->{{3.435663162829*^9, 3.435663178326*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"M", " ", "=", " ", RowBox[{ RowBox[{"(", RowBox[{"4", "/", "3"}], ")"}], " ", "\[Pi]", " ", RowBox[{"R", "^", "3"}], " ", "\[Rho]"}]}]], "Input", CellChangeTimes->{{3.43566317984*^9, 3.4356631950439997`*^9}}], Cell[BoxData[ RowBox[{ FractionBox["4", "3"], " ", "\[Pi]", " ", SuperscriptBox["R", "3"], " ", "\[Rho]"}]], "Output", CellChangeTimes->{3.43566623496*^9, 3.435885367606*^9, 3.435885505983*^9, 3.4674875483585*^9}] }, Open ]], Cell["\<\ in terms of which the graviational force is the familiar G M m / r^2. \ Equating that with m a, where the acceleration is of course a-vec = (-r \ \[Omega]^2) r-hat, Using the relation to express r:\ \>", "Text", CellChangeTimes->{{3.4356632037279997`*^9, 3.435663283416*^9}, { 3.435704082283*^9, 3.435704100579*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqn", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"-", " ", "G"}], " ", "M", " ", RowBox[{"m", " ", "/", " ", RowBox[{"r", "^", "2"}]}]}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"-", " ", "m"}], " ", "r", " ", RowBox[{"\[Omega]", "^", "2"}]}]}]}]], "Input", CellChangeTimes->{{3.435663285867*^9, 3.43566332291*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"-", FractionBox[ RowBox[{"4", " ", "G", " ", "m", " ", "\[Pi]", " ", SuperscriptBox["R", "3"], " ", "\[Rho]"}], RowBox[{"3", " ", SuperscriptBox["r", "2"]}]]}], "\[Equal]", RowBox[{ RowBox[{"-", "m"}], " ", "r", " ", SuperscriptBox["\[Omega]", "2"]}]}]], "Output", CellChangeTimes->{3.435666236686*^9, 3.435885369028*^9, 3.435885506117*^9, 3.4674875484365*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"s", "=", RowBox[{"Solve", "[", RowBox[{"eqn", ",", "r"}], "]"}]}]], "Input", CellChangeTimes->{{3.435663506808*^9, 3.435663513308*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"r", "\[Rule]", RowBox[{"-", FractionBox[ RowBox[{ SuperscriptBox["2", RowBox[{"2", "/", "3"}]], " ", SuperscriptBox["G", RowBox[{"1", "/", "3"}]], " ", SuperscriptBox[ RowBox[{"(", RowBox[{"-", FractionBox["\[Pi]", "3"]}], ")"}], RowBox[{"1", "/", "3"}]], " ", "R", " ", SuperscriptBox["\[Rho]", RowBox[{"1", "/", "3"}]]}], SuperscriptBox["\[Omega]", RowBox[{"2", "/", "3"}]]]}]}], "}"}], ",", RowBox[{"{", RowBox[{"r", "\[Rule]", FractionBox[ RowBox[{ SuperscriptBox[ RowBox[{"(", RowBox[{"-", "2"}], ")"}], RowBox[{"2", "/", "3"}]], " ", SuperscriptBox["G", RowBox[{"1", "/", "3"}]], " ", SuperscriptBox[ RowBox[{"(", FractionBox["\[Pi]", "3"], ")"}], RowBox[{"1", "/", "3"}]], " ", "R", " ", SuperscriptBox["\[Rho]", RowBox[{"1", "/", "3"}]]}], SuperscriptBox["\[Omega]", RowBox[{"2", "/", "3"}]]]}], "}"}], ",", RowBox[{"{", RowBox[{"r", "\[Rule]", FractionBox[ RowBox[{ SuperscriptBox["2", RowBox[{"2", "/", "3"}]], " ", SuperscriptBox["G", RowBox[{"1", "/", "3"}]], " ", SuperscriptBox[ RowBox[{"(", FractionBox["\[Pi]", "3"], ")"}], RowBox[{"1", "/", "3"}]], " ", "R", " ", SuperscriptBox["\[Rho]", RowBox[{"1", "/", "3"}]]}], SuperscriptBox["\[Omega]", RowBox[{"2", "/", "3"}]]]}], "}"}]}], "}"}]], "Output", CellChangeTimes->{3.435666239215*^9, 3.435885370455*^9, 3.435885507167*^9, 3.4674875485144997`*^9}] }, Open ]], Cell["\<\ Obviously we want the 3rd of these cube roots (the others are complex). And then we get our \[Eta] cubed:\ \>", "Text", CellChangeTimes->{{3.435663526019*^9, 3.435663538429*^9}, { 3.4356635845629997`*^9, 3.4356635858269997`*^9}, {3.435663634501*^9, 3.435663645217*^9}, {3.435666279421*^9, 3.435666283007*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[Eta]3", " ", "=", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"r", "/", "R"}], " ", ")"}], "^", "3"}], "/.", RowBox[{"s", "[", RowBox[{"[", "3", "]"}], "]"}]}]}]], "Input", CellChangeTimes->{{3.4356635479820004`*^9, 3.435663578218*^9}, { 3.435666270057*^9, 3.4356662729449997`*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"4", " ", "G", " ", "\[Pi]", " ", "\[Rho]"}], RowBox[{"3", " ", SuperscriptBox["\[Omega]", "2"]}]]], "Output", CellChangeTimes->{3.435666245035*^9, 3.435666285309*^9, 3.435666388293*^9, 3.4358853724960003`*^9, 3.435885509542*^9, 3.4674875516345*^9}] }, Open ]], Cell["\<\ To convert to a number, let's load up all the physical constants:\ \>", "Text", CellChangeTimes->{{3.435663652775*^9, 3.435663663481*^9}}], Cell[BoxData[ RowBox[{"Needs", "[", "\"\\"", "]"}]], "Input", CellChangeTimes->{{3.435622893804*^9, 3.435622913704*^9}}], Cell["This defines things like", "Text", CellChangeTimes->{{3.435663698635*^9, 3.4356637024119997`*^9}}], Cell[CellGroupData[{ Cell[BoxData["GravitationalConstant"], "Input", CellChangeTimes->{{3.435663703648*^9, 3.435663707278*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"6.67428`*^-11", " ", SuperscriptBox["Meter", "2"], " ", "Newton"}], SuperscriptBox["Kilogram", "2"]]], "Output", CellChangeTimes->{3.4356663907650003`*^9, 3.435885388696*^9, 3.4358855260369997`*^9, 3.4674875539901*^9}] }, Open ]], Cell["and", "Text", CellChangeTimes->{{3.4356637105220003`*^9, 3.435663710703*^9}}], Cell[CellGroupData[{ Cell[BoxData["EarthRadius"], "Input", CellChangeTimes->{{3.435663723182*^9, 3.435663732019*^9}}], Cell[BoxData[ RowBox[{"6378140", " ", "Meter"}]], "Output", CellChangeTimes->{3.43566639234*^9, 3.435885388762*^9, 3.4358855267860003`*^9, 3.4674875583737*^9}] }, Open ]], Cell["It doesn't define the density, so let's create our own:", "Text", CellChangeTimes->{{3.435663765165*^9, 3.435663786332*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[Rho]0", " ", "=", " ", RowBox[{"EarthMass", "/", RowBox[{"(", RowBox[{ RowBox[{"(", RowBox[{"4", "/", "3"}], ")"}], " ", "\[Pi]", " ", RowBox[{"EarthRadius", "^", "3"}]}], ")"}]}]}]], "Input", CellChangeTimes->{{3.435663788402*^9, 3.435663810962*^9}, { 3.435747359269662*^9, 3.435747361109662*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"5496.788221366487`", " ", "Kilogram"}], SuperscriptBox["Meter", "3"]]], "Output", CellChangeTimes->{3.435666393906*^9, 3.435747369715662*^9, 3.435885392219*^9, 3.435885528976*^9, 3.4674875596061*^9}] }, Open ]], Cell["and then plug them in:", "Text", CellChangeTimes->{{3.4356636750439997`*^9, 3.43566368146*^9}, { 3.435705182557*^9, 3.435705183814*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"params", " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"G", "\[Rule]", "GravitationalConstant"}], ",", RowBox[{"\[Omega]", "\[Rule]", RowBox[{"(", RowBox[{"2", " ", RowBox[{"\[Pi]", "/", RowBox[{"(", RowBox[{"3600", "*", "24", " ", "Second"}], ")"}]}]}], ")"}]}], ",", RowBox[{"\[Rho]", "\[Rule]", "\[Rho]0"}]}], "}"}]}]], "Input", CellChangeTimes->{{3.4357051866730003`*^9, 3.435705202547*^9}, { 3.4357059639379997`*^9, 3.435705968244*^9}, 3.4357060884440002`*^9, { 3.435747368058662*^9, 3.435747368924662*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"G", "\[Rule]", FractionBox[ RowBox[{"6.67428`*^-11", " ", SuperscriptBox["Meter", "2"], " ", "Newton"}], SuperscriptBox["Kilogram", "2"]]}], ",", RowBox[{"\[Omega]", "\[Rule]", FractionBox["\[Pi]", RowBox[{"43200", " ", "Second"}]]}], ",", RowBox[{"\[Rho]", "\[Rule]", FractionBox[ RowBox[{"5496.788221366487`", " ", "Kilogram"}], SuperscriptBox["Meter", "3"]]}]}], "}"}]], "Output", CellChangeTimes->{{3.435706073841*^9, 3.435706089158*^9}, 3.435747369781662*^9, 3.43588539421*^9, 3.4358855314969997`*^9, 3.4674875642081003`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[Eta]3", "/.", " ", "params"}]], "Input", CellChangeTimes->{{3.4356654838859997`*^9, 3.4356655935810003`*^9}, { 3.435666307729*^9, 3.435666314102*^9}, {3.4357051982609997`*^9, 3.435705205758*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"290.5827200411906`", " ", "Newton", " ", SuperscriptBox["Second", "2"]}], RowBox[{"Kilogram", " ", "Meter"}]]], "Output", CellChangeTimes->{3.435666320127*^9, 3.435666398619*^9, 3.4357052105959997`*^9, 3.4357061316289997`*^9, 3.435885395712*^9, 3.435885533061*^9, 3.4674875657369003`*^9}] }, Open ]], Cell[TextData[{ "Sometimes you have to help ", StyleBox["Mathematica", FontSlant->"Italic"], " along:" }], "Text", CellChangeTimes->{{3.435665698191*^9, 3.435665711101*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"NewtonHelp", " ", "=", " ", RowBox[{"{", RowBox[{"Newton", "\[Rule]", " ", RowBox[{"Kilogram", " ", RowBox[{"Meter", " ", "/", " ", RowBox[{"Second", "^", "2"}]}]}]}], "}"}]}]], "Input", CellChangeTimes->{{3.435706110804*^9, 3.4357061182019997`*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{"Newton", "\[Rule]", FractionBox[ RowBox[{"Kilogram", " ", "Meter"}], SuperscriptBox["Second", "2"]]}], "}"}]], "Output", CellChangeTimes->{3.4357061247*^9, 3.435747381848662*^9, 3.435885397248*^9, 3.435885534942*^9, 3.4674875700425*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"\[Eta]3", " ", "/.", " ", "params"}], " ", "/.", " ", "NewtonHelp"}]], "Input", CellChangeTimes->{{3.4356652136359997`*^9, 3.4356652148929996`*^9}, { 3.435665729196*^9, 3.435665813058*^9}, {3.435666420156*^9, 3.435666424932*^9}, {3.4357061204969997`*^9, 3.4357061628640003`*^9}}], Cell[BoxData["290.5827200411906`"], "Output", CellChangeTimes->{3.435706163705*^9, 3.435885399189*^9, 3.4358855362869997`*^9, 3.4674875717585*^9}] }, Open ]], Cell["\<\ And our numerical expression for \[Eta] is:\ \>", "Text", CellChangeTimes->{{3.435666442943*^9, 3.435666450468*^9}, { 3.4358854058129997`*^9, 3.435885426791*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[Eta]1", " ", "=", " ", RowBox[{ RowBox[{"(", "%", ")"}], "^", RowBox[{"(", RowBox[{"1", "/", "3"}], ")"}]}]}]], "Input", CellChangeTimes->{{3.435665835973*^9, 3.4356658706280003`*^9}}], Cell[BoxData["6.623536413682786`"], "Output", CellChangeTimes->{3.435666435415*^9, 3.435885401769*^9, 3.435885537616*^9, 3.4674875767973003`*^9}] }, Open ]], Cell[TextData[{ "Next envision a very long rope of uniform mass density (call it \[Lambda], \ though they didn't specify it---hopefully we won't need it to respond to the \ questions asked).\nIt extends from radius R to \[Eta]' R, where our job is to \ find \[Eta]'. But we'll call our variable, say, \[Alpha], since ", StyleBox["Mathematica", FontSlant->"Italic"], " is fussy about primes.\nFirst let's get the tension on the structure \ applied at the contact with Earth.\nViewed as a system, the rope has mass m = \ \[Lambda] (\[Alpha]-1) R, center of mass located at 1+(\[Alpha]-1)/2 in units \ of R:" }], "Text", CellChangeTimes->{{3.435665897258*^9, 3.435666046342*^9}, { 3.4356660947860003`*^9, 3.435666186889*^9}, {3.435666468118*^9, 3.43566650485*^9}, {3.43570415252*^9, 3.43570416265*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"m", " ", "=", " ", RowBox[{"\[Lambda]", " ", RowBox[{"(", RowBox[{"\[Alpha]", "-", "1"}], ")"}], " ", "R"}]}]], "Input", CellChangeTimes->{{3.435666189709*^9, 3.435666209373*^9}, { 3.4356665076800003`*^9, 3.4356665089519997`*^9}}], Cell[BoxData[ RowBox[{"R", " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "\[Alpha]"}], ")"}], " ", "\[Lambda]"}]], "Output", CellChangeTimes->{3.435666511762*^9, 3.435885414653*^9, 3.435885539447*^9, 3.4674875803073*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"rcm", " ", "=", " ", RowBox[{"R", "+", RowBox[{"R", RowBox[{ RowBox[{"(", RowBox[{"\[Alpha]", "-", "1"}], ")"}], "/", "2"}]}]}]}]], "Input", CellChangeTimes->{{3.4356665287390003`*^9, 3.435666553572*^9}}], Cell[BoxData[ RowBox[{"R", "+", RowBox[{ FractionBox["1", "2"], " ", "R", " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "\[Alpha]"}], ")"}]}]}]], "Output", CellChangeTimes->{3.4356665582209997`*^9, 3.435885416041*^9, 3.4358855408529997`*^9, 3.4674875815241003`*^9}] }, Open ]], Cell[TextData[{ "And the total gravitational force on the sytem is the sum of of the bits. \ This requires a quick little integral,\nwhich provides as good a time as any \ to introduce the Assumptions option to Integrate---this is where you\ncan \ inform ", StyleBox["Mathematica", FontSlant->"Italic"], " of extra information it can assume is true.\nWithout it:" }], "Text", CellChangeTimes->{{3.4356665668640003`*^9, 3.435666612375*^9}, { 3.435704181843*^9, 3.435704377974*^9}, {3.435704415349*^9, 3.435704435633*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Integrate", "[", " ", RowBox[{ RowBox[{"G", " ", "M", " ", RowBox[{"\[Lambda]", " ", "/", " ", RowBox[{"r", "^", "2"}]}]}], ",", RowBox[{"{", RowBox[{"r", ",", "R", ",", RowBox[{"\[Alpha]", " ", "R"}]}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.435704385546*^9, 3.4357043881549997`*^9}}], Cell[BoxData[ RowBox[{ FractionBox["4", "3"], " ", "G", " ", "\[Pi]", " ", SuperscriptBox["R", "3"], " ", "\[Lambda]", " ", "\[Rho]", " ", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"Re", "[", "\[Alpha]", "]"}], "\[GreaterEqual]", "0"}], "||", RowBox[{"\[Alpha]", "\[NotElement]", "Reals"}]}], ",", FractionBox[ RowBox[{ RowBox[{"-", "1"}], "+", "\[Alpha]"}], RowBox[{"R", " ", "\[Alpha]"}]], ",", RowBox[{"Integrate", "[", RowBox[{ FractionBox["1", SuperscriptBox["r", "2"]], ",", RowBox[{"{", RowBox[{"r", ",", "R", ",", RowBox[{"R", " ", "\[Alpha]"}]}], "}"}], ",", RowBox[{"Assumptions", "\[Rule]", RowBox[{"!", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"Re", "[", "\[Alpha]", "]"}], "\[GreaterEqual]", "0"}], "||", RowBox[{"\[Alpha]", "\[NotElement]", "Reals"}]}], ")"}]}]}]}], "]"}]}], "]"}]}]], "Output", CellChangeTimes->{3.435704389343*^9, 3.435885434076*^9, 3.43588554451*^9, 3.4674875871556997`*^9}] }, Open ]], Cell["With it:", "Text", CellChangeTimes->{{3.435704410837*^9, 3.43570441326*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Fg", " ", "=", " ", RowBox[{"Integrate", "[", " ", RowBox[{ RowBox[{"G", " ", "M", " ", RowBox[{"\[Lambda]", " ", "/", " ", RowBox[{"r", "^", "2"}]}]}], ",", RowBox[{"{", RowBox[{"r", ",", "R", ",", RowBox[{"\[Alpha]", " ", "R"}]}], "}"}], ",", RowBox[{"Assumptions", "\[Rule]", RowBox[{"{", RowBox[{"\[Alpha]", ">", "0"}], "}"}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.4356232239960003`*^9, 3.435623225047*^9}, { 3.435666614734*^9, 3.435666784925*^9}, {3.4356668582469997`*^9, 3.435666873869*^9}, {3.4357044021219997`*^9, 3.435704402479*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"4", " ", "G", " ", "\[Pi]", " ", SuperscriptBox["R", "2"], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "\[Alpha]"}], ")"}], " ", "\[Lambda]", " ", "\[Rho]"}], RowBox[{"3", " ", "\[Alpha]"}]]], "Output", CellChangeTimes->{{3.435666689506*^9, 3.4356667487860003`*^9}, { 3.435666779*^9, 3.435666787102*^9}, {3.435666861282*^9, 3.435666874998*^9}, 3.435704406795*^9, 3.4358854374519997`*^9, 3.435885550245*^9, 3.4674875890745*^9}] }, Open ]], Cell["\<\ Together, gravity and tension provide the force necessary for circular motion:\ \>", "Text", CellChangeTimes->{{3.435666884453*^9, 3.435666908109*^9}}], Cell[BoxData[ RowBox[{"T0", "=."}]], "Input", CellChangeTimes->{{3.4674876095261*^9, 3.4674876115229*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqn", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"-", " ", "m"}], " ", RowBox[{"\[Omega]", "^", "2"}], " ", "rcm"}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"-", "Fg"}], " ", "-", " ", "T0"}]}]}]], "Input", CellChangeTimes->{{3.435666910639*^9, 3.435666942599*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"-", "R"}], " ", RowBox[{"(", RowBox[{"R", "+", RowBox[{ FractionBox["1", "2"], " ", "R", " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "\[Alpha]"}], ")"}]}]}], ")"}], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "\[Alpha]"}], ")"}], " ", "\[Lambda]", " ", SuperscriptBox["\[Omega]", "2"]}], "\[Equal]", RowBox[{ RowBox[{"-", "T0"}], "-", FractionBox[ RowBox[{"4", " ", "G", " ", "\[Pi]", " ", SuperscriptBox["R", "2"], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "\[Alpha]"}], ")"}], " ", "\[Lambda]", " ", "\[Rho]"}], RowBox[{"3", " ", "\[Alpha]"}]]}]}]], "Output", CellChangeTimes->{ 3.4356669453120003`*^9, 3.435667685517*^9, 3.4358854375360003`*^9, 3.435885550502*^9, {3.4674875927405*^9, 3.4674876133637*^9}}] }, Open ]], Cell["So let's solve for the tension:", "Text", CellChangeTimes->{{3.435704469224*^9, 3.4357044869049997`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"solnT0", " ", "=", " ", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"Solve", "[", RowBox[{"eqn", ",", "T0"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}], "//", "Simplify"}], ")"}]}]], "Input", CellChangeTimes->{{3.435666947289*^9, 3.435666960301*^9}, {3.435667643318*^9, 3.4356676820220003`*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{"T0", "\[Rule]", FractionBox[ RowBox[{ SuperscriptBox["R", "2"], " ", "\[Lambda]", " ", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"-", "8"}], " ", "G", " ", "\[Pi]", " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "\[Alpha]"}], ")"}], " ", "\[Rho]"}], "+", RowBox[{"3", " ", "\[Alpha]", " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", SuperscriptBox["\[Alpha]", "2"]}], ")"}], " ", SuperscriptBox["\[Omega]", "2"]}]}], ")"}]}], RowBox[{"6", " ", "\[Alpha]"}]]}], "}"}]], "Output", CellChangeTimes->{{3.435666954443*^9, 3.4356669606540003`*^9}, { 3.4356676779379997`*^9, 3.435667687153*^9}, 3.435885438531*^9, 3.435885558001*^9, {3.4674875969993*^9, 3.4674876166553*^9}}] }, Open ]], Cell["\<\ If our elevator rope is to stand up, the tension can never drop below 0 \ anywhere, including at r=R. We'll have to check this with the explict T(r) later on, but it seems \ plausible that if T0>0 the rest will be OK. So for what value of \[Alpha] does T0 vanish? Dividing by the various constants, the polynomial whose roots we want is:\ \>", "Text", CellChangeTimes->{{3.4357045002139997`*^9, 3.435704856564*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"q", "=", RowBox[{ RowBox[{ RowBox[{"-", "8"}], " ", "G", " ", "\[Pi]", " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "\[Alpha]"}], ")"}], " ", "\[Rho]"}], "+", RowBox[{"3", " ", "\[Alpha]", " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", SuperscriptBox["\[Alpha]", "2"]}], ")"}], " ", SuperscriptBox["\[Omega]", "2"]}]}]}]], "Input", CellChangeTimes->{{3.43570163012*^9, 3.435701630337*^9}, { 3.4357048295150003`*^9, 3.435704859801*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"-", "8"}], " ", "G", " ", "\[Pi]", " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "\[Alpha]"}], ")"}], " ", "\[Rho]"}], "+", RowBox[{"3", " ", "\[Alpha]", " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", SuperscriptBox["\[Alpha]", "2"]}], ")"}], " ", SuperscriptBox["\[Omega]", "2"]}]}]], "Output", CellChangeTimes->{3.4357016307539997`*^9, 3.435704863769*^9, 3.4358854402790003`*^9, 3.435885561182*^9, 3.4674876279809*^9}] }, Open ]], Cell["\<\ Notice this cubic factorizes---the \[Alpha]=1 root is the trivial elevator of \ zero length:\ \>", "Text", CellChangeTimes->{{3.435704874623*^9, 3.435704926565*^9}, { 3.4357050251289997`*^9, 3.4357050517790003`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Factor", "[", "q", "]"}]], "Input", CellChangeTimes->{{3.435701634502*^9, 3.435701637427*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"-", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "\[Alpha]"}], ")"}]}], " ", RowBox[{"(", RowBox[{ RowBox[{"8", " ", "G", " ", "\[Pi]", " ", "\[Rho]"}], "-", RowBox[{"3", " ", "\[Alpha]", " ", SuperscriptBox["\[Omega]", "2"]}], "-", RowBox[{"3", " ", SuperscriptBox["\[Alpha]", "2"], " ", SuperscriptBox["\[Omega]", "2"]}]}], ")"}]}]], "Output", CellChangeTimes->{3.435701637659*^9, 3.435885442882*^9, 3.435885564026*^9, 3.4674876323645*^9}] }, Open ]], Cell["\<\ Adding in the roots of the quadratic, the list of all solutions is:\ \>", "Text", CellChangeTimes->{{3.435704929422*^9, 3.435704964021*^9}, {3.435705044061*^9, 3.435705073646*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"soln\[Alpha]", " ", "=", " ", RowBox[{"Solve", "[", RowBox[{ RowBox[{"q", "\[Equal]", "0"}], ",", "\[Alpha]"}], "]"}]}]], "Input", CellChangeTimes->{{3.4357049808599997`*^9, 3.435705001743*^9}, { 3.435705077336*^9, 3.4357050840880003`*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"\[Alpha]", "\[Rule]", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"\[Alpha]", "\[Rule]", FractionBox[ RowBox[{ RowBox[{ RowBox[{"-", "3"}], " ", SuperscriptBox["\[Omega]", "2"]}], "-", RowBox[{ SqrtBox["3"], " ", SqrtBox[ RowBox[{ RowBox[{"32", " ", "G", " ", "\[Pi]", " ", "\[Rho]", " ", SuperscriptBox["\[Omega]", "2"]}], "+", RowBox[{"3", " ", SuperscriptBox["\[Omega]", "4"]}]}]]}]}], RowBox[{"6", " ", SuperscriptBox["\[Omega]", "2"]}]]}], "}"}], ",", RowBox[{"{", RowBox[{"\[Alpha]", "\[Rule]", FractionBox[ RowBox[{ RowBox[{ RowBox[{"-", "3"}], " ", SuperscriptBox["\[Omega]", "2"]}], "+", RowBox[{ SqrtBox["3"], " ", SqrtBox[ RowBox[{ RowBox[{"32", " ", "G", " ", "\[Pi]", " ", "\[Rho]", " ", SuperscriptBox["\[Omega]", "2"]}], "+", RowBox[{"3", " ", SuperscriptBox["\[Omega]", "4"]}]}]]}]}], RowBox[{"6", " ", SuperscriptBox["\[Omega]", "2"]}]]}], "}"}]}], "}"}]], "Output", CellChangeTimes->{3.43570500254*^9, 3.435705088759*^9, 3.435885444491*^9, 3.435885565851*^9, 3.4674876599921*^9}] }, Open ]], Cell["\<\ Plainly we are interesting in the positive solution, which numerically is: \ \>", "Text", CellChangeTimes->{{3.4357050982860003`*^9, 3.4357051300290003`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"num\[Alpha]", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"\[Alpha]", " ", "/.", " ", RowBox[{"soln\[Alpha]", "[", RowBox[{"[", "3", "]"}], "]"}]}], " ", "/.", " ", "params"}], " ", "//", "N"}]}]], "Input", CellChangeTimes->{{3.435705147679*^9, 3.435705171065*^9}, { 3.4357052320439997`*^9, 3.435705269255*^9}}], Cell[BoxData[ RowBox[{"3.1514940960112743`*^7", " ", RowBox[{"(", RowBox[{ RowBox[{"1.7320508075688772`", " ", SqrtBox[ RowBox[{ FractionBox["8.390459747315523`*^-17", SuperscriptBox["Second", "4"]], "+", FractionBox[ RowBox[{"1.9504980926168525`*^-13", " ", "Newton"}], RowBox[{"Kilogram", " ", "Meter", " ", SuperscriptBox["Second", "2"]}]]}]]}], "-", FractionBox["1.5865490613891073`*^-8", SuperscriptBox["Second", "2"]]}], ")"}], " ", SuperscriptBox["Second", "2"]}]], "Output", CellChangeTimes->{{3.435705233014*^9, 3.435705251229*^9}, 3.435705305026*^9, 3.435885446196*^9, 3.43588556848*^9, {3.4674876407261*^9, 3.4674876639701*^9}}] }, Open ]], Cell["And again we need to give a push:", "Text", CellChangeTimes->{{3.435705276809*^9, 3.4357052820550003`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[Alpha]0", " ", "=", " ", RowBox[{"Simplify", "[", RowBox[{ RowBox[{"num\[Alpha]", " ", "/.", " ", RowBox[{"{", RowBox[{"Newton", " ", "\[Rule]", " ", RowBox[{"Kilogram", " ", RowBox[{"Meter", "/", RowBox[{"Second", "^", "2"}]}]}]}], "}"}]}], ",", RowBox[{"Assumptions", "\[Rule]", RowBox[{"{", RowBox[{"Second", ">", "0"}], "}"}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.435705283778*^9, 3.4357053491730003`*^9}, { 3.4357059001029997`*^9, 3.43570590177*^9}}], Cell[BoxData["23.612557725848603`"], "Output", CellChangeTimes->{{3.435705302131*^9, 3.4357053074820004`*^9}, 3.43570534941*^9, 3.4357059025559998`*^9, 3.4358854479560003`*^9, 3.435885571215*^9, 3.4674876693521*^9}] }, Open ]], Cell["", "Text", CellChangeTimes->{{3.435705412667*^9, 3.4357054369300003`*^9}}], Cell["\<\ (c) We are asked at what radius the tension is maximized. Well at such a \ radius, it is clear that T'(r) = 0, which means that the force on a tiny \ little piece of string at that location is purely gravitational. If that bit is supposed \ to keep up with the rest of the elevator, it had better be located at the \ geosynchronous radius.\ \>", "Text", CellChangeTimes->{{3.435705454583*^9, 3.435705609578*^9}}], Cell["\<\ But to fully answer this question, we might as well go ahead and get the full \ T(r). To get it, we derive and solve a simple differential equation: Consider the small bit of rope between r and r+\[CapitalDelta]r. Its mass is\ \>", "Text", CellChangeTimes->{{3.435666978304*^9, 3.435667012769*^9}, {3.435705440884*^9, 3.435705448293*^9}, {3.43570561344*^9, 3.435705665601*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[CapitalDelta]m", " ", "=", " ", RowBox[{"\[Lambda]", " ", "\[CapitalDelta]r"}]}]], "Input", CellChangeTimes->{{3.435667014557*^9, 3.4356670256070004`*^9}, { 3.435667239605*^9, 3.435667254808*^9}}], Cell[BoxData[ RowBox[{"\[CapitalDelta]r", " ", "\[Lambda]"}]], "Output", CellChangeTimes->{3.435667258152*^9, 3.435885450314*^9, 3.435885576641*^9, 3.4674876741101*^9}] }, Open ]], Cell["F = ma for that bit reads:", "Text", CellChangeTimes->{{3.4356672736730003`*^9, 3.435667280564*^9}, { 3.435667350675*^9, 3.435667361073*^9}, {3.435705670809*^9, 3.435705675677*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqn", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"T", "[", RowBox[{"r", "+", "\[CapitalDelta]r"}], "]"}], " ", "-", " ", RowBox[{"T", "[", "r", "]"}], " ", "-", " ", RowBox[{"G", " ", "M", " ", RowBox[{"\[CapitalDelta]m", " ", "/", " ", RowBox[{"r", "^", "2"}]}]}]}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"-", " ", "\[CapitalDelta]m"}], " ", RowBox[{"\[Omega]", "^", "2"}], " ", "r"}]}]}]], "Input", CellChangeTimes->{{3.435667281976*^9, 3.435667347859*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"-", FractionBox[ RowBox[{"4", " ", "G", " ", "\[Pi]", " ", "R", " ", SuperscriptBox["r0", "4"], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "\[Alpha]"}], ")"}], " ", "\[Lambda]", " ", "\[Rho]"}], RowBox[{"3", " ", SuperscriptBox["r", "3"]}]]}], "-", FractionBox[ RowBox[{"4", " ", "G", " ", "\[Pi]", " ", SuperscriptBox["R", "3"], " ", "\[CapitalDelta]r", " ", "\[Lambda]", " ", "\[Rho]"}], RowBox[{"3", " ", SuperscriptBox["r", "2"]}]], "+", FractionBox[ RowBox[{"4", " ", "G", " ", "\[Pi]", " ", "R", " ", SuperscriptBox["r0", "4"], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", "\[Alpha]"}], ")"}], " ", "\[Lambda]", " ", "\[Rho]"}], RowBox[{"3", " ", SuperscriptBox[ RowBox[{"(", RowBox[{"r", "+", "\[CapitalDelta]r"}], ")"}], "3"]}]]}], "\[Equal]", RowBox[{ RowBox[{"-", "r"}], " ", "\[CapitalDelta]r", " ", "\[Lambda]", " ", SuperscriptBox["\[Omega]", "2"]}]}]], "Output", CellChangeTimes->{3.435667323191*^9, 3.435667362292*^9, 3.435885451914*^9, 3.4358855799709997`*^9, 3.4674876756389*^9}] }, Open ]], Cell["\<\ Taking \[CapitalDelta]r to 0, we get the differential equation\ \>", "Text", CellChangeTimes->{{3.435667418234*^9, 3.435667436351*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"eqnT", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"T", "'"}], "[", "r", "]"}], " ", "\[Equal]", " ", RowBox[{ RowBox[{ RowBox[{"-", "r"}], " ", "\[Lambda]", " ", RowBox[{"\[Omega]", "^", "2"}]}], " ", "+", " ", RowBox[{"G", " ", "M", " ", RowBox[{"\[Lambda]", " ", "/", " ", RowBox[{"r", "^", "2"}]}]}]}]}]}]], "Input", CellChangeTimes->{{3.435667437618*^9, 3.435667497539*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ SuperscriptBox["T", "\[Prime]", MultilineFunction->None], "[", "r", "]"}], "\[Equal]", RowBox[{ FractionBox[ RowBox[{"4", " ", "G", " ", "\[Pi]", " ", SuperscriptBox["R", "3"], " ", "\[Lambda]", " ", "\[Rho]"}], RowBox[{"3", " ", SuperscriptBox["r", "2"]}]], "-", RowBox[{"r", " ", "\[Lambda]", " ", SuperscriptBox["\[Omega]", "2"]}]}]}]], "Output", CellChangeTimes->{3.435667499172*^9, 3.435885464197*^9, 3.435885603526*^9, 3.4674876781973*^9, 3.4674878094089003`*^9}] }, Open ]], Cell["\<\ Solving with the boundary condition that the tension at the Earth end is T0:\ \>", "Text", CellChangeTimes->{{3.4357057756879997`*^9, 3.435705816784*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"solnT", " ", "=", " ", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"DSolve", "[", RowBox[{ RowBox[{"{", RowBox[{"eqnT", ",", RowBox[{ RowBox[{"T", "[", "R", "]"}], "\[Equal]", RowBox[{"(", RowBox[{"T0", "/.", "solnT0"}], ")"}]}]}], "}"}], ",", RowBox[{"T", "[", "r", "]"}], ",", "r"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}], ")"}], "//", "Simplify"}]}]], "Input", CellChangeTimes->{{3.4356675013459997`*^9, 3.43566756438*^9}, { 3.4356676640559998`*^9, 3.435667669513*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"T", "[", "r", "]"}], "\[Rule]", FractionBox[ RowBox[{ RowBox[{"(", RowBox[{"r", "-", RowBox[{"R", " ", "\[Alpha]"}]}], ")"}], " ", "\[Lambda]", " ", RowBox[{"(", RowBox[{ RowBox[{"8", " ", "G", " ", "\[Pi]", " ", SuperscriptBox["R", "2"], " ", "\[Rho]"}], "-", RowBox[{"3", " ", "r", " ", "\[Alpha]", " ", RowBox[{"(", RowBox[{"r", "+", RowBox[{"R", " ", "\[Alpha]"}]}], ")"}], " ", SuperscriptBox["\[Omega]", "2"]}]}], ")"}]}], RowBox[{"6", " ", "r", " ", "\[Alpha]"}]]}], "}"}]], "Output", CellChangeTimes->{{3.435667525373*^9, 3.435667564999*^9}, { 3.4356676700810003`*^9, 3.4356676999040003`*^9}, 3.435885472101*^9, 3.435885605446*^9, 3.4674876828929*^9, 3.4674877870697002`*^9, 3.4674878254456997`*^9}] }, Open ]], Cell["\<\ As a check that we are on the right track, let's get the tension at the far \ end:\ \>", "Text", CellChangeTimes->{{3.43570569681*^9, 3.435705714755*^9}, {3.435705819711*^9, 3.435705820671*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"T", "[", "r", "]"}], "/.", " ", "solnT"}], " ", "/.", " ", RowBox[{"r", "\[Rule]", " ", RowBox[{"\[Alpha]", " ", "R"}]}]}]], "Input", CellChangeTimes->{{3.435705717763*^9, 3.435705731132*^9}}], Cell[BoxData["0"], "Output", CellChangeTimes->{3.4357057322019997`*^9, 3.4358856077390003`*^9, 3.4674878307653*^9}] }, Open ]], Cell["In fact we could have used this condition to find T(r):", "Text", CellChangeTimes->{{3.435705742933*^9, 3.435705764105*^9}, {3.4357058243*^9, 3.435705827189*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"solnT", " ", "=", " ", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"DSolve", "[", RowBox[{ RowBox[{"{", RowBox[{"eqnT", ",", RowBox[{ RowBox[{"T", "[", RowBox[{"\[Alpha]", " ", "R"}], "]"}], "\[Equal]", "0"}]}], "}"}], ",", RowBox[{"T", "[", "r", "]"}], ",", "r"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}], ")"}], "//", "Simplify"}]}]], "Input", CellChangeTimes->{{3.435705838134*^9, 3.435705852358*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"T", "[", "r", "]"}], "\[Rule]", FractionBox[ RowBox[{ RowBox[{"(", RowBox[{"r", "-", RowBox[{"R", " ", "\[Alpha]"}]}], ")"}], " ", "\[Lambda]", " ", RowBox[{"(", RowBox[{ RowBox[{"8", " ", "G", " ", "\[Pi]", " ", SuperscriptBox["R", "2"], " ", "\[Rho]"}], "-", RowBox[{"3", " ", "r", " ", "\[Alpha]", " ", RowBox[{"(", RowBox[{"r", "+", RowBox[{"R", " ", "\[Alpha]"}]}], ")"}], " ", SuperscriptBox["\[Omega]", "2"]}]}], ")"}]}], RowBox[{"6", " ", "r", " ", "\[Alpha]"}]]}], "}"}]], "Output", CellChangeTimes->{3.435705853623*^9, 3.4358856099049997`*^9, 3.4674878357261*^9}] }, Open ]], Cell["\<\ Now let's put in numbers and plot. For plotting define the dimensionless \ parameter x = r/R:\ \>", "Text", CellChangeTimes->{{3.435706567757*^9, 3.4357065820039997`*^9}, { 3.435706766133*^9, 3.435706789126*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"q", " ", "=", RowBox[{"(", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"T", "[", "r", "]"}], "/.", "solnT"}], " ", "/.", " ", RowBox[{"\[Alpha]", "\[Rule]", "\[Alpha]0"}]}], " ", "/.", "params"}], "/.", "NewtonHelp"}], " ", "//", "Simplify"}], ")"}], " "}]], "Input", CellChangeTimes->{{3.435705918627*^9, 3.435705942126*^9}, {3.435706038332*^9, 3.4357060485880003`*^9}, {3.43570617977*^9, 3.435706191027*^9}, { 3.435706354002*^9, 3.435706372849*^9}, 3.435706649683*^9}], Cell[BoxData[ RowBox[{ FractionBox["1", RowBox[{"r", " ", SuperscriptBox["Second", "2"]}]], RowBox[{"0.007058391073162613`", " ", RowBox[{"(", RowBox[{"r", "-", RowBox[{"23.612557725848603`", " ", "R"}]}], ")"}], " ", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"-", "3.746248129694121`*^-7"}], " ", SuperscriptBox["r", "2"]}], "-", RowBox[{"8.84585002177548`*^-6", " ", "r", " ", "R"}], "+", RowBox[{"9.220474834744893`*^-6", " ", SuperscriptBox["R", "2"]}]}], ")"}], " ", "\[Lambda]"}]}]], "Output", CellChangeTimes->{ 3.435705943582*^9, 3.4357059819890003`*^9, {3.435706031869*^9, 3.435706041718*^9}, {3.435706180392*^9, 3.435706191323*^9}, 3.435706360677*^9, 3.435706650189*^9, 3.435885613374*^9, 3.4674878395949*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"F", "[", "x_", "]"}], " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"q", " ", "/.", " ", RowBox[{"{", RowBox[{ RowBox[{"r", "\[Rule]", RowBox[{"x", " ", "R"}]}], ",", RowBox[{"\[Lambda]", "\[Rule]", RowBox[{"1", " ", RowBox[{"Kilogram", "/", "Meter"}]}]}]}], "}"}]}], "/.", RowBox[{"R", "\[Rule]", "EarthRadius"}]}], "//", "Simplify"}]}]], "Input", CellChangeTimes->{{3.435706377349*^9, 3.4357064149110003`*^9}, { 3.435706653126*^9, 3.435706744993*^9}, {3.43570679609*^9, 3.435706805824*^9}, {3.4357068358929996`*^9, 3.435706861384*^9}, { 3.43570691658*^9, 3.435706918617*^9}}], Cell[BoxData[ RowBox[{"-", FractionBox[ RowBox[{"107569.79763738086`", " ", "Kilogram", " ", "Meter", " ", RowBox[{"(", RowBox[{ RowBox[{"-", "23.612557725848603`"}], "+", "x"}], ")"}], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1.`"}], "+", "x"}], ")"}], " ", RowBox[{"(", RowBox[{"24.612557725848607`", "\[InvisibleSpace]", "+", "x"}], ")"}]}], RowBox[{ SuperscriptBox["Second", "2"], " ", "x"}]]}]], "Output", CellChangeTimes->{ 3.4357064157939997`*^9, {3.435706678035*^9, 3.435706745666*^9}, 3.43570680621*^9, 3.435706861829*^9, 3.435706918915*^9, 3.435885616273*^9, 3.4674878421844997`*^9}] }, Open ]], Cell["This is the force in Newtons. Let's divide out the units:", "Text", CellChangeTimes->{{3.435706866303*^9, 3.4357068764049997`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"f", "[", "x_", "]"}], " ", "=", " ", RowBox[{ RowBox[{ RowBox[{"F", "[", "x", "]"}], " ", "/", " ", "Newton"}], " ", "/.", " ", "NewtonHelp"}]}]], "Input", CellChangeTimes->{{3.435706877617*^9, 3.435706933666*^9}}], Cell[BoxData[ RowBox[{"-", FractionBox[ RowBox[{"107569.79763738086`", " ", RowBox[{"(", RowBox[{ RowBox[{"-", "23.612557725848603`"}], "+", "x"}], ")"}], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1.`"}], "+", "x"}], ")"}], " ", RowBox[{"(", RowBox[{"24.612557725848607`", "\[InvisibleSpace]", "+", "x"}], ")"}]}], "x"]}]], "Output", CellChangeTimes->{{3.435706889847*^9, 3.435706933994*^9}, 3.435885618877*^9, 3.4674878461781*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"f", "[", "x", "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "1", ",", "\[Alpha]0"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4357064181940002`*^9, 3.43570643869*^9}, { 3.4357069398529997`*^9, 3.4357069414040003`*^9}}], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.67, 0.6, 0.6], LineBox[CompressedData[" 1:eJwV13k0VVscB3DzPE93MoYUQsJF6v62KKWolCRPFEloknnIdM8tRSUyJJWb UqESKiWJiBAieYSIjJmSmbffX2d91llrr71/Z5/fd2+VI6f2unNxcHDs4OTg +P955UV3CAfHOONMnYmc+jszCL18Iem4/DjDPlc7qkqPio676j1pMB5nDNUa mZzj0kTmwhE9d86MM/Tj1/RzZJugP85K21HvOCNJxTrFdd4KOfA5y0VVTjCI YQf5da8OIIt2Xr2hngmGS5z3ZIDIQbT+ae72vSsTjLai+5yXDzkiIcel0FXG kwz29M+zzqNOqCQ3vff9w0lGpl5PZMe4C1q1v/0pd9wU46NPlKdKvDsS04yu 8Xo4xWgsFB8wph5DC8uaP798mGLc/9jNXXzvGGrODibdW55iFLgQojKFHohY pIRbnP7D+LvnuUhHuScaZjtYM+2mGQHRbPHxDB9UMNnSx0edYawNUvF3p59F HpslnjYZzzCEkojsJJ+ziBq7IzjjwAyjYY9lmgH7LIpQKRUzSpphVCRIJFaJ +KKdu7Pp7hKzjPszH3aHtfmin7nBF8v55hg1FSrqPxz9UPJcgd0V9TmGZ/nh K+MX/NAOyzGFQxZzjO1htj5xRX7oacfR/MnIOYZUQeMfPwl/FCq8q11laY7h HD+Stq7UH8l6Kq2LmJpnJDOLtoUIBqKPBQdnrKUWGHt7l9bKrA9EoRyJZaT1 CwwXQ365PQ6BqCdZwP7JyQUGR/pS6+usQJRXORHeObjA0LTY5utnFoS2qlU0 mHUvMuZHz9t4OwYj/67j5+ZqlxlyGfJViodDUbzcrdriwWUG75/qGnpIKMra 1agWyrfCaFYbK6Emh6Lm1yYty4wVRsA263dQH4o2pAgZ8TxfYUz7j3XJm4ah wDVfQ1g7OcDZIs/9skA4MvgRsClBnxM4GnxNMqPPo3eL1wYngRNcxTtdp1LP o53knCQ7W04YzoFQhafn0VHb7lEZb064pqPCvdx+HiWUWGUkZ3FC2YjfpiVy BBpPpaykk7ngZWq9drJXBMrd+/rdg2UuUN/mkubIE4lWh9wweSfCDWw9h49G opHoDvtM/jcqN0yYnR/jkYtECX807gnSuSEuli8zQCMS+d9IZHmd4oYL11iN r7ZHos3/+tjodnPDumhbmZpLkajeVbmjqIwHynP7TRv4otC22IV9nz/zwAcf f5KyWBR6l/+17td3Hhhdo6vkLhuF8rnjSsnzPODc283zWTUK3ciaywzW5wWB 0f0n1SAKOQ82eW5m8wJZ56beL/8o9Ps0c+ZDDB/Y7fMb3vU9CtU0P7SSSOQD 8s6/p0Z6o9B94/pURzYf8Kkf+RkxFIUOc5DMxsr4YPCt3PClmSjUcCU7grzC BzfF/2FpS0aj/LxPgl5B/OC+XU862zwa+Y9IykucFIBuE9UPKxnRaO9uIx/H MAEY2JZ8PfxeNNIpcHx777IA2MdGnZh+GI1+hbBdTB4LwLF+oxOfCqKRg7Bh 1pEBAVjc9cmAWhONTDUddAqPCML+3Pr7NlPRaNkjAxwPCIGHlo3qCYhBl8tK HW67C0FgsUJWgUUMotF+nP7pKwQFBamX5qxikHG96t2TV4Wg/8Wd7LN7YtBZ g4ec0dVCcFfDWFT1SAzq5yh4/3ijMJSHe6ZGR8Wg+tRqiyUlESjdxlQLKo1B TlNDTuY6IhC0/1GAUnkMGt4p4scyEwGGhIVyWWUMEuCwzZI8KAJ1iSKX/9bF IPNjzbyrE0Rg9ltSlGZHDCrS76q04RGFUm5ejzczMSjj0x+rOwOicGrSx++Z FhNddTlsQprF70v/fpTQZaKo6eq18fxiUJ4WFualz0TuSreFQleLwcGONFVp EybS9t1ee8BNDNaslJG0tzJRMTXDVrxbDGoT+KRjDzNRi+c2+/BWcThJ3XxO 6QoTVS4/2zrdLw7JRTsy/l5jopfX5enef8VhqLGlpzqRieo7Z4VzhSSAdevV Z7c0JnomUD+StlYC/i1vqfDOYqJAp8A8fw8JOJzk5FxdzER8PHXrdXolQNH/ XmxLDxP9bT5y9cOQBBwpkRfX6WOivqzZ306TEhBYaeMc/YuJKrap5VzilIQf L2S81Ubw+i6FrB5UkoTdzYp5MM1Ey1KatHtOkvDlgvPyTz4C/VVh8VC/SkLF UjZ1WoNA/ZPyR599lwRnZ7P20bUEainPL7Pqk4SUaavmXi0CFbh3hgf8kcT1 5g+t0iXQ2YeGc81SUlBnd/2vD51Av/V+jl6xlYIsYR0t0614PAZq5a2WgvdC 0ht6XQmUd2l/KrVBCkKeee/zPkqggFbPQ7qtUmBx9+WBKTcCCZxK6HLok4Kq RlORBQ8CaWX0/nrMKQ3Reh/dJnwIdHqRObvHVBp8Qg5fDAki0PzLGkrGY2mY ynj8QuoKgd7zdLXn50vD/LEzNYeuEujS7qlbVa+kYZeT+3zmNQLJD9BWTVRJ g7HN1ZdaiQRikHw0LX5Kw7WGgI7VqQSK8RPfOCQvA0VDwrofMgkkpr/PyShe BpxXEaM5BQS6QIsT+pkkA5tNttz4UkggLt7Kl9duyYCY6k00W0SgmVa67GiO DFzftePBxlcE6g6j1bM/ycDO2IPdj0oIlF/dw5AUlAXLSft47UoCaT+n/X4r IQtFX9v0DaoIdD99X7o3WRZePGJNm3wk0M1TlbNVGrKwymyinVGD5yf76Fn4 VlkABztHw3oC2bueUR2JlgXBXYERH1sI1LDjUWPqJVlQdTxalf+VQDsMes9v uy4Lh4szLW+24vXy7+/IzJSFOn3a72NtBFqTa5x0sEwWynvcyYMduJ6zK3xV y7IQ0aVHSusl0K2r8UN3g+QgUVoo9OUYgcb/WC7WRsjB0aNspss4gSwOLonO suTA4vtNDf4JAg2peK+3uSEH65+9N949SSDj59sD5/PlYAdtR07jHwI1tfDw 2Y3IwffhNS8S5gi02vQNKXxKDlIkR9+qzRMoKMN37cN5OZB17jpZiK3s0bNz RYAEwy6kT00LBPKZLb3+WJ0ELBWpK0tLeL/QQlR4DpPg++n90jJcLOR0Xn+D 7jESqCSpiV7DftI7aOHoQwKnlnclItwsZJ/jcPxpCAnOJv7YysHDQuxNRk+c Ukjg+l1M8hsvC212mTArbCRBawunhbUgCyVUZNt0fyOBzOoEyQLsvjUuLsLd JHjJDGbThFjo8kR9tOtvEnzsSyD9wm6LyqkRFSbDD4njB06JsNC5LA+HYxZk SP9T0G8pjse/en63jzUZoqtbclOxBUKSrc7tJcOZ0od7RrDTd1cZR7mQ4Zyj uX68BAtVLKymZISSwe/V8IkKSRaK798smRWN3eCiJS7FQg6N9oI5sWQYvrqq 3gF75D4x9yqFDLsebi8ZwJbZ29/WUkCGzfVr9y9Is1Cn2XJjx2sy+NiJbtwk w0LZGnI1ve/xfBPvCYRjmy1ZFk80kCHS/vo/i9hu2VlpoqNksDj4iWNEloUK lt0OWapToE9NqCSZxELhg6F2O7UpMJI97/UR26o50dpuAwV2O3eKzGJ3PKzY 6IooYOf5d/U+Mgvx7FeTD/uHAltIMXUr2PUMM5kYNwq8IOsorKGwUIrmPpFL XhTIfvvgqC22NkfMYkoQBbaHerWmYe973NtRkEQB5ZLiE+pUFlK8sdD8Op0C QyzvSEvsgQjpuvdsCnyh3Lnuhh1qv6Wk4RkFjge25dzG3ooOFba+pEC8Ok/h a2wJbd/czlIKEE7zxV+x73Gyb43UUSBxz+X3gjQWOjlSnDTVTIH6+W0fVLCN W5vi5tsp8JFX/KMxdm0OV7jAEAUG3WY/H8W+kUz1F5+gQFK14dcAbJco/ZNy sxQozC/ojMWeOnDEWY2PCrP37s/m/j9+d4Z5hSgV8nfb/1OKPXS8fbWbLBUm WMOpn7GPTZCEeRSwpeWedGL3BO0bY6tR4dd4zK0RbGeua1+2aFNBzrbffQ67 LbbuRe8GKogk/hLglcf1khZKj95IhaJDhixx7IabWyNUt1AhMSjkBxl7p1q0 W/kOKnyZcyOrYFfllFod3UuFM6vStddgmxsuanM7UuHguRpFHey3JcaSbFcq ROWkjOljm271mzb3pILQh7zbRtiF9c/aek5Twebvc10TbL0Dv0uiAqnA8dLm jil2Tpdm5qoIKsB7tcn/vea4B/GeRYXHYu3q/5s9zj5x5AoVTrXJmhljKwZ1 23AlU+FAZqChIXYap8KGzAwq9Ky7L7UeWy72IMn8PhU2EdCshZ0gdWPhRy4V vBcHgtWxxW42dUUWUkF9LfArYl9UFa9QKcH1+d0XJIvNk2OdXVZBBcI/6Isw doTBhcuutVToNk6V4cRefFNxmrMZz3emZ9M0rm+gJef+u+1UePBuynYA+0/d JhPUS4WxCQ/rf7FP2Qcr/BiiQrVRu96n/7+fx1Sf8jwVeE013zz8//uN6da8 46ThfmtyNBn7n0DvPBdBGuT5Pf0bjb3vYp//HTINfN/p9x3EbpBcdQiUaTC2 4o22YO9Mc2Z0a9Cg2tTrshb2lset/Mp0Gox7C07M4v37doPMSOlmGhg8aBLu xDZ9s7vh8FYapLjlk95j69dVp9zeTwPhJg5eFrby2Ou1Sudo4PfwgyUPdnrA rGhpCA16izbMdeP/jcRhOOkcTYP5zM2Zb7DFJPOKMxJoYOl5pPU09qL+HWvF ZzSILDP/Xov/58DXHbpvX9Lgus7SzrvYU1soMs7vaLDb8XnROeyhfQkdtz7T IIeLHkzGbvOP8VH4TQPZkwENdrhf6AQzCk2nabBRMCZdFTsqbH7xwCINnrrK XZiUw/0g5vTlBCF58K8OLo3DDr/m9JhfQx7sVMaLX+H+pJZjMDhxWB7KZtNg APe7oCdjeuIe8iBdkmz0CLs+/1Gg9kl5+NjG3uuFHfBKWcAjVB62W4cvD+F+ WVMpotGRIg8Mhw163bjfnv7x062yUR7y46T3ZuL+/OHn7Zzeb/LQk5bUao9N HXD8w9EtD+84rS8KYZf/boje+Fse9Is+nT0lhvfn4pvMp0IKYG/ne1xXlIXe yCV1p21RgFuBbN0LOC/4d1o6nSpUgOq3F7Ju4zwSG1W7ql6iAElvpdrWY8vE 81S0VyjA4a4p5XKcX8oN5VpWzQrwospjrAfnm+k+8wXlKQXo+P08gcTJQt5O jLQmPUW4ecTDZj/OxyZvk2+GOYpQXTrtoj5NoG+iFJGR54qgzTnVn4bzuDNv lpH5WhEupnfHiWMPj794IPZJERy7eeEvzm8eP6OAX4OKsMD9nPEK5z09bINc qoYS5GlsXJIdIVB63Lp9i5lKYFT6tFe7h0CUQp+T8Y+UYH2tCIr9QaAbHbkX lPOVQOHgqqb+bgJd1dIpsShTgqf0wqu3uvB5plpndVyXEjhfELjA+Z1ARVzk RTExZQh0+5XJxueVjM2U+ts7lIE92H1jby3O/yLa2bJyZWh/rcvj9ZxAKfwL eturlMFn9PjXrHwCVTj8O9ZQowy1KRZ83c8IRF1I8eluVAY3et75vU8JVMmQ 81zpUgZuy7pO3VwCKVZLuGxaVAbfV5VBtfcJVN/Oa/PKQAWM3R/4x+PzoB7n +NpnWSrwmXIzhxFGIA0uh2Nv01YB11JGXzM+75o7X5EKPK8KBvEbGY9Hmeja accttgFqEHHxn09PrjPR8z1GwD6hDp89zU5Q8P1iPu5HDnvXamjqEhTS+hyD zkUoZ5Rt0YBVQZmymYdikFS9zsqltWtAy+NiGQxEo5ihXdpfhNaCN1U4x+Z0 NNIs4eikr6yFrVuF1d/0R6E/Q1ErVr2akCShdJN5OApN1qdkBfyrBT69oqVP PkSiishSkmqdNnhf0f/the/DxVcK54KfrIMtGco9Z+MiUK8dw2X8ng4MDyVV W5WeR3q+KUZSsbpQ/W/UtMrJcJStF+ntYKgH4oMRcn2kMNTExRFh9EQPZqw/ si8mh6D4qGOfhpTXg6et4+VvasHI7btc27r09fBqZrfRODMQ1fblKW4T14fW bIOwA3/9UcZ+2xrFCH0YJlHfw1E/FHvHxJg5rw+D7MUdPnd9kUCqcGeZ9waQ Oino8m3iDLrjrbE1bmADXLeo8fGUPI0yH1jLkI4YwNYlea/PB72R0dUD1IAv BvCrTsZN8vVxvJ7cHncbQ2DyJy15Fboh1Q9DPZplhmD64OfdmQ4XVHtLb3ve eiNId8/W8OFxRFf2vDvz7rERaCWdbhzz34N+5tObshXocOmb7lq4ZY6y5tTO ZCnR4dfoj0d37MzRMZCSyFShgzV16ui8oDn6VTey66Y6HaZ5o0NT/REaGrhb HbeODlaVF7cTtoAmFEXKzm6iw7Ya82oDDjO0HNv9xOwfOnTZSe11fKmPShvr bEwO0/H9hi/YU1UfRZBfjxq60kF1E1vWK3494ryfpKXrTodzNWezLd30EE/Z jgcqPnQo1jCIfKqojYRmCjL4wujQltD7sv/DKvRpU+Ym7vN0uN9Ze9cuTQVd jrnSsRJBB7OBT/5ZJ5WRqNQJ6lwMHfilztSOrZNHEuuUbgxfpoPDKf7KJ7VS qNFXxHAgng4v39z3/OYrgRKK5778vEqHiINbmpMMRZCMVbNkZyIdqq4u8dMa uFBLfNnTf2/QYTFCM9jfZBFutOTZtqbQIb9O1rWzcRLs5dN/f0mjg0W3fHx7 Uw+Qjl6Ma0ingx7bO0z/ABf8BxywM5w= "]]}}, AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesOrigin->{5., 0}, PlotRange->{{1, 23.612557725848603`}, {0., 4.846575826794863*^7}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{3.4357064390769997`*^9, 3.435706941815*^9, 3.435885620988*^9, 3.4674878481593*^9}] }, Open ]], Cell["\<\ Where is that maximum? Is it in fact at \[Eta]R?\ \>", "Text", CellChangeTimes->{{3.435706466697*^9, 3.4357064815889997`*^9}, { 3.435706543683*^9, 3.435706554959*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"FindRoot", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"f", "'"}], "[", "r", "]"}], "\[Equal]", "0"}], ",", RowBox[{"{", RowBox[{"r", ",", "7"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.435706486079*^9, 3.435706494709*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{"r", "\[Rule]", "6.623536413682785`"}], "}"}]], "Output", CellChangeTimes->{3.4357064951809998`*^9, 3.4358856363529997`*^9, 3.4674878523557*^9}] }, Open ]], Cell["Yup.", "Text", CellChangeTimes->{{3.4674878545709*^9, 3.4674878559749002`*^9}}] }, Open ]] }, Open ]] }, Open ]] }, ScreenStyleEnvironment->"Presentation", WindowSize->{1008, 647}, WindowMargins->{{0, Automatic}, {Automatic, 0}}, ShowSelection->True, FrontEndVersion->"7.0 for Microsoft Windows (32-bit) (February 18, 2009)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[567, 22, 138, 1, 61, "Subsubtitle"], Cell[CellGroupData[{ Cell[730, 27, 127, 1, 106, "Section"], Cell[860, 30, 866, 15, 367, "Text"], Cell[1729, 47, 161, 2, 47, "Text"], Cell[CellGroupData[{ Cell[1915, 53, 313, 9, 50, "Input"], Cell[2231, 64, 366, 9, 50, "Output"] }, Open ]], Cell[2612, 76, 104, 1, 47, "Text"], Cell[CellGroupData[{ Cell[2741, 81, 437, 10, 50, "Input"], Cell[3181, 93, 374, 8, 50, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[3592, 106, 345, 9, 50, "Input"], Cell[3940, 117, 7692, 131, 238, "Output"] }, Open ]], Cell[11647, 251, 105, 1, 47, "Text"], Cell[CellGroupData[{ Cell[11777, 256, 206, 5, 50, "Input"], Cell[11986, 263, 617, 18, 52, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[12640, 286, 229, 5, 50, "Input"], Cell[12872, 293, 312, 7, 69, "Output"] }, Open ]], Cell[13199, 303, 118, 1, 47, "Text"], Cell[CellGroupData[{ Cell[13342, 308, 218, 6, 50, "Input"], Cell[13563, 316, 1054, 31, 71, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[14654, 352, 157, 3, 50, "Input"], Cell[14814, 357, 411, 11, 71, "Output"] }, Open ]], Cell[15240, 371, 166, 4, 47, "Text"], Cell[CellGroupData[{ Cell[15431, 379, 190, 4, 50, "Input"], Cell[15624, 385, 446, 12, 96, "Output"] }, Open ]], Cell[16085, 400, 109, 1, 47, "Text"], Cell[CellGroupData[{ Cell[16219, 405, 189, 4, 50, "Input"], Cell[16411, 411, 535, 15, 123, "Output"] }, Open ]], Cell[16961, 429, 157, 3, 47, "Text"], Cell[CellGroupData[{ Cell[17143, 436, 518, 11, 50, "Input"], Cell[17664, 449, 396, 9, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[18097, 463, 336, 10, 50, "Input"], Cell[18436, 475, 958, 26, 75, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[19431, 506, 115, 2, 50, "Input"], Cell[19549, 510, 753, 20, 75, "Output"] }, Open ]], Cell[20317, 533, 181, 4, 47, "Text"], Cell[CellGroupData[{ Cell[20523, 541, 289, 7, 50, "Input"], Cell[20815, 550, 135, 2, 50, "Output"] }, Open ]], Cell[20965, 555, 366, 8, 111, "Text"], Cell[CellGroupData[{ Cell[21356, 567, 297, 7, 50, "Input"], Cell[21656, 576, 117, 2, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[21810, 583, 685, 19, 85, "Input"], Cell[22498, 604, 622, 18, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[23157, 627, 257, 7, 50, "Input"], Cell[23417, 636, 414, 12, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[23868, 653, 322, 9, 50, "Input"], Cell[24193, 664, 14415, 243, 273, "Output"] }, Open ]], Cell[38623, 910, 220, 5, 79, "Text"], Cell[CellGroupData[{ Cell[38868, 919, 302, 8, 50, "Input"], Cell[39173, 929, 256, 5, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[39466, 939, 135, 3, 50, "Input"], Cell[39604, 944, 201, 3, 73, "Output"] }, Open ]], Cell[39820, 950, 149, 3, 47, "Text"], Cell[CellGroupData[{ Cell[39994, 957, 725, 19, 85, "Input"], Cell[40722, 978, 580, 17, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[41339, 1000, 301, 8, 50, "Input"], Cell[41643, 1010, 349, 11, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[42029, 1026, 279, 8, 50, "Input"], Cell[42311, 1036, 12853, 217, 265, "Output"] }, Open ]], Cell[55179, 1256, 239, 5, 79, "Text"], Cell[CellGroupData[{ Cell[55443, 1265, 396, 12, 50, "Input"], Cell[55842, 1279, 231, 4, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[56110, 1288, 239, 6, 50, "Input"], Cell[56352, 1296, 1137, 24, 270, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[57526, 1325, 713, 21, 119, "Input"], Cell[58242, 1348, 2251, 47, 351, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[60542, 1401, 276, 3, 106, "Section"], Cell[60821, 1406, 573, 10, 207, "Text"], Cell[CellGroupData[{ Cell[61419, 1420, 616, 17, 50, "Input"], Cell[62038, 1439, 575, 15, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[62650, 1459, 380, 9, 50, "Input"], Cell[63033, 1470, 535, 13, 95, "Output"] }, Open ]], Cell[63583, 1486, 151, 3, 47, "Text"], Cell[CellGroupData[{ Cell[63759, 1493, 116, 3, 50, "Input"], Cell[63878, 1498, 449, 10, 96, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[64364, 1513, 1013, 28, 153, "Input"], Cell[65380, 1543, 674, 16, 101, "Output"] }, Open ]], Cell[66069, 1562, 120, 1, 47, "Text"], Cell[CellGroupData[{ Cell[66214, 1567, 188, 4, 50, "Input"], Cell[66405, 1573, 725, 19, 105, "Output"] }, Open ]], Cell[67145, 1595, 209, 4, 47, "Text"], Cell[CellGroupData[{ Cell[67379, 1603, 423, 12, 50, "Input"], Cell[67805, 1617, 448, 10, 96, "Output"] }, Open ]], Cell[68268, 1630, 94, 1, 47, "Text"], Cell[CellGroupData[{ Cell[68387, 1635, 631, 17, 85, "Input"], Cell[69021, 1654, 526, 13, 107, "Output"] }, Open ]], Cell[69562, 1670, 117, 1, 47, "Text"], Cell[CellGroupData[{ Cell[69704, 1675, 271, 7, 50, "Input"], Cell[69978, 1684, 399, 9, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[70414, 1698, 423, 11, 50, "Input"], Cell[70840, 1711, 2498, 47, 274, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[73375, 1763, 324, 8, 50, "Input"], Cell[73702, 1773, 3438, 63, 274, "Output"] }, Open ]], Cell[77155, 1839, 266, 5, 47, "Text"], Cell[CellGroupData[{ Cell[77446, 1848, 649, 16, 50, "Input"], Cell[78098, 1866, 453, 11, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[78588, 1882, 428, 10, 50, "Input"], Cell[79019, 1894, 455, 10, 94, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[79511, 1909, 977, 28, 153, "Input"], Cell[80491, 1939, 589, 16, 105, "Output"] }, Open ]], Cell[81095, 1958, 192, 4, 47, "Text"], Cell[CellGroupData[{ Cell[81312, 1966, 408, 11, 50, "Input"], Cell[81723, 1979, 436, 12, 95, "Output"] }, Open ]], Cell[82174, 1994, 169, 2, 47, "Text"], Cell[CellGroupData[{ Cell[82368, 2000, 874, 21, 119, "Input"], Cell[83245, 2023, 1821, 54, 179, "Output"] }, Open ]], Cell[85081, 2080, 275, 6, 47, "Text"], Cell[CellGroupData[{ Cell[85381, 2090, 184, 4, 50, "Input"], Cell[85568, 2096, 853, 25, 106, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[86458, 2126, 242, 7, 50, "Input"], Cell[86703, 2135, 440, 13, 108, "Output"] }, Open ]], Cell[87158, 2151, 107, 1, 47, "Text"], Cell[CellGroupData[{ Cell[87290, 2156, 326, 8, 50, "Input"], Cell[87619, 2166, 563, 18, 110, "Output"] }, Open ]], Cell[88197, 2187, 256, 5, 79, "Text"], Cell[CellGroupData[{ Cell[88478, 2196, 699, 21, 85, "Input"], Cell[89180, 2219, 4122, 74, 284, "Output"] }, Open ]], Cell[93317, 2296, 177, 4, 47, "Text"], Cell[CellGroupData[{ Cell[93519, 2304, 517, 16, 85, "Input"], Cell[94039, 2322, 6122, 106, 262, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[100210, 2434, 367, 5, 106, "Section"], Cell[100580, 2441, 535, 10, 175, "Text"], Cell[101118, 2453, 292, 6, 111, "Text"], Cell[CellGroupData[{ Cell[101435, 2463, 361, 9, 50, "Input"], Cell[101799, 2474, 313, 8, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[102149, 2487, 494, 14, 50, "Input"], Cell[102646, 2503, 276, 7, 111, "Output"] }, Open ]], Cell[102937, 2513, 128, 1, 47, "Text"], Cell[CellGroupData[{ Cell[103090, 2518, 259, 7, 50, "Input"], Cell[103352, 2527, 226, 5, 100, "Output"] }, Open ]], Cell[103593, 2535, 2560, 70, 187, "Input"], Cell[CellGroupData[{ Cell[106178, 2609, 491, 10, 50, "Input"], Cell[106672, 2621, 2254, 45, 497, "Output"] }, Open ]], Cell[108941, 2669, 486, 10, 143, "Text"], Cell[CellGroupData[{ Cell[109452, 2683, 221, 5, 50, "Input"], Cell[109676, 2690, 207, 4, 95, "Output"] }, Open ]], Cell[109898, 2697, 162, 3, 47, "Text"], Cell[CellGroupData[{ Cell[110085, 2704, 201, 4, 50, "Input"], Cell[110289, 2710, 280, 7, 95, "Output"] }, Open ]], Cell[110584, 2720, 101, 1, 47, "Text"], Cell[CellGroupData[{ Cell[110710, 2725, 246, 5, 50, "Input"], Cell[110959, 2732, 296, 7, 95, "Output"] }, Open ]], Cell[111270, 2742, 109, 1, 47, "Text"], Cell[CellGroupData[{ Cell[111404, 2747, 647, 18, 85, "Input"], Cell[112054, 2767, 1297, 40, 172, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[113388, 2812, 309, 9, 50, "Input"], Cell[113700, 2823, 7911, 137, 276, 3803, 68, "CachedBoxData", "BoxData", \ "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[121660, 2966, 351, 4, 106, "Section"], Cell[122014, 2972, 332, 6, 143, "Text"], Cell[122349, 2980, 746, 14, 335, "Text"], Cell[123098, 2996, 312, 8, 50, "Input"], Cell[123413, 3006, 610, 11, 271, "Text"], Cell[CellGroupData[{ Cell[124048, 3021, 279, 7, 50, "Input"], Cell[124330, 3030, 230, 5, 95, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[124597, 3040, 271, 7, 50, "Input"], Cell[124871, 3049, 231, 5, 95, "Output"] }, Open ]], Cell[125117, 3057, 143, 3, 47, "Text"], Cell[CellGroupData[{ Cell[125285, 3064, 380, 11, 50, "Input"], Cell[125668, 3077, 437, 12, 95, "Output"] }, Open ]], Cell[126120, 3092, 137, 1, 47, "Text"], Cell[CellGroupData[{ Cell[126282, 3097, 193, 4, 50, "Input"], Cell[126478, 3103, 753, 23, 119, "Output"] }, Open ]], Cell[127246, 3129, 96, 1, 47, "Text"], Cell[CellGroupData[{ Cell[127367, 3134, 300, 8, 50, "Input"], Cell[127670, 3144, 268, 7, 119, "Output"] }, Open ]], Cell[127953, 3154, 100, 1, 47, "Text"], Cell[CellGroupData[{ Cell[128078, 3159, 222, 5, 50, "Input"], Cell[128303, 3166, 259, 7, 111, "Output"] }, Open ]], Cell[128577, 3176, 226, 5, 111, "Text"], Cell[128806, 3183, 143, 2, 50, "Input"], Cell[CellGroupData[{ Cell[128974, 3189, 329, 8, 50, "Input"], Cell[129306, 3199, 212, 5, 98, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[129555, 3209, 516, 13, 85, "Input"], Cell[130074, 3224, 288, 7, 115, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[130399, 3236, 184, 4, 50, "Input"], Cell[130586, 3242, 177, 3, 73, "Output"] }, Open ]], Cell[130778, 3248, 491, 8, 111, "Text"], Cell[CellGroupData[{ Cell[131294, 3260, 668, 18, 50, "Input"], Cell[131965, 3280, 449, 11, 95, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[132451, 3296, 159, 3, 50, "Input"], Cell[132613, 3301, 634, 20, 119, "Output"] }, Open ]], Cell[133262, 3324, 213, 4, 47, "Text"], Cell[133478, 3330, 497, 13, 50, "Input"], Cell[CellGroupData[{ Cell[134000, 3347, 151, 3, 50, "Input"], Cell[134154, 3352, 156, 3, 95, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[134347, 3360, 207, 5, 50, "Input"], Cell[134557, 3367, 202, 4, 101, "Output"] }, Open ]], Cell[134774, 3374, 519, 15, 50, "Input"], Cell[135296, 3391, 542, 16, 50, "Input"], Cell[CellGroupData[{ Cell[135863, 3411, 222, 4, 50, "Input"], Cell[136088, 3417, 18942, 317, 403, "Output"] }, Open ]], Cell[155045, 3737, 1158, 34, 153, "Input"], Cell[CellGroupData[{ Cell[156228, 3775, 821, 22, 119, "Input"], Cell[157052, 3799, 2197, 45, 470, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[159298, 3850, 259, 3, 106, "Section"], Cell[159560, 3855, 438, 8, 111, "Text"], Cell[160001, 3865, 188, 4, 79, "Text"], Cell[CellGroupData[{ Cell[160214, 3873, 427, 12, 50, "Input"], Cell[160644, 3887, 268, 7, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[160949, 3899, 823, 25, 85, "Input"], Cell[161775, 3926, 445, 13, 100, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[162257, 3944, 251, 7, 50, "Input"], Cell[162511, 3953, 561, 17, 95, "Output"] }, Open ]], Cell[163087, 3973, 335, 6, 143, "Text"], Cell[163425, 3981, 243, 6, 79, "Text"], Cell[CellGroupData[{ Cell[163693, 3991, 340, 10, 50, "Input"], Cell[164036, 4003, 183, 3, 91, "Output"] }, Open ]], Cell[164234, 4009, 227, 4, 47, "Text"], Cell[CellGroupData[{ Cell[164486, 4017, 156, 3, 50, "Input"], Cell[164645, 4022, 203, 4, 95, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[164885, 4031, 185, 4, 50, "Input"], Cell[165073, 4037, 195, 5, 95, "Output"] }, Open ]], Cell[165283, 4045, 204, 4, 47, "Text"], Cell[CellGroupData[{ Cell[165512, 4053, 194, 4, 50, "Input"], Cell[165709, 4059, 165, 2, 73, "Output"] }, Open ]], Cell[165889, 4064, 285, 6, 111, "Text"], Cell[CellGroupData[{ Cell[166199, 4074, 377, 9, 50, "Input"], Cell[166579, 4085, 259, 6, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[166875, 4096, 879, 26, 85, "Input"], Cell[167757, 4124, 456, 13, 100, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[168250, 4142, 341, 9, 50, "Input"], Cell[168594, 4153, 735, 22, 152, "Output"] }, Open ]], Cell[169344, 4178, 259, 6, 111, "Text"], Cell[CellGroupData[{ Cell[169628, 4188, 331, 9, 50, "Input"], Cell[169962, 4199, 204, 4, 95, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[170203, 4208, 293, 8, 50, "Input"], Cell[170499, 4218, 175, 4, 91, "Output"] }, Open ]], Cell[170689, 4225, 126, 1, 47, "Text"], Cell[CellGroupData[{ Cell[170840, 4230, 97, 1, 63, "Subsection"], Cell[170940, 4233, 284, 5, 79, "Text"], Cell[171227, 4240, 220, 4, 79, "Text"], Cell[CellGroupData[{ Cell[171472, 4248, 389, 9, 50, "Input"], Cell[171864, 4259, 399, 9, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[172300, 4273, 376, 9, 50, "Input"], Cell[172679, 4284, 365, 9, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[173081, 4298, 547, 16, 50, "Input"], Cell[173631, 4316, 360, 11, 100, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[174028, 4332, 279, 7, 50, "Input"], Cell[174310, 4341, 727, 13, 46, "Message"], Cell[175040, 4356, 3112, 103, 405, "Output"] }, Open ]], Cell[178167, 4462, 618, 12, 239, "Text"], Cell[178788, 4476, 128, 1, 47, "Text"], Cell[CellGroupData[{ Cell[178941, 4481, 451, 10, 50, "Input"], Cell[179395, 4493, 396, 9, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[179828, 4507, 431, 10, 50, "Input"], Cell[180262, 4519, 380, 9, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[180679, 4533, 619, 17, 50, "Input"], Cell[181301, 4552, 468, 13, 100, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[181806, 4570, 350, 9, 50, "Input"], Cell[182159, 4581, 744, 13, 46, "Message"], Cell[182906, 4596, 4253, 135, 569, "Output"] }, Open ]], Cell[187174, 4734, 253, 5, 79, "Text"], Cell[187430, 4741, 89, 1, 47, "Text"], Cell[CellGroupData[{ Cell[187544, 4746, 545, 16, 50, "Input"], Cell[188092, 4764, 1013, 29, 128, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[189142, 4798, 503, 15, 50, "Input"], Cell[189648, 4815, 1035, 30, 130, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[190720, 4850, 647, 17, 73, "Input"], Cell[191370, 4869, 1049, 30, 128, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[192456, 4904, 609, 16, 73, "Input"], Cell[193068, 4922, 1018, 29, 130, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[194123, 4956, 289, 7, 73, "Input"], Cell[194415, 4965, 246, 6, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[194698, 4976, 1149, 35, 176, "Input"], Cell[195850, 5013, 2266, 47, 367, "Output"] }, Open ]], Cell[198131, 5063, 141, 3, 47, "Text"], Cell[CellGroupData[{ Cell[198297, 5070, 2695, 74, 312, "Input"], Cell[200995, 5146, 2445, 53, 837, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[203489, 5205, 143, 2, 63, "Subsection"], Cell[203635, 5209, 176, 4, 47, "Text"], Cell[CellGroupData[{ Cell[203836, 5217, 207, 5, 73, "Input"], Cell[204046, 5224, 184, 4, 73, "Output"] }, Open ]], Cell[204245, 5231, 222, 5, 47, "Text"], Cell[CellGroupData[{ Cell[204492, 5240, 559, 16, 73, "Input"], Cell[205054, 5258, 579, 17, 73, "Output"] }, Open ]], Cell[205648, 5278, 144, 3, 47, "Text"], Cell[CellGroupData[{ Cell[205817, 5285, 469, 13, 73, "Input"], Cell[206289, 5300, 586, 17, 119, "Output"] }, Open ]], Cell[206890, 5320, 141, 1, 47, "Text"], Cell[CellGroupData[{ Cell[207056, 5325, 409, 13, 73, "Input"], Cell[207468, 5340, 351, 9, 75, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[207856, 5354, 115, 2, 73, "Input"], Cell[207974, 5358, 382, 10, 106, "Output"] }, Open ]], Cell[208371, 5371, 210, 4, 79, "Text"], Cell[CellGroupData[{ Cell[208606, 5379, 261, 7, 73, "Input"], Cell[208870, 5388, 324, 10, 114, "Output"] }, Open ]], Cell[209209, 5401, 107, 2, 73, "Input"], Cell[CellGroupData[{ Cell[209341, 5407, 288, 8, 73, "Input"], Cell[209632, 5417, 357, 8, 102, "Output"] }, Open ]], Cell[210004, 5428, 218, 5, 47, "Text"], Cell[CellGroupData[{ Cell[210247, 5437, 575, 18, 73, "Input"], Cell[210825, 5457, 380, 10, 95, "Output"] }, Open ]], Cell[211220, 5470, 79, 1, 47, "Text"], Cell[CellGroupData[{ Cell[211324, 5475, 444, 14, 73, "Input"], Cell[211771, 5491, 435, 12, 104, "Output"] }, Open ]], Cell[212221, 5506, 273, 5, 111, "Text"], Cell[CellGroupData[{ Cell[212519, 5515, 506, 14, 108, "Input"], Cell[213028, 5531, 450, 12, 96, "Output"] }, Open ]], Cell[213493, 5546, 242, 5, 111, "Text"], Cell[CellGroupData[{ Cell[213760, 5555, 271, 6, 73, "Input"], Cell[214034, 5563, 1166, 34, 164, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[215237, 5602, 177, 3, 73, "Input"], Cell[215417, 5607, 117, 2, 73, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[215583, 5615, 113, 1, 63, "Subsection"], Cell[215699, 5618, 641, 11, 175, "Text"], Cell[216343, 5631, 118, 1, 47, "Text"], Cell[CellGroupData[{ Cell[216486, 5636, 248, 6, 73, "Input"], Cell[216737, 5644, 223, 5, 95, "Output"] }, Open ]], Cell[216975, 5652, 330, 7, 111, "Text"], Cell[CellGroupData[{ Cell[217330, 5663, 371, 10, 73, "Input"], Cell[217704, 5675, 434, 12, 102, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[218175, 5692, 167, 4, 73, "Input"], Cell[218345, 5698, 1794, 56, 186, "Output"] }, Open ]], Cell[220154, 5757, 325, 6, 79, "Text"], Cell[CellGroupData[{ Cell[220504, 5767, 331, 9, 73, "Input"], Cell[220838, 5778, 298, 6, 97, "Output"] }, Open ]], Cell[221151, 5787, 149, 3, 47, "Text"], Cell[221303, 5792, 143, 2, 73, "Input"], Cell[221449, 5796, 105, 1, 47, "Text"], Cell[CellGroupData[{ Cell[221579, 5801, 107, 1, 73, "Input"], Cell[221689, 5804, 268, 6, 106, "Output"] }, Open ]], Cell[221972, 5813, 84, 1, 47, "Text"], Cell[CellGroupData[{ Cell[222081, 5818, 97, 1, 73, "Input"], Cell[222181, 5821, 164, 3, 73, "Output"] }, Open ]], Cell[222360, 5827, 131, 1, 47, "Text"], Cell[CellGroupData[{ Cell[222516, 5832, 357, 9, 73, "Input"], Cell[222876, 5843, 245, 5, 98, "Output"] }, Open ]], Cell[223136, 5851, 145, 2, 47, "Text"], Cell[CellGroupData[{ Cell[223306, 5857, 603, 14, 108, "Input"], Cell[223912, 5873, 649, 17, 169, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[224598, 5895, 227, 4, 73, "Input"], Cell[224828, 5901, 341, 7, 105, "Output"] }, Open ]], Cell[225184, 5911, 179, 6, 47, "Text"], Cell[CellGroupData[{ Cell[225388, 5921, 300, 7, 73, "Input"], Cell[225691, 5930, 293, 7, 98, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[226021, 5942, 323, 6, 73, "Input"], Cell[226347, 5950, 150, 2, 73, "Output"] }, Open ]], Cell[226512, 5955, 175, 4, 47, "Text"], Cell[CellGroupData[{ Cell[226712, 5963, 226, 6, 73, "Input"], Cell[226941, 5971, 149, 2, 73, "Output"] }, Open ]], Cell[227105, 5976, 810, 14, 239, "Text"], Cell[CellGroupData[{ Cell[227940, 5994, 269, 6, 73, "Input"], Cell[228212, 6002, 245, 7, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[228494, 6014, 253, 7, 73, "Input"], Cell[228750, 6023, 296, 8, 95, "Output"] }, Open ]], Cell[229061, 6034, 532, 11, 207, "Text"], Cell[CellGroupData[{ Cell[229618, 6049, 350, 9, 73, "Input"], Cell[229971, 6060, 1099, 30, 149, "Output"] }, Open ]], Cell[231085, 6093, 83, 1, 47, "Text"], Cell[CellGroupData[{ Cell[231193, 6098, 638, 15, 73, "Input"], Cell[231834, 6115, 510, 12, 101, "Output"] }, Open ]], Cell[232359, 6130, 162, 3, 47, "Text"], Cell[232524, 6135, 108, 2, 73, "Input"], Cell[CellGroupData[{ Cell[232657, 6141, 310, 8, 73, "Input"], Cell[232970, 6151, 902, 27, 101, "Output"] }, Open ]], Cell[233887, 6181, 112, 1, 47, "Text"], Cell[CellGroupData[{ Cell[234024, 6186, 348, 9, 73, "Input"], Cell[234375, 6197, 854, 22, 105, "Output"] }, Open ]], Cell[235244, 6222, 426, 8, 207, "Text"], Cell[CellGroupData[{ Cell[235695, 6234, 534, 15, 79, "Input"], Cell[236232, 6251, 523, 14, 78, "Output"] }, Open ]], Cell[236770, 6268, 229, 5, 47, "Text"], Cell[CellGroupData[{ Cell[237024, 6277, 119, 2, 73, "Input"], Cell[237146, 6281, 535, 15, 78, "Output"] }, Open ]], Cell[237696, 6299, 194, 4, 47, "Text"], Cell[CellGroupData[{ Cell[237915, 6307, 278, 6, 73, "Input"], Cell[238196, 6315, 1345, 40, 199, "Output"] }, Open ]], Cell[239556, 6358, 169, 4, 79, "Text"], Cell[CellGroupData[{ Cell[239750, 6366, 362, 9, 73, "Input"], Cell[240115, 6377, 737, 18, 216, "Output"] }, Open ]], Cell[240867, 6398, 114, 1, 47, "Text"], Cell[CellGroupData[{ Cell[241006, 6403, 560, 14, 108, "Input"], Cell[241569, 6419, 224, 3, 73, "Output"] }, Open ]], Cell[241808, 6425, 81, 1, 47, "Text"], Cell[241892, 6428, 425, 8, 143, "Text"], Cell[242320, 6438, 392, 7, 111, "Text"], Cell[CellGroupData[{ Cell[242737, 6449, 228, 4, 73, "Input"], Cell[242968, 6455, 173, 3, 73, "Output"] }, Open ]], Cell[243156, 6461, 193, 3, 47, "Text"], Cell[CellGroupData[{ Cell[243374, 6468, 536, 13, 73, "Input"], Cell[243913, 6483, 1229, 34, 173, "Output"] }, Open ]], Cell[245157, 6520, 146, 3, 47, "Text"], Cell[CellGroupData[{ Cell[245328, 6527, 448, 12, 73, "Input"], Cell[245779, 6541, 551, 14, 102, "Output"] }, Open ]], Cell[246345, 6558, 165, 3, 47, "Text"], Cell[CellGroupData[{ Cell[246535, 6565, 595, 16, 108, "Input"], Cell[247133, 6583, 880, 22, 105, "Output"] }, Open ]], Cell[248028, 6608, 208, 5, 47, "Text"], Cell[CellGroupData[{ Cell[248261, 6617, 247, 6, 73, "Input"], Cell[248511, 6625, 119, 2, 73, "Output"] }, Open ]], Cell[248645, 6630, 172, 2, 47, "Text"], Cell[CellGroupData[{ Cell[248842, 6636, 520, 15, 73, "Input"], Cell[249365, 6653, 738, 20, 105, "Output"] }, Open ]], Cell[250118, 6676, 226, 5, 47, "Text"], Cell[CellGroupData[{ Cell[250369, 6685, 567, 13, 73, "Input"], Cell[250939, 6700, 807, 21, 137, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[251783, 6726, 686, 17, 108, "Input"], Cell[252472, 6745, 664, 17, 99, "Output"] }, Open ]], Cell[253151, 6765, 139, 1, 47, "Text"], Cell[CellGroupData[{ Cell[253315, 6770, 265, 7, 73, "Input"], Cell[253583, 6779, 491, 14, 95, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[254111, 6798, 293, 7, 73, "Input"], Cell[254407, 6807, 7275, 125, 279, "Output"] }, Open ]], Cell[261697, 6935, 180, 4, 47, "Text"], Cell[CellGroupData[{ Cell[261902, 6943, 275, 8, 73, "Input"], Cell[262180, 6953, 187, 4, 73, "Output"] }, Open ]], Cell[262382, 6960, 86, 1, 47, "Text"] }, Open ]] }, Open ]] }, Open ]] } ] *) (* End of internal cache information *)