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

Answer 1

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]

Answer 2

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 *)

Answer 3

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.

Answer 4

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

Answer 5

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}}*)