# How do you find the self-intersection points of a single parametric trigonometric function? [duplicate]

How do you use Solve or FindRoot or other Mathematica functions to find the points at which the graph of ${\bf a}(t) = 3 \cos (3.3 \pi t)\hat{\bf x} + (\sin (4 \pi t) + 4 t) \hat{\bf y}$ intersects itself?

a[t_] := 3 Cos[33/10 Pi t]*{1, 0} + (Sin[4 Pi t] + 4 t)*{0, 1};
ParametricPlot[a[t], {t, 0, 2}] • And please try to learn at least the basics of Mathematica syntax – Dr. belisarius Sep 11 '15 at 23:59
• This is a very good problem, which is not a duplicate of others, and has a non-trivial solution. It should not be closed. – David G. Stork Sep 12 '15 at 0:58
• @DavidG.Stork Ansering this question migth be an interesting exercise, however it doesn't address a (Mathematica- lly) new problem. . There were at least a few other quite analogical questions on MSE. And finally the OP doesn't formulated a well - posed question, just " do it for me", no effort on his side. Such questions make this site disordered. – Artes Sep 12 '15 at 1:25
• @Artes: Implied in the problem is "How to solve this using Mathematica"? I agree, the poser showed no work, but the problem is rather difficult and he/she might have said that any number of obvious techniques don't work. – David G. Stork Sep 12 '15 at 1:27
• @DavidG.Stork Certainly, I assume it is related to Mathematica. Just check if answers to the linked post don't work here. I haven't tried but I'm quite sure at least two of those methods work perfectly. – Artes Sep 12 '15 at 1:41

FindRoot is used to find the intersection values of the parameter. Starting values for FindRoot are determined by annotating parameter milestones along the curve.

intersect = FindRoot[{
3 Cos[33/10 Pi* t1] == 3 Cos[33/10 Pi* t2],
Sin[4 Pi t1] + 4 t1 == Sin[4 Pi t2] + 4 t2},
{{t1, .15}, {t2, .45}}]

(* {t1 -> 0.134804, t2 -> 0.471257} *)

intersect = FindRoot[{
3 Cos[33/10 Pi* t1] == 3 Cos[33/10 Pi* t2],
Sin[4 Pi t1] + 4 t1 == Sin[4 Pi t2] + 4 t2},
{{t1, 1.05}, {t2, 1.38}}]

(* {t1 -> 1.03533, t2 -> 1.38891} *)

intersect = FindRoot[{
3 Cos[33/10 Pi* t1] == 3 Cos[33/10 Pi* t2],
Sin[4 Pi t1] + 4 t1 == Sin[4 Pi t2] + 4 t2},
{{t1, 1.65}, {t2, 1.98}}]

(* {t1 -> 1.66478, t2 -> 1.97158} *)

