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$
  • $\begingroup$ Can you give an example curve and rectangle? $\endgroup$ – J. M. will be back soon Jun 23 '16 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$ – Markus Müller Jun 23 '16 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$ – J. M. will be back soon Jun 23 '16 at 18:54
  • $\begingroup$ I can add an example. Please give me a little time. $\endgroup$ – Markus Müller Jun 23 '16 at 18:55
  • 1
    $\begingroup$ When I run the code you posted, it doesn't draw any rectangles. $\endgroup$ – m_goldberg Jun 24 '16 at 23:30
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$
  • $\begingroup$ Thanks for detailing two methods. $\endgroup$ – Markus Müller Jun 25 '16 at 16:09
  • $\begingroup$ @MarkusMüller - glad to help! $\endgroup$ – Jason B. Jun 25 '16 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$
  • $\begingroup$ Thanks a lot this nice piece of code. $\endgroup$ – Markus Müller Jun 25 '16 at 22:40
  • $\begingroup$ @MarkusMüller You're welcome. $\endgroup$ – Michael E2 Jun 25 '16 at 22:53

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.