(*^ ::[ Information = "This is a Mathematica Notebook file. It contains ASCII text, and can be transferred by email, ftp, or other text-file transfer utility. It should be read or edited using a copy of Mathematica or MathReader. If you received this as email, use your mail application or copy/paste to save everything from the line containing (*^ down to the line containing ^*) into a plain text file. On some systems you may have to give the file a name ending with ".ma" to allow Mathematica to recognize it as a Notebook. The line below identifies what version of Mathematica created this file, but it can be opened using any other version as well."; FrontEndVersion = "NeXT Mathematica Notebook Front End Version 2.2"; NeXTStandardFontEncoding; fontset = title, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L3, e8, 24, "Times"; ; fontset = subtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6, 18, "Times"; ; fontset = subsubtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6, 14, "Times"; ; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, a20, 14, "Times"; ; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, a15, 12, "Times"; ; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, a12, 10, "Times"; ; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 14, "Times"; ; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times"; ; fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, 12, "Courier"; ; fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, 12, "Courier"; ; fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, R65535, 12, "Courier"; ; fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, 12, "Courier"; ; fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, 12, "Courier"; ; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, 10, "Courier"; ; fontset = name, inactive, noPageBreakInGroup, nowordwrap, nohscroll, preserveAspect, M7, italic, B65535, 10, "Times"; ; fontset = header, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times"; ; fontset = leftheader, 12; fontset = footer, inactive, nohscroll, noKeepOnOnePage, preserveAspect, center, M7, 12; fontset = leftfooter, 12; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times"; ; fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12; fontset = completions, inactive, nowordwrap, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12; fontset = special1, inactive, nowordwrap, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12; fontset = special2, inactive, nowordwrap, nohscroll, noKeepOnOnePage, preserveAspect, center, M7, 12; fontset = special3, inactive, nowordwrap, nohscroll, noKeepOnOnePage, preserveAspect, right, M7, 12; fontset = special4, inactive, nowordwrap, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12; fontset = special5, inactive, nowordwrap, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12; paletteColors = 128; currentKernel; ] :[font = title; inactive; preserveAspect] Chapter Two: Rolling Circles :[font = section; inactive; Cclosed; preserveAspect; startGroup] 2.1 Discovering the Cycloid :[font = input; preserveAspect] rotate[point_, t_, center_] := center + {{Cos[t], Sin[t]}, {-Sin[t], Cos[t]}} . (point - center) :[font = input; Cclosed; preserveAspect; startGroup] rotate[{0, 0}, t, {0, 1}] + {t, 0} :[font = output; output; inactive; preserveAspect; endGroup] {t - Sin[t], 1 - Cos[t]} ;[o] {t - Sin[t], 1 - Cos[t]} :[font = input; preserveAspect] cycloid[t_] := {t - Sin[t], 1 - Cos[t]}; ParametricPlot[cycloid[t], {t, 0, 4 Pi}, AspectRatio->2/(4 Pi)] :[font = input; preserveAspect] cycloid[t_] := {t - Sin[t], 1 - Cos[t]}; baseline = Line[{{-2, 0}, {10.5, 0}}]; pi = N[Pi]; dots = {PointSize[.006]}; Do[ AppendTo[dots, Point[cycloid[t]]]; Show[Graphics[{{GrayLevel[.5], Disk[{t, 1}, 1]}, Line[{{t, 1}, cycloid[t]}], (* spoke *) baseline, dots}], AspectRatio->3/12, PlotRange->{{-1.5, 10.5}, {-.5, 2.5}}], {t, 0., 59/40 2 pi, 2 pi/15}] :[font = input; preserveAspect; endGroup] Do[ParametricPlot[{t - r Sin[t], 1 - r Cos[t]}, {t, 0, 2 Pi 58/40}, PlotRange->{{-1,8.6},{-1.2, 3.2}}, AspectRatio->4.4/9.5], {r, 0, 2, .1}] :[font = section; inactive; Cclosed; preserveAspect; startGroup] 2.2 The Derivative of the Trochoid :[font = input; Cclosed; preserveAspect; startGroup] trochoid[t_] := {t - 1.3 Sin[t], 1 - 1.3 Cos[t]} velocity = trochoid' :[font = output; output; inactive; preserveAspect; endGroup] {1 - 1.3*Cos[#1], 1.3*Sin[#1]} & ;[o] {1 - 1.3 Cos[#1], 1.3 Sin[#1]} & :[font = input; Cclosed; preserveAspect; startGroup] ParametricPlot[velocity[t], {t, 0, 2 Pi}, AspectRatio->1] :[font = input; preserveAspect; endGroup] vectors = Table[{ trochoid[t], trochoid[t] + velocity[t]}, {t, 0, 8, .3}]; Show[Graphics[{Thickness[.0005], Map[Line, vectors]}], AspectRatio->4/8] :[font = input; preserveAspect; endGroup] Show[Graphics[Table[ Line[{{0,0}, velocity[t]}], {t, 0, 2 Pi, .3}]], AspectRatio->1] :[font = section; inactive; Cclosed; preserveAspect; startGroup] 2.3 Circles Rolling on Circles :[font = input; preserveAspect; endGroup] all code in this section is in the Appendix :[font = section; inactive; Cclosed; preserveAspect; startGroup] 2.4 The Cycloid and Gravity :[font = input; Cclosed; preserveAspect; startGroup] cycloid[t_] := {t - Sin[t], Cos[t] - 1} norm[u_] := Sqrt[u.u] norm[cycloid'[t]]/Sqrt[2g(cycloid[t0][[2]] - cycloid[t][[2]])] :[font = output; output; inactive; preserveAspect; endGroup] ((1 - Cos[t])^2 + Sin[t]^2)^(1/2)/ (2^(1/2)*g^(1/2)*(-Cos[t] + Cos[t0])^(1/2)) ;[o] 2 2 Sqrt[(1 - Cos[t]) + Sin[t] ] --------------------------------------- Sqrt[2] Sqrt[g] Sqrt[-Cos[t] + Cos[t0]] :[font = input; Cclosed; preserveAspect; startGroup] ExpandAll[%] /. Cos[w_]^2 + Sin[w_]^2 -> 1 :[font = output; output; inactive; preserveAspect; endGroup] (2 - 2*Cos[t])^(1/2)/(2^(1/2)*g^(1/2)*(-Cos[t] + Cos[t0])^(1/2)) ;[o] Sqrt[2 - 2 Cos[t]] --------------------------------------- Sqrt[2] Sqrt[g] Sqrt[-Cos[t] + Cos[t0]] :[font = input; preserveAspect] < ArcCos[1/Sqrt[r^2+1]] :[font = output; output; inactive; preserveAspect; endGroup] (2*ArcCos[(1 + (-1 + Cos[t0] + Sin[t]^2/(1 + Cos[t])^2 + (Cos[t0]*Sin[t]^2)/(1 + Cos[t])^2)/2)^(-1/2)])/g^(1/2) ;[o] 1 2 ArcCos[--------------------------------------------------------] 2 2 Sin[t] Cos[t0] Sin[t] -1 + Cos[t0] + ------------- + --------------- 2 2 (1 + Cos[t]) (1 + Cos[t]) Sqrt[1 + ----------------------------------------------] 2 ------------------------------------------------------------------ Sqrt[g] :[font = input; Cclosed; preserveAspect; startGroup] Simplify[%] /. Cos[w_]^2 + Sin[w_]^2 -> 1 :[font = output; output; inactive; preserveAspect; endGroup] (2*ArcCos[(2^(1/2)*(1 + Cos[t]))/((2 + 2*Cos[t])^(1/2)*(1 + Cos[t0])^(1/2))])/ g^(1/2) ;[o] Sqrt[2] (1 + Cos[t]) 2 ArcCos[------------------------------------] Sqrt[2 + 2 Cos[t]] Sqrt[1 + Cos[t0]] ---------------------------------------------- Sqrt[g] :[font = input; Cclosed; preserveAspect; startGroup] MapAll[Factor, %] :[font = output; output; inactive; preserveAspect; endGroup] (2*ArcCos[(1 + Cos[t])^(1/2)/(1 + Cos[t0])^(1/2)])/g^(1/2) ;[o] Sqrt[1 + Cos[t]] 2 ArcCos[-----------------] Sqrt[1 + Cos[t0]] --------------------------- Sqrt[g] :[font = input; Cclosed; preserveAspect; startGroup] % /. Cos[x_] -> Cos[x/2]^2 - 1 :[font = output; output; inactive; preserveAspect; endGroup] (2*ArcCos[Cos[t/2]/Cos[t0/2]])/g^(1/2) ;[o] t Cos[-] 2 2 ArcCos[-------] t0 Cos[--] 2 ----------------- Sqrt[g] :[font = input; Cclosed; preserveAspect; startGroup] t /. First@ Solve[% == time, t] :[font = message; inactive; preserveAspect] Solve::ifun: Warning: inverse functions are being used by Solve, so some solutions may not be found. :[font = output; output; inactive; preserveAspect; endGroup] 2*ArcCos[Cos[t0/2]*Cos[(g^(1/2)*time)/2]] ;[o] t0 Sqrt[g] time 2 ArcCos[Cos[--] Cos[------------]] 2 2 :[font = input; preserveAspect] pi = Pi//N; cycloid[t_] := {t - Sin[t], -1 + Cos[t]} cycloidplot = ParametricPlot[cycloid[s], {s, 0, pi}, Axes->None, PlotStyle->Thickness[.0005], MaxBend->5, DisplayFunction->Identity]; showframe := Show[cycloidplot, Graphics[{Thickness[.0004], Disk[posn, radius], {Thickness[.002], Line[{{pi,-2.1}, {pi,-1.8}}]}}], PlotRange->{{-.2, 2 pi + .2}, {-2.2, .2}}, AspectRatio->2.4/(2 pi + .4), DisplayFunction->$DisplayFunction]; t0 = N[Input["Enter initial t-value for start time on cycloid: 0 ² t < Pi"]]; radius = .07; g = 980 2 pi /15; inc = 1./100; Do[ t = 2 ArcCos[Cos[t0/2] * Cos[Sqrt[g]*time/2]]; posn = cycloid[Min[t, pi - radius/2]]; showframe, {time, 0, pi/Sqrt[g], inc}] :[font = input; Cclosed; preserveAspect; startGroup] degree = . (* code in this cell is changed from first printing of book because of errors I made in the theory *) pi = Pi//N; y[t_] := -2 (t/pi) ^ degree; g = 980 2 pi / 15; h[t_] := (1 - y'[t]) / Sqrt[-y[t] 2 g]; Integrate[h[t], t] :[font = output; output; inactive; preserveAspect] (0.02467815353366681995*t^(1 - degree/2))/ (0.3183098861837906716^(degree/2)*(1 - degree/2)) + 0.0987126141346672798*0.3183098861837906716^(degree/2)*t^(degree/2) ;[o] 1 - degree/2 0.0246782 t degree/2 degree/2 ---------------------------- + 0.0987126 0.31831 t degree/2 degree 0.31831 (1 - ------) 2 :[font = input; Cclosed; preserveAspect; startGroup] error[eps_] := Release[(% /. t-> eps) - Sqrt[-2 y[eps]/g]] Table[degree = 1/n; N[error[.001]], {n, 2, 10}] :[font = output; output; inactive; preserveAspect; endGroup; endGroup] {0.0002463422289147617805, 0.0001133319131161539284, 0.0000771699720409489218, 0.0000613458431212997226, 0.00005266600533389057192, 0.00004723824613109101766, 0.00004354248916889393075, 0.00004087166684072338854, 0.00003885496751351271337} ;[o] {0.000246342, 0.000113332, 0.00007717, 0.0000613458, 0.000052666, 0.0000472382, 0.0000435425, 0.0000408717, 0.000038855} :[font = input; preserveAspect] t = . (* Clears t so it can be used as a dummy variable *) time[n_] := (degree = n; Sqrt[2 y[.001] / -g] + (* Time to fall straight down *) NIntegrate[Sqrt[(1 + y'[t]^2) / (-y[t])] / Sqrt[2g], {t, .001, Pi}]) /; n != 1. time[1.] := norm[{pi,-2}] / Sqrt[g] :[font = input; Cclosed; preserveAspect; startGroup] TableForm[Table[{n, time[n]}, {n, 8}]] (* this and following cell take a while *) :[font = output; output; inactive; preserveAspect; endGroup] TableForm[{{1, 0.1838123529843132298}, {2, 0.1565731725026128765}, {3, 0.1570584055408548462}, {4, 0.158682629254157256}, {5, 0.160206276209858825}, {6, 0.1615076061602091076}, {7, 0.1626070616177456447}, {8, 0.1635416857551882762}}] ;[o] 1 0.183812 2 0.156573 3 0.157058 4 0.158683 5 0.160206 6 0.161508 7 0.162607 8 0.163542 :[font = input; Cclosed; preserveAspect; startGroup] Plot[time[n], {n, 1, 15}, Axes->{0, 0.155}] :[font = postscript; PICT; formatAsPICT; output; inactive; preserveAspect; pictureLeft = 2; pictureWidth = 440; pictureHeight = 281; endGroup; endGroup; pictureID = 14061] ^*)