(*^ ::[paletteColors = 128; currentKernel; fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e8, 24, "Times"; ; fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e6, 18, "Times"; ; fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, L1, e6, 14, "Times"; ; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, L1, a20, 18, "Times"; ; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, L1, a15, 14, "Times"; ; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, L1, a12, 12, "Times"; ; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Times"; ; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 10, "Times"; ; fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L1, 12, "Courier"; ; fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, 12, "Courier"; ; fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, R65535, L1, 12, "Courier"; ; fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, B65535, L1, 12, "Courier"; ; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, L1, 12, "Courier"; ; fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, B65535, L1, 10, "Geneva"; ; fontset = header, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Times"; ; fontset = Left Header, inactive, nohscroll, L1, 12, "Times"; ; fontset = footer, inactive, nohscroll, noKeepOnOnePage, preserveAspect, center, M7, L1, 12, "Times"; ; fontset = Left Footer, inactive, nohscroll, center, L1, 12, "Times"; ; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 10, "Geneva"; ; fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Times"; ; fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Courier"; ; fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Times"; ; fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Times"; ; fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Times"; ; fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Times"; ; fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Times"; ;] :[font = title; inactive; Cclosed; dontPreserveAspect; startGroup; ] Making Animations and Flipbooks :[font = text; inactive; dontPreserveAspect; center; endGroup; ] Mathematica code as it appeared in Mathematica in Education, Volume 1, No. 1, Fall 1991. ;[s] 4:0,1;11,0;35,1;46,0;90,-1; 2:2,17,12,Times,0,12,0,0,0;2,17,12,Times,2,12,0,0,0; :[font = subsubtitle; inactive; dontPreserveAspect; ] Carl Swenson Department of Mathematics Seattle University swenson@seattle.edu ;[s] 1:0,0;78,-1; 1:1,19,14,Times,0,14,0,0,0; :[font = input; preserveAspect; ] (* function plot *) Plot[x^3-6x^2+9x+3, {x,0,4}, PlotRange->{{-1,5},{-1,10}}, PlotStyle->RGBColor[0,0,1]] :[font = input; preserveAspect; ] (* circle and point graphics *) Show[ Graphics[ {Circle[{0,0},1], PointSize[.03],Point[{1,0}]}], AspectRatio->1] :[font = input; dontPreserveAspect; ] (* iteration by a For, b+= is the step *) For[ b=.1, b<=4, b+=.25, Plot[x^3-6x^2+9x+3,{x,0,b}, PlotRange ->{{-1,5},{-1,10}}]] :[font = input; preserveAspect; ] (* iteration by a Do, creates a small wobble *) Do[ Show[ Graphics[ {Circle[{0,0},1], {GrayLevel[.1], Disk[{Cos[t],Sin[t]},.04]}}], AspectRatio->1, PlotRange->{-1.1, 1.1}], (* should be {{-1.1, 1.1},{-1.1, 1.1}} *) {t, 0., 2Pi, Pi/10}] :[font = input; preserveAspect; ] (* iteration by a While, accumulates dots *) dots = {PointSize[.05]}; t=0. While[t<2Pi//N, (* t<2Pi will not work *) AppendTo[ dots, Point[ {Cos[t], Sin[t]}]]; Show[ Graphics[{Circle[{0,0},1], dots}], AspectRatio->1]; t+=Pi/10] :[font = input; dontPreserveAspect; ] (* pointwise to across-time function animation *) f[x_] := x^3-6x^2+9x+3 (* define the function *) xmin=-1; xmax=4.5; ymin=0; ymax=8.5 (* axes ranges *) xlabel="x"; ylabel="f(x)" (* axes labels *) start=0; stop=4; step=.25 (* graph x controls *) (* Iterated copies: start/stop/step determines # of frames *) For[ b=start,b<=stop,b+=step, Show[ Plot[ (* function graph *) f[x],{x,xmin,b}, PlotRange ->{{xmin,xmax},{ymin,ymax}}, AxesLabel ->{xlabel,ylabel}, DisplayFunction -> Identity (* no display *) ], Graphics[ PointSize[.03], (* points *) Point[{b,0}], Map[ Point, Table[{x,f[x]}, {x,start,b,step}] ] ], Graphics[ Dashing[{.01}], (* line and text *) Line[{{b,0},{b,f[b]}}], Text[ StringForm["f(``) = ``",b,N[f[b],3]], {xmin+2,ymax+.5},{-1,0}] ], DisplayFunction ->$DisplayFunction (* display *) ] ] :[font = input; preserveAspect; ] (* The Fundamental Theorem of Calculus 2.0 code *) f[x_] = 3x^2-12x+9 integralf[x_] = Integrate[f[x],x] xmin = -1; xmax = 4.5; ymin = -4; ymax = 10.5 xlabel = "x"; ylabel = "f(x)" start = .25; stop = 4; step = .25; inc = .05 (* function plot held for later display *) functionplot= Plot[ f[x], {x,xmin,xmax}, PlotRange ->{{xmin,xmax}, {ymin,ymax}}, AxesLabel ->{xlabel,ylabel}, PlotStyle ->{{Thickness[.007], RGBColor[0,0,1]}}, DisplayFunction ->Identity] (* Holds display *) (* area plot coordinate system for later display *) areaplot= Plot[ 0,{x,xmin,xmax}, PlotRange ->{{xmin,xmax}, {ymin,ymax}}, AxesLabel ->{xlabel,"Area"}, DisplayFunction ->Identity] (* make table of function plots, hold display *) tableplots1= Table[ Show[ functionplot, Graphics[ Dashing[{.01}], RGBColor[0,1,0], Map[ Line, Table[{{x,0}, {x,f[x]}}, {x,start,b,inc}]] ] ], {b,start,stop,step}] (* make table of area point plots and hold display *) tableplots2= Table[ Show[ areaplot, Graphics[ PointSize[.02], RGBColor[0,1,0], Point[{b,integralf[b]-integralf[start]}] ] ], {b,start,stop,step}] (* Display framed pairs *) Do[ Show[ GraphicsArray[ {{tableplots1[[i]]},{tableplots2[[i]]}}], Frame ->True, DisplayFunction ->$DisplayFunction ], {i,1,16}] (* Generate last frame with all area points *) Show[ GraphicsArray[ {{tableplots1[[16]]},{Show[tableplots2]}}], Frame->True,DisplayFunction ->$DisplayFunction] :[font = input; preserveAspect; ] (* Title page for Fundamental Theorem flipbook *) title= Show[ Graphics[ { Text[FontForm[ "The", {"Times-Bold",14.}],{1.75,9.0}], Text[FontForm[ "Fundamental Theorem", {"Times-Bold",14.}],{1.75,7.0}], Text[FontForm[ "of Calculus", {"Times-Bold",14.}],{1.75,5.0}], Text[FontForm[ "Carl Swenson", {"Times-Bold",12.}],{1.75,2.0}], Text[FontForm[ "Seattle University", {"Times-Bold",12.}],{1.75,0.0}], Text[FontForm[ "1991", {"Times-Bold",9.}],{1.75,-2.0}] }, PlotRange ->{{xmin,xmax},{ymin,ymax}}, DisplayFunction ->Identity ] ] (* Generate title frame *) Show[ GraphicsArray[ {{title}, {Show[{tableplots1[[16]],tableplots2}]}}], Frame->True,DisplayFunction ->$DisplayFunction] ^*)