(* 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[ 58501, 1487] NotebookOptionsPosition[ 54854, 1368] NotebookOutlinePosition[ 55548, 1393] CellTagsIndexPosition[ 55505, 1390] WindowFrame->Normal ContainsDynamic->False*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Range of a projectile, including air resistance.", "Subtitle"], Cell[CellGroupData[{ Cell["Introduction", "Section"], Cell[TextData[{ "Here we study the motion of a projectile thrown through the air, including \ the important effects of air resistance.We will investigate how the maximum \ distance the projectile travels before hitting the ground (optimized with \ respect to the initial angle at a fixed initial speed) varies as a function \ of the friction coefficient.\n\nNeglecting air resistance, it is easy to show \ (elementary physics classes) that if we throw a projectile with a speed v at \ an angle \[Theta] to the horizontal (angle of throw), that its trajectory is \ a parabola, it reaches the ground after a time ", Cell[BoxData[ FormBox[ RowBox[{ SubscriptBox["t", RowBox[{"0", " "}]], ","}], TraditionalForm]]], "and it has then traveled a horizontal distance ", Cell[BoxData[ FormBox[ SubscriptBox["x", "max"], TraditionalForm]]], "where" }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{ SubscriptBox["t", "0"], "=", " ", FractionBox[ RowBox[{"2", "v", " ", "sin", " ", "\[Theta]"}], "g"]}], ",", " ", RowBox[{ SubscriptBox["x", "final"], " ", "=", " ", RowBox[{ FractionBox[ RowBox[{ SuperscriptBox["v", "2"], "sin", " ", "2", "\[Theta]", " "}], "g"], "."}]}]}]], "DisplayFormula"], Cell[TextData[{ "The maximum distance traveled by the ball is clearly for \[Theta]=\[Pi]/4, \ and is equal to ", Cell[BoxData[ FormBox[ RowBox[{ SubscriptBox["x", "max"], "="}], TraditionalForm]]], " ", Cell[BoxData[ FormBox[ SuperscriptBox["v", "2"], TraditionalForm]]], "/g. Here we wish to see how the optimal angle changes from \[Pi]/4 if \ there is air resistance, and how the maximum distance is reduced from ", Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["v", "2"], "/", "g"}], TraditionalForm]]], ".\n\nClearly we need to have a model for the force due to air resistance, \ which is a complicated problem. For an object moving slowly though a viscous \ medium (e.g. molasses) the flow is smooth (laminar) and the force is \ proportional to the velocity. However, in air, except for a really tiny \ velocity, the flow of the air is turbulent and a better approximation is that \ the force is proportional to the square of the velocity (note that this is \ still an approximation). Clearly the direction of the force is opposite to \ the velocity. Hence we write:" }], "Text", CellChangeTimes->{{3.4516916413364353`*^9, 3.451691643018508*^9}, { 3.514326047972356*^9, 3.5143260599467773`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ StyleBox["F", FontWeight->"Bold"], StyleBox[" ", FontWeight->"Bold"], "=", " ", RowBox[{ RowBox[{"-", " ", "k"}], " ", "|", "v", "|", " ", StyleBox["v", FontWeight->"Bold"]}]}], StyleBox[",", FontWeight->"Bold"]}], StyleBox[" ", FontWeight->"Bold"]}]], "DisplayFormula"], Cell["or", "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ SubscriptBox["F", "x"], "=", " ", RowBox[{ RowBox[{"-", " ", "k"}], " ", SqrtBox[ RowBox[{ SuperscriptBox[ SubscriptBox["v", "x"], "2"], "+", " ", SuperscriptBox[ SubscriptBox["v", "y"], "2"]}]], " ", SubscriptBox["v", "x"]}]}], StyleBox[",", FontWeight->"Bold"], StyleBox[" ", FontWeight->"Bold"], RowBox[{ SubscriptBox["F", "y"], "=", " ", RowBox[{ RowBox[{"-", " ", "k"}], " ", SqrtBox[ RowBox[{ SuperscriptBox[ SubscriptBox["v", "x"], "2"], "+", " ", SuperscriptBox[ SubscriptBox["v", "y"], "2"]}]], " ", SubscriptBox["v", "y"]}]}]}], StyleBox[" ", FontWeight->"Bold"]}]], "DisplayFormula"], Cell["\<\ where k is a parameter. I emphasize that this is only a rough model for the \ friction of a projectile in air, but it should give us an idea of the effects \ of friction. First of all we clear any variables previously defined, give the value of g , \ 9.81, and initial values for v, \[Theta], and the friction parameter k (20, \ \[Pi]/4, and 0.3 respectively):\ \>", "Text", CellChangeTimes->{ 3.4516916720203457`*^9, {3.5143260889320097`*^9, 3.514326151898391*^9}}], Cell[BoxData[ RowBox[{"Clear", "[", "\"\\"", "]"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"g", " ", "=", " ", "9.81"}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"v", " ", "=", " ", "20"}], ";", " ", RowBox[{"theta", " ", "=", " ", RowBox[{"Pi", "/", "4"}]}], ";", " "}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"k", " ", "=", " ", "0.3"}], ";"}]], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["\<\ Fixed initial speed and angle of throw \[Theta].\ \>", "Section"], Cell[TextData[{ "First we will fix the initial speed and angle of throw, and see how far the \ particle travels before it hits the ground. This distance is call the ", StyleBox["range", FontWeight->"Bold"], ".\n\nNext, we integrate the equations of motion using NDSolve up to time t \ = 10, which is sufficient for the projectile to hit the ground with initial \ speed v = 20." }], "Text", CellChangeTimes->{{3.514326174481885*^9, 3.514326181866991*^9}, { 3.514326274486445*^9, 3.5143263098528767`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"sol", " ", "=", " ", RowBox[{"NDSolve", " ", "[", " ", RowBox[{ RowBox[{"{", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"x", "'"}], "'"}], "[", "t", "]"}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"-", "k"}], " ", RowBox[{ RowBox[{"x", "'"}], "[", "t", "]"}], RowBox[{"Sqrt", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "t", "]"}], "^", "2"}], " ", "+", " ", RowBox[{ RowBox[{ RowBox[{"x", "'"}], "[", "t", "]"}], "^", "2"}]}], "]"}]}]}], " ", ",", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "'"}], "'"}], "[", "t", "]"}], " ", "\[Equal]", " ", RowBox[{ RowBox[{ RowBox[{"-", "k"}], " ", RowBox[{ RowBox[{"y", "'"}], "[", "t", "]"}], RowBox[{"Sqrt", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "t", "]"}], "^", "2"}], " ", "+", " ", RowBox[{ RowBox[{ RowBox[{"x", "'"}], "[", "t", "]"}], "^", "2"}]}], "]"}]}], " ", "-", "g"}]}], ",", RowBox[{ RowBox[{"x", "[", "0", "]"}], " ", "\[Equal]", " ", "0"}], ",", " ", RowBox[{ RowBox[{"y", "[", "0", "]"}], " ", "\[Equal]", " ", "0"}], ",", " ", RowBox[{ RowBox[{ RowBox[{"x", "'"}], "[", "0", "]"}], " ", "\[Equal]", " ", RowBox[{"v", " ", RowBox[{"Cos", "[", "theta", "]"}]}]}], ",", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "0", "]"}], " ", "\[Equal]", " ", RowBox[{"v", " ", RowBox[{"Sin", "[", "theta", "]"}]}]}]}], " ", "}"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "y"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"t", ",", " ", "0", ",", " ", "10"}], "}"}]}], "]"}], " "}]], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{"{", RowBox[{ RowBox[{"x", "\[Rule]", TagBox[ RowBox[{"InterpolatingFunction", "[", RowBox[{ RowBox[{"{", RowBox[{"{", RowBox[{"0.`", ",", "10.`"}], "}"}], "}"}], ",", "\<\"<>\"\>"}], "]"}], False, Editable->False]}], ",", RowBox[{"y", "\[Rule]", TagBox[ RowBox[{"InterpolatingFunction", "[", RowBox[{ RowBox[{"{", RowBox[{"{", RowBox[{"0.`", ",", "10.`"}], "}"}], "}"}], ",", "\<\"<>\"\>"}], "]"}], False, Editable->False]}]}], "}"}], "}"}]], "Output", CellChangeTimes->{3.419991721051214*^9, 3.419992170565873*^9, 3.419992252002469*^9, 3.41999253886804*^9, 3.420363121504238*^9, 3.42036322113806*^9, 3.4203961008162117`*^9, 3.451691889439579*^9, 3.45174235588634*^9, 3.4517541670455647`*^9, 3.482969953313767*^9, 3.514326354646791*^9}] }, Open ]], Cell[TextData[{ "It is convenient to determine the time ", Cell[BoxData[ FormBox[ SubscriptBox["t", "final"], TraditionalForm]]], "when the particle hits the ground, i.e. y[t] == 0. This is done using the \ ", StyleBox["FindRoot", "Input"], " command. However, it is convenient to first convert y[t] to a function \ rather than the replacement rule in the last output. This can be done for \ both x and y by" }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"yy", "[", "t_", "]"}], " ", "=", " ", RowBox[{ RowBox[{"y", "[", "t", "]"}], " ", "/.", " ", RowBox[{"sol", "[", RowBox[{"[", "1", "]"}], "]"}]}]}], ";", " ", RowBox[{ RowBox[{"xx", "[", "t_", "]"}], " ", "=", " ", RowBox[{ RowBox[{"x", "[", "t", "]"}], " ", "/.", " ", RowBox[{"sol", "[", RowBox[{"[", "1", "]"}], "]"}]}]}], ";"}]], "Input"], Cell["\<\ in which we removed a curly bracket by taking the first element (even though \ there's only 1). We also needed to take different variable names, so we use \ xx and yy rather than x and y. As an example, for t = 1 we get\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"yy", "[", "1", "]"}]], "Input"], Cell[BoxData["1.7493579237923607`"], "Output", CellChangeTimes->{3.41999172115596*^9, 3.419992170657981*^9, 3.419992252094493*^9, 3.419992538951284*^9, 3.4203631215883427`*^9, 3.4203632214522247`*^9, 3.420396100929117*^9, 3.45169188954458*^9, 3.451742356001549*^9, 3.451754281579557*^9, 3.482969953348193*^9, 3.514326354696607*^9}] }, Open ]], Cell[TextData[{ "tfinal is given by the root of yy[t]. However, the result of ", StyleBox["FindRoot[yy[t] == 0, {t, 0.1, 4}], ", "Input"], "is again a replacement rule, whereas we want the numerical value. Hence the \ desired command is:" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"tfinal", " ", "=", " ", RowBox[{"t", "/.", " ", RowBox[{"FindRoot", "[", " ", RowBox[{ RowBox[{ RowBox[{"yy", "[", "t", "]"}], " ", "\[Equal]", " ", "0"}], ",", " ", RowBox[{"{", RowBox[{"t", ",", " ", "0.1", ",", " ", "4"}], "}"}]}], "]"}], StyleBox[" ", FontWeight->"Bold"]}]}]], "Input"], Cell[BoxData["1.4101589336830336`"], "Output", CellChangeTimes->{3.419991721238265*^9, 3.419992170727132*^9, 3.4199922521637373`*^9, 3.4199925390044193`*^9, 3.420363121643404*^9, 3.4203632215067167`*^9, 3.420396100986609*^9, 3.45169188958608*^9, 3.451742356053771*^9, 3.451754360790951*^9, 3.482969953382059*^9, 3.514326354728876*^9}] }, Open ]], Cell[TextData[{ "This example is showing us that, for all its power, ", StyleBox["Mathematica", FontSlant->"Italic"], " is not as intuitive as one would like. \n\n", StyleBox["I emphasize that it is generally convenient to turn the \ replacement rule coming from the solution of a differential equation into a \ function, and the replacement rule from the solution of an equation into a \ number.", FontWeight->"Bold"], "\n\nNow we can, for example, plot the height, y, as a function of time up \ to the time ", Cell[BoxData[ FormBox[ SubscriptBox["t", "final"], TraditionalForm]]], "at which the projectile hits the ground:" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"yy", "[", "t", "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "tfinal"}], "}"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}]}], "]"}]], "Input"], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.67, 0.6, 0.6], PointSize[Large], Thickness[Large], LineBox[CompressedData[" 1:eJwV13k4Vd0XB3A5xxQqQxkylCSlMhVC1nYVKv0qiWssCm+RqSihkJRUhKhk KnkRlSEUSqakVK+EjPece02VMVOG/La/7vN51r3Ps88+d6/13WudPM2dubm4 uFYt4eJa/Dxg+bAyvdfBgGuvvcKqg4kGPLfXJF9i6oPaDZ+xVNIfKgRbvhgy zSB+aGXs1tlrILdH44cC0w7mrxu9et5/Fxr6uv3EmO5gr3WufWd1JigWa5UL MgMhQP/gntbAEvgi58TiY96Ac+q2/wT8fgcZjVOjPMwHUOwly28w3gy3PYtW qUXkgkHgKouuyR7I9tgt3DHyAkwFcqICrIZAJzaSJf2nDDrs+yr034zBo489 qVNmldD7NC14SmESbuwRitTpqIFIMV1zh4Fp2F6sql9d/B5aZOSuGt2ahcLV Syz3hzQAp0iyI6FpHgSDcuKaw74AzRdanpK/AImcZkrFsxF61nkdDyvjQqsj qiN/6TTBnWS3N+C7BPFuFPjx5M83EDKOzCkS5Ubmhh+fRLNawLwzw3oynRv9 a2P8K6uvBXrF3lEDGdxo7kzF5qqhFrBf859MRyY3ysgozJ2Ya4G/zlROWQ43 mhFMemYj1QrTZ5J2ehRyo7Tm0wWK5q0wJLXJJbaKG424LS8tqWqFmgViqI/F jaLizetZGd+hYMiPt16CQLVZNqkxT78Do5OrIEqKQHNlTn67ir7DgfbawcOr CfQP20chs+Y7uGo7LG+VIxBDLfaCJ+c79IQuF/q8nkCT779u+ru2DYLJY9vP axLIft4icnVSG9xnvr/+cj+B4lbYOzakt8HRumephw4QqH6ds/alnDZ49Xr1 gf6DBNLa68umS9ugMPm1n4gFgVYk3NHLbmsD4+6yP+Y2BKpWa/6pI9kOAZyD orEuBFI5YWVmGdsOFpKvUwUuEujgVzVZzv12GJxfV+JxiUBnGUuHvB+2g7bK 5ouNwQQqW1MedTMP/95jm0T8ZQKZdSp8rf6Mv68bEyYcQSB3yyFrTaEOYPTZ Xy2PJdBT0yuuK650gGiB1Oy6TAI1FjvoJN/oAKHYj65Hs/DzKukIbI7rgC98 VpH3sglkwPMz2+RRBzQdHpoSyCXQ57cHhy6+7QAx+YXT7XkEGtGV8R2c7wDB kZ+EYSmBNLYUhNb7dUKTERki2UCgvVkLXM1BneD0uKFG8hOBnNabXaLCOoEm WGMSnwkUI9sTMB3TCfFHHvCK/UegUWEJX6VnnWD38I7UXBOBng9dcA3t6wTi +65V9zsItPU5w0yX2QUchals3p8EMt4cVb/7aBfoICNzDrZDZrvpIZcuOFJx va/iF4FupZ7d/c/ZLvg3tLTDb4hAg9EZBvHRXRBOuU1+GyVQjvdS9bG6LhDL nxRynMb7r9m4MntHN3zbYzz6hCSRYlbOxv8ZdoPsDSr4HA+J5OSv7hwz7YaZ E65NhrwkWiGo76zL7AbefqKukY9Ek/Tjwnq/bpj4qdbXs5REFTH+h38WdEPJ xosa/60g0St+C9eo0m5AgqRUhAiJCi5uDdCs6oaTa5/UgiiJMk6xHwY0doNq pNL5LDESRTL2jwmOdoPbyQM7PFaRSMU/2nSVBAtWto8fLV9NIuXCIPN+aRbM f/r92VEGr3f4lN0rORa0pG1ZyiOL1+u828tBiQWTl8W7TOTweg/NJGRsZ4HI 01n+N2vwepVP9GlZsCAmX+/OmfUketuqHW51mwUNJjcbJ7eQSOd+l0t/HAtK DlhGuG8l0VPbKyb+d1mwO+yoNoX9oKuRPzGFBY8ca/3fqZLIj3M6siuXBRFB g4lX1Um0aeRRtHM9C7hlH/k2byNRat5e78kGFhTUpuTpbSeRxJnRQ1f/Y8Fa I8W+FGxy0kAsq5UF13UtwFmLRN2z3+/86mVBisSOTLY2ieL4ViSeISg4IL4h 4JkuiZa+Lwog+SiQqT9wjNQjUch1e7s7SynY/03LkIntIfxEtliEgtH/fZic wzYVM06dkaeglr9tm+5OEr1u+hUcuY6C9eKVs+HY2+NjHWU2UDCYHPSmEVtB ilIw2ErBZNL0TlcDEs3LBT4O0aegsrFMOgxIdJalEC6KKHBoWfhQh/0j7b3L IyMKbj3aECCESNSqKKFcs5eCfvHcr9HY+Zvys/mtKUh4jLxvGpLIRav/WZQv BclunABLIxI1jB9pd/engOz39Y3C3lZQxbs3iIKHRj6Md9iEWoo9eYWCeYvD Vpq78H5utBT0j6Mg+oup9zw2f3+VluVdCmreVC3dsptEnhnqTpoPKGgSnzpv i22wTvjl4CMKVM02NxVit8tUuzgVUMDvZH7d2phEjHb1GCimQMRP9NMl7Ox7 KeUypRRYvPval459flWAeEslBX805pN+YrOa+qGwFr+PrCJdYRMSmcRaut2u p+C3uPjTLdirVmhU7mukYKLCTsoNO+hTyqByMwUtn++KXMPm3BCW4m2jQN9b mnqEXSAw4FlBUeC0J4q3FVu6zjIxqYeCpdWNdiPYoeHVtRcGKFC3nrvOZ0qi g0Sq7PZRCs6lpHlqYJe8Fd4jOkFBodBpJWNs+eCAs8PTFLQKvX7BxA43GEj5 OEeBpkWZ7CnsoTnLD1lcNFiHRzlcwD5SWj0ZTtKgp3X0fAR2mb+Gwgl+Ghx6 zd0SsBV1UvcbCtEwxB+jnY4dOSnsL7eChs8LRp3PsMcKA9JnxWh4KRNt9wrb 5szA51YJGhhpSS+qsN+qW82+WE3D3OvY/g/YyiPVSrHyNIQm3JtoxI5+qmHu tY6GGP3mjlbsKffUoP0baFj93Cu5E9tBZVnWJhUamJwoXQq7diCgiU+Vhq5S mzw29pbMgQWOBg0vBKa5e7DjXKxUKrVoOHn7luqi5xRrLFN0aVjLt1ubg32c rREaaEBD/nKGNI1dn5aaa82g4TnKae3C1ji27LuWMQ0Ra7J92rDvyQWS4ntp iFNy6m/C5uocUB3dT8OG0pkdn7D/SbSy/XSIhmzt+6612J+ta8KfHKHhWa+L dzm2lqRm/jVrGpaQV60KsJObUzud7WkoK1sjnYnNc2eZgJEj3m9Vm5eJ2O6H A7etcaaBcrPefgtb74tVZJs7Dbq6htWe2Pf1txY+9qKhUndM+Sj2dCbZ6XWW BouSQN/92IUheVv5AmnoXZ9bq4QtOnTVqvESDbM+9z+IYHvZOAQnXabBZWq4 ZBb/vzZrCjZqRtLwoNFx/0fs6ynUzN9bNBTJ14znY/cLlqyrj6HhV7TclbvY jzknfI/dpyHT0NDxGLZc/GvJm1l4P76uEWTj8xHIfceQmUvD/ugVfyuw2zzc Tq3Lo2FifHl7Ena8iWTZyxIavkW9P2yBvfyP99HedzQcOzVttHg+PZxNr+V9 oKFWQisyAvvjf3J5gZ9pGB+8V26PfS37A7dYCw3V5xw43NhcduszoJeG5h1p OxHuBw51s5+W/qBBpriZEsIu29Y49W2QhpD53T6tuJ+cF760x32ChiO0DdMd e/R166+7JBsC46R3XmXg86XybOUJfjb4qbUb78N+mnDFQFWIDfZ+vTuXYZ/y 0oiuEWNDQsaJ8Wjcz+i1NzTHFNhwh50fHoH7HbrlZFeuxIZ7xwP/7sJOntG5 cm0TGxI/J59YwP3S9mtPs5wGrn88O+eF3RQGF/YZsiGmbbmDCe63NX1jFelH 2XAuS4v3Le7fyW2hFVuPs0HDMHGHN7Zfg2hFiQsbRGzTg9dgKxVovPl4Gq93 7/K9gXg+hF/0KR8PYAOf+PYG5R0kMl459nLXXTZk+YnmHMHzRY4/9OWnRDaE PDVUmsLzZ3JG5CUzhQ3CjDcvErAzWOol7hlsMBBfvnJxfvHmeBfFFbLhlg67 xUQTnz/GaD7nC96vBOaVBTz/kreH5Hs0seHidMWxmMV5qCySP93Chjbn1YcV sZWWqecJdbOhPWJZ0G48P8O/ez3bNsiGhaqa/sDNuH96jTwJE+DA9B9FrQpl EtUlDacrMjgQupW0v4fn9e2bxsMzuzng2P84icC2CUra8d8eDiRJy35xlyfR T7t9n4IOcaDtsrCgPp73y2T+nWo+xoF8p+COBpwXjtx32BtxiQOmJ38KvMF5 go5vGB4s44DuXLpnqyCJnoQr6lZXcED9icXGtdhn/QLC7ldzwP1kR+s/OM/w WG6UMvnIATuF31IT/Lh/rbzCSG3nwK4lRRuW4DzkEat/x3yGAw5zJjf7Fgg0 G/VEt1i7B7R9IuyHxnCe5C2zNdPrAVfHXi9F7ODAj4GUQQ/MaOemWOM8xnty 8LWgcQ8ox3YdeDuM8zJD1eiYRQ+EHLo3fwXnOaXx/H0C3j1g9jY/ndOD8zHz lZ1tdg9Iu2l+nWohUMaa9xcXZHrBrPWabsBLArF2MZJC1/SChWMuebGEQFIn S0t5FHvhg7/mn0vFBLqRlzstqNILj/WqHENeEMiHEeMjuaMXzstHaF7A+dbg hK2L+pFeUGJ4DBnhfNz87+D+4zd7waQm1lXnLoH4VEVl3833QougVUL2GZx/ D5qHxy/pg8hNd4scfAhk5x0z7MzTB0JrPSgRb5xnC0QrSWFcFzC38fUgkI2O mCtDpg+uqZl1qJ3EedRQPK9ctw94mlP1Ljjg57NYtbvwXB94e77TtzIl0F1/ 6dNpo32QsmHjJML3mTSnMDf1b/0Q6iWpGlbMjdqu5q5u+jAAba7FjoHAjd5v 4laaLP8B2nb2WR2lS5Cae0lXQ8pPuDTl8XzH9iXo3cCWPSVxv6D8QtStqngu 1MzD48T0H4RdyvEROsP4vpfC9+2c9RCEMc7VLHn0F6J93//JMhuGypVSMT8U 5+HvWb/eOokRsItb+J9Y7iyYNfQp18aMQF2c7e+7S2ageTyCkcwzCvLP+/Si j02DXruhgJbfKOz9VzK3pXgSSo5+V7YaGQXVgbo5+7Zx8C5Ikz/sNAaHmIel WMK/gfF4j2dr5xjMyUc0PxQchaEjfO6yVr+h4Eosbwb/EDR/m4Cddb/htFp6 R8qGH9D8u8q9lzEOtblFlaitB0SpSq9TL8ahSKJuyLmCgo03W9Y+XT8BC8Ou jdcPtgOz5YNKQMoE/JjrMC43boSqkRGhdSKToBMlaGBxqgqMMyeMLW5Mglqm /EyIsg9sCZ7jOo69YqerOafbG8SZRKn3Yp01HGmc4I3vySKqUYv1gJqHS3m9 4aLrZol67NRD4m8U3nlCkdLxPrg5CcGSvioaO91A6fGXqyq3sLeEDCpsdALh oBZDXWyW29nh7gRHGLfomjVdrB+fK3jA6wiV5C9PF+yK1HsCKnVHweEEHzNt sd64cJ3fwBbi1xkoS0RNArrhdDVnozkEze6i12NXPHbrkuM7BCe+7nuwDTs4 ztF37fsDoHHZeoU5NldBH0+vwT74RJ+dvrFY15pNP76JAS9eBeQnLtbN5f4X Ug/wICbUPXvRsbauO5AenGJEs94t+qXy90cqGnBIOuF+86KbLh/PYaiAzliS Rc+iV/GC8FYFkKtPXza+aNPqiCYNUeB5+KSOOxqbSzm4Sfiywf8B0jb4Jg== "]]}}, AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesLabel->{ FormBox["\"t\"", TraditionalForm], FormBox["\"y\"", TraditionalForm]}, AxesOrigin->{0, 0}, AxesStyle->Thickness[Large], BaseStyle->{15, FontFamily -> "Times", Bold}, FrameStyle->Thickness[Large], PlotRange->{{0, 1.4101589336830336`}, {0., 2.5355933871634773`}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{3.419991721368643*^9, 3.419992170794652*^9, 3.419992252249483*^9, 3.419992539072637*^9, 3.4203631221198797`*^9, 3.420363221555931*^9, 3.420396101395348*^9, 3.451691889629374*^9, 3.45174235610487*^9, 3.4517544516158247`*^9, 3.48296995341857*^9, 3.514326354762878*^9}] }, Open ]], Cell[TextData[{ "and also y against x (using ", StyleBox["ParametricPlot", "Input"], StyleBox[",", "Input", FontWeight->"Plain"], " in which, just for amusement, I've defined a non-standard ", StyleBox["PlotStyle", FontWeight->"Bold"], " for the line)" }], "Text", CellChangeTimes->{{3.420363479760868*^9, 3.420363625401287*^9}, { 3.514326239260401*^9, 3.51432624325069*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"ParametricPlot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"xx", "[", "t", "]"}], ",", RowBox[{"yy", "[", "t", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "tfinal"}], "}"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"{", RowBox[{ RowBox[{"Hue", "[", "0.75", "]"}], ",", RowBox[{"AbsoluteThickness", "[", "3", "]"}]}], "}"}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{3.4199917334636383`*^9}], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.75], AbsoluteThickness[3], LineBox[CompressedData[" 1:eJxd13k4Ft/7B3DMeDzLzOOxZy8JTz5Jdoq5lQ9FWrSolCUtUtllaUFZkyVa lIgs+YQshQiRvdIi2YoktJAkW9l+x/fP3/wz1+uaMzPXOdeZ933PsoOuVof5 eHh4mLw8PIvn/3+MFm1WXcnvR5UZtvNp4X7Ux5N35j7PhlPZs14bpv+GU7yu V8OODydQz12sy65+TaAcjKcd3z3PolbZN51Xr82iEnx+nea99IgaFpWreXPm EeV8JNHdS6iR+uFkusn3dwM1T+t82KTWTv11601YN95G/R5NUDnmNkixJUYf dU8OUK/d31Yf3feTSk3eyzhtPUJdCt2UtP3mb8r+tETouidjVP+QkVj/qSnq spm95ZTCJLXGMEPvUM1f6j/Vv4q236YpScc23lWceaq54ILdhugZKqHPprE9 nAeKc/eXXm+dozaOzBnPd/BC0Mr25NuFC9QWpez8FeoY5BlI7Q4u5wHrSgtd uh0OzU3PHlDevKB2gDc03o8fZOt97hQL80GFaBnRm0QD27AV2yfT+SCv/ZZz zh0BUF+6e6FJAgOld/kpC5kCYPNhIDtGEoMR+x5Rq2wByM4sGNwhjcFA0IdH 4w8EYP31nfQOOQxeaz6cVq8TgEczMvyvVmDguTI0NeSLACy4Jqr5amLwjmvY mapKh/pCu+BSSwyy4k9plBTQoSSDlsg4h0HVpAqtqYgOQz/dC10CMOBqf1/T VUqH0sAA35ZADNTuZcX9raZDVVic0LULGDTSfAI1W+hQ9pI/gIzAYPVUs1no GB1q180GVcRj4M3N2VqgwQDPGmJyeRYGm9+bZ9zXYcCxwdqDdv9hcCVexibb gAHcpJ2hN+5hoMhj9fXOegYsdZ4cY+Ri8OxpU8xFKwZYqMoce1+AgbpKxMZ1 HgyoeaSxAI8xmJmM51ctYMDZF0lnljRjkHhnw543Dxmw/8/x6iUvMWj3c1fy ecSAAwoXRiReofXq5dGpfsKA/2ib+ETeYOASMK209SUDZlx2ic22YuArpe9r NcSA5OKVwjc/YMA36CE0rcgE+SiVu7QhDEylPFSjVZjwZL/fln7kH8eD6pf/ wwSn6LrPVcMYMFafDrTUZMLlgoWOUyMYCCcE0hONmbCi6enYu18YuBemRcnZ MuHGFw+GwzQGj6upqMZrTBiPIUaycRyWsSPdEm8y4efrnLM+/DiUe1+uPZnM hOy7um+MaTjob014wslkwuzyntoWARyOuWMC24qYkMyR7x9g4kCfCKE9fMuE lun41W84OLBPP5MS4bDA/8jeAxXSOHRFy3i1irAglDrQ7CCDg4/0KpOrEiyo nEwU4JfFYXiF8SYxeRZY3L703kwOBxMfjWG2GgukLMNoT5bi0LerrPyrBQse ao3Eea7A4bpebYVuGAte8ka9nlyFg9HHCpv/LrJAMWRf2Ak1HApkh0Klollw VstJ+xMyX7FTyMwVFsTxd/g0rMZBKzJD6dEdFpzkFboZtgYH+5oLEjKVLNDY 8N2zTQsHwc+BCaHVLDhuO5S3VhuH776NWaO1LKi38Bq4jayXWupT85wFestz DQ/r4BC1pqDFsZMFsqVpmZ91cSi6Jn4jZpwF95lFfnkGODwY7pL9PcUCZ5U+ W3wtDl+Y3zV3z7Bg/GYztQc5uPCwqDQfASGfnCdmkSs99e/dFiSAqxapaWCI Q/ee9SZXVhLQyntZMpjCYXeD2vDoKgLIwx3PGpEDorYpW64hwCwG9ycAh7Mf sq1xPQJmy+JaYpG3CmHpJ/8lIKJU1y3KGIf8yRn8H3sClsO8/+4NOPyJ9TJt ciSg0eWKVwzy2Og+5pGjBMydvmrcgMwt5pNKdiEgZiRgt6YJDjUqD/fTzxJQ pRjuNoesG365KDUQja8SYK76Fwdq/dxlg2ACXJ9SvjbIOMZuc44kIGXbubcP kdUPjUXX3SDAhSiJ2GuKgwZtGd0miYD9jaebA5BPFU/xj6YQ8LHK+Es6creE SuySLAJk/byShpCfjNbL5GQT8OKKhgFphkOocoIalUeAcsaV3FXIMe37+hyL CShMGFxyHPnyndjgiVICDpsrC4UjS7oG5YRWoPWJyu1NQ959STr6bi0BqVmq tA7krn30jbqNBNyo8dw/inxLSTe8/jkBbtOpFwU24uAU25v4uYUAnTPbXDWQ d3clubq3EWAStlTJFNnNT+HZfCcBiYqnivYgx56PyY7sJuAi3U/WGfnUKL/o kk8EZLRts/VH7k3LxNL70XyXrfCNQC53jPNf/ZWA8hOyx68jc7u/+ZYNEXCU 66CbjnwtrXne5CcBDaUS3XnIdeq2xKsxAuJcnfaXIXf3P07dM0mA/SX/ohpk f5rAk09/CHhq7P31OXLlU7tDznME7CwImGhB3rNq8PIYDwmtw1UfOpAToczM HydhzaRdcjfyxe6ZEF46CZlPLhh8Qu57/mxzOIuEJtUdBZ+R15SZ3mILkpBK TvANLM7HMMbrijAJ5SqxqxcNb2veSYqTAGssdPuRk7uxqmRJEvhebJbqQ95y 10VzuSwJCdGPO3qQyxyWq99dSoLrQoVHF7LHCuPilYok9Fz1/9qKbDA2WJer TMLaMgmDl8hSeZp26qokjNY9PlqPfGyl6flCNRKisCj3CuTPkoartTRI+Hi/ wPoBcp6U7pEibRJ4JrZKZSF7Flgp6+iT4D4eVZqIfMj8vkfxOhJUKy5rRyPn lyZnFW0ggXvnfK0rshWls0nRjIQ/EnpcO2TajmrfOHMSKGaDtyWyuuvykJPb SQiz42lQQp7v1zjYtZOEJPmx50LIGTWZL033kOAnvrl0Bu0vbqrqbjk7Erpb 6y1fILvbeLlHHCShOE5tohA5cCJWZvwwCVJel0ISkKUtHyo0niAhGHvkYI98 wCb9l7M/CRkW/7E+o+8jKSAquuUsCYLeSfNVyG47VpTrB5Fw/N/U90nI460v mmjhJDCLHXfuRF4p9q0g8SoJJ7XTTRa/T0JRp30hgYS75oOREchpmwSiHW+R IBO+pfIAcstkcj43De2XHukBPmQnZsCL/HwSlmm5GQHKA+7VxkChhyR0it7r I5AVthxpcC8hQbFS1rMD5cnORpxYU0mC/NG1e08gRz695n3vOQliiYRR2Hq0 n3Qsngi8IkHl2hszC2R2qdytQy1o/Qw+GbGR5dtCBWU7SbBWcpqIRXn2er9w b/ggCb1vG8IiUN7xNJ2q6/tGQv79qwsmyDkCVUbrfpAw7lV+eAHlZYbtwR8/ fqP1Vkycc1vMz5pIw828bNgYZ2ZnZoTDmZ59lePSbEilXRaoRnm8cUCplS3P Bq/MPwbuyOdeK0WpKLBhqoF2fimymyv5bZ8KG0zq/CzOoLxXtQ00f6zFhlUZ eS9V9HFYNbSs1tmSDcVyubm7UL3gOfReLGAbGxyte5WnUD1xSR1hxe9gw7Yh h5LryAEjxwZK97LhW3mp+GI9kjiQsRU7woa7XUmdZpo4TMpHc0LOseGvuGbY AqpnDd4q+fFBbMhyv30wDtllu9ZEajAbDDvmdioiN2f1u1ZcZMP+H9Pn/kX1 UMQsiDt6jQ0ueNX3M/+g/Zy0qdwkjw2cj0Z6VSqoXkztbbn3kQ3P6AfsbqD6 a3J1aM3PPjbU82EpGHLex5NczUE2JHmdazkhj/KnLa63dJgNETY+5DpUv18S Ae5P/7AhbfVMTzOq/+8V7qtViQjCUXo48UQcvU/d5oaLmSD87gn26GDhcA+K pDPNBaG3Qu+fZcgDt630ui0F4XJ27Xsn5uJ8ksB8pyD8rP4sM0FH+ae5N0be QRCKdpWs5EX9yem2E1ol/oKQecc59ssCBpK0AaHEXEGgHRixHxnDwKbUUzs2 XxCMlbZ6KSL/0FjKF/JAENzbJNP2ov7I1ZT/+slSQYj9bLWj+icGRxQc8g3q BCGdR5Y3FPVXzAP/5tR+EITdkruy+gcwqNf6wH7Bz4G+p8LtU+3oeYFniuW1 OJD8tdfodCnqlz/ddAjX5sA1WQbj3CPU336z7h/V4cDVT3FzASUYJItXu1Xr c8DkD/dIUBEGg6LvMuwpDvRcmNf1R/1mr7V8yHVzDlzq5fm9AfWrEpbr9b7Y c8A7wv6EXgIGnLBRR8EoDpzru3brnicGui9MuiKjORDT+/6xrQcGU+etFeix HPhdVDQo5I6e/+K5Mk88B+r2pdp5u2DAe9qHPpLAgfTxe5/Uj2Gw4Rd9RXU6 uu4kZ+xvi0FqefSQSTma3/rz6603YtAaH5lW850D4fQDs4D+B3IFNgvIDHPA oX1A5S36XzAcKdrg9YMDP4z1ww6JY/ArKM5UcZQD54n0zmARDG5z67zOT3Dg 5nPTjsckBpY+Zd66PELQ61tghfGh/rciQy5YTAgiVHiHp7/xQcoN9r0sSgh+ YVyd4BI+OHarlPdXghDIWOcdO0PxQRNnwrr3hxCEbFEv/PCYF1q/S3k+MBAG k6e0Mn1tXqh/bdBxMlIYLnmNJ9Rc44HjG+JzDrYKQ7P1q9t6PxcozQq2aK6k CMQ7Mbp50+apscnRmEMHRcD8Cif7u+Ic5fFzreBYmgj8vqB1TCR3hvokWEa/ +FUEhM3b2Td4/1JvWwZOWiqJQold8J5Y+2kqXiFXtNJeFDofVT9rL5mk/qj9 c+llkiicfxAsbds1TjkuCcm52yoKay7w6PeSv6lUE97EZlIMOqdUp+6wflH1 OUulMzaIATP41qZM+gg1nuFrPOApBuWeustSlL9T3jXt62QzxeBWYCfduGuA 0lB9LSf6Vgyiu0x1jlR9oky54R+d5sTA7W2fY+S299RE8gNTV6448OW976ow baGk+PxfN24Th83XDzvvcq6hHhv/kbrlJw6cmGqhLBUPqkdq7mMKsnqJjT6j 150SMPybnoHsNqi93vm6OxW2v1ctb3F8QvaUKs2d4jD2r3+KXFW48bNNgytV JSfk9BU5ZX6JyR7D45S7m8d9LX9xCFwV9EOBe5BK8b3toY+8VKQzqvu6A1X9 rE7HCDklvWb0Os2B+rt5vtIMuSoic1ai0Y4SfCb3at/i/Tqdbn2GNpRJruxI 4OL1HBEre64VJbLnY0EIMmRnDDTTtlOWlje9Ly6O1/446924lZKQmJ2NR+YJ tg9QNrKgelRcWXcX/Z7BF8BdT9Upz7zMXrRXz5/0Rora7h4Yl79o5fu4udFa yrP/lGTZote57Y3malAS7K8fKhfd1m5qY6RKnTtvlVKzaPN5/BpXgco1LnZs /N/7Hnfd4ApT9y1ElJsX/b+jcN3/AfLH1Xk= "]]}}, Axes->True, AxesLabel->{ FormBox["\"x\"", TraditionalForm], FormBox["\"y\"", TraditionalForm]}, AxesOrigin->{0, 0}, AxesStyle->Thickness[Large], BaseStyle->{15, FontFamily -> "Times", Bold}, FrameStyle->Thickness[Large], PlotRange->{{0., 5.619923220207893}, {0., 2.5355933872097847`}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{3.41999172237418*^9, 3.419992170860428*^9, 3.419992252331623*^9, 3.41999253915499*^9, 3.420363122428505*^9, 3.420363221589714*^9, 3.420396101501728*^9, 3.451691889691147*^9, 3.4517423561358757`*^9, 3.451754521703806*^9, 3.482969953452527*^9, 3.514326354813465*^9}] }, Open ]], Cell[TextData[{ "Without air resistance this curve would be a parabola which is symmetric \ about the maximum. However, we see that with air resistance the curve is no \ longer symmetric about the maximum, and the particle drops to the ground \ almost vertically. This is in agreement with our experience.\n\nThe \ horizontal distance traveled when the particle hits the ground is called the \ ", StyleBox["range", FontWeight->"Bold"], ". We can determine it from ", StyleBox["xx[tfinal]", FontWeight->"Bold"], ":" }], "Text", CellChangeTimes->{{3.4203963866733637`*^9, 3.4203964160691223`*^9}, { 3.5143263668147593`*^9, 3.514326397238155*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"xx", "[", "tfinal", "]"}]], "Input", CellChangeTimes->{{3.5143263464255342`*^9, 3.514326349695808*^9}}], Cell[BoxData["5.619923220207893`"], "Output", CellChangeTimes->{3.5143263548760347`*^9}] }, Open ]], Cell[TextData[{ "As expected this is less than the distance traveled without friction ", Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["v", "2"], "/", "g"}], TraditionalForm]]], "." }], "Text", CellChangeTimes->{{3.5143404221518507`*^9, 3.514340474656163*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"v", "^", "2"}], "/", "g"}]], "Input", CellChangeTimes->{{3.5143404776580772`*^9, 3.5143404793568*^9}}], Cell[BoxData["40.77471967380224`"], "Output", CellChangeTimes->{3.5143404798474216`*^9}] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["\<\ Fixed initial speed but vary the angle of throw \[Theta] .\ \>", "Section"], Cell[TextData[{ "Next we are going to vary the initial angle \[Theta] to determine the \ maximum range of the projectile, for a given initial speed, in the presence \ of air resistance.To do this we first determine the time, ", Cell[BoxData[ FormBox[ RowBox[{ SubscriptBox["t", "final"], "(", "\[Theta]", ")"}], TraditionalForm]]], " at which the projectile hits the ground as a function of \[Theta]. We \ define a function for doing this, which is just an combination of the above \ commands for integrating the equations and determining the time at which the \ particle hits the ground. Before that, however, we need to remove the \ previous expressions for tfinal and theta:" }], "Text", CellChangeTimes->{{3.4203964264885283`*^9, 3.420396451151762*^9}}], Cell[BoxData[ RowBox[{"Clear", "[", RowBox[{"tfinal", ",", " ", "theta"}], "]"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"tfinal", "[", "theta_", "]"}], " ", ":=", " ", RowBox[{"(", RowBox[{ RowBox[{"sol", "=", " ", RowBox[{"NDSolve", " ", "[", " ", RowBox[{ RowBox[{"{", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"x", "'"}], "'"}], "[", "t", "]"}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"-", "k"}], " ", RowBox[{ RowBox[{"x", "'"}], "[", "t", "]"}], RowBox[{"Sqrt", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "t", "]"}], "^", "2"}], " ", "+", " ", RowBox[{ RowBox[{ RowBox[{"x", "'"}], "[", "t", "]"}], "^", "2"}]}], "]"}]}]}], " ", ",", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "'"}], "'"}], "[", "t", "]"}], " ", "\[Equal]", " ", RowBox[{ RowBox[{ RowBox[{"-", "k"}], " ", RowBox[{ RowBox[{"y", "'"}], "[", "t", "]"}], RowBox[{"Sqrt", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "t", "]"}], "^", "2"}], " ", "+", " ", RowBox[{ RowBox[{ RowBox[{"x", "'"}], "[", "t", "]"}], "^", "2"}]}], "]"}]}], " ", "-", "g"}]}], ",", RowBox[{ RowBox[{"x", "[", "0", "]"}], " ", "\[Equal]", " ", "0"}], ",", " ", RowBox[{ RowBox[{"y", "[", "0", "]"}], " ", "\[Equal]", " ", "0"}], ",", " ", RowBox[{ RowBox[{ RowBox[{"x", "'"}], "[", "0", "]"}], " ", "\[Equal]", " ", RowBox[{"v", " ", RowBox[{"Cos", "[", "theta", "]"}]}]}], ",", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "0", "]"}], " ", "\[Equal]", " ", RowBox[{"v", " ", RowBox[{"Sin", "[", "theta", "]"}]}]}]}], " ", "}"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "y"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"t", ",", " ", "0", ",", " ", "10"}], "}"}]}], "]"}]}], " ", ";", " ", RowBox[{ RowBox[{"yy", "[", "t_", "]"}], " ", "=", " ", RowBox[{ RowBox[{"y", "[", "t", "]"}], " ", "/.", " ", RowBox[{"sol", "[", RowBox[{"[", "1", "]"}], "]"}]}]}], ";", " ", RowBox[{ RowBox[{"xx", "[", "t_", "]"}], " ", "=", " ", RowBox[{ RowBox[{"x", "[", "t", "]"}], " ", "/.", " ", RowBox[{"sol", "[", RowBox[{"[", "1", "]"}], "]"}]}]}], ";", " ", RowBox[{"t", "/.", " ", RowBox[{"FindRoot", "[", " ", RowBox[{ RowBox[{"yy", "[", "t", "]"}], " ", ",", " ", RowBox[{"{", RowBox[{"t", ",", " ", "1", ",", " ", "4"}], "}"}], ",", " ", RowBox[{"MaxIterations", " ", "\[Rule]", " ", "50"}]}], "]"}]}]}], " ", ")"}]}]], "Input"], Cell[TextData[{ "The range, i.e. the distance traveled, ", Cell[BoxData[ FormBox[ RowBox[{ SubscriptBox["x", "final"], "(", "\[Theta]", ")"}], TraditionalForm]]], ", is easily obtained as x[", Cell[BoxData[ FormBox[ RowBox[{ SubscriptBox["t", "final"], "(", "\[Theta]", ")"}], TraditionalForm]]], "]. We need to indicate that \[Theta], the argument of xfinal, must be \ numeric to avoid problems with the subsequent ", StyleBox["FindMaximum", FontWeight->"Bold"], " command (see below) when using Version 5 or later (this is most \ annoying):" }], "Text", CellChangeTimes->{{3.419991842750168*^9, 3.419991890650255*^9}, { 3.420396033258636*^9, 3.420396033808978*^9}, {3.420396200806293*^9, 3.42039620407908*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"xfinal", "[", RowBox[{"theta_", "?", "NumericQ"}], "]"}], " ", ":=", " ", RowBox[{"xx", "[", RowBox[{"tfinal", "[", "theta", "]"}], "]"}]}]], "Input"], Cell[TextData[{ "We can now plot the range, ", Cell[BoxData[ FormBox[ SubscriptBox["x", "final"], TraditionalForm]]], ", versus \[Theta]:" }], "Text", CellChangeTimes->{{3.420396159127884*^9, 3.420396167117536*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"xfinal", "[", "theta", "]"}], ",", RowBox[{"{", RowBox[{"theta", ",", "0.01", ",", "1.57"}], "}"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{ "\"\<\[Theta]\>\"", ",", "\"\<\!\(\*SubscriptBox[\(x\), \(final\)]\)\>\""}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{{3.4199916258446703`*^9, 3.419991635523904*^9}}], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.67, 0.6, 0.6], PointSize[Large], Thickness[Large], LineBox[CompressedData[" 1:eJwV1nc8ld8fAHCbbva4TwlJtFCyCvE5EVFahIovklAJKStSZCtlpYEoK6uh kJERWZHscct9LpciQoSs3/n99bzer9e5zznP59zP2GTnanKejYWFxYqVheX/ z7LZuLvM60HQMj9t+ebOMHTM1teWewRDc+jlNVt8R+DX7NJyvFsIrFzglKly +AGSf+1dDBzCwLGY2p+nNgr+f1WPZZ64AwEHFcS5345Diu/FMFXRGJC2U1HR 2jgNub5BaSnRMVDxKKVoMXAain2TK3kFYmH7fLtrEXMavvq2zQ+tiYMPI8Pa qll/gM1P80L8ajxo2Efv+LRpFs75UQ79HX0Eg6nDG1dG58DNT9bBzukxXJkk MwLQPPj56QS2MB9D/qE7nfvj5yHOz70kg/4Ehq4uSQbvW4Aav74dFl1JYGIS VXg58B/E6nRy0ugp8Inmbg4TSzCjkz6873MavDDVMTmSw4LejVLMNQTTwV/0 l/bWLyzI84FbrdrJdLBMStQrmWZB8+NaaTtp6aDmFZ8joMGKlhLbzkr/yoAl olkutpoVcSyu0th5X8C1DW+PfmpgQ2JFZ9obD+cBTYNH8kg+B+qyq9Stu5cH ga15jaONHOgh/5Y3H9vzQP7q2Z7TIxxI3GHqfpllPtw3st+fv5ETSYmFHc2/ 9BKWKAZsEMWJYt/3DdXXvgKJlZF3Lue40BOCxzaX+QaqNG84ik5xozs55j8v cBZAZqFmpwo3D/KDdPetcgXQ6Xr5prokD7J21A1+Zl8AykzvhGFDHiRd5Jf9 cLAA9K4e5VpI5kFp5lMzQeRbMPE/dVvSYA3Kje8L/+9bIQgmNMxMBlBQ4vbt IhuWC2FKkFttLI6C7pZ7JfZIFMGblLOpXzIpyIUp+tLUqgjyXux8ZdFMQUpq xzqM+otgGxlsf4FYi952fJRS7y2GxXl5t6LMtahMJK+Av7MEUhsERHhKeBGr 3nSPwgx2jHjX/kZeZOC+Z+WQSCnUZyysv9THi1pbqwxDT5TCIYeJhDv/eNHQ 3a5vq82lQFi9DebX5EO8PCw8U5/KQN0vYkmukA9ZLZlYtRd/gDdBZ4dNn/Mj f3c/NuOjVZA+ESK9V14QCah55CnYVAFXUMhjRWVBlDJ3+RSfWxV8+bsjQkJD EH30s8lvia4Cu0t808MGgognVPfMic4q2OeaM7PTThDFPOF5Y25VDQsPHyzH JgiijJq4s2cvfgQZvbHA38uCqJmaV+kZUguGz1PmHpcIIYfiq6J7HtRCh1yQ QGuFEGI5o+k0l14LlhPBG1hrhZByUp2Ad20tqHdZyFh8EUIPNjOsfTg+AePk tYvtg0LIVolY9g38BOqipdWCvMJoxihAI8C/DiKuUxilp4WRxA2zN5GeDeDs qjKbMSqM0ozck5NCG2B/eASn2W9hpEC9F/HyYQMsSupdXv0jjPa9rLdrL2mA kjW0E0bLwsiK1BLZsNoAVxyNu18LiKBEfZlr2aGN4B9d/69HRQRt4P+t1vCw CUJzqMkJPiJI/GnYe67SZuC9psgatCiCjN+n/Klvaobh9CMlx1ZFkH97sWIk rRmoqgEv1rGLokHun6kCK81g33BF5RlFFOW6GUWs298CC8X9anHrRZGOLsVy R10LbHHw+jWrLorOMiOXjrR/AXc3/l0VrqKoI77uaeNsK3SMNwR194qiKzGa 0U+WW2HqqVNpI00U8d/LC3Tm/Aq6KsenSgdEkWFY7Hl+sa/A8FG3fcgUReXX beRNVL/Cs8QsF40pUZRhM1fY6/4VJo6wXZLkEUPe27e2/Pj9FcremHp4qIqh DeUhS1yjbeBgOpuSHiqGlL7IltyabgPlO/cTLSLE0AGy2uvfvzYI3Kcdw31X DDlzrk6Pr22HR0+VXc7GiKEPR7x+dii2g7Wzy/rlRDFk992x69mVdqB9JFU6 X4uh7FXDVzoL7fB43OWWYJ8Y0tBda+/J0wntO7T0f8tSUZue4F8bwU7gitau ZNtKRRf1xcKM1nXCxoHyN6Lbqeix4cZciW2dkBK0jVVVkYqWjqrMVB/sBFrR 2lO2alRUaWkZJBDaCSqrWVFu+lRk6JGTlsXZBX07ni9dtacii6zDzD62bjgQ 8ctDPpmKao4fTU6kdINnrm9w71MqUl44bmEt3A0VLs/0QlKpiP+QeQO5qRsE 3/U096fh9WO2eT9QN4RpFG/zyqEipV2eHn/9u6H3hMhl12IqohSmcAovdgOF JaHswlcq8rZ+/qGdrQdQ0d+kiTYqYnJleMVTeuBx9hod9w58Xoucn+vEe0CM TbHMo5uKvBbeNW/U6IHm5xHll79R0dC+pnhFrx4oMNXcJ/OTiso/zsoZ/cG/ P/zlWMoqFT0L2JxTsNgDAVbnYjewEigETihJcfSCScGjy/FsBDpemqv5R7QX 3BuEfwRxEmjozbljSeq9wMotzWG6lkC8z756T/n0ghTHvqO5VAJZ3cpresTS B/S2uDJzBQLt1+k/zrGmD8QWpzvSFQm0ZYmny0WoD4RbtsX92UmgSS97up5M H1hNsq6J3E2gINcNs+N6ffBtOan3hTqBcq3DpXRD+0DtSYZ/JiLQ4r7zV0b5 +qHb+j5bhimB7EcXGmvE+uH5nS2Hi04S6HNClOxTyX5YXFN8tc6MQMnTRd2m iv2w+bKCw5AFgXSzKDrlxv1gnDPcK2hFoAiRV5T7kf0Q/mKtoao9gcRH/z1X W0MDz7SYyMyrBLqdcG9ZQIgGrgOO3vHXCPTrgKzF6DoaXFl8cSzQg0Afnh6h PN1Gg+cjrz6c8iKQnVmKG48hDa5l2GTOXyfQi0p97f4QGqilS4xwBBJob8L9 rlsc30D91cruE/cItO7M8SV2vm+QJesstPM+geYlBGVCxb7B85n6d2uiCfT+ 2b3Ld7d8A7ns0qPlMQTSzI/ieGz4DaxkzzaJPSCQdu0d5YI736Dyarj2nUT8 fX/Copii36Gj64l9dBaBZAoN3zpJfodjjHV3Dr4gELsPT9+Y3HfopRjfXsKu WQmVm1b/DmK3xBl2OQTSp4SWrZz6DgZ+uy9uyieQ4abgUSLpOwh5qY6eLyDQ kWMBBofkBqCe5b8m/nICsb3XiU1XHAAhIm8gEbtYZmmARX0Ayr7y92z/gPf/ 6+lTZDAAx1skPFEF/r5E51xZpwGI6xt3sa0iUNqohfBq9gAww7juXaol0JmT YjZnCgYgUCaE4we2wIe2nHelA1DRdNLu3CcCXY8+ou/8eQBOHBzpNq/D/8+9 et694wMwBHxvlBoItKJL/D69jg4uElTLV58J1DvnER8qQQc1J8q1Dc0Eepvb ofVOmg7/wNwnGPsCNSZMcDsdmJ9+G5m3EKjjJ69MnQYdqtuW14x9IVD2fTYz VUs6PD5wW4tsI1Cw/tnFszbYRxbVtdoJZPuvIvXeOTrePVUmDlvM/sbE6CU6 9FU5Nel2EOjWnvnQVD86fDW2vRDbSSCz7+Ml/Ml0mEo6S2HrIdA05dbhmVQ6 sOblggF21B5hWm86HYyHiiLDsevvqy+n5dHhT0WdE18vvn+9m6BVTofN6R1a lD4CdbsKtUpX0cHy9HaFg9jXEp/bctXSQaIxV/U2dt5sXcDXz3QYr5qJmseW zhKscaTRQXnXtcs9/QQq73h28gidDmtbdsjy03D8WdWYykN0CM3znNHFjj1z mmtlDJ+XuMl4gc3F98wwbpEO/p82LTh/I9BzDdVen1U6XMg2CXiCjRw+XbBh J+GJr5dsA7ZPxWjEjrUklM8YlW36jvPnikpzpTgJ+mvr1Ouxw5Nr/8uQIuHL vPGT39hbmiwmImVIiCYlJagDBLKR9ROw2EHCqRmjq7bYbV01J8Y1SPjed95v FNuV3YLRpk1CzM6BOgod1yOln+7F+0nYK/NHaQe2fjhf3G0jEvJj71s5YBdr mXetP03CNMdmqQ5sM6cfDqtWJPCF/Tkzjj0dd31uyJYEB/HMQk6SQPITyete OZGQEXm6SQW7Xnz3i3hnEsRVXwQZYdsf/Kjh64b3u3njP2vs5JSRMwbeJPjZ nHQJxtZq9hmT9yNhnp6RkYDds7DWT+gWCfXfJFezsK9tSeadu03CW27S6z22 kKlSEi2UBIVZQqgBO/9mtWJ1JAlZm0Ybu7EP5Z78kHmPhNBx/3QmdhCnz4B7 AglJ1nfLV7BpZdJduU9IiJJLGKIwCKR2rf7z8FMSfstXclKxo+TdPkqnkXCe RXOTNPYwgyg5k0UCF5/6nu3YOo8rXsXlkuCYwDy4GzvhhGNmyysSiip9TPdi T/IIJPO8w/EP3nxGB9uwsjBO9z0JVRUiVnrYKV7WkX7lJGzc7Hv6IPbCTq7A wioSmCjC5BC2yXCe92QtCedCrhw0xs5OMnPd0UiCjPbZvUew2cyWz9u3kHA2 Mlzu/z7Dm26V3EYC7aq4wP/Xv/lobNrTRYJKl96sEfZa3xkj4X4S/rmo9Rhg 2ysnIuMBHK9uqWJd7LKfentCBklQ+54Yr40tmjqmWDlCgoQMh9sebOdTsbL/ xvB6pamDStg1AlobVCdJmFgXK7kNW7KOIeQyg+Ndt25KCtvTP4Ina54EDu7X 1aLYLWrKq+QSCdU3I2LWYG8Z753dwMoApeJ222V8HzfTAn6ZcTKAVaxUcfL/ 92+5ffDeGgbw9roskNhKIl97G/gY8FJOsqYNO6zRu5VdmAFF//7crcYmA6Tr tKkMyFffZPEaO2bS9e1rKQboF6n9iMQezSRyxmQYsFPE+5UXtp5NRarcVgb0 cdR522HPNPPfe7SLAZ9dgKKGbRxcGNyugs83X90ugZ22z9qPby8DpjS4k9mx zXLyLgQgBkSnBam14HzItzOzLT3AAHUalf0NNpf4svmsIQMGf25oi8MuDDM+ cOEEPp/+Lg8L7HUOY1In7BjgYmjU0Yrz000yVizSgQGOp/e/ycVu6NDkrb3I AKkISmwo9nW9iIW9VxkQI1X+nyY2TXp7h3QQA7plzCXicD1Q7WltPBPGgAfi kWJO2HfveVfF3WFAWdmIsBa2zkpdPk88A6w5qsS/43rztN8hfDKdAXSVO+fW YZdQdC8yXjAg3Hnv6giuXx0akoc78hjQ6ZZcWYjN87Cdt/gdAx6bSr07ge1+ Et2/WcsA5/F4pxu4Pho0r0/gZzIgcdmGmovrr+3SjBfLTwbU+WhLumD7yree mv7FAL7iocO7sF+Fh4h3zeD9w4Q2vcT1e73Bn6QkjkGg6Tnmp3Xj+vfhc5qC 7CBMiXe6OeJ+wDWRGSy1bRA2yeuxS2BvkrztIKgwCNyfPSq+4P5h7quxbUZl EHKz0t6pYlfuycgp1RsE3s+hiTO4H8W+uvnm0Dm8vlTc1bgV94dnypVOzwZh wnvXglUjgQStNnO/zBiEx+6XXSdwfxwWEz06mz0IRvuCJ/yxY8Jn+wMKBsEv v507qZ5AY27Fc49rBkEymZ7djPttIujsah4eBB0x/jaWj7i/0oySd8sPQbjl 4qOXJTieDzSZXruGAFapbjLY2cflFT6oDMHTvAumce/x+Wt4Sw7tG4L6lxq6 HsUEepnzpfPckSFYx7alRr4Qx/O6Gd8D1yHY7zXjcek1gaqIs37/CoaANBe6 qp6J60F6a5dC8RDMqgUdi8rA840y2m1TNgQHM5v1mek4X403Dn+sGYIHrqdu 3U8j0KeAb8fudg6BXImnEi0Vz4NjpzdLzw3B6XdkvCGej7oqTBr1NZlQVs2p 6YnnrTHHA+uiK5mguIP8usOTQBPOI1a+NUwoTZEWP43nu8krEann65kQwDny NATPf399W3dotjLBiTxlP+BOIJb7VtqDA0xY1WFpD3UlELX4mp3aKhPW5r8+ 9dYJ90Oe9Nxe7WG4J/P9rt8ZAsVnce6XKR2GOTmHsmYtAp3c+2HMtmIYIiz1 UKEmgYTrPR88/TgMp2M5mUkauF6PjIxJfB4GpUPR0Rf34PqwpfEB8W0YFiIU fBaUcf6kRf3iXR0G7bTr8ePbcTxTiIdzuiOQeHw8YReB+9fD7b8/N47ATseS Axt/U9F+b/kd7vU/oKn0qvCeJ1S0qMw4IFH1E0r5/fqfaVNRauLi0EDLKGy2 ujCf2SSG6v5OCyU3joGzXC57jZkY6l01rvHo/wUNyZGVDxtE0b1BS3OTkXEw usszHK8iimqKDD22kxPAunSwvyBRBDE1H64Xn/wNxC5Nib3jwkiv2y490HMS rKRNKZY6wuj8Snve9elJ0NySsjk9TAgt+/31XvWegtna4nT2YkHU+Sc0IuDv FBxOb+o36xRAm6sbre/7T8NzO+Wn0yz86HWYn0/i8jQM+lvVzarxougyHg75 63+AOlZfRrOhoJGDBicMWGega1ngRvZhHnSjaXrI+uYMvq9FZxMDLhSecVyL g2cW7pnMGySusqORiTBWhahZuKPcTSvPY0VBu5T4T6z9C28DF3cvkiuQUBf2 jS32L7Ar7Do6T1+AUYvjf14LzYG1dPXWMWH8HrNp78G7cxBXLWO4CU1CdrZ+ VaroPAQ7va7f/pUJnPPcx/+LmQd1a33BLJtu6Er0TU0XX4BnwQ+f3JCNBaS4 4dc7bPJUuvTCQgxkl5eof8KujJ17fu1LDPh/X2gaxj43r5V+6XoMbJX2/rt1 wwJcN5CzP90aDd7Prx3OxpbrPL9fze8+rM++PJsvsQA8C43OPZmREKTJhyqw CxrGNb+YRMJEY27EF2wHJSPuT8sRUD02tnES+8fbnocFphFwUfHiod2SC+D8 2zczajUMSl45PC3A/rjg7XPAIgRk93ONfsQuV4lT0GILgaiv6aod2M3sat93 5wWD3fRQwwz2rdAN2hvZg2Gt6rkZNakFUKDwjC7k3wbPGjYwwHZkoUVPnr4N 9JPPws2xX9va7B3huA1vPUgpL+ydq7cDOs4EghRXwIVQ7G1tu2SbOAMh7IH0 2wRs7tak2qpXATC9pXIlE1vGlXQotgwAqyIbo2Jsiwoa50uuAPgfxBJVsw== "]]}}, AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesLabel->{ FormBox["\"\[Theta]\"", TraditionalForm], FormBox[ "\"\\!\\(\\*SubscriptBox[\\(x\\), \\(final\\)]\\)\"", TraditionalForm]}, AxesOrigin->{0, 0}, AxesStyle->Thickness[Large], BaseStyle->{15, FontFamily -> "Times", Bold}, FrameStyle->Thickness[Large], PlotRange->{{0.01, 1.57}, {0., 5.970997696814523}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Scaled[0.02]}]], "Output", CellChangeTimes->{ 3.4199917233851357`*^9, 3.419992170961462*^9, {3.419992244139821*^9, 3.4199922524899817`*^9}, {3.419992528758863*^9, 3.419992540174636*^9}, 3.420363123836618*^9, 3.420363222632318*^9, 3.420396102772785*^9, 3.4516918909199657`*^9, 3.451742357025704*^9, 3.4829699550495*^9, 3.514326355835306*^9, 3.514340528180422*^9}] }, Open ]], Cell[TextData[{ "Note that the range increases rapidly as \[Theta] increases and reaches a \ maximum at a value ", StyleBox["less", FontSlant->"Italic"], " than \[Pi]/4 = 0.784... (which is the value without air resistance). I \ would say that this is also in agreement with our experience. " }], "Text", CellChangeTimes->{{3.420396483855365*^9, 3.420396487238204*^9}, { 3.514340568833107*^9, 3.514340574389163*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["Optimize with respect to \[Theta] .", "Section"], Cell[TextData[{ "We would like to know what is the choice of \[Theta] which maximises the \ range of the projectile. We will call the maximum range xmax. We locate the \ maximum with the ", StyleBox["Mathematica", FontSlant->"Italic"], " function ", StyleBox["FindMaximum", "Input"] }], "Text", CellChangeTimes->{{3.4203960500731783`*^9, 3.420396056256493*^9}, { 3.420396237359557*^9, 3.420396277389496*^9}, {3.420396507846024*^9, 3.420396523582402*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{" ", RowBox[{"FindMaximum", "[", RowBox[{ RowBox[{"xfinal", "[", "theta", "]"}], ",", " ", RowBox[{"{", RowBox[{"theta", ",", " ", "0.1", ",", " ", "1.3"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.420396061047325*^9, 3.4203960651217823`*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{"5.97099805032239`", ",", RowBox[{"{", RowBox[{"theta", "\[Rule]", "0.5561489486631733`"}], "}"}]}], "}"}]], "Output", CellChangeTimes->{3.419991723581126*^9, 3.4199921714883423`*^9, 3.419992252588469*^9, 3.419992540384233*^9, 3.420363124016453*^9, 3.420363222855139*^9, 3.420396102929214*^9, 3.451691891125355*^9, 3.451742357181836*^9, 3.482969956303464*^9, 3.51432635595473*^9}] }, Open ]], Cell[TextData[{ "Note that we have to give two starting values because the derivative of ", StyleBox["xfinal[theta]", FontWeight->"Bold"], " is not known. The maximum range, xmax, obtained by optimizing with respect \ to the initial angle \[Theta], is the first element of this list:" }], "Text", CellChangeTimes->{{3.420396291191291*^9, 3.420396300477721*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{" ", RowBox[{ RowBox[{"FindMaximum", "[", RowBox[{ RowBox[{"xfinal", "[", "theta", "]"}], ",", " ", RowBox[{"{", RowBox[{"theta", ",", " ", "0.5", ",", " ", "0.6"}], "}"}]}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.420396068062189*^9, 3.420396073722067*^9}}], Cell[BoxData["5.9709980503223905`"], "Output", CellChangeTimes->{3.4199917236287193`*^9, 3.419992171661352*^9, 3.4199922526673317`*^9, 3.419992540418786*^9, 3.420363124068777*^9, 3.420363222898232*^9, 3.4203961029732437`*^9, 3.451691891171315*^9, 3.4517423572263107`*^9, 3.482969957904875*^9, 3.5143263560355167`*^9}] }, Open ]], Cell["\<\ Now lets combine everything together to determine xmax as a function of the \ friction parameter k (assuming the same initial speed v = 20).\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"xmax", "[", "k_", "]"}], " ", ":=", " ", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"tfinal", "[", "theta_", "]"}], " ", ":=", RowBox[{"(", RowBox[{ RowBox[{"sol", "=", " ", RowBox[{"NDSolve", " ", "[", " ", RowBox[{ RowBox[{"{", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"x", "'"}], "'"}], "[", "t", "]"}], " ", "\[Equal]", " ", RowBox[{ RowBox[{"-", "k"}], " ", RowBox[{ RowBox[{"x", "'"}], "[", "t", "]"}], RowBox[{"Sqrt", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "t", "]"}], "^", "2"}], " ", "+", " ", RowBox[{ RowBox[{ RowBox[{"x", "'"}], "[", "t", "]"}], "^", "2"}]}], "]"}]}]}], " ", ",", " ", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "'"}], "'"}], "[", "t", "]"}], " ", "\[Equal]", " ", RowBox[{ RowBox[{ RowBox[{"-", "k"}], " ", RowBox[{ RowBox[{"y", "'"}], "[", "t", "]"}], RowBox[{"Sqrt", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "t", "]"}], "^", "2"}], " ", "+", " ", RowBox[{ RowBox[{ RowBox[{"x", "'"}], "[", "t", "]"}], "^", "2"}]}], "]"}]}], " ", "-", "g"}]}], ",", RowBox[{ RowBox[{"x", "[", "0", "]"}], " ", "\[Equal]", " ", "0"}], ",", " ", RowBox[{ RowBox[{"y", "[", "0", "]"}], " ", "\[Equal]", " ", "0"}], ",", " ", RowBox[{ RowBox[{ RowBox[{"x", "'"}], "[", "0", "]"}], " ", "\[Equal]", " ", RowBox[{"v", " ", RowBox[{"Cos", "[", "theta", "]"}]}]}], ",", RowBox[{ RowBox[{ RowBox[{"y", "'"}], "[", "0", "]"}], " ", "\[Equal]", " ", RowBox[{"v", " ", RowBox[{"Sin", "[", "theta", "]"}]}]}]}], " ", "}"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", " ", "y"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"t", ",", " ", "0", ",", " ", "10"}], "}"}]}], "]"}]}], " ", ";", " ", RowBox[{ RowBox[{"yy", "[", "t_", "]"}], " ", "=", " ", RowBox[{ RowBox[{"y", "[", "t", "]"}], " ", "/.", " ", RowBox[{"sol", "[", RowBox[{"[", "1", "]"}], "]"}]}]}], ";", " ", RowBox[{ RowBox[{"xx", "[", "t_", "]"}], " ", "=", " ", RowBox[{ RowBox[{"x", "[", "t", "]"}], " ", "/.", " ", RowBox[{"sol", "[", RowBox[{"[", "1", "]"}], "]"}]}]}], ";", " ", RowBox[{"t", "/.", " ", RowBox[{"FindRoot", "[", " ", RowBox[{ RowBox[{"yy", "[", "t", "]"}], " ", ",", " ", RowBox[{"{", RowBox[{"t", ",", " ", "1", ",", " ", "4"}], "}"}], ",", " ", RowBox[{"MaxIterations", " ", "\[Rule]", " ", "50"}]}], "]"}]}]}], ")"}]}], ";", " ", RowBox[{ RowBox[{"xfinal", "[", RowBox[{"theta_", "?", "NumericQ"}], "]"}], " ", ":=", " ", RowBox[{"xx", "[", RowBox[{"tfinal", "[", "theta", "]"}], "]"}]}], ";", " ", RowBox[{ RowBox[{"FindMaximum", "[", RowBox[{ RowBox[{"xfinal", "[", "theta", "]"}], ",", " ", RowBox[{"{", RowBox[{"theta", ",", " ", "0.1", ",", " ", "1.3"}], "}"}]}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}], ")"}]}]], "Input", CellChangeTimes->{{3.4203960790917187`*^9, 3.420396086307885*^9}}], Cell[TextData[{ "For example we can recover the exact result, ", Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["v", "2"], "/", "g"}], TraditionalForm]]], " for k = 0 (remember v, the initial speed, is 20 and g = 9.81)" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"xmax", "[", "0", "]"}], ",", " ", RowBox[{ RowBox[{"v", "^", "2"}], "/", "g"}]}], "}"}]], "Input", CellChangeTimes->{{3.420396320447344*^9, 3.4203963292223873`*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{"40.774719673285446`", ",", "40.77471967380224`"}], "}"}]], "Output",\ CellChangeTimes->{3.4199917237095957`*^9, 3.419992171739417*^9, 3.4199922527522297`*^9, 3.4199925404718*^9, 3.420363124147463*^9, 3.4203632229680223`*^9, 3.420396103049612*^9, 3.420396329710082*^9, 3.451691891249271*^9, 3.451742357291039*^9, 3.482969958353215*^9, 3.514326356093363*^9}] }, Open ]], Cell["\<\ Finally we plot the xmax for a certain range of k:\ \>", "Text", CellChangeTimes->{{3.4199917541952457`*^9, 3.419991756108419*^9}, { 3.419992124884025*^9, 3.419992154642311*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"xmax", "[", "k", "]"}], ",", RowBox[{"{", RowBox[{"k", ",", "0", ",", "0.5"}], "}"}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{ "\"\\"", ",", "\"\<\!\(\*SubscriptBox[\(x\), \(max\)]\)\>\""}], "}"}]}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{"0", ",", "41"}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{{3.4199916832448587`*^9, 3.419991692956067*^9}}], Cell[BoxData[ GraphicsBox[{{}, {}, {Hue[0.67, 0.6, 0.6], PointSize[Large], Thickness[Large], LineBox[CompressedData[" 1:eJwVx3k81IsagHEqceVgrM2oJFuyzWSZFL2vpWSrLFlKKElS2iRkD8eeakiW aCxlLMOgbiFEhLKXrBO3JJQ6RRE6v/vH83k+X7nj52w8VvHw8CQT/f/mHpPd 9Z/27O7+31aGirsJrjGmnOeSFSDlu/JUtZkJamWnZVaQteGnoI1oFtUELV71 c7LIJqCfspa1548xOpz4WXuTbAcSv8xd+XOMcUTzb+NE8gnImXOsV/xihIzs 9fWKRzxgjN3VxDNghOYiLP2nmSfBOdOLJtVkhA+/vNSZlfWCMA5VZybdCJNK xLZaK/nA24RPQyoWRpgjeSA6juwLIjJHIhWrDPHqq9tN9k98oSL19Ha9XEO0 j3q3Sv7IZUj46REfcMMQheYuhFZn+sFZJeaFYB9D9O9j+M/IBkBamNvB0G2G aH1r8PR+pRCQq7rX+64QMVygQjmWHAk2PGYFzyMBt5neiOGcjwRRwfjzGZ6A PVHnPg21REKsb498hTmgwmq1Ig2/KBAocYnNIwE2L+dp9PVEQ0nGLXk/5m4U +p6qI5sQCwu5dA9ypwGmjQQaV60kgTevG8P0gD4abnDKGz10HfT4/XTe7NDH qcN0PoGS6xBw7dby9S36uGkmwL1EPRmYzo5fIuZ34TkvXUWe4WRo9xY0cMzZ hWIn2A/yd9yE8svGWfa/d6Kj0z32128M2PsrNqa8XQ9nh+wEmZQUkGF3+80/ 0cNoFwEPW+MUuNE9lnyIpYcV7ucoDxkpYOtSa3gsVg+FfQyirtJTwXCP8537 +/TwecTA4bXBt0Fu8uM/T9p34PZi0toNAukgEORlFzhOx1aN526vqOkQtBIY xOijo1u5f3WIUzosJgT/9ayZjokPuefHWOmwtv57tX0RHSfrS4YKrDIg9lJC 0bHLdLz72qycdisTHpA6HAaF6LjuT7iz6aZsmIgJfmmzTxfTvBxc1PZmw9Gx wbZWfV1U6FNzI/lkw34lBZEDNF3cXdjvPlSbDeKUE7+uUXTxcWFq1SONHMiK bNnL+KyDn21naiw6csDislkSPVUHDz243X7pLyawXhv4Dn/VxsyjEZYn5Zjg pXI8a2pCG8fFzr5y1GGCjGQq35oRbTwXbNRpcJQJXMkuQ8dWbYy1+dzDX8IE tp7grkimNtYuGQ1mWOaCQs25IwP22qho/WWyMT4PjDh1Y4vNWkgJNd3peS8P 3kkuC92o1ULRkpx4wUd58P748gCtUgsXBWw1rMfz4Mr1JKFb97Swq/7RpdEd +ZCZH9TYHaSFgdTwlV8f8uHmomkuVUcLO0QkJDTwPqjtYTYvF2/HKx16kPaj EJyEz/BmVNFQWKPqQ6sAC1juCh79pTTMS6Qm/N7AAtPFrnfkBzTstlQecNnD gon1vMtl6TRUbZe4pJjKAptRp36lMBpyW2YLOPQiGPiYU6diSUPThnzhV4HF UCVtP283SUXpStIoLy8bNKMXyys0qeic8NvuvRQbtK8YhDxXoSLzxIf2ZjU2 rFs/7T4sT0U1yceP4x3ZsNR6x5W8nopGfm4pkmVsOPSb5tjJQ0XdTIcChmYZ HLa+wjUv0MRjLgVHH4yWwdwJw8qMeQ18OG78slOfAxJ2/YHZZer4Zl/4t0RT Dkzl9/puvK+O86VPpSxtOOBUuBTPzFJH+lW9Yy88OfDi28JsQ5w6/ldcc77+ JgeMhFl5dh7q+NiEspkzyYEncbuynsmoY03B10sMRgUoFYBVXKIaPjudJeM0 Uwm8FQFdO6+p4pySgUjJ2UfgcI9Xe3WbCq5aKBKVUXwCh81KFXU1tqLuH7eH tqU1kLZOoj+Xq4QvI7U7mrfVQZOHZsjNWkWUTZ5eKPxSD7G7LVZG8xVw+id3 9DX1GZCV1dSca+Qxb6q6TTipEVKbQht83m5B4Y33Z9+/b4L2Ma8GR+EtmOBV dTJHoRnSc6+fDjouh/NY9P5UaAt0kpcuPH+0GX23N1VKNb6AKPvKuv2Km5Fb 2hTfLdcGKz7slk5FWfx9ui9DJbAdrkubfLHasAlVDflXTla/hL5v4gZ8uhvR lCnnWS7dAdFClY77rDbglY2uW8acO2E5xXveJEIG1WYOreu36oLxUwdEbVoo KC7yVaBpsQvkWoQSGwQouKYugy2f2Q3Vr1zPuB4jo7d29cB/LHrAuV6aavNw PRaZHc95Ot8DVPCOmJNej3PTFNGJ1F5omxY/KJYgjVW2pqsZJn2wXAOftZak MHRfVHblRB8cKB7Zxg6SQrkR87e5Ua+hVfcsXyKfFO6kRzLI299A7TWHWdc4 SXTe1LnA2/sG3g1EbG7cIIlzbYnj58P7QUf92/mDRRKYtsbF10bhLdDCF8ok 90qg+GgVc1XTW+g+ZdH7Y0Ic+YLD7fQuDMDdMMYpiUhx5Cl0YY+LDcJNdoBW qqo4XkxnJ4o9GwROREhmUqcY1qrGCJB8hsCMYj7F9RdDkvlFtQjhYfDjfzIt rSqGw+pdvQE1wxCj30ObGiBh2V1QeO8yAil9xoMzySQ8ytYlbVwZgZyfY7wD FiQMi7oXPswahTXedeHRq0lYMrkxQ9iSC0qjd766PBNFa5LwjpZFLrQvWd1S DhHFOL5VMsOEN2nlJcsSblqYW/5KeEZ8dZI0Yd3xkUbKby5k9w3G8BOmVJQc 8CE8dvCfkI/BojhuZ+UpucQF0taGM/cJ+6YlpLovc8FlamS/MuGShLAAf8LF NmZWsoQnwnydEwmnu9daSBN29HLe8oiwVGjdPn7CBjvVSgVXuPA5XdX4Y5Ao rh1uf15O2M0pV+8+Yeiqe9BMuMLkzo5swv5NFfFDhJ/236bfJjxVnGHN94cL rB+lOn8T7gj2HnEkHCiwZ7snYf6LrvVnCfdrhtFcCeNJ29wIwj4rjVQHwpz9 u7yKCcvc8NA0JTxtpGnZQHjToUYNIKxAl9d8Q3hzvYoGnbCLqrTYNGGJnjR1 TcK3ZdfN/SE8Hyeqrkz4X+YbIiQ= "]]}}, AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948], Axes->True, AxesLabel->{ FormBox["\"k\"", TraditionalForm], FormBox[ "\"\\!\\(\\*SubscriptBox[\\(x\\), \\(max\\)]\\)\"", TraditionalForm]}, AxesOrigin->{0, 0}, AxesStyle->Thickness[Large], BaseStyle->{15, FontFamily -> "Times", Bold}, FrameStyle->Thickness[Large], PlotRange->{{0, 0.5}, {0, 41}}, PlotRangeClipping->True, PlotRangePadding->{ Scaled[0.02], Automatic}]], "Output", CellChangeTimes->{3.419991729928316*^9, 3.419991996338944*^9, 3.4199921768777647`*^9, 3.419992260633359*^9, 3.4199925492793627`*^9, 3.420363129372025*^9, 3.4203632281178427`*^9, 3.420396108219264*^9, 3.4516918966797256`*^9, 3.4517423624516277`*^9, 3.482969972284547*^9, 3.514326361401989*^9}] }, Open ]], Cell[TextData[{ "This plot, which shows the maximum distance traveled by the projectile \ optimized with respect to \[Theta], as a function of the friction constant k, \ summarizes the results of this handout. The maximum distance falls off quite \ rapidly as the friction coefficient k increases. With more time it would be \ interesting to study this behavior in greater detail.\n\nThis notebook shows \ that non-trivial results can be obtained in ", StyleBox["Mathematica", FontSlant->"Italic"], ", and then plotted, with a few quite simple commands." }], "Text", CellChangeTimes->{ 3.419991711090917*^9, {3.4199920898848553`*^9, 3.419992090289611*^9}, { 3.4199921630118227`*^9, 3.419992163604188*^9}, 3.419992559188917*^9}] }, Open ]] }, Open ]] }, WindowSize->{900, 907}, WindowMargins->{{367, Automatic}, {Automatic, 19}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, PrintingOptions->{"Magnification"->1, "PaperOrientation"->"Portrait", "PaperSize"->{612, 792}, "PostScriptOutputFile":>FrontEnd`FileName[{$RootDirectory, "home", "peter", "courses", "115", "mathematica"}, "range.nb.ps", CharacterEncoding -> "iso8859-1"]}, ShowSelection->True, Magnification->1.5, FrontEndVersion->"6.0 for Mac OS X x86 (32-bit) (May 21, 2008)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[590, 23, 68, 0, 69, "Subtitle"], Cell[CellGroupData[{ Cell[683, 27, 31, 0, 100, "Section"], Cell[717, 29, 876, 19, 199, "Text"], Cell[1596, 50, 375, 12, 60, "DisplayFormula"], Cell[1974, 64, 1237, 27, 254, "Text"], Cell[3214, 93, 376, 15, 30, "DisplayFormula"], Cell[3593, 110, 18, 0, 39, "Text"], Cell[3614, 112, 800, 30, 45, "DisplayFormula"], Cell[4417, 144, 481, 10, 129, "Text"], Cell[4901, 156, 73, 1, 40, "Input"], Cell[4977, 159, 80, 2, 40, "Input"], Cell[5060, 163, 160, 4, 40, "Input"], Cell[5223, 169, 79, 2, 40, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[5339, 176, 75, 2, 100, "Section"], Cell[5417, 180, 511, 10, 129, "Text"], Cell[CellGroupData[{ Cell[5953, 194, 1981, 59, 110, "Input"], Cell[7937, 255, 940, 28, 64, "Output"] }, Open ]], Cell[8892, 286, 430, 11, 86, "Text"], Cell[9325, 299, 433, 13, 42, "Input"], Cell[9761, 314, 243, 4, 84, "Text"], Cell[CellGroupData[{ Cell[10029, 322, 55, 1, 40, "Input"], Cell[10087, 325, 344, 5, 40, "Output"] }, Open ]], Cell[10446, 333, 254, 5, 84, "Text"], Cell[CellGroupData[{ Cell[10725, 342, 362, 10, 40, "Input"], Cell[11090, 354, 347, 5, 40, "Output"] }, Open ]], Cell[11452, 362, 653, 16, 199, "Text"], Cell[CellGroupData[{ Cell[12130, 382, 289, 8, 40, "Input"], Cell[12422, 392, 6522, 116, 381, "Output"] }, Open ]], Cell[18959, 511, 389, 11, 62, "Text"], Cell[CellGroupData[{ Cell[19373, 526, 639, 18, 87, "Input"], Cell[20015, 546, 6160, 109, 298, "Output"] }, Open ]], Cell[26190, 658, 656, 15, 152, "Text"], Cell[CellGroupData[{ Cell[26871, 677, 128, 2, 40, "Input"], Cell[27002, 681, 89, 1, 40, "Output"] }, Open ]], Cell[27106, 685, 274, 8, 47, "Text"], Cell[CellGroupData[{ Cell[27405, 697, 138, 3, 40, "Input"], Cell[27546, 702, 89, 1, 40, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[27684, 709, 85, 2, 100, "Section"], Cell[27772, 713, 770, 14, 154, "Text"], Cell[28545, 729, 95, 2, 40, "Input"], Cell[28643, 733, 3079, 89, 182, "Input"], Cell[31725, 824, 746, 20, 86, "Text"], Cell[32474, 846, 196, 5, 42, "Input"], Cell[32673, 853, 224, 7, 41, "Text"], Cell[CellGroupData[{ Cell[32922, 864, 430, 12, 42, "Input"], Cell[33355, 878, 8086, 142, 384, "Output"] }, Open ]], Cell[41456, 1023, 425, 9, 84, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[41918, 1037, 55, 0, 100, "Section"], Cell[41976, 1039, 466, 11, 62, "Text"], Cell[CellGroupData[{ Cell[42467, 1054, 301, 8, 40, "Input"], Cell[42771, 1064, 441, 9, 40, "Output"] }, Open ]], Cell[43227, 1076, 367, 7, 84, "Text"], Cell[CellGroupData[{ Cell[43619, 1087, 356, 10, 40, "Input"], Cell[43978, 1099, 327, 4, 40, "Output"] }, Open ]], Cell[44320, 1106, 164, 3, 62, "Text"], Cell[44487, 1111, 3998, 108, 253, "Input"], Cell[48488, 1221, 243, 7, 70, "Text"], Cell[CellGroupData[{ Cell[48756, 1232, 226, 6, 40, "Input"], Cell[48985, 1240, 410, 8, 40, "Output"] }, Open ]], Cell[49410, 1251, 191, 4, 39, "Text"], Cell[CellGroupData[{ Cell[49626, 1259, 503, 14, 64, "Input"], Cell[50132, 1275, 3941, 73, 387, "Output"] }, Open ]], Cell[54088, 1351, 738, 13, 174, "Text"] }, Open ]] }, Open ]] } ] *) (* End of internal cache information *)