(* This package may be distributed freely, but is copyright by Lafayette College, 1994. *) BeginPackage["PolarIntegral`"] innertriangles::usage = "innertriangles[r[t],{t,tmin,tmax},n] plots the graph of r = r[theta] in polar coordinates over the theta interval (tmin,tmax), and inscribes n triangles." outertriangles::usage = "outertriangles[r[t],{t,tmin,tmax},n] plots the graph of r = r[theta] in polar coordinates over the theta interval (tmin,tmax), and circumscribes n triangles." righttriangles::usage = "righttriangles[r[t],{t,tmin,tmax},n] plots the graph of r = r[theta] in polar coordinates over the theta interval (tmin,tmax), and superimposes n right triangles." Begin["`Private`"] innertriangles[ftn_,paramlist_,ntri_] := Module[{angle,f,graph,incr,n,p,p0,p1,x}, p := paramlist[[1]]; p0 = paramlist[[2]]; p1 = paramlist[[3]]; incr = (p1 - p0)/ntri; f[x_] := ftn /.p->x; angle[n_] := Line[{{0,0},{f[(n-1)incr]Cos[(n-1)incr], f[(n-1)incr]Sin[(n-1)incr]},{f[n incr]Cos[n incr], f[n incr]Sin[n incr]}}]; graph := ParametricPlot[{f[x]Cos[x],f[x]Sin[x]}, {x,p0,p1},DisplayFunction->Identity, PlotStyle->RGBColor[1,0,0]]; Show[graph,Graphics[Join[{RGBColor[0,1,0]}, Table[angle[n],{n,ntri}], {Line[{{f[p1]Cos[p1],f[p1]Sin[p1]},{0,0}}]}]], DisplayFunction->$DisplayFunction, AspectRatio->Automatic] ] outertriangles[ftn_,paramlist_,ntri_] := Module[{angle,f,fp,graph,h,incr,n,p,p0,p1,x}, p := paramlist[[1]]; p0 = paramlist[[2]]; p1 = paramlist[[3]]; incr = (p1 - p0)/ntri; h[n_]:= (n - 1/2)incr; f[x_] := ftn /.p->x; fp[x_] := D[ftn,p]/.p->x; angle[n_] := Line[{{0,0},{f[h[n]]Cos[h[n]] + Tan[incr/2](f[h[n]]Sin[h[n]] - fp[h[n]]Cos[h[n]]), f[h[n]]Sin[h[n]] - Tan[incr/2](f[h[n]]Cos[h[n]] + fp[h[n]]Sin[h[n]])},{f[h[n]]Cos[h[n]] - Tan[incr/2](f[h[n]]Sin[h[n]] - fp[h[n]]Cos[h[n]]), f[h[n]]Sin[h[n]] + Tan[incr/2](f[h[n]]Cos[h[n]] + fp[h[n]]Sin[h[n]])}}]; graph := ParametricPlot[{f[x]Cos[x],f[x]Sin[x]}, {x,p0,p1},DisplayFunction->Identity, PlotStyle->RGBColor[1,0,0]]; Show[graph,Graphics[Join[{RGBColor[0,0,1]}, Table[angle[n],{n,ntri}], {Line[{{f[h[n]]Cos[h[n]] - Tan[incr/2](f[h[n]]Sin[h[n]] - fp[h[n]]Cos[h[n]]), f[h[n]]Sin[h[n]] + Tan[incr/2](f[h[n]]Cos[h[n]] + fp[h[n]]Sin[h[n]])},{0,0}}/.n->ntri]}]], DisplayFunction->$DisplayFunction, AspectRatio->Automatic] ] righttriangles[ftn_,paramlist_,ntri_] := Module[{angle,f,graph,incr,n,p,p0,p1,t,x}, p := paramlist[[1]]; p0 = paramlist[[2]]; p1 = paramlist[[3]]; incr = (p1 - p0)/ntri; f[x_] := ftn /.p->x; t[n_] := (n-1)incr; angle[n_] := Line[{{0,0},{f[t[n]]Cos[t[n]], f[t[n]]Sin[t[n]]},{f[t[n]](Cos[t[n]] - Tan[incr]Sin[t[n]]),f[t[n]](Sin[t[n]] + Tan[incr]Cos[t[n]])},{0,0}}]; graph := ParametricPlot[{f[x]Cos[x],f[x]Sin[x]}, {x,p0,p1},DisplayFunction->Identity, PlotStyle->RGBColor[1,0,0]]; Show[graph,Graphics[Join[{RGBColor[0,1,0]}, Table[angle[n],{n,ntri}]]], DisplayFunction->$DisplayFunction, AspectRatio->Automatic] ] End[ ](* End of Private Context *) EndPackage[ ]