(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 4.2' Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 12532, 418]*) (*NotebookOutlinePosition[ 13203, 441]*) (* CellTagsIndexPosition[ 13159, 437]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell[TextData[{ StyleBox["261 ", FontColor->RGBColor[0, 0, 1]], StyleBox["Mathematica", FontSlant->"Italic", FontColor->RGBColor[0, 0, 1]], StyleBox[" Session 3", FontColor->RGBColor[0, 0, 1]] }], "Subtitle", TextAlignment->Center, TextJustification->0], Cell["\<\ As in the last session, this notebook has a collection of cells \ which you should read and evaluate. There are also problems to solve, for which you will create and evaluate your \ own cells.\ \>", "Text"], Cell[TextData[StyleBox["Be sure to switch control of the keyboard and mouse \ regularly, so that all group members can be equally frustrated.", FontWeight->"Bold", FontColor->RGBColor[1, 0, 0]]], "Text"], Cell[CellGroupData[{ Cell["Clear symbols", "Section", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ In order to avoid interference from symbols defined in other \ notebooks, we first Clear all symbols. We assume that the relevant symbols \ are in the Global` context.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell["Clear[\"Global`*\"]", "Input", AspectRatioFixed->True] }, Open ]], Cell[CellGroupData[{ Cell["That Mass on a String Problem", "Section"], Cell["\<\ In K+K problem 2.34 for this week, you are asked to consider a \ block sliding on a frictionless table, attached to a string which is being \ pulled down through a hole in the table. Since the string was being shortened at a constant rate V, the radial coordinate satisfies\ \>", "Text"], Cell[BoxData[ \(diffeq1\ = \ \(r'\)[t]\ \[Equal] \ \(-V\)\)], "Input"], Cell[CellGroupData[{ Cell["Step 1:", "Subsubsection"], Cell[TextData[{ "As a warmup, have ", StyleBox["Mathematica", FontSlant->"Italic"], " solve this differential equation, with the boundary condition that at \ t=0, r[t]=r0, i.e." }], "Text"], Cell[BoxData[ \(bc1\ = \ r[0] \[Equal] r0\)], "Input"], Cell[BoxData[ \(DSolve[{diffeq1, bc1}, r[t], t]\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["Question:", "Subsubsection"], Cell[TextData[{ "Noting that the force from the string is purely in the radial direction, \ what can you conclude about the the component of the acceleration in the ", Cell[BoxData[ \(TraditionalForm\`\(\(\(\[Theta]\)\(\ \)\)\&^\)\)]], "direction?\nAnd what differential equation must \[Theta](t) then satisfy?" }], "Text"] }, Open ]], Cell[CellGroupData[{ Cell["\<\ Answer Cell -- open after you've come up with your own answer\ \>", \ "Subsubsection"], Cell[TextData[{ "If there is no component of force in the ", Cell[BoxData[ \(TraditionalForm\`\(\(\(\[Theta]\)\(\ \)\)\&^\)\)]], " direction, then the ", Cell[BoxData[ \(TraditionalForm\`\(\(\(\[Theta]\)\(\ \)\)\&^\)\)]], " component of the acceleration vanishes too. That is, (r[t]*th''[t] + \ 2*r'[t]*th'[t])=0. For the r[t] in the case at hand, this reads:" }], "Text"], Cell[BoxData[ \(diffeq2\ = \ \((r0 - V\ t)\) \(th''\)[t]\ \ - \ 2*V*\(th'\)[t]\ \[Equal] \ 0\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Step 2:", "Subsubsection"], Cell[TextData[{ "Solve this set of equations, including the boundary condition that at t=0, \ \[Theta]=0 and ", Cell[BoxData[ \(TraditionalForm\`d\/dt\)]], Cell[BoxData[ \(TraditionalForm\`\[Theta]\)]], " = ", Cell[BoxData[ \(TraditionalForm\`\[Omega]\_0\)]], ":" }], "Text"], Cell[BoxData[ \(bc2\ = \ \(th'\)[0] \[Equal] omega0\)], "Input"], Cell[BoxData[ \(bc3\ = \ th[0]\ \[Equal] \ 0\)], "Input"], Cell[BoxData[ \(DSolve[{diffeq2, bc2, bc3}, th[t], t]\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["Step 3:", "Subsubsection"], Cell["\<\ Taking all parameters to be 1 (i.e. omega0 = 1rad/s, v=1m/s, \ r0=1m), use ParametricPlot to graph the trajectory of the sliding mass. To get you going, here is the spiral of problem 1.20.\ \>", "Text"], Cell[BoxData[{ \(r[t_]\ := \ th[t]/Pi; \ th[t_] = \ t^2/2;\), "\[IndentingNewLine]", \(x[t_]\ := r[t]*Cos[th[t]]; \ y[t_]\ := \ r[t]*Sin[th[t]]; \ ParametricPlot[{x[t], y[t]}, {t, 0, 4}, AspectRatio \[Rule] 1]\)}], "Input"], Cell["OK plugging in r0=1 etc. to the above solutions we have", "Text"], Cell[BoxData[ \(r[t_]\ = \ 1\ - \ t; \ th[t_]\ = \ \(-1\)\ + \ 1/\((1 - t)\);\)], "Input"], Cell[BoxData[ \(x[t_]\ := r[t]*Cos[th[t]]; \ y[t_]\ := \ r[t]*Sin[th[t]]; \ ParametricPlot[{x[t], y[t]}, {t, 0, 1}, AspectRatio \[Rule] 1]\)], "Input"], Cell["Next just for fun lets animate this plot.", "Text"], Cell[BoxData[ \(pt[t_]\ := \ {r[t]*Cos[th[t]], r[t]*Sin[th[t]]}\)], "Input"], Cell[BoxData[""], "Input"], Cell[BoxData[ \(doplot[t_]\ := \ Show[{ParametricPlot[pt[tmp], {tmp, 0, t}, AspectRatio \[Rule] 1, PlotRange \[Rule] {{\(-1.1\), 1.1}, {\(-1.1\), 1.1}}, DisplayFunction \[Rule] Identity], ListPlot[{pt[t]}, PlotStyle \[Rule] {PointSize[ .03], RGBColor[1, 0, 0]}\[IndentingNewLine], DisplayFunction \[Rule] Identity]}, DisplayFunction \[Rule] $DisplayFunction]\)], "Input"], Cell[BoxData[ \(Table[doplot[t], {t, .05, .95, .05}]\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["Optional:", "Subsubsection"], Cell["\<\ Using the notebook from class (KK-1.20) as a model, add velocity \ and acceleration vectors to your plot. Check: is the acceleration always \ radial?\ \>", "Text"], Cell["OK lets add in acceleration vectors:", "Text"], Cell[BoxData[ \(<< Graphics`PlotField`\)], "Input"], Cell[BoxData[ \(doplot2[t_]\ := \ Show[{ParametricPlot[pt[tmp], {tmp, 0, t}, AspectRatio \[Rule] 1, PlotRange \[Rule] {{\(-1.1\), 1.1}, {\(-1.1\), 1.1}}, DisplayFunction \[Rule] Identity], ListPlot[{pt[t]}, PlotStyle \[Rule] {PointSize[ .03], RGBColor[1, 0, 0]}\[IndentingNewLine], DisplayFunction \[Rule] Identity], \[IndentingNewLine]ListPlotVectorField[{{pt[ t], {\(x''\)[t], \(y''\)[t]}}}, DisplayFunction \[Rule] Identity, ScaleFactor \[Rule] .2]\[IndentingNewLine]}, DisplayFunction \[Rule] $DisplayFunction]\)], "Input"], Cell[BoxData[ \(doplot2[ .3]\)], "Input"], Cell[BoxData[ \(Table[doplot2[t], {t, .05, .95, .05}]\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["Another Differential Equation", "Subsection"], Cell["\<\ Consider K&K problem 2.36. A particle of mass m moves in a \ straight line, with a retarding force given by\ \>", "Text"], Cell[BoxData[ \(F\ = \ b*Exp[\[Alpha]\ v]\)], "Input"], Cell["\<\ The boundary condition is that v[t=0]=v0. Find v[t] and compare w/ \ K&K.\ \>", "Text"], Cell[BoxData[ \(DSolve[{m*\(v'\)[t] \[Equal] \(-b\)\ Exp[alpha*v[t]], v[0] \[Equal] v0}, v[t], t]\)], "Input"], Cell["\<\ Taking for definiteness alpha=1 s/m, b = 1 N, and v0 = 1 m/s, make \ a plot of v[t] in the range from t=0 to t=1s. Estimate the time when the velocity is 0 (by \ looking at the plot). Then use the Solve[] command to find the exact expression for that \ time.\ \>", "Text"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[TextData[StyleBox["Euler's Method", "Subsection"]], "Section"], Cell["\<\ If you have time, try exploring the following method for solving \ any differential equation numerically. For definiteness, suppose we are facing \ \>", "Text"], Cell[BoxData[ \(diffeq3\ = \ \(x'\)[t]\ \[Equal] \ \(-\ 2\)\ \((x[t])\)^2\)], "Input"], Cell["\<\ with boundary condition x[0] == 1, and we want to know x[1]. The idea is that if we know x[t] for some particular time t, then we can get \ an approximate value for x at a short time later, call it t+\[Epsilon]. That \ is, since the diffeq gives us x'[t], we can write x[t+\[Epsilon]] ~ x[t] + \[Epsilon] x'[t] = x[t] + \[Epsilon] (-2)(x[t])^2 Then iterating, we get x[t+2\[Epsilon]] etc. By starting at t=0 and by \ making 1/\[Epsilon] steps we can then get all the way to t=1. Of course the \ answer we get at t=1 is an approximation, but by decreasing \[Epsilon] we \ can systematically improve the result. Try applying this method to find \ x[1], and compare your approximate numerical solution to the exact answer. \ It might also be informative to plot the two curves together.\ \>", "Text"], Cell[CellGroupData[{ Cell["One Solution", "Subsubsection"], Cell["\<\ OK here is just one way to do it. First define a function which \ makes one step.\ \>", "Text"], Cell[BoxData[ \(step[{t_, x_}]\ := \ {t + eps, x + eps*\((\(-2\)\ x^2)\)}\)], "Input"], Cell["\<\ Note that this function takes in an argument which is a two-element \ list, and spits out another list of two elements. Once we choose \[Epsilon] \ we can use it as follows:\ \>", "Text"], Cell[BoxData[ \(eps\ = \ .2; \ step[{0, 1}]\)], "Input"], Cell["\<\ We want to start from {0,1} and step forward 10 times. One way to \ do it is:\ \>", "Text"], Cell[BoxData[ \(pt\ = \ {0, 1}; Do[pt\ = \ step[pt], {i, 1, 10}]; \ pt\)], "Input"], Cell["Want to do it again with 100 steps? ", "Text"], Cell[BoxData[ \(\(\(n = 100\)\(;\)\(\ \)\(eps\ = \ 1.0/n\)\(;\)\(pt = {0, 1}\)\(;\)\(Do[ pt = step[pt], {i, 1, n}]\)\(;\)\(pt\)\(\ \)\)\)], "Input"], Cell["We can also save the points we generate by using Table[].", "Text"], Cell[BoxData[ \(\(\(n = 10\)\(;\)\(\ \)\(eps\ = \ 1.0/n\)\(;\)\(pt = {0, 1}\)\(;\)\(listofpoints = Table[pt = step[pt], {i, 1, n}]\)\(;\)\(pt\)\(\ \)\)\)], "Input"], Cell["And then plot them.", "Text"], Cell[BoxData[ \(ListPlot[listofpoints, PlotStyle \[Rule] {PointSize[ .03], RGBColor[1, 0, 0]}, PlotRange \[Rule] {0, 1}]\)], "Input"], Cell["\<\ Ooops, this one omits the first point, so lets complicate the \ function further, adding on the initial point by hand:\ \>", "Text"], Cell[BoxData[ \(n = 10; \ eps\ = \ 1.0/n; pt = {0, 1}; listofpoints = Join[{pt}, Table[pt = step[pt], {i, 1, n}]]; \(\(lplot\)\(\ \)\(=\)\(\ \)\(ListPlot[listofpoints, PlotStyle \[Rule] {PointSize[ .03], RGBColor[1, 0, 0]}, PlotRange \[Rule] {0, 1}]\)\(\ \)\)\)], "Input"], Cell["Now let's get the exact solution and plot it all together:", "Text"], Cell[BoxData[ \(DSolve[{\(x'\)[t]\ \[Equal] \ \(-\ 2\)\ \((x[t])\)^2, x[0] \[Equal] 1}, x[t], t]\)], "Input"], Cell[BoxData[ \(exactplot\ = \ Plot[1\/\(1 + 2\ t\), {t, 0, 1}, PlotRange \[Rule] {0, 1}]\)], "Input"], Cell[BoxData[ \(Show[lplot, exactplot]\)], "Input"], Cell["OK now you try it with n=100.", "Text"] }, Closed]] }, Open ]] }, Open ]] }, FrontEndVersion->"4.2 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 695}}, WindowToolbars->"EditBar", WindowSize->{770, 668}, WindowMargins->{{82, Automatic}, {Automatic, 0}} ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1776, 53, 279, 10, 65, "Subtitle"], Cell[2058, 65, 216, 5, 52, "Text"], Cell[2277, 72, 207, 3, 33, "Text"], Cell[CellGroupData[{ Cell[2509, 79, 80, 2, 59, "Section", Evaluatable->False], Cell[2592, 83, 240, 6, 52, "Text", Evaluatable->False], Cell[2835, 91, 62, 1, 30, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[2934, 97, 48, 0, 59, "Section"], Cell[2985, 99, 299, 5, 71, "Text"], Cell[3287, 106, 76, 1, 30, "Input"], Cell[CellGroupData[{ Cell[3388, 111, 32, 0, 43, "Subsubsection"], Cell[3423, 113, 199, 6, 33, "Text"], Cell[3625, 121, 59, 1, 30, "Input"], Cell[3687, 124, 64, 1, 30, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[3788, 130, 34, 0, 43, "Subsubsection"], Cell[3825, 132, 335, 6, 71, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[4197, 143, 96, 3, 43, "Subsubsection"], Cell[4296, 148, 396, 9, 52, "Text"], Cell[4695, 159, 123, 2, 30, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[4855, 166, 32, 0, 29, "Subsubsection"], Cell[4890, 168, 305, 11, 36, "Text"], Cell[5198, 181, 69, 1, 30, "Input"], Cell[5270, 184, 63, 1, 30, "Input"], Cell[5336, 187, 70, 1, 30, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[5443, 193, 32, 0, 43, "Subsubsection"], Cell[5478, 195, 212, 5, 71, "Text"], Cell[5693, 202, 247, 4, 70, "Input"], Cell[5943, 208, 71, 0, 33, "Text"], Cell[6017, 210, 103, 2, 30, "Input"], Cell[6123, 214, 162, 2, 50, "Input"], Cell[6288, 218, 57, 0, 33, "Text"], Cell[6348, 220, 81, 1, 30, "Input"], Cell[6432, 223, 26, 0, 30, "Input"], Cell[6461, 225, 472, 9, 110, "Input"], Cell[6936, 236, 72, 1, 30, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[7045, 242, 34, 0, 43, "Subsubsection"], Cell[7082, 244, 174, 4, 33, "Text"], Cell[7259, 250, 52, 0, 33, "Text"], Cell[7314, 252, 55, 1, 30, "Input"], Cell[7372, 255, 688, 13, 170, "Input"], Cell[8063, 270, 45, 1, 30, "Input"], Cell[8111, 273, 73, 1, 30, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[8221, 279, 51, 0, 47, "Subsection"], Cell[8275, 281, 132, 3, 33, "Text"], Cell[8410, 286, 59, 1, 30, "Input"], Cell[8472, 289, 98, 3, 33, "Text"], Cell[8573, 294, 123, 2, 30, "Input"], Cell[8699, 298, 283, 7, 71, "Text"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[9031, 311, 67, 0, 57, "Section"], Cell[9101, 313, 170, 4, 52, "Text"], Cell[9274, 319, 92, 1, 30, "Input"], Cell[9369, 322, 815, 12, 147, "Text"], Cell[CellGroupData[{ Cell[10209, 338, 37, 0, 43, "Subsubsection"], Cell[10249, 340, 106, 3, 41, "Text"], Cell[10358, 345, 91, 1, 34, "Input"], Cell[10452, 348, 197, 4, 62, "Text"], Cell[10652, 354, 62, 1, 34, "Input"], Cell[10717, 357, 102, 3, 41, "Text"], Cell[10822, 362, 89, 1, 34, "Input"], Cell[10914, 365, 52, 0, 41, "Text"], Cell[10969, 367, 166, 3, 52, "Input"], Cell[11138, 372, 73, 0, 41, "Text"], Cell[11214, 374, 183, 3, 70, "Input"], Cell[11400, 379, 35, 0, 41, "Text"], Cell[11438, 381, 151, 3, 70, "Input"], Cell[11592, 386, 142, 3, 62, "Text"], Cell[11737, 391, 329, 7, 106, "Input"], Cell[12069, 400, 74, 0, 41, "Text"], Cell[12146, 402, 123, 2, 34, "Input"], Cell[12272, 406, 114, 2, 64, "Input"], Cell[12389, 410, 55, 1, 34, "Input"], Cell[12447, 413, 45, 0, 41, "Text"] }, Closed]] }, Open ]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)