Clear[NewtonMovie]
(* :Author: Christopher Moretti *) 

(* :Summary: 
  This notebook contains a command NewtonMovie[] which creates a sequence of plots which illustrates the idea behind Newton's method of approximating roots of equations.
NewtonMovie[function,x0,n,{x,a,b},{y,c,d}] creates a sequence of plots corresponding to n iterations of Newton's method starting at x=x0 for the equation fun=0.  The ranges show in the plots is x=a to b, y=c to d.  Adding the option RootTable->True at the end adds a table of the root estimates and function values at each step of the method (this may distort the graphics somewhat)
   *) 
(* :History: Version 1.0 by Christopher Moretti, 1997 *)

NewtonMovie[ fun_,pt_,n_,xlist_,ylist_,opts___]:=
	Block[{x,a,b,y,c,d,fp,tanline,x0,m,i,y0,size,rlist,estlist,p1,p2,p3,p4,p5,
      p1a,p1b,flag},
		x=xlist[[1]];a=xlist[[2]];b=xlist[[3]];
		y=ylist[[1]];c=ylist[[2]];d=ylist[[3]];
		size=Max[(b-a)/60,(d-c)/60];
		fp=D[fun,x];
		x0=pt;
		{flag}={RootTable}/.{opts}/. Options[NewtonMovie];
		rlist={Text["root estimate",{0,1}],Line[{{-2,0},{2,0}}]};
		estlist={Text["function value",{0,1}],Line[{{-2,0},{2,0}}]};
		Do[m=(fp/. x->x0);y0=(fun/. x->x0);
				tanline=m(x-x0)+y0;
			AppendTo[rlist,Text[ToString[N[x0]],{0,-i}]];
			AppendTo[estlist,Text[ToString[N[y0]],{0,-i}]];
				p1=Show[{
            Plot[fun,{x,a,b},DisplayFunction->Identity,AspectRatio->Automatic,
              PlotRange->{{a,b},{c,d}}],Graphics[Disk[{x0,0},size]]},
          DisplayFunction->Identity];
			p1a=Show[Graphics[Flatten[rlist]],DisplayFunction->Identity,
          PlotRange->{{-4,4},{-n-2,2}}];
			p1b=Show[Graphics[Flatten[estlist]],DisplayFunction->Identity,
          PlotRange->{{-4,4},{-n-2,2}}];
			If[flag,
        Show[GraphicsArray[{p1,p1a,p1b}],DisplayFunction->$DisplayFunction],
        Show[p1,DisplayFunction->$DisplayFunction]];
			p2=	Show[{Plot[fun,{x,a,b},DisplayFunction->Identity],
            Graphics[{Disk[{x0,y0},size],Line[{{x0,0},{x0,y0}}],
                Disk[{x0,y0},size]}]},AspectRatio->Automatic,
          PlotRange->{{a,b},{c,d}},DisplayFunction->Identity];
			If[flag,
        Show[GraphicsArray[{p2,p1a,p1b}],DisplayFunction->$DisplayFunction],
					Show[p2,DisplayFunction->$DisplayFunction]];
			p3=Show[{Plot[fun,{x,a,b},DisplayFunction->Identity],
            Graphics[Disk[{x0,y0},size]]},AspectRatio->Automatic,
          PlotRange->{{a,b},{c,d}},DisplayFunction->Identity];
		If[flag,
					Show[GraphicsArray[{p3,p1a,p1b}],DisplayFunction->$DisplayFunction],
        Show[p3,DisplayFunction->$DisplayFunction]];
			p4=Show[{
            Plot[{fun,tanline},{x,a,b},AspectRatio->Automatic,
              PlotRange->{{a,b},{c,d}},DisplayFunction->Identity],
            Graphics[Disk[{x0,y0},size]]},DisplayFunction->Identity];
		If[flag,	
        Show[GraphicsArray[{p4,p1a,p1b}],DisplayFunction->$DisplayFunction],
        Show[p4,DisplayFunction->$DisplayFunction]];
			x0=x0-y0/m;y0=(fun/. x->x0);
				p1a=Show[
          Graphics[Flatten[AppendTo[rlist,Text[ToString[N[x0]],{0,-i-1}]]]],
          DisplayFunction->Identity,PlotRange->{{-4,4},{-n-2,2}}];
						p1b=
        Show[Graphics[
            Flatten[AppendTo[estlist,Text[ToString[N[y0]],{0,-i-1}]]]],
          DisplayFunction->Identity,PlotRange->{{-4,4},{-n-2,2}}];
					p5=	Show[{
            Plot[{fun,tanline},{x,a,b},AspectRatio->Automatic,
              PlotRange->{{a,b},{c,d}},DisplayFunction->Identity],
            Graphics[Disk[{x0,0},size]]},DisplayFunction->Identity];
				If[flag,
          Show[GraphicsArray[{p5,p1a,p1b}],DisplayFunction->$DisplayFunction],
          
				Show[p5,DisplayFunction->$DisplayFunction]];
			,{i,1,n}]
		]

Options[NewtonMovie]={RootTable->False}

NewtonMovie::usage=
  "NewtonMovie[function,x0,
    n,{x,a,b},{y,c,
        d}] creates a sequence of plots corresponding to n iterations of 
          Newton's method starting at 
          x=x0 for the equation 
              fun=0.  The ranges show in the plots is x=a to b, y=c to d."
		
(* Example: NewtonMovie[ 2Sin[x]-.3,1,5,{x,-Pi,Pi},{y,-3,2}] *)