How to approximate the distance from {x,y} to a hyperbola?

Question

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]

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

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

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

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?

Answer 1

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

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

Answer 2

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]

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

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

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

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