# How to make moving point and moving circle play automatically?The locus of points is hyperbolic?

How to make moving point and moving circle play automatically?

The last question is that the trajectory of the moving point is ellipse. The trajectory of this moving point is hyperbolic.

It is known that moving circle M is circumscribed with circle C1: (x+4) ^ 2+y ^ 2=2, and inscribed with circle C2: (x-4) ^ 2+y ^ 2=2. According to this relationship, the trajectory of the center of the moving circle M is the right branch of the hyperbola.

It is known that moving circle N is inscribed with circle C1: (x+4) ^ 2+y ^ 2=2, and is circumscribed with circle C2: (x-4) ^ 2+y ^ 2=2. According to this relationship, the locus of the center of the moving circle N is the left branch of the hyperbola.

How to draw a moving circle and its motion path hyperbola, which can be played automatically

Update 1:

Hyperbolic trajectories obtained by circumscribing two circles of different sizes ,code by cvgmt.thank you!

Please do not delete this code when you modify it. I want to keep learning

Clear["Global*"];
n = {4, 0};
m = {-4, 0};
rN = 4;
rM = 2;
circleM = Circle[m, rM];
circleN = Circle[n, rN];
reg = DiscretizeRegion[
ImplicitRegion[
EuclideanDistance[{x, y}, m] - rM ==
EuclideanDistance[{x, y}, n] - rN, {x, y}], {{-20, 20}, {-20,
20}}];
pts = MeshPrimitives[reg, 1][[;; , 1]][[;; , 2]];
ani = ListAnimate[
Table[Module[{circleP},
circleP = Circle[p, EuclideanDistance[p, m] - rM];
Show[Region[reg],
Graphics[{circleM, circleN, circleP,
Line[{n,
n + (EuclideanDistance[p, n] + EuclideanDistance[p, m] -
rM) Normalize[p - n]}], {AbsoluteThickness[2], Cyan,
Line[{m, p}], Line[{n, p}]},
AbsolutePointSize[5], {Blue, Point[m],
Point[n]}, {AbsolutePointSize[10], Red, Point[p]},
Text[Style["P", Bold, Italic, 12, FontFamily -> "Times"],
p, {-2, -2}],
Text[Style["M", Bold, Italic, 12, FontFamily -> "Times"],
m, {0, 1.5}],
Text[Style["N", Bold, Italic, 12, FontFamily -> "Times"],
n, {0, 1.5}]}], Axes -> True,
AxesStyle -> Arrowheads[{{.035, 1.0}}], PlotRange -> 20,
PlotRangePadding -> 1.2, AxesLabel -> {x, y},
LabelStyle -> Directive[FontFamily -> "Times", 10]]], {p, pts}]]


Update 2:

The left branch of the hyperbola obtained by circumscribing two circles with unequal radii. Could you please perfect it and draw both branches of the hyperbola? thank you!

Clear["Global*"];
n = {4, 0};
m = {-4, 0};
rN = Sqrt[2];
rM = Sqrt[2];
circleM = Circle[m, rM];
circleN = Circle[n, rN];
reg = DiscretizeRegion[
ImplicitRegion[
EuclideanDistance[{x, y}, m] - rM ==
EuclideanDistance[{x, y}, n] + rN, {x, y}], {{-20, 20}, {-20,
20}}];
pts = MeshPrimitives[reg, 1][[;; , 1]][[;; , 2]];
ani = ListAnimate[
Table[Module[{circleP},
circleP = Circle[p, EuclideanDistance[p, m] - rM];
Show[Region[reg],
Graphics[{circleM, circleN, circleP,
Line[{n,
n + (EuclideanDistance[p, n] + EuclideanDistance[p, m] -
rM) Normalize[p - n]}], {AbsoluteThickness[2], Cyan,
Line[{m, p}], Line[{n, p}]},
AbsolutePointSize[5], {Blue, Point[m],
Point[n]}, {AbsolutePointSize[10], Red, Point[p]},
Text[Style["P", Bold, Italic, 12, FontFamily -> "Times"],
p, {-2, -2}],
Text[Style["M", Bold, Italic, 12, FontFamily -> "Times"],
m, {0, 1.5}],
Text[Style["N", Bold, Italic, 12, FontFamily -> "Times"],
n, {0, 1.5}]}], Axes -> True,
AxesStyle -> Arrowheads[{{.035, 1.0}}], PlotRange -> 20,
PlotRangePadding -> 1.2, AxesLabel -> {x, y},
LabelStyle -> Directive[FontFamily -> "Times", 10]]], {p, pts}]]


