(* This mathematica file creates the frames for several animations which illustrate the convergence of secants to the tangent. The first two show the secants approaching the tangent on a parabola. The only difference between these files is that the tangent itself is drawn in the second one, along with the curve, moving secants, and a display of the slope of the secant. The third file shows non-convergence at an isolated point of nondifferentiabily but with left and right handed derivatives finite. The fourth file shows the case with the tangent is vertical. The final one is like the first, but with a parabola that arose in an earlier discussion of a bouncing ball. Douglas N. Arnold, 8/29/92, 9/2/94 Douglas N. Arnold Department of Mathematics Penn State University Park, PA 16802 Online documentation related to this file can be found at WWW URL http://www.math.psu.edu/dna/graphics.html. *) BeginPackage["Differential`", "Graphics`Colors`"] Begin["Private`"] SimpleGraph[ fct_, var_, dr_ ] := Module[ {t,xmin, xmax, ymin, ymax }, {{xmin,xmax},{ymin,ymax}} = dr; { Thickness[0.007], Line[Table[{t,fct/.var->t},{t,xmin,xmax,(xmax-xmin)/75}]] } ] PointSlopeLine[ pt_, slope_, dr_ ] := Module[ { x, y, xmin, xmax, ymin, ymax }, {{xmin,xmax},{ymin,ymax}} = dr; {x,y} = pt; Line[ {{xmin-.1,slope (xmin-.1 - x) + y}, {xmax+.1,slope (xmax+.1 - x) + y}}] ] TangentLine[ fct_, var_, x0_, dr_ ] := Module[ { slope }, slope = D[fct,var]/.var->x0; PointSlopeLine[ {x0,fct/.var->x0}, slope, dr ] ] SecantLine[ fct_, var_, x0_, x1_, dr_ ] := Module[ { slope }, If[ x0 == x1, Return[ TangentLine[fct,var,x0,dr]]]; slope = ((fct/.var->x0) - (fct/.var->x1))/(x0-x1); PointSlopeLine[ {x0,fct/.var->x0}, slope, dr ] ] SecantFrame[ fct_, var_, x0_, x1_, dr_] := ( {{xmin,xmax},{ymin,ymax}} = dr; y0 = fct/.var->x0; y1 = fct/.var->x1; slope = (y1-y0)/(x1-x0); Graphics[ Flatten[ { Thickness[0.007],PointSize[0.022], Cyan, SimpleGraph[fct,var,dr], Magenta, SecantLine[fct, var, x0, x1, dr ], Green, Point[{x0,y0}], Yellow, Point[{x1,y1}], Green, Point[{x0,ymin}], Yellow, Point[{x1,ymin}], Yellow,Text[PaddedForm[N[slope],{5,3}],Scaled[{.2,.9}],{-1,0}] } ], PlotRange->dr,Frame->True, Background->Black,DefaultColor->White, DefaultFont->{"Courier-Bold",24.} ] ) SecantTangentFrame[ fct_, var_, x0_, x1_, dr_] := ( {{xmin,xmax},{ymin,ymax}} = dr; y0 = fct/.var->x0; y1 = fct/.var->x1; slope = (y1-y0)/(x1-x0); Graphics[ Flatten[ { Thickness[0.007],PointSize[0.022], Cyan, SimpleGraph[fct,var,dr], Green, TangentLine[fct,var,x0,dr], Magenta, SecantLine[fct, var, x0, x1, dr ], Green, Point[{x0,y0}], Yellow, Point[{x1,y1}], Green, Point[{x0,ymin}], Yellow, Point[{x1,ymin}], Yellow,Text[PaddedForm[N[slope],{5,3}],Scaled[{.2,.9}],{-1,0}] } ], PlotRange->dr,Frame->True, Background->Black,DefaultColor->White, DefaultFont->{"Courier-Bold",24.} ] ) (* first animation, secants only on a parabola *) xlist = {-1,-.9,-.8,-.7,-.6,-.5,-.4,-.3,-.2,-.1,0,.1,.2,.3,.4,.45,.475, .525,.55,.6,.7,.8,.9,1} prefix = "secants1/T"; pixels=400; filename[prefix_,number_] := StringJoin[prefix,ToString[number],".gif"] Table[Display[filename[prefix,i], SecantFrame[x^2,x,0.5,xlist[[i]],{{-1.2,1.2},{-0.2,1.2}}],"gif",ImageSize->pixels], {i,1,Length[xlist]}] Print[StringJoin["-- wrote ",prefix," frames --"]] (* second animation, secants and tangent on the same parabola *) xlist = {-1,-.9,-.8,-.7,-.6,-.5,-.4,-.3,-.2,-.1,0,.1,.2,.3,.4,.45,.475, .525,.55,.6,.7,.8,.9,1} prefix = "secants2/T"; pixels=400; filename[prefix_,number_] := StringJoin[prefix,ToString[number],".gif"] Table[Display[filename[prefix,i], SecantTangentFrame[x^2,x,0.5,xlist[[i]],{{-1.2,1.2},{-0.2,1.2}}],"gif",ImageSize->pixels], {i,1,Length[xlist]}] Print[StringJoin["-- wrote ",prefix," frames --"]] (* third animation: a nondifferentiable function due to a corner *) xlist = Join[Table[t, {t, .05, .55,.05}],{.57,.58,.59,.595,.605,.61,.62,.63}, Table[t,{t,.65,.95,.05}]] prefix = "secants3/T"; pixels=400; filename[prefix_,number_] := StringJoin[prefix,ToString[number],".gif"] Table[Display[filename[prefix,i], SecantFrame[(1/4+Abs[x-3/5])(1-(x-1/2)^2),x,3/5, xlist[[i]],{{0,1},{0,1}}],"gif",ImageSize->pixels], {i,1,Length[xlist]}] Print[StringJoin["-- wrote ",prefix," frames --"]] (* fourth animation: a nondifferentiable function due to a vertical tangent *) xlist = Join[Table[t,{t,-2,-.2,.2}], {-.1,-.05,-.025,-.0125,-.00625,-.0001,.0001, .00625,.0125,.025,.05,.1},Table[t,{t,.2,2,.2}]] prefix = "secants4/T"; pixels=400; filename[prefix_,number_] := StringJoin[prefix,ToString[number],".gif"] Table[Display[filename[prefix,i], SecantFrame[Sign[x]Abs[x]^(1/3),x,0,xlist[[i]],{{-2,2}, {-1.3,1.3}}], "gif",ImageSize->pixels], {i,1,Length[xlist]}] Print[StringJoin["-- wrote ",prefix," frames --"]] (* fifth animation: like the first but with parabola from bouncing ball demo *) xlist = Join[Table[i,{i,0,14}],{15.0001},Table[i,{i,16,30}]]/60. prefix = "secants5/T"; pixels=400; filename[prefix_,number_] := StringJoin[prefix,ToString[number],".gif"] Table[Display[filename[prefix,i], SecantFrame[100-400 x^2,x,0.25,xlist[[i]],{{0.,1.},{0.,120.}}], "gif",ImageSize->pixels], {i,1,Length[xlist]}] Print[StringJoin["-- wrote ",prefix," frames --"]] End[] (* end of context private *) EndPackage[]