7
$\begingroup$

The point $P$ on the circle and the point $F$ inside the circle, perpendicular bisector of line $PF$ intersects the circle at two points $A, B$, the envelope of $AB$ is an ellipse. I use the following code for visualization, I wan't to know how to track AB in a simple and efficient way.
enter image description here

Manipulate[Module[{O, P, A, B, F},
  O = {0, 0};
  P = AngleVector[t];
  F = {0.4, 0.5};
  {A, B} = RegionIntersection[Circle[], PerpendicularBisector[{P, F}]][[1]];
  Graphics[{
    Circle[],
    {Line[{P, F}], Red, Line@{A, B}},
    {Point[{O, P, F}]}
    }, PlotRange -> 1.2]
    ], {t, 0., 2 Pi}, TrackedSymbols :> {t}]

enter image description here

$\endgroup$

3 Answers 3

8
$\begingroup$

Edit-2

Manipulate[
 Module[{F, o, P, AB},
  F = Rationalize[{0.4, 0.5}, 0];
  o = {0, 0};
  P[t_] = AngleVector@t;
  AB[t_] := 
   AngleVector@s /. 
    NSolve[{(AngleVector@s - F) . (AngleVector@s - 
          F) == (AngleVector@s - P@t) . (AngleVector@s - P@t), 
      0 <= s <= 2 π}, s];
  Show[Table[
    Graphics[{{Hue[Rescale[t, {0, 2 π}]], 
       Line[AB@t]}}], {t, .1, τ, .1}], 
   Graphics[{Circle[], Point[{o, F}], Line[{F, P@τ}], 
     Line[AB@τ]}], PlotRange -> 1.2]], {τ, 0, 2 π}]

Edit-1

Use the same setting of the questionor.

Clear[line, plot, n, lines];
line[t_] := Module[{O, P, A, B, F}, O = {0, 0};
   P = AngleVector[t];
   F = {0.4, 0.5};
   {A, B} = 
    RegionIntersection[Circle[], PerpendicularBisector[{P, F}]][[1]];
   Graphics[{Hue[Rescale[t, {0, 2 π}]], 
     Line@{A, B}}, PlotRange -> 1.2]];
plot[t_] := Module[{O, P, A, B, F}, O = {0, 0};
  P = AngleVector[t];
  F = {0.4, 0.5};
  {A, B} = 
   RegionIntersection[Circle[], PerpendicularBisector[{P, F}]][[1]];
  Graphics[{Circle[], {Line[{P, F}], 
     Line@{A, B}}, {Point[{O, P, F}]}}, PlotRange -> 1.2]]
n = 40;
lines = Table[line[t], {t, Subdivide[2 π, n]}];
Manipulate[Show[lines[[1 ;; j]], plot[j/(2 π)]], {j, 0, n, 1}]

Edit-0

Need to be improve since the RegionIntersection too slow in my cases.

F = Rationalize[{0.4, -0.5}, 0];
o = {0, 0};
P[t_] = AngleVector[t];
e[t_] = λ*P@t /. 
   Simplify[
     Solve[{EuclideanDistance[λ*P@t, F] == 1 - λ, 
       0 <= λ <= 1, 0 <= t <= 2 π}, λ, Reals], 
     0 <= t <= 2 π][[1, 1]];
c[t_] = Midpoint[{P@t, F}];
plot[t_] = 
  Graphics[{Circle[], Point[{o, F}], Point[{e@t, c@t}], Red, 
    Point[P@t], {Green, 
     Line[{{e@t, o}, {e@t, P@t}, {e@t, F}}]}, {Dotted, 
     Line[{F, P[t]}]}}];
n = 40;
lines = Table[
   Graphics[{{ColorData["Rainbow"][Rescale[t, {0, 2 π}]], 
      RegionIntersection[Disk[], InfiniteLine[{c[t], e[t]}]]}}], {t, 
    Subdivide[2 π, n]}];
Manipulate[
 Show[plot[(j - 1)/(2 π)], lines[[1 ;; j]]], {j, 1, n, 1}]

enter image description here

$\endgroup$
6
$\begingroup$
bag = <||>; With[{O = {0, 0}, P = AngleVector[t], F = {0.4, 0.5}}, 
 Manipulate[DynamicModule[{A, B},
   If[! KeyExistsQ[bag, t],
    {A, B} = RegionIntersection[Circle[], PerpendicularBisector[{P, F}]][[1]];
    AppendTo[bag, t -> {Hue[t/(2 Pi)], Line@{A, B}}]];
   Graphics[{Circle[], {Line[{P, F}], Values@bag}, {Point[{O, P, F}]}}, 
    PlotRange -> 1.2]], {t, 0, 2 Pi, 2 Pi/100}, TrackedSymbols :> {t}]]
$\endgroup$
2
  • $\begingroup$ Thank you. When I drag the slider, the envelope does not appear to be uniform, when the slider drags back, can the envelope follow it? $\endgroup$
    – expression
    Nov 7, 2022 at 9:07
  • $\begingroup$ @expr You should not drag the slider too fast. If you need the envelope to disappear when dragging back, I think cvgmt's solution is a better choice. $\endgroup$
    – xzczd
    Nov 7, 2022 at 9:29
4
$\begingroup$

We assume a unit circle at the origin. Given a off center point: p0 and a point on the circle: {Cos[phi],Sin[phi]}, pm is the mid-point between these two points. Now A and B are determined by the fact that pm-{x,y} and pm-p0 are orthogonal. From this we can calculate all A and B:

p0 = {0.4, .4}; (*given off center point*)
pc[phi_] = {Cos[phi], Sin[phi]}; (*point on circle*)
pm[phi_] = p0 + (pc[phi] - p0)/2; (*midpoint between pc and p0*)
a[phi_] := 
  Solve[{{x, y} . {x, y} == 1, (pm[phi] - {x, y}) . (pm[phi] - p0) == 
      0}, {x, y}] // Quiet;
Graphics[{Circle[], 
  Line[Table[{x, y} /. a[phi], {phi, 0, 2 Pi, Pi/20}]], Red, 
  Point[p0]}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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