# Finding the point of minimum distance between two parametric functions

I have two functions re and rm, for which I computed the minimum distance between them.

Now I would like to add a point at the minimum of my distance plot. I tried using Graphics[Point...] but somehow couldn't combine the plot and the point into one single graph using Show[...].

Here is my code without the Point:

re[t_] = {Sin[2 π (t)], (t)^3, (Cos[2 π (t)])^2};
rm[t_] = {1.2*Sin[2 π (t)] + 0.3, (t)^4, 1.1*(Cos[2 π*(t + 0.2)])^2};
Distance[t_] = √((rm[t] - re[t]).(rm[t] - re[t]))
Plot[Distance[t], {t, 0, 2},
PlotLabel -> "Distance between re and rm",
AxesLabel -> {"Time t", "Distance"}]
FindMinimum[Distance[t], {t, 2, 3}]


If anyone knows how to make this work I would be very thankful.

• Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Read the faq! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! – Dr. belisarius Sep 28 '14 at 1:34
• I'm not sure if anyone asked, but: Are you looking for the min distance where t is the same? (That is, same time, so to speak.) Or just the min distance between the two parametrized curves. If the latter, then different parameters should be used in the optimization phase. From the PlotLabel wording I'm guessing it is the former, which is what responses show how to do. Seemed like something to check all the same, given the wording of the subject. – Daniel Lichtblau Nov 16 '14 at 16:12

Just for fun,

