Polar Trace

Sub[expr_,var_,val_]:=
expr /. var->val;

Sub[expr_,var_,vals_?ListQ]:=
Transpose[Sub[expr,var,#]& /@ vals];

PolarTrace[f_,{var_,a_,b_},θ0_,mode_,plotrange_,places_]:=
Module[{pl,dt,mx,ln1,ln2,tx,gr,grobjs,r,θ,x0,y0},

r=Sub[f,var,θ0];
x0 = r*Cos[θ0];y0=r*Sin[θ0];
If[a<b,
pl= If[mode===dot || θ0>a,First[PolarPlot[f,Evaluate[Switch[mode,dot,{var,a,b},trace,{var,a,θ0},segment,{var,θ0-0.1,θ0+0.1}]],Axes->False,PlotStyle->ColorData["HTML","SlateBlue"]]],{}];
dt={PointSize[Medium],Style[Point[{x0,y0}],RGBColor[1,.47,0]]};
mx=Max[Select[Join[Flatten[plotrange],{r}],NumberQ]];
ln1 = Style[Line[{{0,0},mx*{Cos[θ0],Sin[θ0]}}],Gray];
grobjs = {pl,dt,ln1};
If[r<0,
ln2=Style[Line[{{0,0},-mx*{Cos[θ0],Sin[θ0]}}],Orange];
AppendTo[grobjs,ln2]
];
{r,θ,x0,y0} = NumberForm[Chop[N[#,places+1]],{places+1,places},NumberPadding->{" ","0"},ExponentFunction-> (Null&) ]& /@  {r,θ0,x0,y0};
tx = Text @ Style[Row[{"θ:",θ,"  r:",r,"  x:",x0,"  y:",y0}],10];

gr=Graphics[grobjs,Axes->True,AspectRatio->Automatic ,AxesOrigin->{Automatic,0}, ImageSize->{400,300},PlotRange->plotrange]
];

Grid[{{tx},{gr}}]
];

PolarFunctionList = 
{{θ,{{-10,10},{-10,10}},{0,4π}}->"r = θ",
{θ/2+1,{{-10,10},{-10,10}},{0,4π}}->"r = θ/2+1",
{θ^2,{{-100,100},{-100,100}},{0,4π}}->"r = (θ^2)",
{1/2,{{-1,1},{-1,1}},{0,2π}}->"r = 1/2",
{Cos[θ],{{-1,1},{-1,1}},{0,2π}}->"r = cos(θ)",
{Sin[θ],{{-1,1},{-1,1}},{0,2π}}->"r = sin(θ)",
{Sqrt[1/(8(Sin[θ])^2+2(Cos[θ])^2)],{{-2,2},{-2,2}},{0,2π}}->"r = (Sqrt[1/(8 (sin^2)[θ] + 2 (cos^2)[θ])])",
{-1/(Sin[θ]-2Cos[θ]),{{-2,2},{-2,2}},{-19π/30,4π/3}}->"r = -1/(sin(θ)-2cos(θ))",
{Tan[θ ],{{-1,1},{-1,1}},{-π/2,π/2}}->"r = tan(θ)",
{Sqrt[1/(Sin[θ]Cos[θ])],{{-10,10},{-10,10}},{0.001,π/2-.001}}->"r = 1/(Sqrt[sin (θ) cos (θ)])]",
{Sin[2θ],{{-1,1},{-1,1}},{0,2π}}->"r = sin(2θ)",
{Cos[3θ],{{-1,1},{-1,1}},{0,2π}}->"r = cos(3θ)",
{1-Sin[θ],{{-2,2},{-2,2}},{0,2π}}->"r = 1 - sin(θ)",
{1+2Sin[4θ],{{-3,3},{-3,3}},{0,2π}}->"r = 1 + 2 sin(4θ)",
{1+4Cos[5θ],{{-5,5},{-5,5}},{0,2π}}->"r = 1 + 4 cos(5θ)",
{Sin[θ/4],{{-1,1},{-1,1}},{0,8π}}->"r = sin(θ/4)",
{Sin[8θ/5],{{-1,1},{-1,1}},{0,10π}}->"r = sin(8θ/5)",
{Sin[θ Sqrt[3]],{{-1,1},{-1,1}},{0,10π}}->"r = sin(θ(Sqrt[3]))",
{Sin[θ]+Sin[5θ/2]^3,{{-2,2},{-2,2}},{0,4π}}->"r = sin(θ)+(sin^3)(5θ/2)"
};

Manipulate[PolarTrace[First[f],Prepend[Last[f],θ],θ0,mode,First[Rest[f]],places],
{{f,PolarFunctionList[[1,1]],"function"},PolarFunctionList,BaseStyle->{FontSize->9}},
{mode,{trace,dot,segment}},
{places,Range[2,6],ControlType->PopupMenu,BaseStyle->{FontSize->9}},
{{θ0,0,"θ"},First[Last[f]],Last[Last[f]]},
SaveDefinitions->True ,AutorunSequencing->{4}]

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Polar Trace" from The Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/PolarTrace/

Contributed by: Richard Mercer

A full-function Wolfram Mathematica 6 system is required to edit or run this notebook.
(Mathematica Player runs only Demonstrations published on this site.)
GET WOLFRAM MATHEMATICA 6 »

© The Wolfram Demonstrations Project & Contributors   |   Terms of Use   |   Make a new version of this Demonstration »