How to find where a parametric curve overlaps itself, problem with calculation?

Question

This should work? But it is giving me the wrong t values

Possible duplicate of How to get intersection values from a parametric graph?. See also: Finding intersections of two parametric curves and How to get accurate intersection point value of Parametric equation? and Intersection of two similar parametric curves. — MarcoB, Jun 19 '18 at 03:58
Did any of the answers worked for you? There are things to do after your question is answered. It's a good idea to stay vigilant for some time, as better approaches may come later improving over previous replies. Also, experienced users may point alternatives, caveats or limitations. New users should test answers before voting and wait 24 hours before accepting the best one, but now may be time for you to accept one. Participation is essential for the site, please do your part. — rhermans, Jun 26 '18 at 19:19

kglr · Answer 1 · 2018-06-19T08:22:54.523

r[t_] := {6 Cos[ 2.9 Pi t], Cos[3.5 Pi t] + 5 t};

pp = ParametricPlot[r[t], {t, 0, 1} ];
pt = First @ Graphics`Mesh`FindIntersections[pp];

Show[pp, Graphics @ {Red, PointSize[Large], Point @ pt}, 
 PlotLabel -> Style[Row[{"intersection = ", pt}], 16]]

To get the same result using FindRoot, we can use the approach from this answer to (1) add the constraints t2 > t1 and (2) randomly change the starting values until no error message is issued by FindRoot :

constraints = 0 < t1 < 1 && t2 > t1;
startingvals = {RandomReal[], RandomReal[]};
While[err == Quiet@Check[
 sol = FindRoot[1 - Boole[constraints] + Boole[constraints] (r[t2] - r[t1]), 
       Transpose[{{t1, t2}, startingvals}]], err], 
  startingvals = {RandomReal[], RandomReal[]};];
r[t1] /. sol

{-0.320402, 3.3467}

To get multiple intersections remove First in definition of pt above:

pp = ParametricPlot[r[t], {t, 0, 10}];
pt = Graphics`Mesh`FindIntersections[pp];
Labeled[Show[pp, Graphics@{Red, PointSize[Large], Point@pt}, AspectRatio -> 1], 
 Style[Column[{"intersections", MatrixForm@pt}], 16], Left]

score 3 · Answer 2 · answered Jun 19 '18 at 05:17

r[t_] := {6 Cos[29 Pi t/10], Cos[7 Pi t/2] + 5 t};

ParametricPlot[r[t], {t, 0, 1}, 
 ColorFunction -> Function[{x, y, t}, ColorData["Rainbow"][t]], 
 PlotLegends -> BarLegend["Rainbow"]]

Using the colors to determine the initial estimates,

sol = FindRoot[{(r[t0][[1]]) == (r[t1][[1]]), (r[t0][[2]]) == (r[
       t1][[2]])}, {{t0, 1/2}, {t1, 9/10}}, WorkingPrecision -> 15]

(* {t0 -> 0.511377264145361, t1 -> 0.867933080682225} *)

Verifying,

r[t0] == r[t1] /. sol

(* True *)

score 2 · Answer 3 · answered Jun 19 '18 at 04:08

If you didn't have a vast knowledge of all the internal functions provided by Mathematica then you might try a more brute force approach.

Trying a variety of starting values for t1 and t2 seems to usually come up with the same value for t1 and t2. Thus it looks like FindRoot might not have sufficiently good starting values to be able to find different t1 and t2 that give you your intersection. But from your graph you have a pretty good estimate of r[t] so lets look for points near that intersection and which have a substantially different values for t.

