(* 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  <dna@math.psu.edu>
   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[]