(* This package may be distributed freely, but is copyright by Lafayette College, 1994. *) BeginPackage["DerivativeGraphics`", {"Graphics`Colors`"}] SecantAni::usage = "SecantAni[f,x0,{x,xmin,xmax},{y,ymin, ymax}] creates a sequence of plots of the graph of f and secant lines intersecting the graph at (x0, f[x0]). The x and y lists give the domain and range of the plots." SecantLine::usage = "SecantLine[f,x1,x2,{x,xmin,xmax}] plots the graph of the function f and the secant line passing through (x1, f[x1]) and (x2, f[x2]). The final list gives the domain of the plot." TangentLine::usage = "TangentLine[f,x0,{x,xmin,xmax}] plots the graph of the function f and the line tangent to its graph at (x0, f[x0]). The final list gives the domain of the plot." NewtonAni::usage = "NewtonAni[f, x0, {x, xmin, xmax}, {y, ymin, ymax}, n] creates a series of plots of the graph of f with tangent lines indicating the sequence of n approximations to the zero of f given by Newton's method with initial guess x0. The x and y lists give the domain and range of the plots."; Cbrt::usage = "Cbrt[z] gives the real cube root of real variable z." Begin["`Private`"] SecantAni[ftn_,x0_,domain_,range_,options___] := Module[{h, m1, l, x}, m1[h_]:= (ftn[x0+h] - ftn[x0])/h; l[x_] := m1[h](x - x0) + ftn[x0]; Do[ h= (domain[[3]] - domain[[2]])/(2n); Plot[Evaluate[{l[x],ftn[x]} /. x->domain[[1]] ],domain, options,PlotRange->{range[[2]],range[[3]]}, PlotStyle->{Red,Blue}];, {n,1,10}] ] SecantLine[ftn_,x1_,x2_,domain_,options___] := Module[{l, m, x}, m = (ftn[x2] - ftn[x1])/(x2 - x1); l[x_] := m(x - x1) + ftn[x1]; Plot[Evaluate[{l[x],ftn[x]} /. x->domain[[1]] ], domain,options,PlotStyle->{Red,Blue}]; ] TangentLine[ftn_,x0_,domain_,options___] := Module[{l, m, x}, m = D[ftn[x],x] /. x->x0; l[x_] := m(x - x0) + ftn[x0]; Plot[Evaluate[{l[x],ftn[x]} /. x->domain[[1]] ], domain,options,PlotStyle->{Orange,Blue}]; ] graph[f_,m_,M_,options___]:=Plot[f[x],{x,m,M},options, DisplayFunction->Identity]; NewtonAni[f_, x0_, domain_, range_, nsteps_:1,options___]:= Module[{x1,tline,xmin,xmax,newplot,vert,inter,tanpt, xx,x,xnew,fcurve,pltrng,ptlist}, x1 = x0; xmin = domain[[2]]; xmax = domain[[3]]; pltrng = {range[[2]],range[[3]]}; fcurve = graph[f,xmin,xmax,PlotRange->pltrng]; newplot[0] = {fcurve}; inter[0] = Point[{x0,0}]; ptlist[n_] := Table[inter[i],{i,0,n}]; Do[ xnew = x1; vert=Graphics[{Dashing[{0.01,0.01}], Line[{{xnew,0},{xnew,f[xnew]}}]}]; x1=xx-f[xx]/f'[xx] /. xx->xnew; tline[x_] := f'[xnew](x-x1); tangraph=graph[tline,xmin,xmax,PlotStyle-> Thickness[0.008]]; inter[k]=Point[{x1,0}]; tanpt=Point[{xnew,f[xnew]}]; Show[Flatten[{newplot[k-1],vert,Graphics[ {PointSize[0.02], Flatten[{ptlist[k-1],tanpt}]}]}],options, PlotRange->pltrng,DisplayFunction-> $DisplayFunction]; newplot[k] = {fcurve,tangraph,Graphics[ {PointSize[0.02],ptlist[k]}]}; Show[Flatten[{newplot[k],vert,Graphics[ {PointSize[0.02],tanpt}]}],options, PlotRange->pltrng,DisplayFunction-> $DisplayFunction];, {k,nsteps}]]; Cbrt[0] := 0; Cbrt[0.] := 0.; Cbrt[x_] := x Sqrt[x^2]^(-2/3); End[ ] EndPackage[ ]