# Finding the minimal distance of a point from an interpolated function

I have an interpolating parametric function (solution of a set of differential equations) and I have an external point. I would like to find the minimal distance between this point and the interpolating function.

The problem is the following

f[x_] := (1 - 1/x);
e = 0.884649;
a = 125.058*10^-3;
xa = 23114.528;
l = 36.525173268841186;
ε = 0.9999796168094026;
tfin = 7*10^6;
sol = NDSolve[{f[x[τ]] t'[τ] == ε,
x[τ]^2 φ'[τ] ==
l, (x'[τ])^2 == ε^2 -
f[x[τ]] (1 + l^2/x[τ]^2), t[0] == 0,
x[0] == xa, φ[0] == Pi}, {t[τ],
x[τ], φ[τ]}, {τ, 0, tfin}, AccuracyGoal -> 3,
PrecisionGoal -> 3][[1]];
pl1 = ParametricPlot[
Evaluate[{x[τ]*Cos[φ[τ]]/10^4,
x[τ]*Sin[φ[τ]]/10^4} /. sol], {τ, 0, tfin},
AspectRatio -> 1, Frame -> True, Axes -> False, PlotRange -> All,
PlotStyle -> Black];
pl2 = ParametricPlot[
Evaluate[{x[τ]*Cos[φ[τ]]/10^4, -x[τ]*
Sin[φ[τ]]/10^4} /. sol], {τ, 0, tfin},
AspectRatio -> 1, Frame -> True, Axes -> False, PlotStyle -> Black];
POINT = ListPlot[{{-1.5, 0.6}}, PlotStyle -> Red];
Show[pl1, pl2, POINT, AspectRatio -> Full, PlotRange -> All]


This is the outcome of this code:

How can I find the minimal distance between the red point and the black curve?

• Just a suggestion: NMinimize[EuclideanDistance[]]
– bmf
Apr 12, 2022 at 22:37
• @bmf thanks for your suggestion, but the problem is that I have an interpolating function, so how can I calculate this distance?
– VDF
Apr 12, 2022 at 23:02

    rgn = RegionUnion[
Cases[pl1, Line[pts_] :> Polygon[pts], Infinity][[1]],
Cases[pl2, Line[pts_] :> Polygon[pts], Infinity][[1]]];

The minimum distance to the point is given by [RegionDistance](https://reference.wolfram.com/language/ref/RegionDistance.html)

dist = RegionDistance[rgn, {-1.5, 0.6}]

(* 0.0592324 *)

The point in the region closest to the point is given by [RegionNearest](https://reference.wolfram.com/language/ref/RegionNearest.html)

rgnPt = RegionNearest[rgn, {-1.5, 0.6}]

(* {-1.49034, 0.541561} *)

Verifying the distance

dist == EuclideanDistance[{-1.5, 0.6}, rgnPt]

(* True *)


EDIT: minimizing the EuclideanDistance is much slower

pt[τvalue_?NumericQ] :=
Chop[{x[τ]*Cos[ϕ[τ]]/10^4, -x[τ]*
Sin[ϕ[τ]]/10^4} /. sol /. τ -> τvalue]

dist[τvalue_?NumericQ] := EuclideanDistance[pt[τvalue], {-1.5, 0.6}]

{minDist, arg} = NMinimize[{dist[τvalue],
0 < τvalue < tfin}, τvalue]

(* {0.0591681, {τvalue -> 3.96287*10^6}} *)


We can also use DiscretizeGraphics and NMinimize.

BTW,In order to avoid ambiguity, it is recommend to use AspectRatio -> Automatic instead of AspectRatio -> Full.

reg = DiscretizeGraphics[Show[pl1, pl2]];
pt1 = {-1.5, 0.6};
sol = NMinimize[{EuclideanDistance[pt1, {x, y}], {x, y} ∈
reg}, {x, y}];
pt2 = {x, y} /. sol[[2]]
Show[Graphics[{{Red, Line[{pt1, pt2}]}}], pl1, pl2,
AspectRatio -> Automatic]


{0.0592325, {x -> -1.49022, y -> 0.54158}}

• (+1) and just stopped by to mention that it was a nice catch your comment about the AspectRatio ambiguity. It's a bit odd though that Full gives only the point but not the distance. Nice work ;)
– bmf
Apr 16, 2022 at 2:42