(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 4.0, MathReader 4.0, or any compatible application. 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[ 62721, 1571]*) (*NotebookOutlinePosition[ 63942, 1618]*) (* CellTagsIndexPosition[ 63802, 1609]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["\<\ Motion Along a Straight Line, Part II: Acceleration \[Rule] Velocity \[Rule] \ Position\ \>", "Title", PageWidth->PaperWidth], Cell[TextData[StyleBox["Chapter 4, Section 5", FontFamily->"Arial", FontWeight->"Bold"]], "Text", PageWidth->PaperWidth, FontSize->16], Cell[BoxData[{ \(\(<< Graphics`Arrow`;\)\), "\n", \(\(<< Graphics`FilledPlot`;\)\), "\n", \(\(Off[General::spell1];\)\), "\n", \(\(Off[NIntegrate::ploss];\)\), "\n", \(\(Off[NIntegrate::ncvb];\)\), "\n", \(\(Off[General::spell];\)\), "\n", \(\(Off[NIntegrate::"\"];\)\), "\n", \(\(Off[FindRoot::"\"];\)\), "\n", \(\(Off[FindRoot::"\"];\)\), "\n", \(\(Clear[position];\)\), "\n", \(\(position[fnc_, interv_List, fncic_] := Module[{}, \n periodic = 0; \[IndentingNewLine]tind = interv[\([1]\)]; \[IndentingNewLine]to = interv[\([2]\)]; \[IndentingNewLine]tf = interv[\([3]\)]; \[IndentingNewLine]f[t_] = fnc /. tind -> t; \n\t\t (*Fint[t_] := NIntegrate[f[s], {s, to, t}]; \n\t\tcint = fncic - Fint[to]; \n\t\tF[t_] := Fint[t] + cint;*) \n F[t_] = \(NDSolve[{\(y'\)[t] == f[t], y[to] == fncic}, y[t], {t, to - 0.1*\((tf - to)\), tf + 0.1*\((tf - to)\)}]\)[\([1, 1, 2]\)]; \n\n fpp[t_] = D[f[t], t]; \n fppvalues = Table[fpp[t], {t, to, tf, \((tf - to)\)/500}]; \t\t\n fvalues = Table[f[t], {t, to, tf, \((tf - to)\)/500}]; \n Fvalues = Table[F[t], {t, to, tf, \((tf - to)\)/500}]; \n Fmax = Max[Fvalues]; \nFmin = Min[Fvalues]; \n\n fmaxt = Max[fvalues]; \nfmint = Min[fvalues]; \nfmin = fmint; \n fmax = fmaxt; \n\nstart = {}; \n Do[If[Sign[fvalues[\([k]\)]] != Sign[fvalues[\([k + 1]\)]] || Sign[fppvalues[\([k]\)]] != Sign[fppvalues[\([k + 1]\)]], start = Flatten[ Append[start, {to + \((tf - to)\)/500. *\((k - 1)\), to + \((tf - to)\)/500. *\((k - 0.5)\)}]]], {k, 1, 500}]; \n\troots = {}; \n\t Do[roots = Append[roots, \(Check[ FindRoot[ f[t] == 0, {t, {start[\([kk]\)], start[\([kk + 1]\)]}, start[\([kk]\)], If[kk == Length[start] - 1, tf, start[\([kk + 2]\)]]}, WorkingPrecision -> 8], {{Null, Null}}, FindRoot::regex]\)[\([1, 2]\)]], {kk, 1, Length[start] - 1, 2}]; \n\t roots = DeleteCases[roots, Null]; \n\t\n\t\t\n steprat = 0.025; \n\t\thrange = If[Fmax < 0, {1.1*Fmin, 0}, If[Fmin > 0, {0, 1.1*Fmax}, {1.1*Fmin, 1.1*Fmax}]]; \n\t\tfrange = If[fmax < 0, {1.1*fmin, 0}, If[fmin > 0, {0, 1.1*fmax}, {1.1*fmin, 1.1*fmax}]]; \nta = 0; size = 6; \n\t\tp2 = Plot[f[t], {t, to, tf}, PlotRange -> {{to, tf}, frange}, AxesLabel \[Rule] {"\", "\"}, AspectRatio -> 1, PlotStyle -> {RGBColor[0, 0, 0], Thickness[0.008]}, Epilog -> {Thickness[0.010], RGBColor[0, 0, 0], Arrow[{to, 0}, {to, f[to]}], Text["\", {to, f[to]/2}, {\(-1\), 0}]}, DisplayFunction -> Identity]; p1 = Plot[F[t], {t, to - 0.00001*\((tf - to)\), to}, AxesLabel \[Rule] {"\", "\"}, PlotRange -> {{to - 0.01*\((tf - to)\), tf + 0.01*\((tf - to)\)}, hrange}, AspectRatio -> 1, PlotStyle -> {RGBColor[0.246098, \ 0.671885, \ 0.199222]}, AxesOrigin -> {0, 0}, Prolog -> {RGBColor[0.246098, \ 0.671885, \ 0.199222], Thickness[0.015], Text[\*"\"\<\!\(s\_0\)\>\"", {to - 0.01*\((tf - to)\), 0.5*F[to]}, {1, 0}], Arrow[{to - 0.01*\((tf - to)\), 0}, {to - 0.01*\((tf - to)\), F[to]}, HeadScaling -> Automatic]}, DisplayFunction -> Identity]; \n\t\tShow[ GraphicsArray[{p2, p1}], ImageSize -> {72*size, 72*size/2}, PlotRegion -> {{0, 1}, {0, 1}}, \ DisplayFunction -> $DisplayFunction]; \n\n If[Length[roots] != 0, \t\t\n If[Abs[roots[\([Length[roots]]\)] - tf] <= 0.00001*Max[Abs[{Fmax, Fmin}]], \n roots = Append[roots, tf + 0.00001*\((tf - to)\)], roots = Append[roots, tf]; roots = Append[roots, tf + 0.00001*\((tf - to)\)]]; \n If[Abs[roots[\([1]\)] - to] <= 0.00001*Max[Abs[{Fmax, Fmin}]], \n roots = Prepend[roots, to - 0.00001*\((tf - to)\)], roots = Prepend[roots, to]; roots = Prepend[roots, to - 0.00001*\((tf - to)\)]];, roots = Append[roots, tf]; roots = Append[roots, tf + 0.00001*\((tf - to)\)]; \n\t\t\troots = Prepend[roots, to]; roots = Prepend[roots, to - 0.00001*\((tf - to)\)]]; \n\n n = Length[roots]; \n\t\troots = Sort[roots // N]; \n\t\tFor[k = 1, k < Length[roots] - 1, \(k++\), If[roots[\([k]\)] == roots[\([k + 1]\)], roots = Delete[roots, k]]]; \n\t\tk = 1; \n\t\tWhile[ k <= Length[roots], If[roots[\([k]\)] < \((to - 0.00001*\((tf - to)\))\) || roots[\([k]\)] > \((tf + 0.00001*\((tf - to)\))\), roots = Delete[roots, k], \(k++\)]]; \t\n\ \ \n\t\t\n Do[Clear[p1, p2]; \n\t\n\tlim = 1; \n\t While[ta > roots[\([lim + 2]\)], \ lim = lim + 1]; \n\t\t\t\t\n\t\t\t\t\tp1t = Plot[F[t], {t, to, If[ta == roots[\([lim + 1]\)], ta - 0.00001*\((tf - to)\), ta]}, AxesLabel \[Rule] {"\", "\"}, PlotRange -> {{to - 0.01*\((tf - to)\), tf + 0.01*\((tf - to)\)}, hrange}, AspectRatio -> 1, PlotStyle -> {RGBColor[0.246098, \ 0.671885, \ 0.199222], Dashing[{}]}, DisplayFunction -> Identity, Epilog -> Flatten[{RGBColor[0.246098, \ 0.671885, \ 0.199222], Text["\", {ta, 0.5*F[ta]}, {\(-1\), 0}], Thickness[0.015], Arrow[{ta, 0}, {ta, F[ta]}, HeadScaling -> Automatic], Text[\*"\"\<\!\(s\_0\)\>\"", {to - 0.01*\((tf - to)\), 0.5*F[to]}, {1, 0}], Arrow[{to - 0.01*\((tf - to)\), 0}, {to - 0.01*\((tf - to)\), F[to]}, HeadScaling -> Automatic], Table[{If[f[roots[\([k]\)] + 0.0001*\((tf - to)\)] > 0, RGBColor[1, 0, 0], RGBColor[0, 0, 1]], Arrow[{roots[\([k]\)], F[roots[\([k]\)]]}, {roots[\([k]\)], F[roots[\([k + 1]\)]]}, HeadScaling -> Automatic], RGBColor[0, 0, 0], Thickness[0.003], Dashing[{0.01, 0.02}], Line[{{roots[\([k]\)], F[roots[\([k + 1]\)]]}, {roots[\([k + 1]\)], F[roots[\([k + 1]\)]]}}]}, {k, 1, lim}], If[f[ta - 0.00001*\((tf - to)\)] > 0, RGBColor[1, 0, 0], RGBColor[0, 0, 1]], Arrow[{roots[\([lim + 1]\)], F[roots[\([lim + 1]\)]]}, {roots[\([lim + 1]\)], F[ta]}, HeadScaling -> Automatic], Thickness[0.003], RGBColor[0, 0, 0], Dashing[{0.01, 0.02}], Line[{{roots[\([lim + 1]\)], F[ta]}, {ta, F[ta]}}], Dashing[{}]}, 1]]; \n\t\t\t\n\t\t\t\n\t\t\tp1 = Show[p1t, AspectRatio \[Rule] 1, AxesFront -> True, \ DisplayFunction -> Identity]; \n\t\t\t\t\t\t\n\t p2t = {}; \n\t\t\n\t\t\t\tDo[ If[f[roots[\([k]\)] + 0.0001*\((tf - to)\)] > 0, fillcolor = RGBColor[1, 0, 0], fillcolor = RGBColor[0, 0, 1]]; \n\t\t\t\t\tpinter = FilledPlot[f[t], {t, roots[\([k]\)], roots[\([k + 1]\)]}, PlotRange -> {{to, tf}, frange}, PlotStyle -> {RGBColor[0, 0, 0], Thickness[0.008]}, Fills -> {fillcolor}, AxesFront -> True, Curves -> Front, AxesLabel \[Rule] {"\", "\"}, DisplayFunction -> Identity]; \n\t\t\t\t\tp2t = Append[p2t, pinter], {k, 1, lim}]; \n\t\t\t\tIf[ f[ta - 0.00001*\((tf - to)\)] > 0, fillcolor = RGBColor[1, 0, 0], fillcolor = RGBColor[0, 0, 1]]; \n\t\t\t\tpinter2 = FilledPlot[ f[t], {t, roots[\([lim + 1]\)], If[ta == roots[\([lim + 1]\)], ta + 0.00001*\((tf - to)\), ta]}, AxesLabel \[Rule] {"\", "\"}, PlotRange -> {{to, tf}, frange}, PlotStyle -> {RGBColor[0, 0, 0], Thickness[0.008]}, Fills -> {fillcolor}, AxesFront -> True, Curves -> Front, DisplayFunction -> Identity]; \n\t\t\tp2t = Append[p2t, pinter2]; \n\t\t\n\t\t\tpint = Plot[f[t], {t, to, tf}, PlotRange -> {{to, tf}, frange}, AspectRatio -> 1, PlotStyle -> {RGBColor[0, 0, 0], Thickness[0.008]}, AxesLabel \[Rule] {"\", "\"}, Epilog -> {Thickness[0.010], RGBColor[0, 0, 0], Arrow[{ta, 0}, {ta, f[ta]}], Text["\", {ta, f[ta]/2}, {\(-1\), 0}]}, DisplayFunction -> Identity]; \n\t\t\tp2t = Prepend[p2t, pint]; \n\t\t\t\n\t\t\t\n\t\t\tp2 = Show[p2t, AxesFront -> True, AspectRatio \[Rule] 1, \ DisplayFunction -> Identity]; \n\t\t\t\n Show[GraphicsArray[{p2, p1}], ImageSize -> {72*size, 72*size/2}, PlotRegion -> {{0, 1}, {0, 1}}, \ DisplayFunction -> $DisplayFunction], {ta, to + steprat*\((tf - to)\), If[periodic == 1, tf - steprat*\((tf - to)\), tf], steprat*\((tf - to)\)}];];\)\), "\n", \(\(Clear[velocity];\)\), "\n", \(\(velocity[fnc_, interv_List, fncic_] := Module[{}, \n periodic = 0; \[IndentingNewLine]tind = interv[\([1]\)]; \[IndentingNewLine]t0 = interv[\([2]\)]; \[IndentingNewLine]tf = interv[\([3]\)]; \[IndentingNewLine]f[t_] = fnc /. tind -> t; \n\t\t (*Fint[t_] := NIntegrate[f[s], {s, to, t}]; \n\t\tcint = fncic - Fint[to]; \n\t\tF[t_] := Fint[t] + cint;*) \n F[t_] = \(NDSolve[{\(y'\)[t] == f[t], y[to] == fncic}, y[t], {t, to - 0.1*\((tf - to)\), tf + 0.1*\((tf - to)\)}]\)[\([1, 1, 2]\)]; \n\n fpp[t_] = D[f[t], t]; \n fppvalues = Table[fpp[t], {t, to, tf, \((tf - to)\)/500}]; \t\t\n fvalues = Table[f[t], {t, to, tf, \((tf - to)\)/500}]; \n Fvalues = Table[F[t], {t, to, tf, \((tf - to)\)/500}]; \n Fmax = Max[Fvalues]; \nFmin = Min[Fvalues]; \n\n fmaxt = Max[fvalues]; \nfmint = Min[fvalues]; \nfmin = fmint; \n fmax = fmaxt; \n\nstart = {}; \n Do[If[Sign[fvalues[\([k]\)]] != Sign[fvalues[\([k + 1]\)]] || Sign[fppvalues[\([k]\)]] != Sign[fppvalues[\([k + 1]\)]], start = Flatten[ Append[start, {to + \((tf - to)\)/500. *\((k - 1)\), to + \((tf - to)\)/500. *\((k - 0.5)\)}]]], {k, 1, 500}]; \n\troots = {}; \n\t Do[roots = Append[roots, \(Check[ FindRoot[ f[t] == 0, {t, {start[\([kk]\)], start[\([kk + 1]\)]}, start[\([kk]\)], If[kk == Length[start] - 1, tf, start[\([kk + 2]\)]]}, WorkingPrecision -> 8], {{Null, Null}}, FindRoot::regex]\)[\([1, 2]\)]], {kk, 1, Length[start] - 1, 2}]; \n\t roots = DeleteCases[roots, Null]; \n\t\n\t\t\n steprat = 0.025; \n\t\thrange = If[Fmax < 0, {1.1*Fmin, 0}, If[Fmin > 0, {0, 1.1*Fmax}, {1.1*Fmin, 1.1*Fmax}]]; \n\t\tfrange = If[fmax < 0, {1.1*fmin, 0}, If[fmin > 0, {0, 1.1*fmax}, {1.1*fmin, 1.1*fmax}]]; \nta = 0; size = 6; \n\t\tp2 = Plot[f[t], {t, to, tf}, PlotRange -> {{to, tf}, frange}, AxesLabel \[Rule] {"\", "\"}, AspectRatio -> 1, PlotStyle -> {RGBColor[0, 0, 0], Thickness[0.008]}, Epilog -> {Thickness[0.010], RGBColor[0, 0, 0], Arrow[{to, 0}, {to, f[to]}], Text["\", {to, f[to]/2}, {\(-1\), 0}]}, DisplayFunction -> Identity]; p1 = Plot[F[t], {t, to - 0.00001*\((tf - to)\), to}, AxesLabel \[Rule] {"\", "\"}, PlotRange -> {{to - 0.01*\((tf - to)\), tf + 0.01*\((tf - to)\)}, hrange}, AspectRatio -> 1, PlotStyle -> {RGBColor[0.246098, \ 0.671885, \ 0.199222]}, AxesOrigin -> {0, 0}, Prolog -> {RGBColor[0.246098, \ 0.671885, \ 0.199222], Thickness[0.015], Text[\*"\"\<\!\(v\_0\)\>\"", {to - 0.01*\((tf - to)\), 0.5*F[to]}, {1, 0}], Arrow[{to - 0.01*\((tf - to)\), 0}, {to - 0.01*\((tf - to)\), F[to]}, HeadScaling -> Automatic]}, DisplayFunction -> Identity]; \n\t\tShow[ GraphicsArray[{p2, p1}], ImageSize -> {72*size, 72*size/2}, PlotRegion -> {{0, 1}, {0, 1}}, \ DisplayFunction -> $DisplayFunction]; \n\n If[Length[roots] != 0, \t\t\n If[Abs[roots[\([Length[roots]]\)] - tf] <= 0.00001*Max[Abs[{Fmax, Fmin}]], \n roots = Append[roots, tf + 0.00001*\((tf - to)\)], roots = Append[roots, tf]; roots = Append[roots, tf + 0.00001*\((tf - to)\)]]; \n If[Abs[roots[\([1]\)] - to] <= 0.00001*Max[Abs[{Fmax, Fmin}]], \n roots = Prepend[roots, to - 0.00001*\((tf - to)\)], roots = Prepend[roots, to]; roots = Prepend[roots, to - 0.00001*\((tf - to)\)]];, roots = Append[roots, tf]; roots = Append[roots, tf + 0.00001*\((tf - to)\)]; \n\t\t\troots = Prepend[roots, to]; roots = Prepend[roots, to - 0.00001*\((tf - to)\)]]; \n\n n = Length[roots]; \n\t\troots = Sort[roots // N]; \n\t\tFor[k = 1, k < Length[roots] - 1, \(k++\), If[roots[\([k]\)] == roots[\([k + 1]\)], roots = Delete[roots, k]]]; \n\t\tk = 1; \n\t\tWhile[ k <= Length[roots], If[roots[\([k]\)] < \((to - 0.00001*\((tf - to)\))\) || roots[\([k]\)] > \((tf + 0.00001*\((tf - to)\))\), roots = Delete[roots, k], \(k++\)]]; \t\n\ \ \n\t\t\n Do[Clear[p1, p2]; \n\t\n\tlim = 1; \n\t While[ta > roots[\([lim + 2]\)], \ lim = lim + 1]; \n\t\t\t\t\n\t\t\t\t\tp1t = Plot[F[t], {t, to, If[ta == roots[\([lim + 1]\)], ta - 0.00001*\((tf - to)\), ta]}, AxesLabel \[Rule] {"\", "\"}, PlotRange -> {{to - 0.01*\((tf - to)\), tf + 0.01*\((tf - to)\)}, hrange}, AspectRatio -> 1, PlotStyle -> {RGBColor[0.246098, \ 0.671885, \ 0.199222], Dashing[{}]}, \ DisplayFunction -> Identity, Epilog -> Flatten[{RGBColor[0.246098, \ 0.671885, \ 0.199222], Text["\", {ta, 0.5*F[ta]}, {\(-1\), 0}], Thickness[0.015], Arrow[{ta, 0}, {ta, F[ta]}, HeadScaling -> Automatic], Text[\*"\"\<\!\(v\_0\)\>\"", {to - 0.01*\((tf - to)\), 0.5*F[to]}, {1, 0}], Arrow[{to - 0.01*\((tf - to)\), 0}, {to - 0.01*\((tf - to)\), F[to]}, HeadScaling -> Automatic], Table[{If[f[roots[\([k]\)] + 0.0001*\((tf - to)\)] > 0, RGBColor[1, 0, 0], RGBColor[0, 0, 1]], Arrow[{roots[\([k]\)], F[roots[\([k]\)]]}, {roots[\([k]\)], F[roots[\([k + 1]\)]]}, HeadScaling -> Automatic], RGBColor[0, 0, 0], Thickness[0.003], Dashing[{0.01, 0.02}], Line[{{roots[\([k]\)], F[roots[\([k + 1]\)]]}, {roots[\([k + 1]\)], F[roots[\([k + 1]\)]]}}]}, {k, 1, lim}], If[f[ta - 0.00001*\((tf - to)\)] > 0, RGBColor[1, 0, 0], RGBColor[0, 0, 1]], Arrow[{roots[\([lim + 1]\)], F[roots[\([lim + 1]\)]]}, {roots[\([lim + 1]\)], F[ta]}, HeadScaling -> Automatic], Thickness[0.003], RGBColor[0, 0, 0], Dashing[{0.01, 0.02}], Line[{{roots[\([lim + 1]\)], F[ta]}, {ta, F[ta]}}], Dashing[{}]}, 1]]; \n\t\t\t\n\t\t\t\n\t\t\tp1 = Show[p1t, ImageSize -> {72*size, 72*size/2}, PlotRegion -> {{0, 1}, {0, 1}}, AxesFront -> True, \ DisplayFunction -> Identity]; \n\t\t\t\t\t\t\n\t p2t = {}; \n\t\t\n\t\t\t\tDo[ If[f[roots[\([k]\)] + 0.0001*\((tf - to)\)] > 0, fillcolor = RGBColor[1, 0, 0], fillcolor = RGBColor[0, 0, 1]]; \n\t\t\t\t\tpinter = FilledPlot[f[t], {t, roots[\([k]\)], roots[\([k + 1]\)]}, AxesLabel \[Rule] {"\", "\"}, PlotRange -> {{to, tf}, frange}, PlotStyle -> {RGBColor[0, 0, 0], Thickness[0.008]}, Fills -> {fillcolor}, AxesFront -> True, Curves -> Front, DisplayFunction -> Identity]; \n\t\t\t\t\tp2t = Append[p2t, pinter], {k, 1, lim}]; \n\t\t\t\tIf[ f[ta - 0.00001*\((tf - to)\)] > 0, fillcolor = RGBColor[1, 0, 0], fillcolor = RGBColor[0, 0, 1]]; \n\t\t\t\tpinter2 = FilledPlot[ f[t], {t, roots[\([lim + 1]\)], If[ta == roots[\([lim + 1]\)], ta + 0.00001*\((tf - to)\), ta]}, AxesLabel \[Rule] {"\", "\"}, PlotRange -> {{to, tf}, frange}, PlotStyle -> {RGBColor[0, 0, 0], Thickness[0.008]}, Fills -> {fillcolor}, AxesFront -> True, Curves -> Front, DisplayFunction -> Identity]; \n\t\t\tp2t = Append[p2t, pinter2]; \n\t\t\n\t\t\tpint = Plot[f[t], {t, to, tf}, PlotRange -> {{to, tf}, frange}, AxesLabel \[Rule] {"\", "\"}, AspectRatio -> 1, PlotStyle -> {RGBColor[0, 0, 0], Thickness[0.008]}, Epilog -> {Thickness[0.010], RGBColor[0, 0, 0], Arrow[{ta, 0}, {ta, f[ta]}], Text["\", {ta, f[ta]/2}, {\(-1\), 0}]}, DisplayFunction -> Identity]; \n\t\t\tp2t = Prepend[p2t, pint]; \n\t\t\t\n\t\t\t\n\t\t\tp2 = Show[p2t, ImageSize -> {72*size, 72*size/2}, AxesFront -> True, PlotRegion -> {{0, 1}, {0, 1}}, \ DisplayFunction -> Identity]; \n\t\t\t\n Show[GraphicsArray[{p2, p1}], ImageSize -> {72*size, 72*size/2}, PlotRegion -> {{0, 1}, {0, 1}}, \ DisplayFunction -> $DisplayFunction], {ta, to + steprat*\((tf - to)\), If[periodic == 1, tf - steprat*\((tf - to)\), tf], steprat*\((tf - to)\)}];];\)\)}], "Input", Editable->False, CellOpen->False, InitializationCell->True], Cell[CellGroupData[{ Cell["Introduction", "Section", PageWidth->PaperWidth], Cell[TextData[{ StyleBox["OBJECTIVE: To develop an understanding of the integral \ relationship between acceleration and velocity, and between velocity and \ position of an object moving along a straight line.\n\nThis module includes \ two specially designed ", PageWidth->PaperWidth], StyleBox["Mathematica", PageWidth->PaperWidth, FontSlant->"Italic"], StyleBox[" commands that animate the integral relations between \ acceleration and velocity, and between velocity and position of an object \ moving along a straight line. A variety of motions are studied, including \ constant velocity, constant acceleration, harmonic oscillation, and decaying \ oscillations. You can also use the specialized ", PageWidth->PaperWidth], StyleBox["Mathematica", PageWidth->PaperWidth, FontSlant->"Italic"], StyleBox[" commands to study other motions that may be of interest to you. \ \n\n", PageWidth->PaperWidth], "Note: This module uses two specially designed functions, \n\n", StyleBox["position[velocityfunction_, timeinterval_, initialposition_ ]", FontWeight->"Bold"], ", and\n\n", StyleBox["velocity[accelerationfunction_, timeinterval_, initialvelocity_ \ ].", FontWeight->"Bold"], "\n\nThese are not built-in ", StyleBox["Mathematica", FontSlant->"Italic"], " functions and are only available in this module. The arguments are a \ velocity function, ", StyleBox["velocityfunction_", FontWeight->"Bold"], ", or an acceleration function, ", StyleBox["accelerationfunction_", FontWeight->"Bold"], ", the time interval over which the motion occurs, ", StyleBox["timeinterval_", FontWeight->"Bold"], ", and the initial position, ", StyleBox["initialposition_", FontWeight->"Bold"], ", or the initial velocity, ", StyleBox[" initialvelocity_", FontWeight->"Bold"], ". In the sections that follow you will see examples of how these \ functions are used." }], "Text", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell["Technology Guidelines", "Subsection", PageWidth->PaperWidth, CellDingbat->"\[LightBulb]"], Cell[TextData[{ StyleBox["NOTE: If you have just finished a module, restart ", CellFrame->True, Background->None], StyleBox["Mathematica", CellFrame->True, FontSlant->"Italic", Background->None], StyleBox[" before executing a new module.\nTO OPEN CELLS, put your cursor \ on the right cell bracket and double click.", CellFrame->True, Background->None], "\nINITIALIZATION CELLS\n\tWhen asked if you want to \". . . automatically \ evaluate all the initialization cells in the \tnotebook . . . ,\" respond by \ pressing the \"Yes\" button.\nTO STOP AN EXECUTION\n\tSelect the ", StyleBox["Kernel", FontSlant->"Italic"], " pull-down menu and click on ", StyleBox["Abort Evaluation.\n", FontSlant->"Italic"], "ORDER OF EXECUTION\n\tExecute cells in the order given. Do not skip any \ Input cells within a given notebook.\nSAVING NOTEBOOKS\n\tYou can save \ anytime to any directory you choose, and it is wise to save often.\n\t \ However, before you do your final save, delete all your output by selecting \ the \n\t ", StyleBox["Delete All Output", FontSlant->"Italic"], " selection under the ", StyleBox["Kernel", FontSlant->"Italic"], " pull-down menu.\nEXPERIENCING MAJOR PROBLEMS\n\tSave if appropriate, and \ then shut down ", StyleBox["Mathematica", FontSlant->"Italic"], " and start it up again." }], "Text", PageWidth->PaperWidth] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Part I: Constant Velocity", "Section", PageWidth->PaperWidth], Cell[TextData[{ "To measure position, select a reference point or origin on the line and \ scale the line in appropriate units (e.g., meters, feet, or miles). ", StyleBox["A distance and a direction specify the position.", PageWidth->PaperWidth], " One direction from the reference point along the reference line is taken \ as positive and the other direction as negative. The distance is measured on \ the scaled line.\n\nSuppose that you drive your car along a straight road at \ a constant speed of 60 mph for 4 hours and then turn around and come back at \ the same speed. Let's take the starting point to be the origin and the \ direction your car travels during the first four hours as positive. The \ velocity is given by the following function." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(Clear[v];\)\), "\n", \(\(v[t_] = Which[t \[LessEqual] 4, 60, \ t > 4, \(-60\)];\)\)}], "Input",\ PageWidth->PaperWidth], Cell[BoxData[ ButtonBox[ ButtonBox[ RowBox[{ StyleBox["\[MathematicaIcon]", FontSize->14, FontWeight->"Bold", FontColor->RGBColor[0.792981, 0.777356, 0.144533], FontVariations->{"CompatibilityType"->0}], StyleBox[" ", FontSize->14, FontWeight->"Bold", FontSlant->"Italic"], StyleBox["About", FontSize->14, FontWeight->"Bold", FontColor->RGBColor[0.500008, 0, 0.500008]], StyleBox[" ", FontSize->14, FontWeight->"Bold", FontSlant->"Italic"], StyleBox["Mathematica", FontSize->14, FontWeight->"Bold", FontSlant->"Italic", FontColor->RGBColor[0.500008, 0, 0.500008]]}], ButtonStyle->"Hyperlink"], ButtonData:>"h1", ButtonStyle->"Hyperlink"]], "Input", PageWidth->PaperWidth, Evaluatable->False, CellTags->"h1b"], Cell["\<\ When the velocity is positive, you are moving in the direction you selected \ to be positive, and when the velocity is negative, you are moving in the \ negative reference direction. The magnitude or absolute value of the velocity \ is the speed of the object, in this case, your car. Now we plot the velocity \ function for the duration of the trip.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(Plot[v[t], {t, 0, 8}, AxesLabel \[Rule] {"\", "\"}];\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ ButtonBox[ ButtonBox[ RowBox[{ StyleBox["\[MathematicaIcon]", FontSize->18, FontWeight->"Bold", FontColor->RGBColor[0.792981, 0.777356, 0.144533], FontVariations->{"CompatibilityType"->0}], StyleBox[" ", FontSize->14, FontWeight->"Bold", FontSlant->"Italic"], StyleBox["About", FontSize->14, FontWeight->"Bold", FontColor->RGBColor[0.500008, 0, 0.500008]], StyleBox[" ", FontSize->14, FontWeight->"Bold", FontSlant->"Italic"], StyleBox["Mathematica", FontSize->14, FontWeight->"Bold", FontSlant->"Italic", FontColor->RGBColor[0.500008, 0, 0.500008]]}], ButtonStyle->"Hyperlink"], ButtonData:>"h2", ButtonStyle->"Hyperlink"]], "Input", PageWidth->PaperWidth, Evaluatable->False, CellTags->"h2b"], Cell[TextData[{ "You may obtain your position at any specific time by integrating the \ velocity from the time at the beginning of the trip up to an arbitrary time \ ", StyleBox["t", FontSlant->"Italic"], ", that is, \n\n", StyleBox["s", FontSlant->"Italic"], "(", StyleBox["t", FontSlant->"Italic"], ")", StyleBox[" = ", FontWeight->"Bold"], Cell[BoxData[ \(TraditionalForm\`\[Integral]\_\(t\_0\)\%t\( v( u)\) \[DifferentialD]u + s(t\_0)\)]], ". \n\nAssuming that ", Cell[BoxData[ \(TraditionalForm\`t\_0 = 0\)]], " and ", StyleBox["s", FontSlant->"Italic"], "(0) = 0, let's find the position function and plot it." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(Clear[s, s0];\)\), "\n", \(\(s0 = 0;\)\), "\n", \(s[t_] = Integrate[v[u], {u, 0, t}] + s0\)}], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(Plot[s[t], {t, 0, 8}, AxesLabel \[Rule] {"\", "\"}];\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "Like velocity, position has a size or magnitude and a direction. The \ magnitude of the position is the distance from the reference point (in this \ case the starting position). The sign of the position function indicates a \ direction, for example, to the right or left of the reference point. If the \ velocity function, ", StyleBox["v", FontSlant->"Italic"], "(", StyleBox["t", FontSlant->"Italic"], "), is positive, then the position function is increasing with time, and if \ it is negative, then the position function is decreasing as time progresses. \ Mathematical quantities that have a magnitude and a direction are called \ vectors. The position and velocity of a moving object are both vector \ quantities.\n\nThe position at time ", StyleBox["t", FontSlant->"Italic"], " is the accumulation or sum of infinitesimal displacements from the \ starting time, added to the initial position, that is, \n\n", Cell[BoxData[ FormBox[ RowBox[{\(s(t)\), "=", RowBox[{ RowBox[{\(s(t\_0)\), "+", RowBox[{\(\[Integral]\_\(t\_0\)\%t\), StyleBox[ RowBox[{"d", StyleBox["s", FontSlant->"Italic"]}]]}]}], "=", RowBox[{\(s(t\_0)\), "+", RowBox[{\(\[Integral]\_\(t\_0\)\%t\), RowBox[{ FractionBox[ StyleBox[ RowBox[{"d", StyleBox["s", FontSlant->"Italic"]}]], StyleBox[ RowBox[{ StyleBox["d", FontSlant->"Plain"], "\[Tau]"}]]], StyleBox[ RowBox[{"d", StyleBox["\[Tau]", FontSlant->"Italic"]}]]}]}]}]}]}], TraditionalForm]]], Cell[BoxData[ FormBox[ RowBox[{ StyleBox["=", FontSlant->"Plain"], RowBox[{\(s(t\_0)\), "+", RowBox[{\(\[Integral]\_\(t\_0\)\%t\), RowBox[{"v", " ", StyleBox[ RowBox[{"d", StyleBox["\[Tau]", FontSlant->"Italic"]}]]}]}]}]}], TraditionalForm]]], ". \n\nThe specially designed ", StyleBox["position[ ]", FontWeight->"Bold"], " command in the input cell that follows illustrates this idea by producing \ a sequence of graphs that show the accumulation of displacements in two \ different formats. The first format shows the displacements as shaded areas \ between the velocity function and the ", StyleBox["t", FontSlant->"Italic"], "-axis, and the second format shows them as a change in the position of the \ object on the position graph. \n\nRed areas on the velocity graph represent \ increases in the position due to positive velocity; blue areas represent \ decreases in position due to negative velocity. Similarly, the red arrows on \ the position graph represent increases in the position function, and the blue \ arrows represent decreases. The lengths of the red arrows on the position \ function are numerically equal to the corresponding red areas on the velocity \ graph, and the lengths of the blue arrows on the position function are \ numerically equal to the corresponding blue areas on the velocity graph." }], "Text", PageWidth->PaperWidth], Cell[TextData[{ "To animate the sequence of graphs generated by the ", StyleBox["position[ ]", FontWeight->"Bold"], " command, do the following:\n1. If necessary, widen the notebook window so \ that both graphs in each cell show across the page.\n2. Put the cursor in the \ cell bracket that contains all the graphics cells and double click the left \ mouse button. This will collapse all the graphs into one cell, displaying \ only the first graphics cell in the sequence.\n3. Be sure the cell bracket \ that contains the collapsed graphics cells is selected (if it is not, place \ the cursor in the cell bracket and click once), and then press Ctrl+Y. This \ will play the sequence of graphics slides to generate the animation. \n4. \ While the animation is playing, a control bar appears at the bottom of the \ notebook window. This bar allows you to control the speed and direction of \ the animation.\n\n", StyleBox["Since the following command generates a lot of output, you \ probably won't want to print this notebook until after you have deleted most \ or all of the graphs. We recommend deleting all but a few representative \ cells from the sequence before you print.", CellFrame->True, Background->GrayLevel[0.849989]] }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(position[v[t], {t, 0, 8}, s0];\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ StyleBox["A note about modeling:", FontWeight->"Bold"], " In the model above, the velocity is undefined at", Cell[BoxData[ \(TraditionalForm\`\(\(\ \)\(t = 4\)\)\)]], " hours. In reality, however, your car would have to slow down, turn \ around, and accelerate back to cruising speed at ", Cell[BoxData[ \(TraditionalForm\`t = 4\)]], " hours. This maneuver would occur over a very short interval of time (say \ a few minutes) when compared to the duration of the trip. The sharp corner at \ the turnaround time would in actuality be rounded, and the sudden jump from \ 60 mph to", Cell[BoxData[ \(TraditionalForm\`\(\(\ \)\(-\ 60\)\)\)]], " mph would actually have a finite slope to it. On the scale of eight \ hours, however, the graphs would look much like those depicted above, even if \ the more precise model were used. With these observations in mind, you may \ claim that the above model is reasonable for describing your trip." }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["\<\ You Try It: Different Starting Positions, Directions, and Speed\ \>", "Section", PageWidth->PaperWidth], Cell[TextData[{ "1. Try different starting positions by changing the value of ", StyleBox["s0", FontWeight->"Bold"], ", which is highlighted in red in the cell that follows. We suggest that \ you try ", Cell[BoxData[ FormBox[ StyleBox[\(s0 = \(-100\)\), FontWeight->"Bold"], TraditionalForm]]], " and ", Cell[BoxData[ FormBox[ StyleBox[\(s0 = 100\), FontWeight->"Bold"], TraditionalForm]]], ". What do you observe about the graphs of ", Cell[BoxData[ \(TraditionalForm\`s(t)\)]], "?\n\n2. Suppose you take a different trip, where you go in the opposite \ direction for 5 hours at 65 mph, and then return to the start position at the \ same speed. Use the same reference directions as in Part I and change the \ velocity function entries that are highlighted in blue, accordingly. If you \ wish, try different starting values as in the first exercise." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{\(Clear[v, s, s0];\), "\n", RowBox[{ RowBox[{\(v[t_]\), "=", RowBox[{"Which", "[", RowBox[{ RowBox[{"t", "\[LessEqual]", StyleBox["4", FontColor->RGBColor[0, 0, 1]]}], ",", StyleBox["60", FontColor->RGBColor[0, 0, 1]], ",", " ", RowBox[{"t", ">", StyleBox["4", FontColor->RGBColor[0, 0, 1]]}], ",", StyleBox[\(-60\), FontColor->RGBColor[0, 0, 1]]}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{"s0", "=", StyleBox["0", FontColor->RGBColor[1, 0, 0]]}], ";"}], "\n", RowBox[{ RowBox[{"position", "[", RowBox[{\(v[t]\), ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", StyleBox["8", FontColor->RGBColor[0, 0, 1]]}], "}"}], ",", "s0"}], "]"}], ";"}]}], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["Part II: Constant Acceleration", "Section", PageWidth->PaperWidth], Cell["\<\ Imagine throwing an object straight up from the ground with an initial speed \ of 128 ft/sec. You can give its velocity as the following function of time.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(Clear[v];\)\), "\n", \(\(v[t_] = 128 - 32*t;\)\), "\n", \(\(Plot[v[t], {t, 0, 8}, AxesLabel \[Rule] {"\", "\"}];\)\)}], "Input", PageWidth->PaperWidth], Cell[TextData[{ "Assuming that the object is thrown straight up from the ground, which is \ taken as the reference point (i.e., ", StyleBox["s", FontSlant->"Italic"], " = 0), you can determine the position function and graph it." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{\(Clear[s];\), "\n", RowBox[{ RowBox[{"s0", "=", StyleBox["0", FontColor->RGBColor[1, 0, 0]]}], ";"}], "\n", \(s[t_] = Integrate[v[u], {u, 0, t}] + s0\)}], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(Plot[s[t], {t, 0, 8}, AxesLabel \[Rule] {"\", "\"}];\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "Now use ", StyleBox["position[ ] ", FontWeight->"Bold"], "to illustrate the accumulation of displacements on the graphs of the \ velocity and the position functions. On the velocity graph, shaded areas \ represent displacements or changes in position of the moving object. Red \ areas are numerically equal to positive displacements of the moving object, \ and blue areas are numerically equal to negative displacements. On the \ position graph, the red and blue colored arrows represent the displacements \ of the object. Red arrows show positive displacements and blue arrows show \ negative displacements. The red shaded areas on the velocity graph are \ numerically equal to the lengths of the corresponding red arrows on the \ position graph. Similarly, the blue areas are numerically equal to the \ lengths of the corresponding blue arrows." }], "Text", PageWidth->PaperWidth], Cell[TextData[StyleBox["Note: The next command generates a lot of graphics, \ which may fill up your computer's memory. Before executing the next command, \ pull down the Kernel menu and select Delete All Output. All computed values \ are saved when you do this.", CellFrame->True, Background->GrayLevel[0.849989]]], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(position[v[t], {t, 0, 8}, s0];\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "Change the commands above to try several different starting values for ", StyleBox["s0", FontWeight->"Bold"], ", highlighted in red.", " We suggest ", Cell[BoxData[ FormBox[ StyleBox[\(s0 = \(-100\)\), FontWeight->"Bold"], TraditionalForm]]], " and ", Cell[BoxData[ FormBox[ StyleBox[\(s0 = 100\), FontWeight->"Bold"], TraditionalForm]]], ". What do you observe about the graphs of ", StyleBox["s", FontSlant->"Italic"], "(", StyleBox["t", FontSlant->"Italic"], ")? " }], "Text", PageWidth->PaperWidth], Cell[TextData[{ "In the preceding example, the rate of change or the slope of the velocity \ function (i.e., the acceleration) is constant at ", Cell[BoxData[ FormBox[ RowBox[{"a", " ", "=", " ", RowBox[{\(-g\), " ", "=", " ", RowBox[{\(-32\), " ", FormBox[\(ft/sec\^2\), "TraditionalForm"]}]}]}], TraditionalForm]]], ". \n\nAcceleration is also a vector quantity. If the acceleration is in \ the negative direction, the velocity (which can be positive or negative) is \ decreasing with time. And, if the acceleration is in the positive direction, \ the velocity (which can be positive or negative) is increasing with time. If \ the velocity and the acceleration have the same sign (positive or negative), \ then the object is speeding up, and if they have opposite signs, then the \ object is slowing down. " }], "Text", PageWidth->PaperWidth], Cell[TextData[{ "The specially designed ", StyleBox["velocity[ ]", FontWeight->"Bold"], " command illustrates this idea by producing a sequence of graphs that show \ the accumulation of velocity in two different formats. The first format shows \ the changes in velocity as shaded areas between the acceleration function and \ the ", StyleBox["t", FontSlant->"Italic"], "-axis, and the second format shows the velocity changes as vertical \ increments of the function on the velocity graph. \n\nRed areas on the \ acceleration graph are numerically equal to increases in the velocity due to \ positive acceleration, whereas blue areas are equal to decreases in velocity \ due to negative acceleration. Similarly, the lengths of the red arrows on the \ velocity graph represent increases in the velocity function, and the lengths \ of the blue arrows represent decreases in the velocity. The lengths of the \ red arrows on the velocity function are numerically equal to the \ corresponding red areas on the acceleration graph, and the lengths of the \ blue arrows on the velocity function are numerically equal to the \ corresponding blue areas on the acceleration graph." }], "Text", PageWidth->PaperWidth], Cell[TextData[{ "In this case, the initial value of the velocity is ", Cell[BoxData[ \(TraditionalForm\`\(+128\)\ ft/sec\)]], "." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(Clear[a];\)\), "\n", \(\(a[t_] = \(-32\);\)\), "\n", \(\(v0 = 128;\)\)}], "Input", PageWidth->PaperWidth], Cell[TextData[StyleBox["Note: The next command generates a lot of graphics, \ which may fill up your computer's memory. Before executing the next command, \ pull down the Kernel menu and select Delete All Output. All computed values \ are saved when you do this.", CellFrame->True, Background->GrayLevel[0.849989]]], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(velocity[a[t], {t, 0, 8}, v0];\)\)], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["You Try It: Oscillation of a Mass and Spring", "Section", PageWidth->PaperWidth], Cell[TextData[{ "If you hang a mass from a spring, it will eventually come to rest in an \ equilibrium position where the weight of the mass is balanced by the tension \ in the spring. Now, if you pull the mass down slightly and let it go, it will \ move up and down or oscillate about the equilibrium position. If there were \ no air resistance and no friction in the mass and spring, it would oscillate \ forever with the same amplitude and frequency. Since the motion is periodic, \ the periodic trig functions are used to describe the motion. Suppose you were \ to pull the mass down 2 centimeters (", Cell[BoxData[ \(TraditionalForm\`\(\(=\)\(0.02\ meters\)\)\)]], ") below its equilibrium position and let it go. The position of the mass \ would be described with the following function." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(Clear[s];\)\), "\[IndentingNewLine]", \(\(s[t_] = \(-0.02\)*Cos[1.5*t];\)\), "\[IndentingNewLine]", \(\(Plot[s[t], {t, 0, 8*Pi/3}, AxesLabel \[Rule] {"\", "\"}];\)\)}], "Input", PageWidth->PaperWidth], Cell[TextData[{ "The time coefficient inside the cosine function is called the angular \ frequency of the oscillation. The period of the oscillation, that is, the \ time to go up and come back down to the release position, can be calculated \ from the angular frequency using the formula, ", Cell[BoxData[ \(TraditionalForm\`T = \(2 \[Pi]\)\/\[Omega]\)]], ", where ", StyleBox["T", FontSlant->"Italic"], " is the period in seconds and \[Omega] is the angular frequency in radians \ per second. In our example, the angular frequency of the oscillation is 1.5 \ radians per second. This value is determined by the size of the mass and the \ stiffness of the spring. In fact, the angular frequency of oscillation is \ equal to ", Cell[BoxData[ \(TraditionalForm\`\@\(\(k/m\)\(\ \)\)\)]], " where ", StyleBox["k", FontSlant->"Italic"], " is the stiffness of the spring in newtons per meter, for example, and ", StyleBox["m", FontSlant->"Italic"], " is the size of the mass, in kilograms. For the position function above, \ ", Cell[BoxData[ \(TraditionalForm\`\[Omega] = \@\(\(k/m\)\(\ \)\)\)]], Cell[BoxData[ \(TraditionalForm\`\(\(=\)\(\ \)\(1.5\)\)\)]], " radians per second." }], "Text", PageWidth->PaperWidth], Cell[TextData[{ "Determine the velocity and acceleration of the mass as it moves up and \ down, and graph them. Complete the ", StyleBox["Mathematica", FontSlant->"Italic"], " commands that follow by replacing the red \"", StyleBox["?", FontColor->RGBColor[1, 0, 0]], "\" marks with the appropriate functions in ", StyleBox["Mathematica", FontSlant->"Italic"], " format (don't include the underscore \"_\" after the independent \ variable). The purple left cell bracket will change to black when you replace \ the question mark." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{\(Clear[v, a];\), "\n", RowBox[{\(v[t_]\), "=", RowBox[{"D", StyleBox["[", FontColor->GrayLevel[0]], RowBox[{ StyleBox["?", FontColor->RGBColor[1, 0, 0]], ",t]"}]}]}]}], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(Plot[v[t], {t, 0, 8*Pi/3}, AxesLabel \[Rule] {"\", "\"}];\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{\(a[t_]\), "=", RowBox[{"D", "[", RowBox[{ StyleBox["?", FontColor->RGBColor[1, 0, 0]], ",t]"}]}]}]], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(Plot[a[t], {t, 0, 8*Pi/3}, AxesLabel \[Rule] {"\", "\"}];\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "Let's complete the circle of ideas. Now that you know the acceleration \ function and an initial condition, fill in the following commands by \ replacing the red \"", StyleBox["?", FontColor->RGBColor[1, 0, 0]], "\" mark with the appropriate function and initial condition to reconstruct \ the velocity function, ", StyleBox["v", FontSlant->"Italic"], "(", StyleBox["t", FontSlant->"Italic"], "). Recall that you release the mass from rest after pulling it down 0.02 \ meters. You will need to replace ", StyleBox["t", FontSlant->"Italic"], ", the independent variable inside the integrand function, with ", StyleBox["u", FontSlant->"Italic"], " so that the ", StyleBox["Integrate[ ]", FontWeight->"Bold"], " command will work correctly." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{\(Clear[v, v0];\), "\n", RowBox[{"v0", "=", RowBox[{ StyleBox["?", FontColor->RGBColor[1, 0, 0]], ";"}]}], "\n", RowBox[{\(v[t_]\), "=", RowBox[{"(", RowBox[{"Integrate", "[", RowBox[{ StyleBox["?", FontColor->RGBColor[1, 0, 0]], ",{u,0,t}]+v0)//Simplify"}]}]}]}]}], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(Plot[v[t], {t, 0, 8*Pi/3}, AxesLabel \[Rule] {"\", "\"}];\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "Next, use the special ", StyleBox["velocity[ ] ", FontWeight->"Bold"], "function to see the visual reconstruction of ", StyleBox["v", FontSlant->"Italic"], "(", StyleBox["t", FontSlant->"Italic"], ")." }], "Text", PageWidth->PaperWidth], Cell[TextData[StyleBox["Note: The next command generates a lot of graphics, \ which may fill up your computer's memory. Before executing the next command, \ pull down the Kernel menu and select Delete All Output. All computed values \ are saved when you do this.", CellFrame->True, Background->GrayLevel[0.849989]]], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(velocity[a[t], {t, 0.0, 8.0*Pi/3.0}, s0];\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "Now you can reconstruct the position function, ", StyleBox["s", FontSlant->"Italic"], "(", StyleBox["t", FontSlant->"Italic"], "). Fill in the following commands by replacing the red question marks \ appropriately. Recall that the mass is released from a position 0.02 meters \ below the equilibrium position." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{\(Clear[s, s0];\), "\n", RowBox[{"s0", "=", RowBox[{ StyleBox["?", FontColor->RGBColor[1, 0, 0]], ";"}]}], "\n", RowBox[{\(s[t_]\), "=", RowBox[{"(", RowBox[{"Integrate", "[", RowBox[{ StyleBox["?", FontColor->RGBColor[1, 0, 0]], ",{u,0,t}]+s0)//Simplify"}]}]}]}]}], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(Plot[s[t], {t, 0, 8*Pi/3}, AxesLabel \[Rule] {"\", "\"}];\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "Use ", StyleBox["position[ ] ", FontWeight->"Bold"], "to see the visual reconstruction of ", StyleBox["s", FontSlant->"Italic"], "(", StyleBox["t", FontSlant->"Italic"], ")." }], "Text", PageWidth->PaperWidth], Cell[TextData[StyleBox["Note: The next command generates a lot of graphics, \ which may fill up your computer's memory. Before executing the next command, \ pull down the Kernel menu and select Delete All Output. All computed values \ are saved when you do this.", CellFrame->True, Background->GrayLevel[0.849989]]], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(position[v[t], {t, 0, 8*Pi/3}, s0];\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "We can make some observations about this motion. The first is that the \ acceleration is in the direction opposite the position. When the mass is \ below the equilibrium position, the stretch in the spring increases, thus \ exerting a net upward force on the mass, accelerating it in that direction. \ When the mass is above the equilibrium position, the stretch in the spring is \ reduced resulting in a net downward force on the mass, accelerating it in \ that direction. The second observation is that the acceleration is \ proportional to the position. The first two observations are demonstrated \ mathematically by noting that \n\nif ", Cell[BoxData[ \(TraditionalForm\`s(t) = \ \(-\ A\)\ cos\ \((\[Omega]\ t)\)\)]], ", then ", Cell[BoxData[ \(TraditionalForm\`\(\(a(t)\)\(=\)\)\)]], Cell[BoxData[ \(TraditionalForm\`\(\(d\^2\) s\)\/\(d\ t\^2\)\)]], " ", Cell[BoxData[ FormBox[ RowBox[{"=", " ", RowBox[{"A", FormBox[\(\[Omega]\^2\), "TraditionalForm"], "cos", " ", \((\[Omega]\ t)\), " "}]}], TraditionalForm]]], " ", Cell[BoxData[ FormBox[ RowBox[{"=", " ", RowBox[{ RowBox[{ FormBox[\(\[Omega]\^2\), "TraditionalForm"], "(", \(A\ cos\ \((\[Omega]\ t)\)\), ")"}], " ", "=", " ", RowBox[{ RowBox[{"-", " ", FormBox[\(\[Omega]\^2\), "TraditionalForm"]}], " ", \(s(t)\)}]}]}], TraditionalForm]]], ",\n\nwhere \[Omega] and ", StyleBox["A", FontSlant->"Italic"], " are constants.", "\n\nAnother thing to note is that the velocity and acceleration are 90 \ degrees or ", Cell[BoxData[ \(TraditionalForm\`\[Pi]\/2\)]], " radians out of phase with one another. During the first quarter-cycle of \ the motion, the velocity and acceleration are both positive and the mass is \ speeding up, moving upward. During the second-quarter cycle, the velocity is \ positive and the acceleration is negative, and the mass is still moving \ upward but now is slowing down. During the third quarter-cycle, the velocity \ and acceleration are both negative, and the mass is speeding up as it moves \ downward. During the fourth quarter-cycle, the velocity is negative and the \ acceleration is positive, and the mass is slowing down as it moves downward. \ Overlaying the graphs of the velocity and acceleration functions shows these \ relationships." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(Plot[{s[t], v[t], a[t]}, {t, 0, 4*Pi/3}, AxesLabel \[Rule] {"\", "\"}, PlotStyle \[Rule] {{RGBColor[1, 0, 0]}, {RGBColor[0, 1, 0]}, {RGBColor[0, 0, 1]}}];\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "The velocity is ", Cell[BoxData[ \(TraditionalForm\`v( t)\ = \ \(-\ A\)\ \[Omega]\ sin\ \((\[Omega]\ t)\)\)]], " and the acceleration is ", Cell[BoxData[ FormBox[ RowBox[{\(a(t)\), " ", "=", " ", RowBox[{\(-\ A\), FormBox[\(\[Omega]\^2\), "TraditionalForm"], "cos", " ", \((\[Omega]\ t)\)}]}], TraditionalForm]]], ". From basic trigonometry, we know that the sine and cosine functions are \ 90 degrees or ", Cell[BoxData[ \(TraditionalForm\`\[Pi]\/2\)]], " radians out of phase with one another.\n\nThe final observation is that \ at the instant that the mass passes the equilibrium position, the velocity \ reaches its extreme values (positive on the way up and negative on the way \ down): its speed is at its maximum value, and its acceleration is zero." }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["Part III: Decaying Oscillations", "Section", PageWidth->PaperWidth], Cell["\<\ A more realistic model for oscillations accounts for the loss of energy that \ results in a decay in the amplitude of the oscillations. In mechanical \ systems, this energy loss is usually due to friction (objects rubbing against \ one another in some way). For the motion of the mass hanging from a spring, a \ more realistic position function has amplitude that decays exponentially.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(Clear[s];\)\), "\n", \(\(s[t_] = \(-0.02\)*Exp[\(-t\)/5]*Cos[t];\)\), "\n", \(\(Plot[s[t], {t, 0, 6*Pi}, PlotRange \[Rule] All, AxesLabel \[Rule] {"\", "\"}];\)\)}], "Input", PageWidth->PaperWidth], Cell["Let's find the velocity and acceleration, and graph them.", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(v[t_] = D[s[t], t] // Simplify\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(Plot[v[t], {t, 0, 6*Pi}, PlotRange \[Rule] All, AxesLabel \[Rule] {"\", "\"}];\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(a[t_] = D[v[t], t] // Simplify\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(Plot[a[t], {t, 0, 6*Pi}, PlotRange \[Rule] All, AxesLabel \[Rule] {"\", "\"}];\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "It is apparent that the amplitudes of the velocity and acceleration also \ decay with time.\n\nYou can analyze the motion using the ", StyleBox["position[ ]", FontWeight->"Bold"], " and ", StyleBox["velocity[ ] ", FontWeight->"Bold"], "commands." }], "Text", PageWidth->PaperWidth], Cell[TextData[StyleBox["Note: The next two commands generate a lot of \ graphics, which may fill up your computer's memory. Before executing them, \ pull down the Kernel menu and select Delete All Output. All computed values \ are saved when you do this.", CellFrame->True, Background->GrayLevel[0.849989]]], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(position[v[t], {t, 0, 6*Pi}, s[0]];\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(velocity[a[t], {t, 0, 6*Pi}, v[0]];\)\)], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["You Try It: A Kid on a Swing", "Section", PageWidth->PaperWidth], Cell[TextData[{ "While friction takes energy out of an oscillating mass and spring, there \ are some systems where energy is continually added to the mass so that the \ oscillations actually get bigger and bigger in amplitude. An example of this \ type of system is a kid on a swing, \"pumping\" to get the swing going or \ being pushed by another kid. In this situation, the position starts at zero \ and the amplitude of the oscillation gets bigger as time progresses.\n\n1. \ Modify the code below to make a model of this kind of motion. (Hint: The ", Cell[BoxData[ \(TraditionalForm\`sin\ t\)]], " is 0 at ", Cell[BoxData[ \(TraditionalForm\`t = 0\)]], ", and the oscillations should grow rather than decay.)" }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(Clear[s];\)\), "\n", \(\(s[t_] = \(-0.02\)*Exp[\(-t\)/5]*Cos[t];\)\), "\n", \(\(Plot[s[t], {t, 0, 6*Pi}, PlotRange \[Rule] All, AxesLabel \[Rule] {"\", "\"}];\)\)}], "Input", PageWidth->PaperWidth], Cell["\<\ 2. Find the velocity and acceleration of the kid, and plot them.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(v[t_] = D[s[t], t]\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(a[t_] = D[v[t], t]\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(Plot[v[t], {t, 0, 6*Pi}, PlotRange \[Rule] All, AxesLabel \[Rule] {"\", "\"}];\)\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(\(Plot[a[t], {t, 0, 6*Pi}, PlotRange \[Rule] All, AxesLabel \[Rule] {"\", "\"}];\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "3. Use the ", StyleBox["velocity[ ]", FontWeight->"Bold"], " and ", StyleBox["position[ ] ", FontWeight->"Bold"], "commands to visualize the integral relationships between the acceleration \ and velocity and between the velocity and position." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(position[v[t], {t, 0, 6*Pi}, s[0]]\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(velocity[a[t], {t, 0, 6*Pi}, v[0]]\)], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["\[MathematicaIcon]", FontWeight->"Bold", FontColor->RGBColor[0.792981, 0.777356, 0.144533], FontVariations->{"CompatibilityType"->0}], StyleBox[" ", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["About", FontWeight->"Bold", FontColor->RGBColor[0.500008, 0, 0.500008]], StyleBox[" ", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["Mathematica", FontWeight->"Bold", FontSlant->"Italic", FontColor->RGBColor[0.500008, 0, 0.500008]] }], "Section", PageWidth->PaperWidth, CellDingbat->None], Cell[TextData[{ "The ", StyleBox["Which[ ]", FontWeight->"Bold"], " command is useful for creating piecewise defined functions. To learn more \ about the ", StyleBox["Which[ ]", FontWeight->"Bold"], " command, pull down the Help menu, select the Help Browser, and type ", StyleBox["Which", FontWeight->"Bold"], ". ", ButtonBox["Go Back.", ButtonData:>"h1b", ButtonStyle->"Hyperlink"] }], "Text", PageWidth->PaperWidth, CellTags->"h1"], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " graphs a function by plotting a series of points on the function and then \ connecting them with straight lines, sometimes when they really shouldn't be \ connected. The vertical line at ", Cell[BoxData[ \(TraditionalForm\`t = 4\)]], " hours really shouldn't be there. The upper segment of the graph at ", Cell[BoxData[ \(TraditionalForm\`\(+\ 60\)\ mph\)]], " should not be connected to the lower segment at ", Cell[BoxData[ \(TraditionalForm\`\(-\ 60\)\ mph\)]], ". ", ButtonBox["Go Back.", ButtonData:>"h2b", ButtonStyle->"Hyperlink"], "\n" }], "Text", PageWidth->PaperWidth, CellTags->"h2"] }, Closed]] }, Open ]] }, FrontEndVersion->"4.0 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 695}}, AutoGeneratedPackage->None, WindowToolbars->"RulerBar", WindowSize->{714, 652}, WindowMargins->{{90, Automatic}, {Automatic, 4}}, PrintingCopies->1, PrintingPageRange->{1, 2} ] (*********************************************************************** 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->{ "h1b"->{ Cell[27318, 551, 1010, 31, 41, "Input", Evaluatable->False, CellTags->"h1b"]}, "h2b"->{ Cell[28867, 598, 1010, 31, 44, "Input", Evaluatable->False, CellTags->"h2b"]}, "h1"->{ Cell[61503, 1527, 474, 17, 71, "Text", CellTags->"h1"]}, "h2"->{ Cell[61980, 1546, 713, 21, 109, "Text", CellTags->"h2"]} } *) (*CellTagsIndex CellTagsIndex->{ {"h1b", 63421, 1591}, {"h2b", 63527, 1595}, {"h1", 63632, 1599}, {"h2", 63709, 1602} } *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1739, 51, 137, 4, 195, "Title"], Cell[1879, 57, 142, 4, 37, "Text"], Cell[2024, 63, 20605, 357, 19, "Input", CellOpen->False, InitializationCell->True], Cell[CellGroupData[{ Cell[22654, 424, 56, 1, 53, "Section"], Cell[22713, 427, 1986, 50, 394, "Text"], Cell[CellGroupData[{ Cell[24724, 481, 99, 2, 47, "Subsection"], Cell[24826, 485, 1415, 36, 299, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[26290, 527, 69, 1, 33, "Section"], Cell[26362, 530, 800, 13, 185, "Text"], Cell[27165, 545, 150, 4, 50, "Input"], Cell[27318, 551, 1010, 31, 41, "Input", Evaluatable->False, CellTags->"h1b"], Cell[28331, 584, 399, 7, 90, "Text"], Cell[28733, 593, 131, 3, 30, "Input"], Cell[28867, 598, 1010, 31, 44, "Input", Evaluatable->False, CellTags->"h2b"], Cell[29880, 631, 728, 26, 131, "Text"], Cell[30611, 659, 161, 4, 70, "Input"], Cell[30775, 665, 131, 3, 30, "Input"], Cell[30909, 670, 3468, 78, 492, "Text"], Cell[34380, 750, 1287, 22, 280, "Text"], Cell[35670, 774, 92, 2, 30, "Input"], Cell[35765, 778, 1026, 21, 166, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[36828, 804, 115, 3, 33, "Section"], Cell[36946, 809, 964, 24, 166, "Text"], Cell[37913, 835, 972, 27, 90, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[38922, 867, 74, 1, 33, "Section"], Cell[38999, 870, 203, 4, 52, "Text"], Cell[39205, 876, 203, 5, 70, "Input"], Cell[39411, 883, 276, 7, 52, "Text"], Cell[39690, 892, 240, 6, 70, "Input"], Cell[39933, 900, 131, 3, 30, "Input"], Cell[40067, 905, 911, 16, 185, "Text"], Cell[40981, 923, 353, 6, 71, "Text"], Cell[41337, 931, 92, 2, 30, "Input"], Cell[41432, 935, 605, 23, 52, "Text"], Cell[42040, 960, 923, 18, 166, "Text"], Cell[42966, 980, 1225, 22, 242, "Text"], Cell[44194, 1004, 178, 6, 33, "Text"], Cell[44375, 1012, 140, 4, 70, "Input"], Cell[44518, 1018, 353, 6, 71, "Text"], Cell[44874, 1026, 92, 2, 30, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[45003, 1033, 88, 1, 33, "Section"], Cell[45094, 1036, 843, 14, 166, "Text"], Cell[45940, 1052, 252, 5, 70, "Input"], Cell[46195, 1059, 1276, 31, 169, "Text"], Cell[47474, 1092, 592, 15, 90, "Text"], Cell[48069, 1109, 279, 8, 50, "Input"], Cell[48351, 1119, 136, 3, 30, "Input"], Cell[48490, 1124, 199, 6, 30, "Input"], Cell[48692, 1132, 136, 3, 30, "Input"], Cell[48831, 1137, 842, 25, 109, "Text"], Cell[49676, 1164, 415, 12, 70, "Input"], Cell[50094, 1178, 136, 3, 30, "Input"], Cell[50233, 1183, 281, 12, 33, "Text"], Cell[50517, 1197, 353, 6, 71, "Text"], Cell[50873, 1205, 103, 2, 30, "Input"], Cell[50979, 1209, 382, 11, 71, "Text"], Cell[51364, 1222, 415, 12, 70, "Input"], Cell[51782, 1236, 136, 3, 30, "Input"], Cell[51921, 1241, 254, 12, 33, "Text"], Cell[52178, 1255, 353, 6, 71, "Text"], Cell[52534, 1263, 97, 2, 30, "Input"], Cell[52634, 1267, 2561, 58, 403, "Text"], Cell[55198, 1327, 259, 5, 70, "Input"], Cell[55460, 1334, 909, 22, 150, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[56406, 1361, 75, 1, 33, "Section"], Cell[56484, 1364, 434, 7, 90, "Text"], Cell[56921, 1373, 249, 5, 90, "Input"], Cell[57173, 1380, 98, 1, 33, "Text"], Cell[57274, 1383, 88, 2, 30, "Input"], Cell[57365, 1387, 157, 3, 30, "Input"], Cell[57525, 1392, 88, 2, 30, "Input"], Cell[57616, 1396, 157, 3, 30, "Input"], Cell[57776, 1401, 318, 10, 71, "Text"], Cell[58097, 1413, 345, 6, 71, "Text"], Cell[58445, 1421, 97, 2, 30, "Input"], Cell[58545, 1425, 97, 2, 30, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[58679, 1432, 72, 1, 33, "Section"], Cell[58754, 1435, 772, 15, 166, "Text"], Cell[59529, 1452, 249, 5, 90, "Input"], Cell[59781, 1459, 113, 3, 33, "Text"], Cell[59897, 1464, 76, 2, 30, "Input"], Cell[59976, 1468, 76, 2, 30, "Input"], Cell[60055, 1472, 157, 3, 30, "Input"], Cell[60215, 1477, 157, 3, 30, "Input"], Cell[60375, 1482, 315, 10, 52, "Text"], Cell[60693, 1494, 92, 2, 30, "Input"], Cell[60788, 1498, 92, 2, 30, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[60917, 1505, 583, 20, 33, "Section"], Cell[61503, 1527, 474, 17, 71, "Text", CellTags->"h1"], Cell[61980, 1546, 713, 21, 109, "Text", CellTags->"h2"] }, Closed]] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)