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

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?

• the cusp points are at the real root of this NSolve[(D[Rep[{-\[Xi], Sqrt[\[Eta]]}, {a -> 2}], r])[] == 0, r] Feb 9, 2017 at 22:42

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][] //
RootReduce, pt0, ri, ptip, ptin},
pt0 = {-ξ[a, r0], Sqrt[η[a, r0]]} // RootReduce // N;
ri = r /. Minimize[{-ξ[2, r], r > 1}, r][];
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,
Tooltip[Point[pt0], pt0],
Tooltip[Point[ptip], ptip],
Tooltip[Point[ptin], ptin]}]]]] 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, 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_}] :=
pb1F = perpendicularBisectorF[{p1, p2}];
pb2F = perpendicularBisectorF[{p2, p3}];
center = pb1F @ (Solve[pb1F@s == pb2F@t, {s, t}][[1, 1, 2]]);

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.

• clean and neat +1 :) Feb 10, 2017 at 6:33
• @m_goldberg My congrats. Feb 10, 2017 at 13:44
• @m_goldberg My intuition was for the outer curve, as hyperbola, fwiw.. Feb 10, 2017 at 13:45
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}