• re-write the equation to rP==EuclideanDistance[{x, y}, m] +rM == EuclideanDistance[{x, y}, n] - rN. rP is the radius of the circle P etc.

• Since we use the equation is the implicit form, we use ContourPlot and Cases the ordered points along the curve.

Clear["Global*"];
n = {4, 0};
m = {-4, 0};
rN = Sqrt[2];
rM = Sqrt[2];
circleM = Circle[m, rM];
circleN = Circle[n, rN];
plot = ContourPlot[
EuclideanDistance[{x, y}, m] + rM ==
EuclideanDistance[{x, y}, n] - rN, {x, -25, 25}, {y, -25, 25},
ContourStyle -> Red];
pts = Catenate@
Cases[plot, GraphicsComplex[coords_, rest__] :> coords, Infinity];
Graphics[{Arrowheads[.1], Arrow @ Partition[pts, 2, 1]}]


• After that we complete the animation along the pts.
pics = Table[circleP = Circle[p, EuclideanDistance[p, m] + rM];
Show[plot,
Graphics[{circleM, circleN,
circleP, {AbsoluteThickness[2], Cyan, Line[{m, p}],
Line[{n, p}]},
AbsolutePointSize[5], {Blue, Point[m],
Point[n]}, {AbsolutePointSize[10], Red, Point[p]},
Text[Style["P", Bold, Italic, 12, FontFamily -> "Times"],
p, {-2, -2}],
Text[Style["M", Bold, Italic, 12, FontFamily -> "Times"],
m, {0, 1.5}],
Text[Style["N", Bold, Italic, 12, FontFamily -> "Times"],
n, {0, 1.5}]}], Axes -> True,
AxesStyle -> Arrowheads[{{.035, 1.0}}], PlotRange -> 20,
PlotRangePadding -> 1.2, AxesLabel -> {x, y}, Frame -> False,
LabelStyle -> Directive[FontFamily -> "Times", 10]], {p, pts}];
ani = ListAnimate[pics, AnimationRunning -> True]


• For the case rM=rN, we can draw the two branch of hyperbola by

Abs[EuclideanDistance[{x, y}, n] - EuclideanDistance[{x, y}, m]] == rM + rN and the radius of the circle P by rP=(EuclideanDistance[{x, y}, n] + EuclideanDistance[{x, y}, m])/2

Clear["Global*"];
n = {4, 0};
m = {-4, 0};
rN = Sqrt[2];
rM = Sqrt[2];
circleM = Circle[m, rM];
circleN = Circle[n, rN];
plot = ContourPlot[
Abs[EuclideanDistance[{x, y}, n] - EuclideanDistance[{x, y}, m]] ==
rM + rN, {x, -25, 25}, {y, -25, 25}, ContourStyle -> Red];
pts = Catenate@
Cases[plot, GraphicsComplex[coords_, rest__] :> coords, Infinity];
pics = Table[
circleP =
Circle[p, (EuclideanDistance[p, m] + EuclideanDistance[p, n])/2];
Show[plot,
Graphics[{circleM, circleN,
circleP, {AbsoluteThickness[2], Cyan, Line[{m, p}],
Line[{n, p}]},
AbsolutePointSize[5], {Blue, Point[m],
Point[n]}, {AbsolutePointSize[10], Red, Point[p]},
Text[Style["P", Bold, Italic, 12, FontFamily -> "Times"],
p, {-2, -2}],
Text[Style["M", Bold, Italic, 12, FontFamily -> "Times"],
m, {0, 1.5}],
Text[Style["N", Bold, Italic, 12, FontFamily -> "Times"],
n, {0, 1.5}]}], Axes -> True,
AxesStyle -> Arrowheads[{{.035, 1.0}}], PlotRange -> 20,
PlotRangePadding -> 1.2, AxesLabel -> {x, y}, Frame -> False,
LabelStyle -> Directive[FontFamily -> "Times", 10]], {p, pts}];
ani = ListAnimate[pics, AnimationRunning -> True]


