2
$\begingroup$

I can get a good approximation, but making this into a MMA algorithm is getting complicated. Consider this example:

hyperbola=(x y-x^2/12-y^2/15==2);
ContourPlot[Evaluate@hyperbola,{x,0,10},{y,0,10},AspectRatio->Automatic]

fig 1

When we solve the hyperbola equations for y, we get two solutions that I use to define f1, f2 below. I also define the inverse functions.

f1[x_]:=Evaluate[y/.First@Solve[hyperbola,y]];
f2[x_]:=Evaluate[y/.Last@Solve[hyperbola,y]];
f1Inverse[y_]:=Evaluate[x/.First@Solve[y==f1[x],x]]   
(* but this f1Inverse only works for 0 < x < 4.954 *)
f2Inverse[y_]:=Evaluate[x/.First@Solve[y==f2[x],x]] 
{f1[x],f2[x],f1Inverse[y],f2Inverse[y]}
(* {
  (5*(3*x-(2*Sqrt[-6+11*x^2])/Sqrt[5]))/2,
  (5*(3*x+(2*Sqrt[-6+11*x^2])/Sqrt[5]))/2,
  (2*(15*y-Sqrt[10]*Sqrt[-15+22*y^2]))/5,
  (2*(15*y-Sqrt[10]*Sqrt[-15+22*y^2]))/5
} *)

I skip the derivation, but the next function gives the shortest distance from {x0, y0} to a line passing though {x1, y1} with slope yp1.

distance[{x0_,y0_},{x1_,y1_,yp1_}]:=(Sqrt[1 + yp1^2]*Abs[y0 - y1 - x0*yp1 + x1*yp1])/Abs[1 + yp1^2];

I also define eiplog[ ] which is used to make the Graphics below.

epilog[{x0_,y0_},{x1_,y1_},r_]:={Point@{x0,y0},Circle[{x0,y0},r]};
SetOptions[Plot,AspectRatio->Automatic];

Case 1: To approximate the distance from {8, 1.5} to hyperbola, we can let {x1,y1} = {8, f1[8]} and compute the distance from {8, 1.5} to the line going through {x1, y1} with slope = f1'[x1].

{x0,y0}={8,1.5};
{x1,y1}={x0,f1[x0]};
yp1=f1'[x1];
r=distance[{x0,y0},{x1,y1,yp1}];
Plot[{f1[x]},{x,1,10},PlotRange->{0,3},Epilog->epilog[{x0,y0},{x1,y1},r]]

fig 2

Case 2: To approximate the distance from {1.35, 3.25} to hyperbola, we can let {x1, y1} ={f1Inverse[3.25], 3.25}, and compute the distance from {1.35, 3.25} to the line going through {x1, y1} with slope = f1'[x1].

{x0,y0}={1.35,3.25};
{x1,y1}={f1Inverse[y0],y0};
yp1=f1'[x1];
r=distance[{x0,y0},{x1,y1,yp1}];
Plot[{f1[x]},{x,0,10},PlotRange->{0,4},Epilog->epilog[{x0,y0},{x1,y1},r]]

fig 3

Case 3: To approximate the distance from {2, 7} to hyperbola, we can let {x1, y1} = {f2Inverse[7], 7}, and compute the distance from {2, 7} to the line going through {x1, y1} with slope = f2'[x1].

{x0,y0}={2,7};
y1=y0;
x1=f2Inverse[y1];
yp1=f2'[x1];
r=distance[{x0,y0},{x1,y1,yp1}];
Plot[{f2[x]},{x,0,4},PlotRange->{{0.5,4},{5.5,12}},Epilog->epilog[{x0,y0},{x1,y1},r]]

fig 4

However, all hyperbolas have two disconnected parts, and I didn't even touch on how to decide which part is closer, and make sure we are performing computations for disconnected part that is closest. How can we make an efficient MMA algorithm that takes the equation of a hyperbola, and return an approximate distance from {x0,y0} to the hyperbola?

$\endgroup$
1
  • 2
    $\begingroup$ Use hyp = ImplicitRegion[x y-x^2/12-y^2/15 == 2, {x, y}] to define your hyperbola, and eg RegionDistance[hyp, {2, 7}] to calculate the distance? Perhaps I'm missing some nuance of your problem though, in which case it may be helpful to explain further. $\endgroup$
    – MarcoB
    Aug 28, 2023 at 21:53

2 Answers 2

5
$\begingroup$
  • Here is the animation to test the RegionNearest or RegionNearest.
Clear[f, reg, regn, plot];
f[x_, y_] = x*y - x^2/12 - y^2/15 - 2;
reg = ImplicitRegion[f[x, y] == 0, {{x, -10, 10}, {y, -10, 10}}];
regn = RegionNearest[reg];
plot = ContourPlot[f[x, y] == 0, {x, -10, 10}, {y, -10, 10}, 
   AspectRatio -> Automatic, PerformanceGoal -> "Quality"];
Manipulate[
 Show[plot, 
  Graphics[{Arrow[{pt, regn@pt}], Dashed, 
    Circle[pt, EuclideanDistance[pt, regn@pt]]}], 
  PlotRange -> 12], {{pt, {3, 5}}, Locator}]

enter image description here

  • Another way is using Grad and Normalize to compute the unit normal of the curve.
Clear["Global`*"];
f[x_, y_] = x*y - x^2/12 - y^2/15 - 2;
normal[x_, y_] = ComplexExpand@Normalize[Grad[f[x, y], {x, y}]];
sol[{u_, v_}] := 
  Solve[{f[x, y] == 0, {x, y} + d*normal[x, y] == {u, v}}, {x, y, d}, 
   Reals];
nearst[{u_, v_}] := 
  SortBy[{x, y, d} /. sol[{u, v}], Abs@*N@*Last] // First;
With[{pt = {-2, 3}}, 
 ContourPlot[f[x, y] == 0, {x, -10, 10}, {y, -10, 10}, 
  Epilog -> Arrow[{pt, Most@nearst[pt]}]]]

enter image description here

$\endgroup$
4
$\begingroup$

You could define the area inside the hyperbola as a region:

Clear[hyperbola];
hyperbola[x_, y_] := x y - x^2/12 - y^2/15

r = ImplicitRegion[hyperbola[x, y] >= 2, {{x, 0, 10}, {y, 0, 10}}]

That looks like:

RegionPlot[r]

enter image description here

Then the nearest distance to the boundary is

dist[pt_] := Abs[SignedRegionDistance[r, pt]]

Examples:

pt = {8, 1.5};
ContourPlot[hyperbola[x, y] == 2, {x, 0, 10}, {y, 0, 10}, AspectRatio -> Automatic, 
 Epilog -> {Point[pt], Circle[pt, dist[pt]]}]

enter image description here

pt = {1.35, 3.25};
ContourPlot[hyperbola[x, y] == 2, {x, 0, 10}, {y, 0, 10}, AspectRatio -> Automatic, 
 Epilog -> {Point[pt], Circle[pt, dist[pt]]}]

enter image description here

pt = {2, 7};
ContourPlot[hyperbola[x, y] == 2, {x, 0, 10}, {y, 0, 10}, AspectRatio -> Automatic, 
 Epilog -> {Point[pt], Circle[pt, dist[pt]]}]

enter image description here

pt = {.5, 1};
ContourPlot[hyperbola[x, y] == 2, {x, 0, 10}, {y, 0, 10}, AspectRatio -> Automatic, 
 Epilog -> {Point[pt], Circle[pt, dist[pt]]}]

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.