2
$\begingroup$

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: enter image description here

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

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

2 Answers 2

8
$\begingroup$
    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}} *)
$\endgroup$
1
$\begingroup$

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

enter image description here

$\endgroup$
1
  • 1
    $\begingroup$ (+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 ;) $\endgroup$
    – bmf
    Apr 16, 2022 at 2:42

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.