ParametricPlot[
{3 Cos[33/10 Pi* t], Sin[4 Pi t] + 4 t},
{t, 0, 2},
ColorFunction ->
(ColorData["Rainbow"][#3] &),
Epilog -> {
AbsolutePointSize,
Table[
Tooltip[
Point[ (*
milestones used to determine starting values for FindRoot *)
{3 Cos[33/10 Pi* t], Sin[4 Pi t] + 4 t}],
t],
{t, 0, 2, .1}],
Red,
Table[
Tooltip[
Point[ (*
intersection points *)
{3 Cos[33/10 Pi* t1],
Sin[4 Pi t1] + 4 t1} /.
intersect[n]],
ToString[intersect[n]]],
{n, 3}]}] • neat...like metaphor of milestones on a path also...+1 of course :) – ubpdqn Sep 12 '15 at 8:18

I'm not at all suggesting that things should be done this way, since it will be decidedly slow, and the undocumented FindIntersections function is apparently a little unreliable, but I thought the following method was cute, and we will give FindIntersections every change to succeed. This method also has the distinction of not requiring guesses that can be fed to FindRoot, and in fact it can be used to generate good guesses for using FindRoot. In any case, here it is.

Let's take as our function

r[t_] = {3 Cos[33 π t/10], Sin[4 π t] + 4 t};


## Step 1: Generate the zero-contours of r[t1] - r[t2]

The two components of r must simultaneously and independently by equal. In other words, it must be true that

0 == r[t1] - r[t2] // First


and

0 == r[t1] - r[t2] // Last


for t1 != t2. Individually, we can think of each of these equations as defining the zero-contours of a function f[t1, t2]. In order to satisfy these equations simultaneously, we will look for the intersections between the contours of the two different component functions. This is the main insight. So, we generate the ContourPlots:

pl = Show[
ContourPlot[#1
, {t1, 0, 5}, {t2, 0, 5}
, Contours -> {0}
, RegionFunction -> Function[#1 > #2]
, ContourStyle -> #2
, PlotPoints -> 20] &
, {r[t1] - r[t2], {Blue, Red}}]
]


resulting in We have chosen to use RegionFunction -> Function[#1 > #2] because t1 and t2 are basically dummy variables.

Now, we care about where the blue curves intersect the red curves, because it is at those points that both components of r[t1] - r[t2] are simultaneously zero. We want to try to cut out any extra intersections, like the ones between the blue curves. For this, we modify the code above to include instead

RegionFunction -> Function[#1 > #2 && Abs[#1 - #2] < 0.6]


We had to come up with the number 0.6 by hand, of course. This method is not without some necessary fiddling. The result is ## Step 2: Find the intersections

We use an undocumented function to find those intersections:

GraphicsMeshMeshInit[];
intersections = GraphicsMeshFindIntersections[pp];
Show[pp, Epilog -> {PointSize[0.017], Point /@ intersections}]


resulting in ## Step 3: Feed the results to FindRoot

The answers are already pretty good, but we can polish them by using them as the guesses for FindRoot:

times = FindRoot[Thread[r[t1] == r[t2]], Transpose[{{t1, t2}, #}]] & /@ intersections
(* {{t1 -> 0.471257, t2 -> 0.134804}, {t1 -> 1.38891, t2 -> 1.03533}
, {t1 -> 1.97158, t2 -> 1.66478}, {t1 -> 2.90891, t2 -> 2.54563}
, {t1 -> 3.45833, t2 -> 3.20833}, {t1 -> 4.42628, t2 -> 4.05857}
, {t1 -> 4.88051, t2 -> 4.81646}} *)


## Step 4: Check the results

In order to make sure that each pair {t1, t2} corresponds to the same intersection, and that we have found them all, and that they are correct, we can plot the points together with the original curve:

Manipulate[
ParametricPlot[r[t]
, {t, 0, 5}
, Epilog -> {PointSize[0.07], Red, Point@r[#] /. times[[kk]]}
] & /@ {t1, t2} // GraphicsRow
, {kk, 1, Length@times, 1}]


resulting in: First, note that the techniques on the "possible duplicate" link do not work directly:

sol = t /. {ToRules@
Reduce[
3 Cos[3.3 \[Pi] t] == 3 Cos[3.3 \[Pi] (t + x)] &&
Sin[4 \[Pi] t] + 4 t == Sin[4 \[Pi] (t + x)] + 4 (t + x) &&
0 < t < 4 \[Pi] &&
0 < x < 2 \[Pi],
{t, x}]}


Reduce was unable to solve the system with inexact coefficients or \ the system obtained by direct rationalization of inexact numbers \ present in the system. Since many of the methods used by Reduce \ require exact input, providing Reduce with an exact version of the \ system may help

Here's the solution:

Consider first the position in the $\hat{\bf x}$ (horizontal) direction:

The vertical red line marks the time $t0 = 1/3.3$, i.e., the first minimum of the cosine function. The two times corresponding to the intersection point must be of the form $t1 = t0 - dt = 1/3.3 - dt$ and $t2 = t0 + dt = 1/3.3 + dt$, for some unknown $dt$, i.e., the times are symmetric with respect to the first minimum of the cosine function at $t0$. Then you solve for the unknown $dt$ by considering the $\hat{\bf y}$ (vertical) position:

FindRoot[Sin[4 \[Pi] (1/3.3 + dt)] + 4 (1/3.3 + dt) ==
Sin[4 \[Pi] (1/3.3 - dt)] + 4 (1/3.3 - dt),
{dt, .5}]


which yields $dt = 0.168227$.

Then you go back to the form of ${\bf a}(t)$ and plug in these new times:

{3 Cos[3.3 \[Pi] t] , (Sin[4 \[Pi] t] + 4 t)} /. t -> 1/3.3 + 0.168227


and

{3 Cos[3.3 \[Pi] t] , (Sin[4 \[Pi] t] + 4 t)} /. t -> 1/3.3 - 0.168227


each of which gives a time which yields the location of the intersection point:

{0.517172, 1.53164}

ParametricPlot[{3 Cos[3.3 \[Pi] t] , (Sin[4 \[Pi] t] + 4 t)},
{t, 0, 2},
Epilog -> {Red, PointSize[0.05], Point[{0.51717, 1.53164}]}] You can find other intersection points by choosing successive peaks or valleys of the (horizontal) cosine function, i.e., at $k/3.3$ where $k$ is an integer.

(The problem gets a bit trickier when the two solution times are not symmetric with respect to an extremum of the cosine function because there are non-loops in the parametric plot, but are of the form $t1 = k/3.3 + dt$ and $t2 = k/3.3 - (2 \pi + dt)$.)

At the core, I suspect the "possible duplicate" methods do not work here because Reduce has problems finding solutions in two variables whereas FindRoot works well with just one variable.

Set up:

p[t_] := {3 Cos[3.3 Pi t], Sin[4 Pi t] + 4 t}


Choosing starting values:

Manipulate[
Show[ParametricPlot[p[t], {t, 0, 2}],
Graphics[{PointSize[0.02], Point[p[j]]}]], {j, 0, 2}] Using FindRoot and testing:

es = {0.135, 1.035, 1.67}
is = p[s] /. (FindRoot[p[s] == p[s + t], {{s, #}, {t, 0.25}}] & /@ es)
ParametricPlot[p[t], {t, 0, 2},
Epilog -> {Red, PointSize[0.02], Point[is]}]


Points: {{0.517162, 1.53164}, {-0.777101, 4.57088}, {-0.0586081, 7.53675}} 