(* This mathematica file creates the files secants1.anim, ..., secants5.anim,
   which illustrate the converge 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`Animation`", "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 *)

opts = ( AnimationFunction -> (DisplayAnimation["secants1.anim",#]&) )
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}
ShowAnimation[
    Table[ SecantFrame[x^2,x,0.5,xlist[[i]],{{-1.2,1.2},{-0.2,1.2}}],
            {i,1,Length[xlist]}],
  opts]
Print["-- wrote file secants1.anim --"]

(* These lines rasterize each frame separately to ppm format.  They can
   be used to create an MPEG animation file. *)
(*
writetofile[i_] := StringJoin["!rasterps -format ppm > /tmp/graphics/secants1.",
  ToString[PaddedForm[i,3,NumberPadding->{"0",""}]],".ppm"]
Table[ Display[writetofile[i],
     SecantFrame[x^2,x,0.5,xlist[[i]],{{-1.2,1.2},{-0.2,1.2}}]],
  {i,1,Length[xlist]}]
Print["-- rasterized frames from secants1 --"]
*)

(* second animation, secants and tangent on the same parabola *)

opts = ( AnimationFunction -> (DisplayAnimation["secants2.anim",#]&) )
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}
ShowAnimation[
    Table[ SecantTangentFrame[x^2,x,0.5,xlist[[i]],{{-1.2,1.2},{-0.2,1.2}}],
            {i,1,Length[xlist]}],
  opts]
Print["-- wrote file secants2.anim --"]

(* These lines rasterize each frame separately to ppm format.  They can
   be used to create an MPEG animation file. *)
(*
writetofile[i_] := StringJoin["!rasterps -format ppm > /tmp/graphics/secants2.",
  ToString[PaddedForm[i,3,NumberPadding->{"0",""}]],".ppm"]
Table[ Display[writetofile[i],
     SecantTangentFrame[x^2,x,0.5,xlist[[i]],{{-1.2,1.2},{-0.2,1.2}}]],
  {i,1,Length[xlist]}]
Print["-- rasterized frames from secants2 --"]
*)

(* third animation: a nondifferentiable function due to a corner *)

opts = ( AnimationFunction -> (DisplayAnimation["secants3.anim",#]&) )
xlist = Join[Table[t, {t, .05, .55,.05}],{.57,.58,.59,.595,.605,.61,.62,.63},
     Table[t,{t,.65,.95,.05}]] 
ShowAnimation[
    Table[ SecantFrame[(1/4+Abs[x-3/5])(1-(x-1/2)^2),x,3/5,
       xlist[[i]],{{0,1}, {0,1}}], {i,1,Length[xlist]}],
  opts]
Print["-- wrote file secants3.anim --"]

(* These lines rasterize each frame separately to ppm format.  They can
   be used to create an MPEG animation file. *)
(*
writetofile[i_] := StringJoin["!rasterps -format ppm > /tmp/graphics/secants3.",
  ToString[PaddedForm[i,3,NumberPadding->{"0",""}]],".ppm"]
Table[ Display[writetofile[i],
     SecantFrame[(1/4+Abs[x-3/5])(1-(x-1/2)^2),x,3/5,
       xlist[[i]],{{0,1}, {0,1}}]],
  {i,1,Length[xlist]}]
Print["-- rasterized frames from secants3 --"]
*)

(* fourth animation: a nondifferentiable function due to a vertical tangent *)

opts = ( AnimationFunction -> (DisplayAnimation["secants4.anim",#]&) )
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}]] 
ShowAnimation[
    Table[ SecantFrame[Sign[x]Abs[x]^(1/3),x,0,xlist[[i]],{{-2,2}, {-1.3,1.3}}],
            {i,1,Length[xlist]}],
  opts]
Print["-- wrote file secants4.anim --"]

(* These lines rasterize each frame separately to ppm format.  They can
   be used to create an MPEG animation file. *)
(*
writetofile[i_] := StringJoin["!rasterps -format ppm > /tmp/graphics/secants4.",
  ToString[PaddedForm[i,3,NumberPadding->{"0",""}]],".ppm"]
Table[ Display[writetofile[i],
     SecantFrame[Sign[x]Abs[x]^(1/3),x,0,xlist[[i]],{{-2,2}, {-1.3,1.3}}]],
  {i,1,Length[xlist]}]
Print["-- rasterized frames from secants4 --"]
*)

(* fifth animation: like the first but with parabola from bouncing ball demo *)

opts = ( AnimationFunction -> (DisplayAnimation["secants5.anim",#]&) )
xlist = Join[Table[i,{i,0,14}],{15.0001},Table[i,{i,16,30}]]/60.
ShowAnimation[
    Table[ SecantFrame[100-400 x^2,x,0.25,xlist[[i]],{{0.,1.},{0.,120.}}],
            {i,1,Length[xlist]}],
  opts]
Print["-- wrote file secants5.anim --"]

(* These lines rasterize each frame separately to ppm format.  They can
   be used to create an MPEG animation file. *)
(*
writetofile[i_] := StringJoin["!rasterps -format ppm > /tmp/graphics/secants5.",
  ToString[PaddedForm[i,3,NumberPadding->{"0",""}]],".ppm"]
Table[ Display[writetofile[i],
     SecantFrame[100-400 x^2,x,0.25,xlist[[i]],{{0.,1.},{0.,120.}}],
            {i,1,Length[xlist]}]],
  {i,1,Length[xlist]}]
Print["-- rasterized frames from secants5 --"]
*)

End[] (* end of context private *)

EndPackage[]