1
$\begingroup$

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}]]
Improve this question
$\endgroup$

1 Answer 1

Reset to default
3
$\begingroup$

  • 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]}]

enter image description here

  • 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]

enter image description here

  • 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];
(* Graphics[{Arrowheads[.1],Arrow@Partition[pts,2,1]}]; *)
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]

enter image description here

  • 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]

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ 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! $\endgroup$
    – csn899
    Mar 14 at 9:47
  • $\begingroup$ @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. $\endgroup$
    – cvgmt
    Mar 14 at 11:02

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.