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

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

• – MarcoB Jun 19 '18 at 3: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

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

pp = ParametricPlot[r[t], {t, 0, 1} ];
pt = First @ GraphicsMeshFindIntersections[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 = GraphicsMeshFindIntersections[pp];
Labeled[Show[pp, Graphics@{Red, PointSize[Large], Point@pt}, AspectRatio -> 1],
Style[Column[{"intersections", MatrixForm@pt}], 16], Left]


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


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.

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


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