7
$\begingroup$

I wish to find the smallest distance from a point to a curved defined via a Bézier function. I want to do this automatically. For particular cases it is not to difficult. Here is a minimum working example. What point on the curve is closest to the red point?

pts = {{-3, 0}, {-1, 3}, {1, -3}, {0, 1}, {0, 2}, {2, 2}, {-2, -2}};
pt = {-0.07194, 0.6342};
Graphics[{BezierCurve[pts], Point[pts], Red, Point[pt]}, 
 Frame -> True]

figure

My first attempt was RegionDistance[] but this does not have BezierCurve as an input. Looking about I found BezierFunction which enables me to make a function that gets the distance to the curve as a parameter of distance along the curve. Thus

ClearAll[f, f1];
f = BezierFunction[pts];
f1[t_?NumberQ] := EuclideanDistance[ f[t], pt]
Plot[f1[t], {t, 0, 1}]

plot of distance from point

I was now able to look for the minimum using FindMinimum. This produced an error without a starting point. However, the point I got was not the minimum.

{min, pos} = FindMinimum[f1[t], {t, 0.5}];
minpt = f1[t /. pos];
Plot[f1[t], {t, 0, 1}, 
 Epilog -> {Orange, PointSize[0.03], Point[{minpt, f1[minpt]}]}]

wrong result

I am aware that finding global minima is not easy so before I try and resolve that issue I wish to return to the original problem and see if anyone can come up with a good method. Thanks

***** Edit*****

Thanks to all who answered. You have taught me much about splines. Clearly BezierFunction is not as good as BSplineFunction. So I perhaps should use BSplineCurve rather than BezierCurve. Are there discussions on which is most suitable when? @flinty has made some very good points in his reply.

Due to the difficulty of local minima it seems that using FindMinimum is not a suitable approach. The best approaches seems to be that of kglr and Chip Hurst. I have opted for the solution of kglr for now (mainly because I started working on that one first). Here is the module I put together to find the point.

nearestPointOnCurve[pts_List, None, sfy_] := {};
nearestPointOnCurve[pts_List, pt_List, sfy_] := 
 Module[{distFun, g, lines, points, p1, p2},
  distFun[{x1_, y1_}, {x2_, y2_}] := 
   Sqrt[((x2 - x1))^2 + (sfy (y2 - y1))^2];
  g = Graphics[{BezierCurve[pts]}, PlotRange -> All, AspectRatio -> 1];
  lines = MeshPrimitives[DiscretizeGraphics[g], 1];
  points = Flatten[Cases[lines, Line[a_] :>  a, \[Infinity]], 1];
  p1 = First@Nearest[points, pt, DistanceFunction -> distFun];
  p1]

