Pattern of Two Loci

Author

Eric W. Weisstein
July 31, 2002

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PlaneGeometry/PatternofTwoLoci.nb.

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

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

Initialization

<<Graphics`Colors`;
<<GIF`;

Two Tangent Circles

Export[gifs<>"patlotan.gif",movie1=Show/@Table[Graphics[{
Line[{{-2,0},{2,0}}],
Line[{{0,-1.2},{0,1.2}}],
Text[StyleForm[#1,FontFamily->Times,FontSlant->Italic],#2]&@@@{
{"P",{.1,.1}},
{"s",{-1.5,.1}},
{"t",{.1,.5}}
},
Circle[{0,t},t],
Circle[{0,-t},t],
PointSize[.02],
{
Red,
Point[{0,-t}],
Point[{0,t}],
Thickness[.01],
Line[{{0,t},{0,-t}}]
},
Point[{0,0}]
},
AspectRatio->Automatic,
PlotRange->{{-2,2},{-1.2,1.2}}],{t,.01,1.2,.05}]]//Timing

Show[GraphicsArray[Partition[Take[movie1,{1,20,5}],2]]]

Rotating Circle

Export[gifs<>"patlocen.gif",movie2=Show/@Table[Graphics[{
        {Dashing[{.02}],Circle[{0,0},1]},
        Line[{{-2,0},{2,0}}],
        Line[{{0,-1.2},{0,1.2}}],
        PointSize[.02],Point[{0,0}],
        Text[StyleForm[#1,FontFamily->
          Times,FontSlant->Italic],#2]&@@@{
            {"P",{.1,.1}},
            {"R",{-.5,.1}},
            {"s",{-1.5,.1}},
            {"c",{-.65,.65}},
            {"t",{.1,.5}}
            },
        {
          {
            Thickness[.01],
            Red,
            Circle[{0,0},1,{0,t}],
            Point[c={Cos[t],Sin[t]}]
            },
          Circle[c,1]
          }
        },
      AspectRatio->Automatic,
      PlotRange->{{-2,2},{-2,2}}],{t,0,2Pi-.01,2Pi/10}]]//Timing

Length[movie2]

Show[GraphicsArray[Partition[Take[movie2,{1,8,2}],2]],GraphicsSpacing->{0,-.2}]

Tangent Circles and Rotating Circle

Export[gifs<>"patlobot.gif",movie3=Show/@Table[Graphics[{
{Dashing[{.02}],Circle[{0,0},1]},
Line[{{-2,0},{2,0}}],
Line[{{0,-1.2},{0,1.2}}],
PointSize[.02],Point[{0,0}],
Text[StyleForm[#1,FontFamily->Times,FontSlant->Italic],#2]&@@@{
{"P",{.1,.1}},
{"R",{-.5,.1}},
{"s",{-1.5,.1}},
{"c",{-.65,.65}},
{"t",{.1,.5}}
},
{
{
Thickness[.01],
Red,
Circle[{0,0},1,{0,2Pi t}],
Point[c={Cos[2Pi t],Sin[2Pi t]}]
},
Circle[c,1]
},
Line[{{-2,0},{2,0}}],
Line[{{0,-1.2},{0,1.2}}],
Text[StyleForm[#1,FontFamily->Times,FontSlant->Italic],#2]&@@@{
{"P",{.1,.1}},
{"s",{-1.5,.1}},
{"t",{.1,.5}}
},
Circle[{0,t},t],
Circle[{0,-t},t],
PointSize[.02],
{
Red,
Point[{0,-t}],
Point[{0,t}],
Thickness[.01],
Line[{{0,t},{0,-t}}]
},
Point[{0,0}],
Blue,
{If[MemberQ[{.75,1.,1.75},t],Thickness[.02],{}],
Circle[{0,-1},1]},
{If[MemberQ[{.25,1.,1.25},t],Thickness[.02],{}],
Circle[{0,1},1]
}
},
AspectRatio->Automatic,
PlotRange->{{-2,2},{-2.1,2.1}}],{t,0,2,.05}]]//Timing

Show[GraphicsArray[Take[movie3,{1,6,2}]]]