BeginPackage["DCPolarPlot`"]; (* *) DCPolarPlot::usage="DCPolarPlot[f[q],{q,a,b}] gives a polar plot of r=f[q] over [a,b] where q is in radian measure."; (* *) PolarGrid::usage="PolarGrid is an option for DCPolarPlot. PolarGrid->True shows the function on a polar grid. PolarGrid->False shows the function on a Cartesian grid."; (* *) Options[DCPolarPlot]={PolarGrid->True,PlotStyle->RGBColor[0,0,0]}; (* *) Begin["`Private`"]; (* *) MakeLines[range_List]:= Module[{pd,pr,lines}, pd=range[[1]];pr=range[[2]]; lines={}; If[Max[pd]>0&&Max[pr]>0, lines=Union[lines, {Graphics[{RGBColor[0.559, 0.554, 0.434], Line[{{0,0},{Max[Max[pd],Max[pr]],Max[Max[pd],Max[pr]]}}]}] }] ]; If[Max[pd]>0&&Max[pr]>0, lines=Union[lines, {Graphics[{RGBColor[0.559, 0.554, 0.434], Line[{{0,0},{Max[Max[pd],Abs[Min[pr]]], -Max[Max[pd],Abs[Min[pr]]]}}]}] }] ]; If[Min[pd]<0&&Min[pr]<0, lines=Union[lines, {Graphics[{RGBColor[0.559, 0.554, 0.434], Line[{{0,0},{-Max[Abs[Min[pd]],Abs[Min[pr]]], -Max[Abs[Min[pd]],Abs[Min[pr]]]}}]}] }] ]; If[Min[pd]<0&&Max[pr]>0, lines=Union[lines, {Graphics[{RGBColor[0.559, 0.554, 0.434], Line[{{0,0},{-Max[Abs[Min[pd]],Max[pr]], Max[Abs[Min[pd]],Max[pr]]}}]}] }] ]; lines=Union[lines, {Graphics[{RGBColor[0.559, 0.554, 0.434], Line[{{0,Min[pr]},{0,Max[pr]}}], Line[{{Min[pd],0},{Max[pd],0}}]}] }]; Return[lines] ] (* *) SortTicks[l_List]:= Module[{ticks,i}, ticks={}; fullticks={}; For[i=1,i<=Length[l[[1]]],i++, If[l[[1,i,2]]>=0 || l[[1,i,2]]<0, ticks=Union[ticks,{l[[1,i,1]]}] ] ]; ticks=Union[Map[Abs,ticks],Map[Abs,ticks]]; Return[ticks] ] (* *) NotHeadListQ[k_List]:=False; NotHeadListQ[k_]:=True; (* *) DCPolarPlot[r_?NotHeadListQ,{x_Symbol,a_,b_},opts___Rule]:= Module[{pstyle,p,square,ticks,lines,circles}, pstyle=PlotStyle/.{opts}/.Options[DCPolarPlot]; p=ParametricPlot[{r Cos[x],r Sin[x]},{x,a,b}, Axes->{False,False}, Ticks->{None,None}, Frame->True, FrameTicks->{Automatic,Automatic}, PlotStyle->pstyle, DisplayFunction->Identity]; square=Flatten[PlotRange[p]]; square={{Min[square],Max[square]}, {Min[square],Max[square]}}; p=Show[p,PlotRange->square]; ticks=SortTicks[FullOptions[p,FrameTicks]]; If[Flatten[ticks]=={}, ticks={Min[square],Max[square], (Min[square]+Max[square])/2} ]; lines=MakeLines[square]; circles={}; For[i=1,i<=Length[ticks],i++, {circles=Union[circles, {Graphics[{RGBColor[0.559, 0.554, 0.434], Circle[{0,0},ticks[[i]]]}], Graphics[{RGBColor[0.046, 0.038, 0.025], Text[N[ticks[[i]],3],{ticks[[i]]/Sqrt[2], ticks[[i]]/Sqrt[2]}], Text[N[ticks[[i]],3],{ticks[[i]]/Sqrt[2], -ticks[[i]]/Sqrt[2]}], Text[N[ticks[[i]],3],{-ticks[[i]]/Sqrt[2], ticks[[i]]/Sqrt[2]}], Text[N[ticks[[i]],3],{-ticks[[i]]/Sqrt[2], -ticks[[i]]/Sqrt[2]}], Text[N[ticks[[i]],3],{ticks[[i]],0}], Text[N[ticks[[i]],3],{-ticks[[i]],0}], Text[N[ticks[[i]],3],{0,ticks[[i]]}], Text[N[ticks[[i]],3],{0,-ticks[[i]]}]}] }]} ]; Show[lines,circles,p,DisplayFunction->$DisplayFunction, AspectRatio->1,Axes->{False,False},Frame->True, Ticks->{None,None},FrameTicks->{None,None}, PlotRange->square] ]/;(PolarGrid/.{opts}/.Options[DCPolarPlot]) (* *) DCPolarPlot[r_,{x_,a_,b_},opts___]:= Module[{newopts}, newopts=Drop[{opts},{Position[{opts},PolarGrid][[1,1]], Position[{opts},PolarGrid][[1,1]]}]; If[newopts=={}, Return[ParametricPlot[{r Cos[x],r Sin[x]},{x,a,b}]], Return[ParametricPlot[{r Cos[x],r Sin[x]},{x,a,b}, Evaluate[newopts]]] ] ]/;(!PolarGrid/.{opts}/.Options[DCPolarPlot]) (* *) End[]; (* *) EndPackage[];