You can see I have put in a distance function because sometimes you need the location of the point nearest the cursor rather than the nearest Cartesian point. Here is an example that illustrates this point and is something to play with.

 pts = {{0, 0.5178`4.}, {0.0007762`4., 0.4642`4.}, {0.0001964`4., 
    2.535`4.}, {0.000477`4., 2.268`4.}, {0.0007575`4., 
    2.`4.}, {0.0009247`4., 3.202`4.}, {0.001171`4., 
    2.834`4.}, {0.001418`4., 2.466`4.}, {0.001614`4., 
    1.833`4.}, {0.001908`4., 2.586`4.}, {0.002202`4., 
    3.338`4.}, {0.002247`4., 1.774`4.}, {0.002647`4., 
    1.87`4.}, {0.003048`4., 1.966`4.}, {0.002157`4., 
    0.2631`4.}, {0.003`4., -0.1185`4.}};

{x1, x2} = MinMax[pts[[All, 1]]];
{y1, y2} = MinMax[pts[[All, 2]]];
ar = 1/4;
{sfx, sfy} = {1/(x2 - x1), ar/(y2 - y1)};

DynamicModule[{},
 Dynamic[Graphics[{BezierCurve[pts], PointSize[0.01], 
    Point[MousePosition["Graphics"]],
    Red, Point[
     nearestPointOnCurve[pts, MousePosition["Graphics"], sfy/sfx]],
    Orange, 
    Point[nearestPointOnCurve[pts, MousePosition["Graphics"], 1]]
    }, Frame -> True, PlotRange -> All, AspectRatio -> ar, 
   ImageSize -> 12 72]
  ]
 ]

Dynamic module showing nearest points

The black point is the cursor, the orange point is the nearest in Cartesian distance and the red point is the nearest in the screen coordinates.

Thanks for all your help.

$\endgroup$
  • 1
    $\begingroup$ Not very efficient, but short: bf = BezierFunction[pts]; minB[t_?NumericQ] := SquaredEuclideanDistance[bf[t], pt]; tm = NArgMin[{minB[t], 0 < t < 1}, t]; Graphics[{BezierCurve[pts], Point[pts], Red, Point[pt], Point[bf[tm]]}, Frame -> True]; There are better ways to do it, but I don't have time to write it up for now. $\endgroup$ – J. M.'s discontentment May 21 at 13:24
  • $\begingroup$ ^ this doesn't work because if you do Graphics[{Line[Table[bf[t], {t, 0, 1, .01}]], Point[pts], Red, Point[pt], Point[bf[tm]]}, Frame -> True] you get a different curve. Your nearest point is not the nearest to the desired point on the BezierCurve $\endgroup$ – flinty May 21 at 13:31
  • 1
    $\begingroup$ @flinty, what "different curve", exactly? $\endgroup$ – J. M.'s discontentment May 21 at 13:39
  • $\begingroup$ BezierCurve and BezierFunction don't give the same curve. They look different: b = BezierFunction[pts]; Graphics[{Red, BezierCurve[pts], Green, Line[Table[b[t], {t, 0, 1, .01}]]}] $\endgroup$ – flinty May 21 at 13:57
  • 1
    $\begingroup$ I did, BSpineFunction[] has a closer shape but it's still off and the loop is bigger. Have we uncovered a bug? - edit: see here: mathematica.stackexchange.com/questions/186949/… Apparently you need to use SplineDegree -> (Length@pts - 1) $\endgroup$ – flinty May 21 at 14:02
5
$\begingroup$
g0 = Graphics[{BezierCurve[pts], Point[pts], Red, Point[pt]}, Frame -> True];
lines = MeshPrimitives[DiscretizeGraphics[g0], 1];

npt = RegionNearest[RegionUnion @@ lines][pt]
 {0.0805512, 0.671604}
Graphics[{Blue,lines, Red, Point[pt], Black, Point@pts, 
  Green, PointSize[Large], Point@npt}, Frame -> True]

enter image description here

| improve this answer | |
$\endgroup$
  • 1
    $\begingroup$ I think this is the way forward for now. However, Chip Hurst has another useful option. I have edited my question to show where I have got to. Thanks. $\endgroup$ – Hugh May 23 at 14:21
5
$\begingroup$

Simply using BezierFunction is not enough. The BezierFunction will not match the BezierCurve because that curve is actually a composite of multiple splines - see here: BezierCurve is different from BezierFunction.

This below is adapted from the above and @J. M.'s technical difficulties solution:

You need to first chop your spline into its components and minimize over both, then find which closest point on each sub-spline is closer to your point. See here on how to produce the parts: How to construct BezierFunction for BezierCurve with npts>4 and SplineDegree -> 3?

pt = {-0.07194, 0.6342};
pts = {{-3, 0}, {-1, 3}, {1, -3}, {0, 1}, {0, 2}, {2, 2}, {-2, -2}};
bzsplinefns = BezierFunction /@ Partition[pts, 4, 3];
distance[p1_, p2_] := SquaredEuclideanDistance[p1, p2]
splineDistance[spline_, point_, t_?NumericQ] := 
 distance[spline[t], point]
closest[spline_, point_] := 
 NArgMin[{splineDistance[spline, point, t], 0 < t < 1}, t]
tvals = closest[#, pt] & /@ bzsplinefns;
finalNearestPoint = 
 MinimalBy[MapThread[#1[#2] &, {bzsplinefns, tvals}], 
   distance[#, pt] &][[1]]
Graphics[{Point[pt], Thick, Gray, BezierCurve[pts], Thin,
  {RandomColor[], Line[Table[#[t], {t, 0, 1, 0.01}]]} & /@ 
   bzsplinefns, PointSize[Large], Point[finalNearestPoint]}]

bezier splines

If you choose BSplineCurve instead, you don't need to worry about breaking it into multiple BSplineFunctions - you can just minimize a single BSplineFunction that accounts for the whole curve.

pt = {-0.07194, 0.6342};
pts = {{-3, 0}, {-1, 3}, {1, -3}, {0, 1}, {0, 2}, {2, 2}, {-2, -2}};
distance[p1_, p2_] := SquaredEuclideanDistance[p1, p2]
splineDistance[spline_, point_, t_?NumericQ] := 
 distance[spline[t], point]
closest[spline_, point_] := 
 NArgMin[{splineDistance[spline, point, t], 0 < t < 1}, t]
bsp = BSplineFunction[pts];
result = bsp[closest[bsp, pt]]
Graphics[{BSplineCurve[pts], Point[pt], PointSize[Large], 
  Point[result]}]

bspline nearest point

| improve this answer | |
$\endgroup$
  • $\begingroup$ Many important points. Thank you. I have edited my question to show where I have got to. Do you have recommendations on which to use BezierFunction or` BSplineFunction`? $\endgroup$ – Hugh May 23 at 14:20
  • $\begingroup$ BSplineFunction and BSplineCurve are better together because they are smoother, unlike BezierCurve which is really made out of multiple BezierFunctions glued together in a sharp C0-continuous piecewise fashion. en.wikipedia.org/wiki/B-spline#Relationship_to_piecewise/… Also if you use just BSplineCurve and BSplineFunction, you don't need to do any of this stuff with decomposition into multiple segments - it just works. $\endgroup$ – flinty May 23 at 18:17
  • $\begingroup$ By the way, klgr's answer suffers from a tiny discretization error from chopping the spline into lines - though I upvoted it myself because it's close enough and the easiest to understand. If you're looking for the most accurate result use NArgMin with the spline function like above. $\endgroup$ – flinty May 23 at 18:20
  • $\begingroup$ Thanks. What would be the procedure with BSplineCurve and BSplineFunction. You still can't do a RegionDistance. Or have I got this wrong? $\endgroup$ – Hugh May 23 at 18:31
  • $\begingroup$ I've updated the answer. Also RegionDistance is slightly inaccurate dregdist = RegionDistance[DiscretizeGraphics@BSplineCurve[pts], pt]; daccurate = EuclideanDistance[pt, result]; (*from above*) error = Abs[dregdist - daccurate] gives 0.0000455788 $\endgroup$ – flinty May 23 at 20:27
3
$\begingroup$

Another way is to express the curve as a union of ParametricRegions and then use RegionNearest.

p1 = (List @@ Expand[(x + y)^3] /. {x -> 1 - t, y -> t}).pts[[1 ;; 4]];

p2 = (List @@ Expand[(x + y)^3] /. {x -> 1 - t, y -> t}).pts[[4 ;; 7]];

breg = RegionUnion[
  ParametricRegion[p1, {{t, 0, 1}}], 
  ParametricRegion[p2, {{t, 0, 1}}]
];

Region[Style[breg, Thick]]

RegionNearest[breg, pt]
{0.0808892, 0.67102}
| improve this answer | |
$\endgroup$
  • $\begingroup$ This is very elegant. Thank you I will look into it more. I have edited my question to show where I have got to. $\endgroup$ – Hugh May 23 at 14:18
0
$\begingroup$

This works for me

{min, pos} = FindMinimum[f1[t], {t, 0.99}, Method -> "Newton"]
minpt = {t, f1[t]} /. pos
Plot[f1[t], {t, 0, 1}, 
 Epilog -> {Orange, PointSize[0.03], Point[minpt]}]

enter image description here

| improve this answer | |
$\endgroup$
  • $\begingroup$ I don't think your point is even on the curve - could you check that? $\endgroup$ – flinty May 21 at 13:39
  • $\begingroup$ @flinty Yes, I checked $\endgroup$ – yarchik May 21 at 13:49
  • 3
    $\begingroup$ @flinty please make sure you maintain proper decency with people willing to help. It’s not what you think, you could have just asked Yarchik how you don’t understand the solution or at least said how the point seems to lie outside. $\endgroup$ – Rupesh May 21 at 14:19
  • $\begingroup$ It is the wrong solution when you draw the curves f1 and the BezierCurve - see my answer. Apologies for not explaining better but I only requested a check - I could have just downvoted and moved on. $\endgroup$ – flinty May 21 at 14:46
  • $\begingroup$ Thanks for looking at this. I think the difficulty of multiple minima makes the FindMimum approach difficult. I have edited my question to show where I have got to. $\endgroup$ – Hugh May 23 at 14:22

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.