Distance between rectangle and parametric curve

Question

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

Answer 1

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

Answer 2

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