1
$\begingroup$

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:

curve example

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]
$\endgroup$
  • $\begingroup$ Do you have an example of the type of curve you're dealing with? $\endgroup$ – Carl Woll Dec 18 '17 at 23:56
  • $\begingroup$ @CarlWoll I added an example. $\endgroup$ – Vsevolod A. Dec 19 '17 at 0:12
  • $\begingroup$ 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. $\endgroup$ – Carl Woll Dec 19 '17 at 1:25
  • $\begingroup$ @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. $\endgroup$ – Vsevolod A. Dec 19 '17 at 1:28
2
$\begingroup$

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

enter image description here

$\endgroup$
  • $\begingroup$ My god this is perfect thank you. $\endgroup$ – Vsevolod A. Dec 19 '17 at 7:50
0
$\begingroup$

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

enter image description here

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Vsevolod A. Dec 19 '17 at 0:22
  • $\begingroup$ Line segments help to obtain result much faster. $\endgroup$ – Vsevolod A. Dec 19 '17 at 1:31
  • $\begingroup$ ...but do not give the true optimum. $\endgroup$ – David G. Stork Dec 19 '17 at 1:33
  • $\begingroup$ I used very fine spacing so that result would be 10^-6 accurate, and it still much more faster. $\endgroup$ – Vsevolod A. Dec 19 '17 at 1:39
0
$\begingroup$
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]

enter image description here

$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – David G. Stork Dec 19 '17 at 1:11
  • $\begingroup$ 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. $\endgroup$ – Bill Watts Dec 19 '17 at 1:17
  • $\begingroup$ But how do I find the value of parameter t? $\endgroup$ – Vsevolod A. Dec 19 '17 at 1:31
  • $\begingroup$ Added solving for t. $\endgroup$ – Bill Watts Dec 19 '17 at 1:51

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.