# Distance between rectangle and parametric curve

Given a 2D parametric curve $(x(s), y(s))$ and a rectangle where each of the four vertices is parameterized $(x_i(t), y_i(t))$, $i \in \{1,2,3,4\}$, how can Mathematica compute the distance function $d$ where $d(t)$ is the distance of the rectangle at $t$ to the parametric curve with $s \in [a,b]$? The algorithm should yield $d(t) = 0$ if the rectangle and the curve share a common point.

Here is an example of a parametric curve {xc, yc} (parameter s) and a rectangle {{xr1, yr1}, {xr2, yr2}, {xr3, yr3}, {xr4, yr4}} (parameter t).

{xc, yc} = {x[s], y[s]} /.
NDSolve[{theta'[s] == 1, x'[s] == Cos[theta[s]],
y'[s] == Sin[theta[s]], theta[0] == 0, x[0] == 0,
y[0] == 0}, {theta, x, y}, {s, 0, 10}][[1]];

{xr1, yr1, theta} = {x[t], y[t], theta[t]} /.
NDSolve[{theta'[t] == 1 + Sin[12 t], x'[t] == Cos[theta[t]],
y'[t] == Sin[theta[t]], theta[0] == 0, x[0] == 0,
y[0] == 0}, {theta, x, y}, {t, 0, 10}][[1]];

{xr2, yr2} = {xr1, yr1} + 0.05 Normalize[{-Sin[theta], Cos[theta]}];

{xr3, yr3} = {xr2, yr2} + 0.05 Normalize[{-Cos[theta], -Sin[theta]}];

{xr4, yr4} = {xr1, yr1} + 0.05 Normalize[{-Cos[theta], -Sin[theta]}];

Manipulate[
Show[ParametricPlot[{xc, yc}, {s, 0, 4}],
Graphics[Polygon[{{xr1, yr1}, {xr2, yr2}, {xr3, yr3},
{xr4, yr4}} /. {t -> T}]]], {T, 0.01, 4}]

• Can you give an example curve and rectangle? Jun 23 '16 at 18:51
• You can think of the parametric curves being any InterpolatingFunction with the additional constraint that for any $t$ the four points indeed form a rectangle. I am looking for a Mathematica procedure to compute $d$ efficiently. Jun 23 '16 at 18:53
• I can think, yes, but can't you share an example? It's hard to propose useful code without an example to try it out on. Jun 23 '16 at 18:54
• I can add an example. Please give me a little time. Jun 23 '16 at 18:55
• When I run the code you posted, it doesn't draw any rectangles. Jun 24 '16 at 23:30

Something like this I think,

You first extract your points from the curve, then define the polygon to be a function of the parameter T

pts = Cases[ParametricPlot[{xc, yc}, {s, 0, 4},PlotPoints->300], Line[{x__}] :> x,
Infinity];

pgon[T_] :=
Polygon[{{xr1, yr1}, {xr2, yr2}, {xr3, yr3}, {xr4, yr4}} /. {t -> T}]


(edit I had to add a high PlotPoints value to get a better result for this method ) Then you find the RegionDistance between the polygon and all the points on the curve, and return the minimum disance

distance[T_] := Min[RegionDistance[pgon[T], pts]]


From your Manipulate I could see that the square and the curve overlap at T=0 and at T=3.33,

distance /@ {0, 2, 3.33}
(* {0., 0.0828211, 0.} *)


And you can plot the curve

Another method is to turn the curve into a region and use the method described here, though you need to use Quiet to suppress error messages,

line = DiscretizeGraphics@ParametricPlot[{xc, yc}, {s, 0, 5}];
pgon[T_] :=
DiscretizeGraphics@
Polygon[{{xr1, yr1}, {xr2, yr2}, {xr3, yr3}, {xr4, yr4}} /. {t -> T}]
distance2[T_] :=
Quiet@MinValue[
EuclideanDistance[x, y], {x ∈ DiscretizeGraphics@r1,
y ∈ pgon[T]}]


But this method is very slow and gives unsatisfactory results in some spots

ListLinePlot[
Table[{T, distance2[T]}, {T, 0.1, 4, .01}]
]


• Thanks for detailing two methods. Jun 25 '16 at 16:09
• @MarkusMüller - glad to help! Jun 25 '16 at 16:26

One can use FindMinimum[] with RegionDistance[rect] to get a quick, accurate result. Speed can be expected here because we have a good estimate for a starting value for s in the parameter T.

Block[{T = 1.},
rect = Polygon[{{xr1, yr1}, {xr2, yr2}, {xr3, yr3}, {xr4, yr4}} /. {t -> T}];
df = RegionDistance[rect];
ndf[{x_Real, y_Real}, df_] := df[{x, y}];
FindMinimum[ndf[{xc, yc}, df], {s, T, 0, 4}]
]
(*  {0.0757601, {s -> 0.982383}}  *)


Because of the numeric nature of {xc, yc} (from NDSolve) and the singularities in the distance to a rectangle (from the corners), FindMinimum[] sometimes senses possible numeric difficulties, none of which here seem to be significant. In particular the message FindMinimum::lstol is common unless AccuracyGoal is reduced. Also FindMinimum::reged occurs when the rectangle goes beyond the end of the curve. (It arises when FindMinimum wants to set s to a value outside the domain {0, 4}.) The last one can simply be suppressed by Quiet. As for the first, one can apply Quiet or set AccuracyGoal -> 3, say, which would be sufficient for the graphics in Manipulate[].

Clear[ndf];
ndf[{x_Real, y_Real}, df_] := df[{x, y}];
Manipulate[
Show[
ParametricPlot[{xc, yc}, {s, 0, 4}],
Graphics[
Dynamic@ With[{rect =
Polygon[{{xr1, yr1}, {xr2, yr2}, {xr3, yr3}, {xr4, yr4}} /. {t -> T}]},
{
rect,
Red, Point[{xc, yc} /.
Quiet[
Last@
FindMinimum[
ndf[{xc, yc}, RegionDistance[rect]], {s, T, 0, 4},
AccuracyGoal -> 3],
{FindMinimum::reged}]
]
}]
]
],
{T, 0.01, 4}]


• Thanks a lot this nice piece of code. Jun 25 '16 at 22:40
• @MarkusMüller You're welcome. Jun 25 '16 at 22:53