(* 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[ 28242, 850] NotebookOptionsPosition[ 25366, 750] NotebookOutlinePosition[ 25809, 767] CellTagsIndexPosition[ 25766, 764] WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Morin 3.53", "Section", CellChangeTimes->{{3.4969958322046003`*^9, 3.4969958342036*^9}}], Cell["\<\ Morin 3.53 asks us to fire a projectile with intial speed v0 at angle \ \[Theta], including the effects both of gravity and of air resistance, and to \ find the angle \[Theta] which makes the peak height occur as far as possible \ downrange. To start, we find the motion for the given initial conditions.\ \>", "Text", CellChangeTimes->{{3.433851572436*^9, 3.433851574736*^9}, {3.433851680567*^9, 3.4338517209230003`*^9}, {3.4969937386605997`*^9, 3.4969938080962*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"sx", "=", RowBox[{ RowBox[{"DSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{"x", "''"}], "[", "t", "]"}], "\[Equal]", " ", RowBox[{ RowBox[{"-", " ", "\[Alpha]"}], " ", RowBox[{ RowBox[{"x", "'"}], "[", "t", "]"}]}]}], ",", " ", RowBox[{ RowBox[{ RowBox[{"x", "'"}], "[", "0", "]"}], "\[Equal]", " ", RowBox[{"v0", " ", RowBox[{"Cos", "[", "\[Theta]", "]"}]}]}], ",", RowBox[{ RowBox[{"x", "[", "0", "]"}], "\[Equal]", "0"}]}], "}"}], ",", RowBox[{"x", "[", "t", "]"}], ",", "t"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.433851722801*^9, 3.433851770166*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"x", "[", "t", "]"}], "\[Rule]", FractionBox[ RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{ RowBox[{"-", "t"}], " ", "\[Alpha]"}]], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", SuperscriptBox["\[ExponentialE]", RowBox[{"t", " ", "\[Alpha]"}]]}], ")"}], " ", "v0", " ", RowBox[{"Cos", "[", "\[Theta]", "]"}]}], "\[Alpha]"]}], "}"}]], "Output", CellChangeTimes->{3.4969959085776*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"sy", "=", RowBox[{ RowBox[{"DSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "''"}], "[", "t", "]"}], "\[Equal]", " ", RowBox[{ RowBox[{ RowBox[{"-", " ", "\[Alpha]"}], " ", RowBox[{ RowBox[{"y", "'"}], "[", "t", "]"}]}], " ", "-", "g"}]}], ",", " ", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "0", "]"}], "\[Equal]", " ", RowBox[{"v0", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}]}], ",", RowBox[{ RowBox[{"y", "[", "0", "]"}], "\[Equal]", "0"}]}], "}"}], ",", RowBox[{"y", "[", "t", "]"}], ",", "t"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.433851722801*^9, 3.433851805432*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"y", "[", "t", "]"}], "\[Rule]", RowBox[{"-", FractionBox[ RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{ RowBox[{"-", "t"}], " ", "\[Alpha]"}]], " ", RowBox[{"(", RowBox[{"g", "-", RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"t", " ", "\[Alpha]"}]], " ", "g"}], "+", RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"t", " ", "\[Alpha]"}]], " ", "g", " ", "t", " ", "\[Alpha]"}], "+", RowBox[{"v0", " ", "\[Alpha]", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}], "-", RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"t", " ", "\[Alpha]"}]], " ", "v0", " ", "\[Alpha]", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}]}], ")"}]}], SuperscriptBox["\[Alpha]", "2"]]}]}], "}"}]], "Output", CellChangeTimes->{3.4969959105945997`*^9}] }, Open ]], Cell["\<\ Let's pick some numerical values for illustration, and draw the trajectory. \ Let's use a \"rule\" to do this:\ \>", "Text", CellChangeTimes->{{3.433852016212*^9, 3.433852072835*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"params", " ", "=", " ", RowBox[{"{", RowBox[{ RowBox[{"g", "\[Rule]", "9.8"}], ",", RowBox[{"v0", "\[Rule]", "50"}], ",", RowBox[{"\[Alpha]", "\[Rule]", ".1"}], ",", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"\[Pi]", "/", "3"}]}]}], "}"}]}]], "Input", CellChangeTimes->{{3.4338520478789997`*^9, 3.4338520959700003`*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"g", "\[Rule]", "9.8`"}], ",", RowBox[{"v0", "\[Rule]", "50"}], ",", RowBox[{"\[Alpha]", "\[Rule]", "0.1`"}], ",", RowBox[{"\[Theta]", "\[Rule]", FractionBox["\[Pi]", "3"]}]}], "}"}]], "Output", CellChangeTimes->{3.4969959127516003`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"ParametricPlot", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"x", "[", "t", "]"}], "/.", "sx"}], ",", RowBox[{ RowBox[{"y", "[", "t", "]"}], "/.", "sy"}]}], "}"}], "/.", "params"}], ",", " ", RowBox[{"{", RowBox[{"t", ",", "0", ",", "7.7"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.433852099454*^9, 3.433852163902*^9}, { 3.4969938390778*^9, 3.4969938436954*^9}}], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.67, 0.6, 0.6], LineBox[CompressedData[" 1:eJxd13k4Vd0XB3BKinRDKRQREUoZCglfZMp0zzn3XmO6pJBEKnnNKZWpwVSK ColMpTmZMxQNiOaXlErGpJG3+u3+/d1/7vN57rOfffba66y1rqJXIL15ioCA gISggMDf7///2E/d6BhuUGbSLjeULa5RYfLjbE3wMf1qk4HtJTfCl7aYeDg3 dVWtfmjyIUvSkFZ6YfJGvVtsvk63ScEBZq+AzIDJUOZT41aNEROuRaaol9CE yb76r2Vr5H6byEc2Tjd4KYJpaRKFqwRYUHvl5rc6Xgbi0qr3NaYsQkcmW4rp U4OHV/xis1cq4I++j7lWpY2ntc+Mbn9bjpD9uHhVTh8+IwYSHk3a0FnycP7L U0bg7/e3DDBbjf51Bx/JrTaFcYnajT8/DTAy/HO6UIE5Tl9YtW7BMSNM5qr9 auu1gFOrpEfaduBR27DTjTYrVJ1Luj5HywzBy6bLitfZQL7joK3YI3PIVyrX qvvbwu7LyJ4WDwucVB98Gj1gB8s0vTkPRazgFKKuGu3tAIOiaNeZKdZQvPl7 RCXXEdtGBrWP6q7H9fVRMwK3slGVK6/+4K4t2Cvdak1H2HiTISf809AeezyV HSqdKSQ7xovpmdnD4JRoqo8rBRWp1qJd1vbw0Ewpl3Cn4Do6WDbCsYe6Qke4 10YKnNf8J/8G2KNWWdPq22YKk5bChYVn7GGsL9vyPpiCcFJW3KcpDpiqmy08 lEjBeW9Q3vq7Dih3mx2XWEHBZvCStPBDBySmOOs9uU3hu+cF3brHDvhnPT28 qIpC5opn/NU9Dniel+Z9qYbCqENjwsJvDihMnRLb2EChNidL7ZmSI/wkhuNq H1LQ91W5JRbtiMoBabmJXgqf0T+7ar8j5qnLb1ryloI8dzYrIMERB7hVZY59 FKpqcgXupzvixUZhp5z35Lxhu2viShxhfCJgWH+QwgQdU9j/3BEFRq+NDb5Q eBDYp7Jalo2tk7ndUdNo+Nc1rLSQY0N9XzOVI0zj4Pdp0zkKbASkq+bUT6fx uPSm9A4VNrqtP3QKitLQjzJuL9RmQ3Z5dEowi8a7Bw2ZLFs29Du7Q+Tm05Dw +efslXA2qJiErZmqNI69EzGqjGLjmb5dwvGlNP6r8TnfsJeNoYSyQ2lqNM7O yOzpPMjGQpscxUQNGlvcVw59TmXjihC3aesKmuSn8o4lJWyckTw7OL6axnyZ clPvV2yYRj9V17SgEcFtDHXuYUO1NMFeyJKGTdSHKLs3bHw0yHR7TtwHrx86 /WwYscTXxFjTsNdKOCvwhZzvqsuUOlsaAna+d4/OJHG/LdjGommkSe1JSlpD wVrt8KuXG2i06/sWhxlRGBi3Sj7iQfY3v5/pCwqxL45rmG2k4Xv6Z5+5Jbmn aaZa5/g01vFNV/2gKLC7L3i5baKxtd+81smPQvYc14AMXxp18oIZn49TOEQv PG0STNa/UK0uPEkhS+iFbzPxIX/vSo9sClMtLlk67KRRtFzNsCWXQldBj6HL Lhoe05aanSkleWn9YpZ3CA1HRa1Q0zsUFC9Vu9uH0dBL65vytZGC+7cbG5uI X1g/2VR4l8J187IQ43AaU5KjClkkz16Pt7zWiKARLq5m9PwZhYgwpmAyksRL QDZjywgFXttc0cC9NFJbeuLmj1F4V5/APCc2XyBmd3ecgp5Lb7lZLI3TG3Ld 1H5S6DXwK5XcR6OjfOahj1Np0At25BTspyGye6q0lwwNU7F78fkHyf02eQSK L6SxQWhUVfAQjZVV1tnV8jRUPZ+9dCP2yu6IkFWmoftyeRwrnsbQCiHbNk0a wTmBPb4JNHLdWSq662i4LC+qHkuiYbZozz8yViTuCydXWiTTsK5xyvptQ8NZ 5/fR48T1dsnsu440gkq9ZA0O09h9YPFOFzcah51OcQKP0KiUzzMzIvfqMG/X 6griyJ9XexU8aZyMOywsdJTGd+XMwx+2kP2V2nakEdOsyrxgck8rXoWHFB6j gZBFnzi7aRw573R/gDgodLmYXijZ10NIYlkKyc9x7pUJEtcKBWmfYmKKrVUd Tc4l7S1nnZ1Ko9Cp627MWRraL4yH7dNpWJ3bIMHPoxE7O14/mnhM8o6ayXka G+/X7bxILD+m1fJfMXkOWcsKsQya1K/v93bfoPFxV1J8BbHe9rpjTAWNBHcj 3tu/dtirplVFI2Op/5yZx2lcPvHp7mA9DY0D+zc6Efc5v2v2eEjiWHsGb4lj wm7NNmynYbRWLXXqCRqLJLJV53fSmCyrerKYeEz9TPPD5ySP/R20PIi3fLnj WPSKnHPZduswYs8aocK4HpIn7T3sdGKtvvd3Dd/RiC74s+ou8dnYw8fm9dNw smyXfE38uNhDfWyAxq88w95vxKFL4u7nf6Kx30+RUcwkz3eztyt6nMR3Ve03 XeI/7jsvunyjEX/IOMmKWMzN7LHYfzSeRCkk+xEbtmpWX/tN3iMBlck9xLlb I6I9BBmsGB+OjCOObVg+f7oQg6s3DkilEP/YZBF3UZiBUdnvumziiceN95xE GHxd5b2vkJg6U973ZyYD09JGl8vE59gznxSwGCTs0LK4TRwY3JXtKMFgV881 izvE049Irv0+h0E+7enWQnxiZeOl0/MYiKqYHWgj1ugdnbSQYbDvypamLuJM 9XS54QUMVDn/LnhBfCrjhlSaPAM1/tUD/xLXlrn0rVFk0K85IfyaeNt/kfG9 Sgzq51Vl9RL3zFCddkiFAS9gpvUb4pUbnJw01Rg4Hhyf8dfsWImYTg3yvDf3 9fxdLyzoHB2myWCcaWntJv7kuZyroMUgubjrwUvixOVpgk06DE6JX333lFh5 6PB+/9UMvB/vnPOY+MMShW5xA2JzJacHxJ1e61nXDRnMu9h2qYm4UV1cys2Y AbwTFGqIt0/b9fkPGJRd9Dh/ndg1LPT8OXMGrv+6mZUSD4graNlYMlitf/RL LrEbOyBl2JpBuqho1XHihhqvlmO2DJqyn55KJJ60YVc/ZzPwVC3ICvp73mD7 sEiGwaKSxmpPYoV3/4kp8hiYsXZ8p4hNGyKu+7iR+4ksKFnxN95r6QeiHgye SjiqyRH/nN9XUcpnoJVSWSny9z5ZVrLjmxm8dlu89G9+btOVS0r3ZeC7RE+g hdjy8a1OPX8Gx1+uH71MfP0IeyA8iEGfUKFkLHHvwTWqU8IZDLxsDpQi1plI cMyLZKCf4yX4g7xfZSLXHdbFMKhU3170nHjd7PPtcXEknpvFzU8SP5unOyB8 lMEWq9lHxf/+3nXm3vkUBtOnVHcPkvfZynYi2jKdQa2Co0UTsa1v3I64kwxu 2lCuocSj+Wt8BfMZvOJ65beTeqFmldGZUsAg4nR76nniIzeSZJSLGGzvy8gL I5bawyy3vMggsclZVYG4eW9CxKFbDNRtV9Tx02iIlv0ula5kYD1457YmMQ4p 3CysZrB/pcyzSVK/DK+E8O7eIfk6uiYklTi8s+z2tIcMcsce2dwk9c7Tq+Ny WhuDkV3dTDTxxM7rsUqPGWhISsdYEAcl3CvBMwZOjaYmj0j9HOJuUP/nDYPl Em9dnpF6Gxhh8+DNNwYB5RMz60j9PrzyCBX4kzyv0RfjMOKOHxVlk5MMVHSH 07SJB5Qfjs8R5EDaRbLoLKn/7yKVL5jN5KBtUVZYMOkXj9nZ9ScWcdD81aR2 iNThApZMnao1BxHdWmvWkn5V+Gexy/v1HPS1Ve9vJ/1slWfMnXP2HFi1Kz/Y TKzKM52tyHBwfEGNUyLpf3z5Ffvme3CwMWQKryWG1Ku1dM/kTg6CLgVMkyZ1 38EoIDL3DAeLdvef+0z6t51B7ma3XA5kXk9r9SFutIlXmJvPQabZnLGXpN8/ CPyHFVfEQUssjOpIn+lYo9vqfY2DZfXXn0YHkX6893zLglYOONbZSg/8aZTv EPnm842sXxCcWEj61qap12YN/+DAbGGkiQjxdpbx7x2THOi8483zI/PJwdmf /cIFuCgOL1mmQuaXo5rK25JEuSg0dfqV7k5jxvAduQJ5LrJueq+xc6IhbhNr WWPJRX2/wN45diSfH+2MMrHhgurrLHQm85NbzOEjNbZclIYrfc1aT87bZm1U w+aiq27z5GLSh3/Mm9Nc6crFPbfxGmUyj3FsZmVc2s7F2zNdun9MaCyTEtEO z+Ci+l2uurgO6Vs7f3VoZHJxYumfX6rapP72F1m+OsVF6O/gdmMtGtxfa8+v zeEi5WJfqB+ZDzOVjllOFnNxRLC59TKZHztXpLKC6riITFlzVIrMEayo+ja9 IS7uDq4VWTiXRpSu3R2Y8nC2hrVpJZlr0hP87z835yGWJbyU9YmCuW92UbAl Dx8p94kBMgede2T+Ps+WhxJX7+acIQrbn/e7CvF4sKg4ISTUT0H75B/Dqq08 TKSaypzqpsCKuPqJlcZD8eMu6bmtFAoqbKu13/MQY/bgqW4OmcOSPBem9/Mw s7tbZOQMBfuGG9zvAzyM6K/ddv40+f9ipOl6e5SHcC2x+rlZFCzN9xaZ/uRh lvLGKx8yKGBf2VYrMSco21Tf2JJEoVU6I1RP2wnyP/JO3wuh8MSvxKIo0glx gsVZS2zI3Dprz+SGRc74kj5DU+clmdO7qjTHrzjjeX3gTV0fNpqeKrzYZu6C ks166dwOR/SX6my6+sqFzEmxDln5Dgg5U+4Y5eeKA16S997ttEd+7MhoxR9X WDQq0Ptm2cHa8PvhR/FuqHBaSA/mr8fLiX87lsx2x7b803kumja45LYy7lC2 OzrDzUaPR1rBoHzKF2eFDViq1e9p1GGBq1/XW/UWb4DIQKPG94/mWOC35vd5 bQ8YV6dqHhwzxWlWqM+2Mg/wkmH7SQjIT3yFeO2NaDmW3MUrM8QTqZiJT8Ub 8YSJ+LJ4hx7exn+wzRDnoyH4AOu9gg7kmotbtR35GBO+t+1y0jLMbbsac/0Q HytO3jKL0VCC8e+rTtfi+XBN83k9KKAEg1mhclcT+EiMX+xDPVmMc3tsd5cn 8VG0YrOW6N7F5H+jNa/4KB/rA841aD9RxLKk7O5TJ/iQd9cw40croFX8pXhQ IR+ekk/GPE4ugLJ+aP22C2T9b4EZl80XQG3rLy+/Ij5qwg6K/hyShe7hhiCv Ej6u5Aw+9TKRRYXWlhrmEh+Tw0NF+W+lkRrzU03nJh8Ktw7296vNQ3p/Tovm LT5GfnFUwjukINuxzlW9go+HG+I3CIZLobghylKxko9kb9/bH1vnIoT/lmbV 8qGmfcdWPWAOCmfF+IvU8XGBk+zvLjUHDkEKO4Xq+VCcZZIYWyWJPSNBjhN3 yH4RJx4UzZKEME9J+WsDH2X5PWMl1ySgPLP7w2gjH3O59jJ5GyRwTif35EAT H6aLytclT5OA7degte+a+Th99MUu/1Jx/A/H73U+ "]]}}, Axes->True, AxesOrigin->{0, 0}, PlotRange->{{0., 134.246732922193}, {0., 74.4044361220925}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{3.4969959142086*^9}] }, Open ]], Cell["\<\ To simplify the algebra for us, Morin specifies \[Alpha] in the following \ peculiar way: assume that the drag force at time t=0 has magnitude mg, i.e. that \[Alpha] \ v0 = g. Defining another substitution rule,\ \>", "Text", CellChangeTimes->{{3.4338518157530003`*^9, 3.433851908749*^9}, { 3.4338519471470003`*^9, 3.4338519753929996`*^9}, {3.4969938568929996`*^9, 3.496993934191*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[Alpha]rule", " ", "=", " ", RowBox[{"\[Alpha]", " ", "\[Rule]", " ", RowBox[{"g", "/", "v0"}]}]}]], "Input", CellChangeTimes->{{3.433851937551*^9, 3.4338519629189997`*^9}, { 3.433852513731*^9, 3.433852515157*^9}}], Cell[BoxData[ RowBox[{"\[Alpha]", "\[Rule]", FractionBox["g", "v0"]}]], "Output", CellChangeTimes->{3.4969959191266003`*^9}] }, Open ]], Cell["\<\ ... we then ask for the time at which we peak, i.e. when y[t] is a maximum:\ \>", "Text", CellChangeTimes->{{3.433851970699*^9, 3.433852001882*^9}, { 3.4338521994639997`*^9, 3.433852208013*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"peakeqn", " ", "=", RowBox[{"(", " ", RowBox[{ RowBox[{ RowBox[{"D", "[", RowBox[{ RowBox[{ RowBox[{"y", "[", "t", "]"}], "/.", " ", "sy"}], ",", "t"}], "]"}], "\[Equal]", "0"}], "//", "Simplify"}], ")"}]}]], "Input", CellChangeTimes->{{3.4969939559997997`*^9, 3.496993993934*^9}}], Cell[BoxData[ RowBox[{ FractionBox[ RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{ RowBox[{"-", "t"}], " ", "\[Alpha]"}]], " ", RowBox[{"(", RowBox[{"g", "-", RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"t", " ", "\[Alpha]"}]], " ", "g"}], "+", RowBox[{"v0", " ", "\[Alpha]", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}]}], ")"}]}], "\[Alpha]"], "\[Equal]", "0"}]], "Output", CellChangeTimes->{3.4969959205746*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"st", " ", "=", " ", RowBox[{ RowBox[{"Solve", "[", RowBox[{"peakeqn", ",", "t"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.433852213264*^9, 3.433852251334*^9}, { 3.4338522945810003`*^9, 3.43385229798*^9}, {3.496994013512*^9, 3.4969940271308002`*^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.4969959218996*^9}], Cell[BoxData[ RowBox[{"{", RowBox[{"t", "\[Rule]", FractionBox[ RowBox[{"Log", "[", FractionBox[ RowBox[{"g", "+", RowBox[{"v0", " ", "\[Alpha]", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}]}], "g"], "]"}], "\[Alpha]"]}], "}"}]], "Output", CellChangeTimes->{3.4969959219156*^9}] }, Open ]], Cell["\<\ Given that solution for t, we next ask for the x-range as we peak:\ \>", "Text", CellChangeTimes->{{3.433852281308*^9, 3.4338522876879997`*^9}, { 3.4969940360696*^9, 3.4969940515136003`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"d", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{"x", "[", "t", "]"}], "/.", "sx"}], "/.", "st"}], " ", "//", "Simplify"}]}]], "Input", CellChangeTimes->{{3.433852289329*^9, 3.4338523187869997`*^9}}], Cell[BoxData[ FractionBox[ RowBox[{ SuperscriptBox["v0", "2"], " ", RowBox[{"Cos", "[", "\[Theta]", "]"}], " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}], RowBox[{"g", "+", RowBox[{"v0", " ", "\[Alpha]", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}]}]]], "Output", CellChangeTimes->{3.4969959271156*^9}] }, Open ]], Cell["\<\ And folding in the special value of \[Alpha] in this problem:\ \>", "Text", CellChangeTimes->{{3.4338524457060003`*^9, 3.4338524619309998`*^9}, { 3.4969940687516003`*^9, 3.4969940723396*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"d", " ", "=", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"x", "[", "t", "]"}], "/.", "sx"}], "/.", "st"}], " ", "/.", "\[Alpha]rule"}], "//", "Simplify"}]}]], "Input", CellChangeTimes->{{3.4338524689*^9, 3.433852482582*^9}}], Cell[BoxData[ FractionBox[ RowBox[{ SuperscriptBox["v0", "2"], " ", RowBox[{"Cos", "[", "\[Theta]", "]"}], " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}], RowBox[{"g", "+", RowBox[{"g", " ", RowBox[{"Sin", "[", "\[Theta]", "]"}]}]}]]], "Output", CellChangeTimes->{3.4969959295886*^9}] }, Open ]], Cell[TextData[{ "Since we have ", StyleBox["Mathematica", FontSlant->"Italic"], ", we can just ask for the optimal angle as:" }], "Text", CellChangeTimes->{{3.433852347771*^9, 3.433852357742*^9}, { 3.4969952961216*^9, 3.4969953092335997`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[Theta]rule", " ", "=", " ", RowBox[{"Solve", "[", RowBox[{ RowBox[{ RowBox[{"D", "[", RowBox[{"d", ",", "\[Theta]"}], "]"}], "\[Equal]", "0"}], ",", "\[Theta]"}], "]"}]}]], "Input", CellChangeTimes->{{3.433852414236*^9, 3.433852423892*^9}, { 3.4338526361359997`*^9, 3.433852639701*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Solve", "::", "\<\"verif\"\>"}], RowBox[{ ":", " "}], "\<\"\\!\\(\\*StyleBox[\\\"\\\\\\\"Potential solution \ \\\\\\\"\\\", \\\"MT\\\"]\\)\[NoBreak]\\!\\(\\*StyleBox[\\!\\({\[Theta] \ \[Rule] \\(\\(-\\(\\(\[Pi]\\/2\\)\\)\\)\\)}\\), \ \\\"MT\\\"]\\)\[NoBreak]\\!\\(\\*StyleBox[\\\"\\\\\\\" (possibly discarded by \ verifier) should be checked by hand. May require use of limits.\\\\\\\"\\\", \ \\\"MT\\\"]\\) \\!\\(\\*ButtonBox[\\\"\[RightSkeleton]\\\", \ ButtonStyle->\\\"Link\\\", ButtonFrame->None, \ ButtonData:>\\\"paclet:ref/message/Solve/verif\\\", ButtonNote -> \ \\\"Solve::verif\\\"]\\)\"\>"}]], "Message", "MSG", CellChangeTimes->{3.4969959349906*^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.4969959350086*^9}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"ArcCos", "[", RowBox[{"-", SqrtBox[ RowBox[{ FractionBox["1", "2"], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", SqrtBox["5"]}], ")"}]}]]}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"ArcCos", "[", SqrtBox[ RowBox[{ FractionBox["1", "2"], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", SqrtBox["5"]}], ")"}]}]], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"-", RowBox[{"ArcCos", "[", RowBox[{ RowBox[{"-", "\[ImaginaryI]"}], " ", SqrtBox[ RowBox[{ FractionBox["1", "2"], " ", RowBox[{"(", RowBox[{"1", "+", SqrtBox["5"]}], ")"}]}]]}], "]"}]}]}], "}"}], ",", RowBox[{"{", RowBox[{"\[Theta]", "\[Rule]", RowBox[{"-", RowBox[{"ArcCos", "[", RowBox[{"\[ImaginaryI]", " ", SqrtBox[ RowBox[{ FractionBox["1", "2"], " ", RowBox[{"(", RowBox[{"1", "+", SqrtBox["5"]}], ")"}]}]]}], "]"}]}]}], "}"}]}], "}"}]], "Output", CellChangeTimes->{3.4969959350236*^9}] }, Open ]], Cell["\<\ We of course want the real positive angle with this Cos and Sin:\ \>", "Text", CellChangeTimes->{{3.433852647028*^9, 3.433852703602*^9}, { 3.4969953997206*^9, 3.4969954037216*^9}, {3.4969954497846003`*^9, 3.4969954690036*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Cos", "[", "\[Theta]", "]"}], ",", RowBox[{"Sin", "[", "\[Theta]", "]"}]}], "}"}], "/.", RowBox[{"\[Theta]rule", "[", RowBox[{"[", "2", "]"}], "]"}]}], "//", "Simplify"}]], "Input", CellChangeTimes->{{3.433852672212*^9, 3.433852685909*^9}, { 3.4969953673406*^9, 3.4969954168926*^9}, {3.4969954718056*^9, 3.4969954724906*^9}, {3.4969955701766*^9, 3.4969955764245996`*^9}, { 3.4969957219866*^9, 3.4969957369896*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ SqrtBox[ RowBox[{ FractionBox["1", "2"], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", SqrtBox["5"]}], ")"}]}]], ",", SqrtBox[ RowBox[{ FractionBox["1", "2"], " ", RowBox[{"(", RowBox[{"3", "-", SqrtBox["5"]}], ")"}]}]]}], "}"}]], "Output", CellChangeTimes->{3.4969959423266*^9}] }, Open ]], Cell["\<\ If we were doing the algebra for this problem \"by hand\", we might do this \ last step by defining a variable \[Beta]=Sin[\[Theta]], in which case we need to optimize the function\ \>", "Text", CellChangeTimes->{{3.49699413917*^9, 3.4969941960008*^9}, {3.496994257652*^9, 3.4969942869488*^9}, {3.4969943804708*^9, 3.4969943967728*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"f", "[", "\[Beta]_", "]"}], " ", "=", " ", RowBox[{ RowBox[{"Sqrt", "[", RowBox[{"1", "-", RowBox[{"\[Beta]", "^", "2"}]}], "]"}], RowBox[{"\[Beta]", "/", RowBox[{"(", RowBox[{"1", "+", "\[Beta]"}], ")"}]}]}]}]], "Input", CellChangeTimes->{{3.49699439852*^9, 3.496994439158*^9}}], Cell[BoxData[ FractionBox[ RowBox[{"\[Beta]", " ", SqrtBox[ RowBox[{"1", "-", SuperscriptBox["\[Beta]", "2"]}]]}], RowBox[{"1", "+", "\[Beta]"}]]], "Output", CellChangeTimes->{3.4969959473456*^9}] }, Open ]], Cell["\<\ (That's the expression for d with constants taken out and Cos expressed in \ terms of Sin.) Then the equation we need to solve boils down to a quadratic:\ \>", "Text", CellChangeTimes->{{3.4969944681272*^9, 3.496994513726*^9}, { 3.4969949415418*^9, 3.4969949647390003`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[Beta]eqn", " ", "=", " ", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{ RowBox[{"f", "'"}], "[", "\[Beta]", "]"}], "\[Equal]", "0"}], "//", "Simplify"}], ")"}]}]], "Input", CellChangeTimes->{{3.4969945197632*^9, 3.496994543132*^9}}], Cell[BoxData[ RowBox[{ FractionBox[ RowBox[{ RowBox[{"-", "1"}], "+", "\[Beta]", "+", SuperscriptBox["\[Beta]", "2"]}], RowBox[{ RowBox[{"(", RowBox[{"1", "+", "\[Beta]"}], ")"}], " ", SqrtBox[ RowBox[{"1", "-", SuperscriptBox["\[Beta]", "2"]}]]}]], "\[Equal]", "0"}]], "Output", CellChangeTimes->{3.4969959492746*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[Beta]soln", " ", "=", RowBox[{"Solve", "[", "\[Beta]eqn", "]"}]}]], "Input", CellChangeTimes->{{3.4969949666577997`*^9, 3.4969949748322*^9}, { 3.4969955336286*^9, 3.4969955353836*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"\[Beta]", "\[Rule]", RowBox[{ FractionBox["1", "2"], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "-", SqrtBox["5"]}], ")"}]}]}], "}"}], ",", RowBox[{"{", RowBox[{"\[Beta]", "\[Rule]", RowBox[{ FractionBox["1", "2"], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", SqrtBox["5"]}], ")"}]}]}], "}"}]}], "}"}]], "Output", CellChangeTimes->{3.4969959508456*^9}] }, Open ]], Cell["\<\ And we recognize the root we want as the inverse of the Golden ratio:\ \>", "Text", CellChangeTimes->{{3.4969955409835997`*^9, 3.4969955412736*^9}, { 3.4969956056935997`*^9, 3.4969956351616*^9}, {3.4969956857356*^9, 3.4969956872636003`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"(", RowBox[{"\[Beta]", "/.", RowBox[{"\[Beta]soln", "[", RowBox[{"[", "2", "]"}], "]"}]}], ")"}], " ", "\[Equal]", RowBox[{"1", "/", "GoldenRatio"}]}]], "Input", CellChangeTimes->{{3.4969956388636*^9, 3.4969956792716*^9}}], Cell[BoxData["True"], "Output", CellChangeTimes->{3.4969959561056004`*^9}] }, Open ]], Cell["The result above agrees, of course:", "Text", CellChangeTimes->{{3.4969957644796*^9, 3.4969957734716*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ SqrtBox[ RowBox[{ FractionBox["1", "2"], " ", RowBox[{"(", RowBox[{"3", "-", SqrtBox["5"]}], ")"}]}]], "//", "FullSimplify"}]], "Input", CellChangeTimes->{{3.4969957859126*^9, 3.4969957890736*^9}}], Cell[BoxData[ RowBox[{ FractionBox["1", "2"], " ", RowBox[{"(", RowBox[{ RowBox[{"-", "1"}], "+", SqrtBox["5"]}], ")"}]}]], "Output", CellChangeTimes->{3.4969959576946*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"%", "*", "GoldenRatio"}], "//", "Simplify"}]], "Input", CellChangeTimes->{{3.4969957969046*^9, 3.4969958081605997`*^9}}], Cell[BoxData["1"], "Output", CellChangeTimes->{3.4969959591186*^9}] }, Open ]] }, Open ]] }, WindowSize->{1008, 647}, WindowMargins->{{0, Automatic}, {Automatic, 0}}, Magnification:>FEPrivate`If[ FEPrivate`Equal[FEPrivate`$VersionNumber, 6.], 1.5, 1.5 Inherited], 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, 95, 1, 105, "Section"], Cell[665, 25, 482, 8, 90, "Text"], Cell[CellGroupData[{ Cell[1172, 37, 799, 23, 43, "Input"], Cell[1974, 62, 516, 15, 69, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[2527, 82, 837, 24, 43, "Input"], Cell[3367, 108, 976, 26, 70, "Output"] }, Open ]], Cell[4358, 137, 195, 4, 41, "Text"], Cell[CellGroupData[{ Cell[4578, 145, 374, 9, 43, "Input"], Cell[4955, 156, 306, 8, 59, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[5298, 169, 470, 14, 43, "Input"], Cell[5771, 185, 5808, 101, 333, "Output"] }, Open ]], Cell[11594, 289, 402, 9, 90, "Text"], Cell[CellGroupData[{ Cell[12021, 302, 249, 5, 43, "Input"], Cell[12273, 309, 129, 3, 59, "Output"] }, Open ]], Cell[12417, 315, 207, 4, 41, "Text"], Cell[CellGroupData[{ Cell[12649, 323, 350, 10, 43, "Input"], Cell[13002, 335, 501, 15, 69, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[13540, 355, 331, 8, 43, "Input"], Cell[13874, 365, 662, 12, 94, "Message"], Cell[14539, 379, 323, 10, 78, "Output"] }, Open ]], Cell[14877, 392, 204, 4, 41, "Text"], Cell[CellGroupData[{ Cell[15106, 400, 248, 7, 43, "Input"], Cell[15357, 409, 327, 9, 70, "Output"] }, Open ]], Cell[15699, 421, 204, 4, 41, "Text"], Cell[CellGroupData[{ Cell[15928, 429, 281, 8, 43, "Input"], Cell[16212, 439, 309, 9, 70, "Output"] }, Open ]], Cell[16536, 451, 251, 7, 41, "Text"], Cell[CellGroupData[{ Cell[16812, 462, 343, 9, 43, "Input"], Cell[17158, 473, 702, 13, 111, "Message"], Cell[17863, 488, 662, 12, 94, "Message"], Cell[18528, 502, 1378, 47, 142, "Output"] }, Open ]], Cell[19921, 552, 242, 5, 41, "Text"], Cell[CellGroupData[{ Cell[20188, 561, 516, 12, 43, "Input"], Cell[20707, 575, 400, 16, 77, "Output"] }, Open ]], Cell[21122, 594, 350, 6, 66, "Text"], Cell[CellGroupData[{ Cell[21497, 604, 347, 10, 43, "Input"], Cell[21847, 616, 217, 7, 79, "Output"] }, Open ]], Cell[22079, 626, 287, 6, 66, "Text"], Cell[CellGroupData[{ Cell[22391, 636, 280, 8, 43, "Input"], Cell[22674, 646, 365, 12, 82, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[23076, 663, 216, 4, 43, "Input"], Cell[23295, 669, 531, 19, 62, "Output"] }, Open ]], Cell[23841, 691, 257, 5, 41, "Text"], Cell[CellGroupData[{ Cell[24123, 700, 276, 7, 43, "Input"], Cell[24402, 709, 75, 1, 42, "Output"] }, Open ]], Cell[24492, 713, 113, 1, 41, "Text"], Cell[CellGroupData[{ Cell[24630, 718, 249, 8, 78, "Input"], Cell[24882, 728, 192, 7, 62, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[25111, 740, 156, 3, 43, "Input"], Cell[25270, 745, 68, 1, 42, "Output"] }, Open ]] }, Open ]] } ] *) (* End of internal cache information *)