rt[t_] := {6 Cos[2.9 Pi t], Cos[3.5 Pi t] + 5 t, t};
Select[Table[rt[t], {t, 0, 1, .001}], 3.2<#[[2]]<3.4 && -1<#[[1]]<0 &]

which gives us

{...
 {-0.067857, 3.39995, 0.516},
 {-0.0508932, 3.31707, 0.863},
 ...
}

which hints that t1 ~= .516 and t2 ~= .863 so we try

r[t_] := {6 Cos[2.9 Pi t], Cos[3.5 Pi t] + 5 t};
sol = FindRoot[r[t1] - r[t2], {{t1, .516}, {t2, .863}}]

and that correctly finds two distinct t1 and t2 for your problem.

Akku14 · Answer 4 · 2018-06-19T05:21:56.383

NSolve can do the job, if you use rationalized parameters. Even Solve can do it, gives Root expression.

r[t_] = {6 Cos[29/10 Pi t], Cos[35/10 Pi t] + 5 t};

eq1 = And @@ Thread[r[t1] == r[t2]] && 0 < t1 < t2 < 1

eq2 = eq1 // TrigToExp // Simplify

(*   E^(-(29/10) I \[Pi] t2) + E^((29 I \[Pi] t2)/10) == 
     E^(-(29/10) I \[Pi] t1) + E^((29 I \[Pi] t1)/10) && 
     E^(-(7/2) I \[Pi] t2) + E^((7 I \[Pi] t2)/2) + 10 t2 == 
     E^(-(7/2) I \[Pi] t1) + E^((7 I \[Pi] t1)/2) + 10 t1 && 
   0 < t1 < t2 < 1      *)

nsol = NSolve[eq2, {t1, t2}, WorkingPrecision -> 30] // Chop // 
    Simplify[#, t1 \[Element] Reals && t2 \[Element] Reals] &

(*   {{t1 -> 0.511377264145361554521949670476, 
       t2 -> 0.867933080682224652374602053662}}   *)

sol = Solve[eq2, {t1, t2}] // Chop // 
       Simplify[#, t1 \[Element] Reals && t2 \[Element] Reals] &

(*   {{t1 -> Root[{-29 (-1 + (-1)^(1/29)) (1 + (-1)^(1/29)) (1 + (-1)^(
      2/29)) (1 - (-1)^(1/29) + (-1)^(2/29)) (1 + (-1)^(
      1/29) + (-1)^(2/29)) (1 + (-1)^(4/29)) (1 - (-1)^(
      2/29) + (-1)^(4/29)) (1 - (-1)^(4/29) + (-1)^(8/29)) - 
   400 E^((7 I \[Pi] #1)/2) + 29 E^(7 I \[Pi] #1) - 
   29 E^(7/29 I \[Pi] (-20 + 29 #1)) + 
   580 E^((7 I \[Pi] #1)/2) #1 &, 
 0.511377264145361554521949670476156189687360774384 + 
  0.*10^-49 I}], 
t2 -> 40/29 - 
  Root[{-29 (-1 + (-1)^(1/29)) (1 + (-1)^(1/29)) (1 + (-1)^(
       2/29)) (1 - (-1)^(1/29) + (-1)^(2/29)) (1 + (-1)^(
       1/29) + (-1)^(2/29)) (1 + (-1)^(4/29)) (1 - (-1)^(
       2/29) + (-1)^(4/29)) (1 - (-1)^(4/29) + (-1)^(8/29)) - 
    400 E^((7 I \[Pi] #1)/2) + 29 E^(7 I \[Pi] #1) - 
    29 E^(7/29 I \[Pi] (-20 + 29 #1)) + 
    580 E^((7 I \[Pi] #1)/2) #1 &, 
  0.511377264145361554521949670476156189687360774384 + 
   0.*10^-49 I}]}}   *)

Ulrich Neumann · Answer 5 · 2018-06-19T13:42:28.647

2

Without special knowledge NMinimize solves the problem straight forward:

NMinimize[{1/(t2 - t1)^2 (*force t1!=t2*), r[t1] == r[t2], 0 < t1 < t2 < 1}, {t1, t2}]    
(*{7.86584, {t1 -> 0.511377, t2 -> 0.867933}}*)

edited Jun 19 '18 at 13:42

answered Jun 19 '18 at 08:54

Ulrich Neumann

53,729
2
23
55

How to find where a parametric curve overlaps itself, problem with calculation?

5 Answers5