1
$\begingroup$
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

enter image description here

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?

$\endgroup$
  • 1
    $\begingroup$ the cusp points are at the real root of this NSolve[(D[Rep[{-\[Xi], Sqrt[\[Eta]]}, {a -> 2}], r])[[1]] == 0, r] $\endgroup$ – george2079 Feb 9 '17 at 22:42
2
$\begingroup$
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]}]]]]

enter image description here

$\endgroup$
4
$\begingroup$

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

plot1

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

plot2

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

plot3

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

plot4

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.

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

$\endgroup$

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.