9
$\begingroup$

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

enter image description here

Improve this question
$\endgroup$
5
  • $\begingroup$ And please try to learn at least the basics of Mathematica syntax $\endgroup$
    – Dr. belisarius
    Sep 11, 2015 at 23:59
  • 2
    $\begingroup$ This is a very good problem, which is not a duplicate of others, and has a non-trivial solution. It should not be closed. $\endgroup$
    – David G. Stork
    Sep 12, 2015 at 0:58
  • $\begingroup$ @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. $\endgroup$
    – Artes
    Sep 12, 2015 at 1:25
  • $\begingroup$ @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. $\endgroup$
    – David G. Stork
    Sep 12, 2015 at 1:27
  • $\begingroup$ @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. $\endgroup$
    – Artes
    Sep 12, 2015 at 1:41

4 Answers 4

Reset to default
7
$\begingroup$

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

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ neat...like metaphor of milestones on a path also...+1 of course :) $\endgroup$
    – ubpdqn
    Sep 12, 2015 at 8:18
6
$\begingroup$

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

enter image description here

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

enter image description here

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

enter image description here

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:

enter image description here

Improve this answer
$\endgroup$
5
$\begingroup$

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$.

enter image description here

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

enter image description here

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.

Improve this answer
$\endgroup$
4
$\begingroup$

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

enter image description here

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

enter image description here

Improve this answer
$\endgroup$

Not the answer you're looking for? Browse other questions tagged or ask your own question.