2
$\begingroup$

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}]
$\endgroup$
10
  • $\begingroup$ Can you give an example curve and rectangle? $\endgroup$ Jun 23, 2016 at 18:51
  • $\begingroup$ 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. $\endgroup$ Jun 23, 2016 at 18:53
  • 3
    $\begingroup$ 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. $\endgroup$ Jun 23, 2016 at 18:54
  • $\begingroup$ I can add an example. Please give me a little time. $\endgroup$ Jun 23, 2016 at 18:55
  • 1
    $\begingroup$ When I run the code you posted, it doesn't draw any rectangles. $\endgroup$
    – m_goldberg
    Jun 24, 2016 at 23:30

2 Answers 2

1
$\begingroup$

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

Mathematica graphics

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

Mathematica graphics

$\endgroup$
2
  • $\begingroup$ Thanks for detailing two methods. $\endgroup$ Jun 25, 2016 at 16:09
  • $\begingroup$ @MarkusMüller - glad to help! $\endgroup$
    – Jason B.
    Jun 25, 2016 at 16:26
2
$\begingroup$

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

Mathematica graphics

$\endgroup$
2
  • $\begingroup$ Thanks a lot this nice piece of code. $\endgroup$ Jun 25, 2016 at 22:40
  • $\begingroup$ @MarkusMüller You're welcome. $\endgroup$
    – Michael E2
    Jun 25, 2016 at 22:53

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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