8
$\begingroup$

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.

Improve this question
$\endgroup$
2
  • $\begingroup$ 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! $\endgroup$
    – Dr. belisarius
    Commented Sep 28, 2014 at 1:34
  • $\begingroup$ 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. $\endgroup$
    – Daniel Lichtblau
    Commented Nov 16, 2014 at 16:12

4 Answers 4

Reset to default
6
$\begingroup$

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.

enter image description here

Improve this answer
$\endgroup$
6
$\begingroup$

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

enter image description here

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,
 PlotRangePadding -> 0,
 PlotTheme -> "Marketing"]

enter image description here

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,
   PlotRangePadding -> {0, 0.15},
   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]

enter image description here

Improve this answer
$\endgroup$
1
  • 2
    $\begingroup$ thank you for introducing me to MovingMap +1 :) $\endgroup$
    – ubpdqn
    Commented Sep 28, 2014 at 10:59
5
$\begingroup$

Use NMinimize instead of FindiMinimum:

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

Mathematica graphics

Improve this answer
$\endgroup$
5
  • $\begingroup$ Note that your distance is equivalent to Norm[re[t] - rm[t]] or EuclideanDistance[re[t], rm[t]] $\endgroup$
    – Dr. belisarius
    Commented Sep 28, 2014 at 0:43
  • $\begingroup$ 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]]}]}] $\endgroup$
    – Gregoire Du Pasquier
    Commented Sep 28, 2014 at 0:47
  • $\begingroup$ @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]]}]}] $\endgroup$
    – Dr. belisarius
    Commented Sep 28, 2014 at 1:05
  • $\begingroup$ I don't see what is different, but thanks a lot for the help! $\endgroup$
    – Gregoire Du Pasquier
    Commented Sep 28, 2014 at 1:16
  • $\begingroup$ @GregoireDuPasquier In your code NMinimize[] is finding a minimum at a negative t $\endgroup$
    – Dr. belisarius
    Commented Sep 28, 2014 at 3:17
5
$\begingroup$

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

enter image description here

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

enter image description here

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

Improve this answer
$\endgroup$

Your Answer

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

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