Finding the zero crossing and the end points of the arc-like segment of my plot?

Question

ClearAll["Global`*"];

Rep[A_, B_] := Fold[ReplaceAll, A, Flatten[List[B]]]
ξ := (-2 a^2 - 2 a^2 r + 6 r^2 - 2 r^3)/(a (-2 + 2 r))
η := -((r^3 (-16 a^2 + 36 r - 24 r^2 + 4 r^3))/(a^2 (-2 + 2 r)^2))

{{-ξ, Sqrt[η]}, {-ξ, -Sqrt[η]}} // Rep[#, {a -> 2}] & // 
  ParametricPlot[#, {r, -10, 10}, PlotStyle -> {{Thin, Black}, {Thin, Black}}] &

For $1<a<2$ the plot of $-\xi$ and $\sqrt{\eta}$ gives shape similar to

Is there a way to find the position of the end points of the circle-like shape formed for $1<a<2$ marked by two red points in the graph above?

Also, how to find the position of the point where circle-like shape intersects the horizontal axis?

Answer 1

ClearAll["Global`*"];

ξ[a_, r_] := (-2 a^2 - 2 a^2 r + 6 r^2 - 2 r^3)/(a (-2 + 2 r))

η[a_, 
  r_] := -((r^3 (-16 a^2 + 36 r - 24 r^2 + 4 r^3))/(a^2 (-2 + 2 r)^2))

With[{a = 2},
 Module[{
   r0 = r /. Minimize[{Sqrt[η[a, r]], r > 1}, r][[2]] // 
     RootReduce, pt0, ri, ptip, ptin},
  pt0 = {-ξ[a, r0], Sqrt[η[a, r0]]} // RootReduce // N;
  ri = r /. Minimize[{-ξ[2, r], r > 1}, r][[2]];
  ptip = {-ξ[a, ri], Sqrt[η[a, ri]]} // RootReduce // N;
  ptin = ptip*{1, -1};
  Show[
   ParametricPlot[
    {{-ξ[a, r], Sqrt[η[a, r]]},
     {-ξ[a, r], -Sqrt[η[a, r]]}},
    {r, -10, 10},
    PlotStyle -> {{Thin, Black}},
    Exclusions -> {1}],
   Graphics[{Red, AbsolutePointSize[6],
     Tooltip[Point[pt0], pt0],
     Tooltip[Point[ptip], ptip],
     Tooltip[Point[ptin], ptin]}]]]]

Answer 2

Here is another, more pedestrian approach to solving the OP's problem.

ξ[r_, a_] := (-2 a^2 - 2 a^2 r + 6 r^2 - 2 r^3)/(a (-2 + 2 r))
η[r_, a_] := Sqrt[-((r^3 (-16 a^2 + 36 r - 24 r^2 + 4 r^3))/(a^2 (-2 + 2 r)^2))]

ParametricPlot[{{-ξ[r, 2], η[r, 2]}, {-ξ[r, 2], -η[r, 2]}}, {r, -10, 10},
  PlotStyle -> Black,
  Exclusions -> {-1, 1}]

By observation of the plot, it is clear that one of the points we are looking for is the zero of η[r, 2] near -ξ[r, 2] = 8. Lets, solve for it.

Solve[η[r, 2] == 0, r] // N

{{r -> 0.}, {r -> 4.82164}, {r -> 0.58918 + 1.72373 I}, {r -> 0.58918 - 1.72373 I}}

We can reject the two imaginary root. Of the two real roots, the one we want is the one that makes -ξ[r, 2] positive.

-ξ[r, 2] /. {{r -> 0.}, {r -> 4.82164}}

{-2., 8.58747}

So r = 4.82164 is one the desired points.

Again by observation, we see the upper cusp is the value of r that minimizes -ξ[r,2] (by symmetry the lower cusp is also at that value of r). We plot -ξ[r,2] so we can eyeball that value of r. Then we compute it more precisely.

Plot[-ξ[r, 2], {r, 1, 4.8},
  PlotRange -> {Automatic, {0, 7}},
  Exclusions -> {1}]

My eyeball says we should look for the minimum near 5/2.

FindMinimum[-ξ[r, 2], {r, 5/2}]

{3.62013, {r -> 2.44225}}

So the other two desired points are at r = 2.44225.

We can now make the plot the OP asked for.

ParametricPlot[{{-ξ[r, 2], η[r, 2]}, {-ξ[r, 2], -η[r, 2]}}, {r, -10, 10},
  PlotStyle -> Black,
  Epilog ->
    {AbsolutePointSize[6], Red,
     Point[{-ξ[r, 2], η[r, 2]}] /. r -> 2.44225, 
     Point[{-ξ[r, 2], -η[r, 2]}] /. r -> 2.44225,
     Point[{-ξ[r, 2], η[r, 2]}] /. r -> 4.82164},
  Exclusions -> {-1, 1}]

Update

Just for fun, let's see if we can show the what the OP calls a "circle-like shape" really lies on the arc of circle. First, I will work purely from intuition. My intuition tells me that arc-like section is indeed the arc of a circle and that the full circle must pass through both zeroes of the parametric curve. If that holds, then the x-coordinate of the center of circle is given by

 xcenter = Mean[{-2., 8.58747}]

3.29374

and the radius is given by

radius = xcenter - (-2)

5.29374

Let's see how that works out.

ParametricPlot[{{-ξ[r, 2], η[r, 2]}, {-ξ[r, 2], -η[r, 2]}}, {r, -10, 10}, 
  PlotStyle -> GrayLevel[.6],
  Epilog -> {Red, Thick, Dotted, Circle[{xcenter, 0}, radius]},
  Exclusions -> {-1, 1}]

Pretty convincing I would say, but we should verify it with a little geometric computation. A few years ago I wrote a function to find the center and radius of the circumcircle of a triangle. It's just what we need. It uses a helper function that, given two points, computes the parametric equation of the perpendicular bisector of the line segment joining the two points.

perpendicularBisectorF[{p1_, p2_}] :=
  Module[{midPt, unitPerp, unitPara},
    midPt = .5 (p1 + p2);
    unitPara = Normalize[p2 - p1];
    unitPerp = Cross @ unitPara;
    With[{a = midPt, b = unitPerp}, (a + b #) &]]

circumcircle[{p1_, p2_, p3_}] :=
  Module[{pb1F, pb2F, center, radius},
    pb1F = perpendicularBisectorF[{p1, p2}];
    pb2F = perpendicularBisectorF[{p2, p3}];
    center = pb1F @ (Solve[pb1F@s == pb2F@t, {s, t}][[1, 1, 2]]); 
    radius = EuclideanDistance[center, p1];
    {center, radius}]

circumcircle[
  {{-ξ[r, 2], η[r, 2]} /. r -> 2.44225,
   {-ξ[r, 2], -η[r, 2]} /. r -> 2.44225,
   {-ξ[r, 2], η[r, 2]} /. r -> 4.82164}]

{{3.41804, 0.}, 5.16943}

So my intuition is confirmed mathematically as well as visually.

Answer 3

a = 2.;
ξ[r_] := ((-2 a^2 - 2 a^2 r + 6 r^2 - 2 r^3)/(a (-2 + 2 r)))
η[r_] := -((r^3 (-16 a^2 + 36 r - 24 r^2 + 4 r^3))/(a^2 (-2 + 2 r)^2))^0.5

ParametricPlot[{{ ξ[r], η[r]}, { -ξ[r], -η[r]}}, {r, -5, 5}, PlotStyle -> Purple]

NSolve[(ξ'[r]^2 + η'[r]^2)^1.5 == 0, r]
NSolve[η[r] == 0, r]

From direct definition of cusp, $(\kappa \rightarrow \infty)$ for $a=2$ we get two different real repetitive roots

r -> {4.3553}, {r -> 2.44225}

And for the point of symmetry

{r -> 4.82164}