min = {t /. #2, #1} & @@ NMinimize[Norm[re[t] - rm[t]], {t, 2, 3}];
Manipulate[
Column[{Show[
ParametricPlot3D[{re[s], rm[s]}, {s, 0, 2},
BoxRatios -> {2, 2, 1}],
Graphics3D[{{Red, Thick, Line[{re[p], rm[p]}]}, {Purple, Thick,
Line[{re[min[[1]]], rm[min[[1]]]}]}}], ImageSize -> 300],
Plot[Norm[re[t] - rm[t]], {t, 0, 2},
Epilog -> {{Red, PointSize[0.02],
Point[{p, Norm@{re[p] - rm[p]}}], {Purple, PointSize[0.02],
Point[min]}}}, ImageSize -> 300]}], {p, 0, 2, 0.05}]


Converting Manipulate to Table and exporting as gif.

To see all local minima

Plot[Distance[t], {t, 0, 2},
Mesh -> {{0}},
MeshFunctions ->
{ConditionalExpression[Distance'[#], Distance''[#] > 0 && Distance[#] > 0] &},
MeshStyle -> {PointSize[Large], Red},
PlotTheme -> "Detailed"]


Just for fun

tab = Table[Sqrt[(rm[t] - re[t]).(rm[t] - re[t])], {t, 0, 1.5, 0.01}];

Block[{p = -Infinity, q = Infinity},
max = MovingMap[(p = Max[p, Max[#]]) &, tab, 1];
min = MovingMap[(q = Min[q, Min[#]]) &, tab, 1]];

ListLinePlot[{min, tab, max},
DataRange -> {0, 1.5},
GridLinesStyle -> Black,
Filling -> {1 -> {2}},
ImageSize -> 600,
PlotMarkers -> None,
PlotTheme -> "Marketing"]


re[t_] := {Sin[2 Pi t], t^3, (Cos[2 Pi t])^2};
rm[t_] := {1.2 Sin[2 Pi t] + 0.3, t^4, 1.1 (Cos[2 Pi (t + 0.2)])^2};
f[t_] := Sqrt@((rm[t] - re[t]).(rm[t] - re[t]));

d = f'[t] // Simplify;

p1 = Plot[f[t], {t, 0, 2},
Filling -> Axis,
ImageSize -> 600,
PlotStyle -> Black,
PlotTheme -> "Detailed"];

p2 = NumberLinePlot[{d > 0, d < 0, d == 0}, {t, 0, 2},
PlotStyle -> {{Thickness[0.01], Darker@Green},
{Thickness[0.01], Red}, {PointSize[0.02], Black}},
ImageSize -> 400,
Spacings -> 0,
PlotLegends -> {"Increase", "Decrease", "Minimax"}];

Show[p1, p2]


• thank you for introducing me to MovingMap +1 :) – ubpdqn Sep 28 '14 at 10:59

NMinimize always attempts to find a global minimum of f subject to the constraints given.
.

Except when f and cons are both linear, the results found by FindMinimum may correspond only to local, but not global, minima.

re[t_] := {Sin[2 Pi t ], t^3, (Cos[2 Pi t])^2};
rm[t_] := {1.2 Sin[2 Pi t] + 0.3, t^4, 1.1 (Cos[2 Pi (t + 0.2)])^2};
Distance[t_] := Sqrt @((rm[t] - re[t]).(rm[t] - re[t]))
fm = NMinimize[Distance[t], {t, 2, 3}]
fm1 = FindMinimum[Distance[t], {t, 2, 3}];
mark[t_] := Reverse /@ Point[t /. # & @@@ #] &;

Plot[Distance[t], {t, 0, 2},
PlotLabel -> "Distance between re and rm",
AxesLabel -> {"Time t", "Distance"},
Epilog -> {PointSize[Large], mark[t]@fm, Red, mark[t]@fm1}]


• Note that your distance is equivalent to Norm[re[t] - rm[t]] or EuclideanDistance[re[t], rm[t]] – Dr. belisarius Sep 28 '14 at 0:43
• Ok that worked for this function, but when I try to use the same concept for an other function it doesnt plot the point any more: re[t_] := {Sin[2 Pi t], t^3, (Cos[2 Pi t])^2}; rm2[t_] = {Sin[2 [Pi] (t)] + 0.4, (t)^4, (Cos[2 [Pi]*(t + 0.2)])^2}; Distance2[t_] := Sqrt@((rm2[t] - re[t]).(rm2[t] - re[t])) fm2 = NMinimize[Distance2[t], {t, 2, 3}] Plot[Distance2[t], {t, 0, 2}, PlotLabel -> "Distance between re and rm2", AxesLabel -> {"Time t", "Distance"}, Epilog -> {PointSize[Large], Point[{t /. fm2[[2]], fm2[[1]]}]}] – Gregoire Du Pasquier Sep 28 '14 at 0:47
• @GregoireDuPasquier re[t_] := {Sin[2 Pi t], t^3, Cos[2 Pi t]^2}; rm2[t_] := {Sin[2 Pi t] + 0.4, t^4, Cos[2 Pi*(t + 0.2)]^2}; Distance2[t_] := Norm@(rm2[t] - re[t]); fm2 = NMinimize[{Distance2[t], 0 <= t}, {t}] ; Plot[ Distance2[t], {t, 0, 2}, Epilog -> {PointSize[Large], Point[{t /. fm2[[2]], fm2[[1]]}]}] – Dr. belisarius Sep 28 '14 at 1:05
• I don't see what is different, but thanks a lot for the help! – Gregoire Du Pasquier Sep 28 '14 at 1:16
• @GregoireDuPasquier In your code NMinimize[] is finding a minimum at a negative t – Dr. belisarius Sep 28 '14 at 3:17

Using NMinimize to find the global minimum as suggested by belisarius, you can also use Mesh as an alternative to Epilog to mark the global minimum:

re[t_] := {Sin[2 Pi t], t^3, (Cos[2 Pi t])^2};
rm[t_] := {1.2 Sin[2 Pi t] + 0.3, t^4, 1.1 (Cos[2 Pi (t + 0.2)])^2};
Distance[t_] := Sqrt@((rm[t] - re[t]).(rm[t] - re[t]))
fm = NMinimize[Distance[t], {t, 2, 3}];

mesh = fm[[2, 1, -1]];
Plot[Distance[t], {t, 0, 2},
PlotLabel -> "Distance between re and rm", AxesLabel -> {"Time t", "Distance"},
Mesh -> {{mesh}}, MeshStyle -> Directive[Blue, PointSize[Large]]]


Update: An alternative approach is to find the local minima and post-process the graphics output to mark the minimum of the local minima. Using a combination of MeshFunctions and ConditionalExpression as in @eldo's answer and in this answer in this Q/A

f = Distance;
Plot[f[t], {t, 0, 2},
PlotLabel -> "Distance between re and rm", AxesLabel -> {"Time t", "Distance"},
Mesh -> {{0}},  MeshStyle -> {PointSize[Large], Red},
MeshFunctions -> {ConditionalExpression[f'[#], f''[#] > 0 && 0 < # <= 2] &}] /.
Point[x_] :> {Point[x], Opacity[.7], PointSize[.05], Blue, Point[Min@x]}


To remove the local minima, change the right-hand-side of RuleDelayed to Point[Min@x].