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

Question

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

Answer 1

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[1] = 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[2] = 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[3] = 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[6],
   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}]}]

Answer 2

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[
  MapThread[
    ContourPlot[#1
      , {t1, 0, 5}, {t2, 0, 5}
      , Contours -> {0}
      , RegionFunction -> Function[#1 > #2]
      , ContourStyle -> #2
      , ContourShading -> False
      , 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:

Graphics`Mesh`MeshInit[];
intersections = Graphics`Mesh`FindIntersections[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:

Answer 3

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.

Answer 4

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