Circle Catacaustic

Author

Eric W. Weisstein
July 13, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PlaneCurves/CircleCatacaustic.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/CircleCatacaustic.html.

©2008 Wolfram Research, Inc. except for portions noted otherwise

Equations

General

cat=FullSimplify[Catacaustic[{Cos[t],Sin[t]},R{Cos[θ],Sin[θ]},t]]

Table[FullSimplify[cat/.θ->n π/4],{n,0,1}]

cat=FullSimplify[Catacaustic[{Cos[t],Sin[t]},{μ,0},t]]

At Infinity = nephroid

FullSimplify[Limit[cat,μ->∞]]

eqn=Thread[{x,y}==TrigExpand[%]]

Factor/@GroebnerBasis[Append[eqn,Cos[t]^2+Sin[t]^2==1],{x,y},{Cos[t],Sin[t]}]

General Position

cat

eqn=Numerator[Together[Thread[{x,y}-cat]]]

Factor/@GroebnerBasis[Append[TrigExpand[eqn],Cos[t]^2+Sin[t]^2-1],{x,y},{Cos[t],Sin[t]}]

On circumference = cardioid

FullSimplify[cat/.μ->1]

par[t_]:={(1/3) (2 Cos[t]+Cos[2 t]),(2/3) (1+Cos[t]) Sin[t]}

Factor/@GroebnerBasis[Append[Thread[{x,y}==TrigExpand[par[t]]],Cos[t]^2+Sin[t]^2==1],{x,y},{Cos[t],Sin[t]}]

ParametricPlot[par[t],{t,0,2π},PlotStyle->Red,ImageSize->150]

par/@{0,π}

ParametricPlot[{
-2(par[t]+{1/3,0})3/4,
{Cos[t](1-Cos[t]),Sin[t](1-Cos[t])}
},{t,0,2π},PlotStyle->{{Yellow,Thickness[.02]},Blue},ImageSize->250]

gb1=GroebnerBasis[{x==Cos[t](1-Cos[t]),y==Sin[t](1-Cos[t]),Sin[t]^2+Cos[t]^2==1},{x,y},{Cos[t],Sin[t]}]

TrigExpand[TrigReduce[-(par[t]+{1/3,0})3/2//FullSimplify]]

gb2=GroebnerBasis[{x==-(1/2)-Cos[t]-(((Cos[t])^2)/2)+(((Sin[t])^2)/2),y==-Sin[t]-Cos[t] Sin[t],Sin[t]^2+Cos[t]^2==1},{x,y},{Cos[t],Sin[t]}]

gb1-gb2

At origin = a focus

FullSimplify[cat/.μ->0]

Plots

Show[GraphicsArray[Partition[{
CatacausticPlot[{Cos[t],Sin[t]},{1000,0},{t,0,2Pi,2Pi/30},PlotRange->1.2{{-1,1},{-1,1}},
DisplayFunction->Identity],
CatacausticPlot[{Cos[t],Sin[t]},{1.5,0},{t,0,2Pi,2Pi/30},DisplayFunction->Identity],
CatacausticPlot[{Cos[t],Sin[t]},{1,0},{t,0,2Pi,2Pi/30},DisplayFunction->Identity],
CatacausticPlot[{Cos[t],Sin[t]},{.8,0},{t,0,2Pi,2Pi/30},PlotRange->2{{-1,1},{-1,1}},
DisplayFunction->Identity]
},2]]]

Animation

movie=Table[CatacausticPlot[{Cos[t],Sin[t]},{x,0},{t,0,2Pi,2Pi/40},
PlotRange->{{-1,1},{-1,1}}2],{x,0,4,.1}]

Export["circcaus.gif",movie]//Timing

More Plots

Caustic[{Cos[t],Sin[t]},{2,0},t]

ParametricPlot[Evaluate[Caustic[{Cos[t],Sin[t]},{1,0},t]],{t,0,2π},AspectRatio->Automatic]

FullSimplify[Caustic[{Cos[t],Sin[t]},{a,0},t]]

Simplify[Limit[{-((a (2-3 a Cos[t]+a Cos[3 t]))/(2+4 (a^2)-6 a Cos[t])),((2 (a^2) ((Sin[t])^3))/(1+2 (a^2)-3 a Cos[t]))},a->∞]]

TrigReduce[%]

ParametricPlot[{(1/4) (3 Cos[t]-Cos[3 t]),((Sin[t])^3)},{t,0,2π},AspectRatio->Automatic]

<<Graphics`Colors`

colors={Red,Orange,Yellow,Green,Blue,Violet};

ParametricPlot[Evaluate[Table[{-((a (2-3 a Cos[t]+a Cos[3 t]))/(2+4 (a^2)-6 a Cos[t])),((2 (a^2) ((Sin[t])^3))/(1+2 (a^2)-3 a Cos[t]))},{a,1,2,.2}]],{t,0,2π},
PlotStyle->colors,
Epilog->{Circle[{0,0},1],PointSize[.02],Table[{colors[[1+Round[(a-1)/.2]]],Point[{a,0}]},{a,1,2,.2}]},
AspectRatio->Automatic,
PlotRange->{{-1,2},{-1,1}}]