Find the value of parameter for the closest point on a curve

I can find the nearest point to {x0,y0} on a curve fast and easy by replacing the curve {x[t],y[t]} with line segments:

A=RegionNearest[Line[Table[{x[t], y[t]}, {t, 0, 1, 0.001}]]];
A[{x0,y0}]


But is there a way to find the value of the parameter that corresponds to that nearest point?

I tried simple minimization:

FindMinimum[(x[t] - x1)^2 + (y[t] - y1)^2, {t,0.5}]


Where x1 and y1 are coordinates of the nearest point to {x0, y0}. It doesn't work too well for all points since t=0.5 is not always a good initial guess.

This one works always, but is very very slow (I need like hundreds of thousands of those):

NMinimize[(x[t] - x1)^2 + (y[t] - y1)^2, t]


I suppose there should be a way to make up a good initial guess for t based on the segment that was found to be the closest one using RegionNearest, but how can I extract that information?

Both x[t] and y[t] are analytical functions generated by the first five terms of fourier series with random coefficients. Here is an example of a curve:

Here is a code example for the whole problem (it works fast but some points are failed):

k = 4;
a = RandomReal[{-1, 1}, k];
b = RandomReal[{-1, 1}, k];
c = RandomReal[{-1, 1}, k];
d = RandomReal[{-1, 1}, k];
f1[t_] := \!$$\*UnderoverscriptBox[\(\[Sum]$$, $$n = 1$$, $$k$$]$$a[\([n]$$] Sin[\[Pi]\ n\ t]/n^2\)\) + \!$$\*UnderoverscriptBox[\(\[Sum]$$, $$n = 1$$, $$k$$]$$b[\([n]$$]\ Cos[\[Pi]\ n\ t]/n^2\)\);
f2[t_] := \!$$\*UnderoverscriptBox[\(\[Sum]$$, $$n = 1$$, $$k$$]$$c[\([n]$$] Sin[\[Pi]\ n\ t]/n^2\)\) + \!$$\*UnderoverscriptBox[\(\[Sum]$$, $$n = 1$$, $$k$$]$$d[\([n]$$] Cos[\[Pi]\ n\ t]/n^2\)\);
SEGLINE = Line[Table[{f1[t], f2[t]}, {t, 0, 1, 0.0001}]];
RN = RegionNearest[SEGLINE];
x = Table[RandomReal[{-1, 1}, 2], {i, 1, 200}];
nrst = Table[RN[x[[i]]], {i, 1, 200}];
LL = Timing[
kke = Table[FindMinimum[(f1[t] - nrst[[l, 1]])^2 + (f2[t] -
nrst[[l, 2]])^2, {t, 0.5}, AccuracyGoal -> 6,
PrecisionGoal -> 6], {l, 1, 200}]];
LL[[1]]
ListPlot[Sqrt[kke[[All, 1]]], PlotRange -> All]

• Do you have an example of the type of curve you're dealing with? Dec 18, 2017 at 23:56
• @CarlWoll I added an example. Dec 19, 2017 at 0:12
• Are you interested in the value of t or the distance to the curve? I think your code is plotting the distance to the curve for each point. Dec 19, 2017 at 1:25
• @CarlWoll the code is plotting the minimum of the distance between the nearest point on the curve and the point with parameter t on the curve that minimizes that distance. It is supposed to be 0 always, but it isnt, because minimization process fails to find the right value of parameter t sometimes. Dec 19, 2017 at 1:28

I think you can use Nearest instead. First, I will specify a random seed so that we can compare better:

SeedRandom[1]
k = 4;
a = RandomReal[{-1, 1}, k];
b = RandomReal[{-1, 1}, k];
c = RandomReal[{-1, 1}, k];
d = RandomReal[{-1, 1}, k];
f1[t_] := Sum[a[[n]]*(Sin[Pi*n*t]/n^2), {n, 1, k}] + Sum[b[[n]]*(Cos[Pi*n*t]/n^2), {n, 1, k}];
f2[t_] := Sum[c[[n]]*(Sin[Pi*n*t]/n^2), {n, 1, k}] + Sum[d[[n]]*(Cos[Pi*n*t]/n^2), {n, 1, k}];
x = RandomReal[{-1, 1}, {200, 2}];


Now, let's use an ordinary Nearest function:

nf = Nearest[Table[{f1[t], f2[t]}, {t, -1, 1, .0001}] -> Table[t,{t, -1, 1, .0001}]];


And, here's a visualization of the data set x and the lines connecting them to the parametric curve:

ParametricPlot[
{f1[t], f2[t]},
{t, -1, 1},
Epilog -> {
Red, Point[x],
Green, MapThread[Arrow[{##}]&, {x, Through @* {f1, f2} @@@ nf[x]}]
},
PlotRange->{{-1,1.2}, {-1,1}}
]


• My god this is perfect thank you. Dec 19, 2017 at 7:50

You should never need to use line segments. Instead, try:

f1[t_] := -t + t^2;
f2[t_] := Sin[t];
mycurve[t_] := {f1[t], f2[t]};

testpt = {3, .5};

Minimize[Norm[mycurve[t] - testpt], t]


(* {0.239742, {t -> 2.31493}} *)

closestpt = mycurve[t /. sol[[2]]]


(* {3.04398, 0.735674} *)

As Vsevolod A. points out, FindMinimum will likely be faster.

ParametricPlot[mycurve[t], {t, 0, 3},
Epilog -> {Red, PointSize[0.02], Point[closestpt], Point[testpt],
Green, Line[{closestpt, testpt}]}]


• Thanks, I just tried that and it works very slow: 10 seconds vs 0.3 seconds for FindMinimum (for 200 different points). And it also fails to find the right minimum for certain points. Dec 19, 2017 at 0:22
• Line segments help to obtain result much faster. Dec 19, 2017 at 1:31
• ...but do not give the true optimum. Dec 19, 2017 at 1:33
• I used very fine spacing so that result would be 10^-6 accurate, and it still much more faster. Dec 19, 2017 at 1:39
f1[t_] = (1 - t^2)/(1 + t^2);
f2[t_] = (2 t)/(1 + t^2);

t1 = 0;
t2 = 1;

R = ParametricRegion[{f1[t], f2[t]}, {{t, t1, t2}}]


Point of interest

pt1 = {4, 3};


Find the nearest point on the curve.

pt2 = RegionNearest[R, pt1]
(*{4/5,3/5}*)


Calculate the nearest parameter t.

s1 = ((Reduce[f1[t] == pt2[[1]], t] /. C[1] -> 0) // Flatten //  ToRules);
s2 = ((Reduce[f2[t] == pt2[[2]], t] /. C[1] -> 0) // Flatten //  ToRules);
t = t /. Intersection[{s1}, {s2},
SameTest -> (Abs[(t /. #1) - (t /. #2)] < 10^-8 &)][[1]]
(*1/3*)

{f1[t], f2[t]}
(*{4/5,3/5}*)


Show the region

p1 = RegionPlot[R];

Show[p1, Graphics[{{{Red, Point[pt1]}, {Blue, Point[pt2]},
Line[{pt1, pt2}]}}], PlotRange -> All, AspectRatio -> Automatic]


• What if the test point is on the other side of the curve? What if (as is the general case) there are multiple "closest" points? Dec 19, 2017 at 1:11
• Works on either side. Multiple closest point will always be a problem, especially if there are and infinite number of them, such as the center of a circle. Dec 19, 2017 at 1:17
• But how do I find the value of parameter t? Dec 19, 2017 at 1:31
• Added solving for t. Dec 19, 2017 at 1:51