• the case rM!=rN.
Clear["Global*"];
n = {4, 0};
m = {-4, 0};
rN = 3;
rM = 1;
circleM = Circle[m, rM];
circleN = Circle[n, rN];
plot1 = ContourPlot[
EuclideanDistance[{x, y}, m] + rM ==
EuclideanDistance[{x, y}, n] - rN, {x, -25, 25}, {y, -25, 25},
ContourStyle -> Red];
plot2 = ContourPlot[
EuclideanDistance[{x, y}, m] - rM ==
EuclideanDistance[{x, y}, n] + rN, {x, -25, 25}, {y, -25, 25},
ContourStyle -> Red];
pts1 = Catenate@
Cases[plot1, GraphicsComplex[coords_, rest__] :> coords,
Infinity];
pts2 = Catenate@
Cases[plot2, GraphicsComplex[coords_, rest__] :> coords,
Infinity];
pics1 = Table[circleP = Circle[p, EuclideanDistance[p, m] + rM];
Show[plot1, plot2,
Graphics[{circleM, circleN,
circleP, {AbsoluteThickness[2], Cyan, Line[{m, p}],
Line[{n, p}]},
AbsolutePointSize[5], {Blue, Point[m],
Point[n]}, {AbsolutePointSize[10], Red, Point[p]},
Text[Style["P", Bold, Italic, 12, FontFamily -> "Times"],
p, {-2, -2}],
Text[Style["M", Bold, Italic, 12, FontFamily -> "Times"],
m, {0, 1.5}],
Text[Style["N", Bold, Italic, 12, FontFamily -> "Times"],
n, {0, 1.5}]}], Axes -> True,
AxesStyle -> Arrowheads[{{.035, 1.0}}], PlotRange -> 20,
PlotRangePadding -> 1.2, AxesLabel -> {x, y}, Frame -> False,
LabelStyle -> Directive[FontFamily -> "Times", 10]], {p, pts1}];
pics2 = Table[circleP = Circle[p, EuclideanDistance[p, m] - rM];
Show[plot1, plot2,
Graphics[{circleM, circleN,
circleP, {AbsoluteThickness[2], Cyan, Line[{m, p}],
Line[{n, p}]},
AbsolutePointSize[5], {Blue, Point[m],
Point[n]}, {AbsolutePointSize[10], Red, Point[p]},
Text[Style["P", Bold, Italic, 12, FontFamily -> "Times"],
p, {-2, -2}],
Text[Style["M", Bold, Italic, 12, FontFamily -> "Times"],
m, {0, 1.5}],
Text[Style["N", Bold, Italic, 12, FontFamily -> "Times"],
n, {0, 1.5}]}], Axes -> True,
AxesStyle -> Arrowheads[{{.035, 1.0}}], PlotRange -> 20,
PlotRangePadding -> 1.2, AxesLabel -> {x, y}, Frame -> False,
LabelStyle -> Directive[FontFamily -> "Times", 10]], {p, pts2}];
ani = ListAnimate[Catenate[{pics1, pics2}], AnimationRunning -> True]
`

• The update2 code I reserved in the question is the left branch of the hyperbola obtained by the circumscribe of two circles with unequal radii written by you. Could you please draw both branches of the hyperbola after improving it? thank you! Commented Mar 14, 2023 at 9:47
• @csn899 Since the two branch of the hyperbola defined by different way, so we need two different equation. That is why I post the last two code. Commented Mar 14, 2023 at 11:02