How to get intersection values from a parametric graph?

Question

I have this graphed:

ParametricPlot[{2.4*Cos[t] + 1.6*Cos[3 t/2], 2.4*Sin[t] - 1.6 Sin[3 t/2]}, {t, 0, 4*Pi}]

It is a star, and the lines cross each other twice in the third quadrant. I need to find the t-values at those points. I have tried a variety of methods but none of them seem to be working.

I have approximate $(x,y)$ coordinates for the two points as: {{-0.3054, -0.9543}, {-1.007, -0.005534}}

Answer 1

We couldn't be really pleased if we didn't exploit existing Mathematica functionality to get exact solutions. Here we provide them with Reduce rewriting the given system to an exact one and using a trick by adding another variable x because one can see that any solutions are described by two different arguments t and t + x. Now we can realize that one can interpret the question in at least two different ways:

• Finding all arguments t in 0 <= t <= 4Pi where the parametric graph intersects.

• Finding only those arguments t where the parametric graph passes appropriate intersection points the second time.

For the first case we need to supplement the equations by two inequalities:
0 <= t <= 4 Pi && 0 < x < 4 Pi. Then we have got 10 real solutions providing only 5 different points since there are periodic functions: Sin and Cos.

For the latter case we can supplement the equations by 2 Pi <= t <= 4 Pi && 0 < x < 4 Pi to avoid many copies of the equivalent solutions, i.e. we get in this case only 5 real solutions in the range 2 Pi <= t <= 4 Pi which in turn provide as before 5 different points of intersection.

Here we write down all 10 solutions:

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

 { 4 Pi - 4 ArcTan[Sqrt[5/3]], 
            4 ArcTan[Sqrt[5/3]], 
   4 Pi + 4 ArcTan[Root[25 - 500 #1^2 + 2510 #1^4 - 1060 #1^6 + #1^8 &, 1]], 
   4 Pi + 4 ArcTan[Root[25 - 500 #1^2 + 2510 #1^4 - 1060 #1^6 + #1^8 &, 2]], 
   4 Pi + 4 ArcTan[Root[25 - 500 #1^2 + 2510 #1^4 - 1060 #1^6 + #1^8 &, 3]], 
   4 Pi + 4 ArcTan[Root[25 - 500 #1^2 + 2510 #1^4 - 1060 #1^6 + #1^8 &, 4]], 
          4 ArcTan[Root[25 - 500 #1^2 + 2510 #1^4 - 1060 #1^6 + #1^8 &, 5]], 
          4 ArcTan[Root[25 - 500 #1^2 + 2510 #1^4 - 1060 #1^6 + #1^8 &, 6]], 
          4 ArcTan[Root[25 - 500 #1^2 + 2510 #1^4 - 1060 #1^6 + #1^8 &, 7]], 
          4 ArcTan[Root[25 - 500 #1^2 + 2510 #1^4 - 1060 #1^6 + #1^8 &, 8]]  }

Now we rewrite these exact solutions manifestly in terms of radicals:

TraditionalForm @ Grid[ Partition[ ToRadicals @ sol, 2], Frame -> All]

One can observe that all the intersection points lie on the unit circle:

anim = 
  Table[ 
    ParametricPlot[{{12/5 Cos[t] + 8/5 Cos[3 t/2], 12/5 Sin[t] - 8/5 Sin[3 t/2]}, 
                    {Cos[1/2 t], Sin[1/2 t]}}, 
                   {t, 0, 4 c Pi}, 
                   Epilog -> {Red, PointSize[0.017], 
                              Point[{12/5 Cos[#] + 8/5 Cos[3 #/2], 
                                     12/5 Sin[#] - 8/5 Sin[3 #/2]} & /@ sol]}, 
                   PlotStyle -> Thick, PlotRange -> {{-4, 4}, {-4, 4}}, 
                   PlotLegends -> Placed[ Style[ Row[{"t = ", NumberForm[4 Pi c, {4, 2}]}], 
                                                 Bold, 20],
                                          {Left, Top}], 
                  ImageSize -> 550], 
    {c, 0.01, 1, 0.01}];

ListAnimate[ anim, Paneled -> False]

To get the intersection points expressed by the solutions t in terms of the cartesian coordinates we can do this:

FullSimplify[{12/5 Cos[t] + 8/5 Cos[3 t/2], 12/5 Sin[t] - 8/5 Sin[3 t/2]} /. {
  ToRules @ Reduce[ 12/5 Cos[t] + 8/5 Cos[3 t/2] == 
                    12/5 Cos[t + x] + 8/5 Cos[3 (t + x)/2] && 
                    12/5 Sin[t] - 8/5 Sin[3 t/2] == 
                    12/5 Sin[t + x] - 8/5 Sin[3 (t + x)/2] && 
                    2 Pi <= t <= 4 Pi && 0 < x < 4 Pi, {t, x}]}]

{{ -1, 0}, 
 { 1/4 (1 + Sqrt[5]), 1/4 Sqrt[10 - 2 Sqrt[5]]}, 
 { 1/4 (1 - Sqrt[5]), 1/2 Sqrt[1/2 (5 + Sqrt[5])]}, 
 { 1/4 (1 - Sqrt[5]), -(1/2) Sqrt[1/2 (5 + Sqrt[5])]}, 
 { 1/4 (1 + Sqrt[5]), -(1/4) Sqrt[10 - 2 Sqrt[5]]}}  

and of course

Simplify[#1^2 + #2^2 & @@@ %]

{1, 1, 1, 1, 1}

Answer 2

Can be done as follows.

• (1) Find implicit form from parametric.

• (2) Solve for pts $(x,y)$ where implicit eqn and gradient simultaneously vanish.

• (3) Discard those solutions that correspond to cusps. The rest correspond to crossings.

The code below handles steps (1) and (2). I found it useful to rationalize because we eventually get an overdetermined system which can be troublesome if we do not take steps to apply "tolerances" in certain computations (vagueness here is intentional).

For the implicitization we trig expand to get everything in terms of trig powers in t/2, then replace with new algebraic variables and enforce the basic trig identity between them. Doesn't matter that we replaced because we're going to eliminate them anyway.

polys = 
  TrigExpand[{x, y} - {2.4*Cos[t] + 1.6*Cos[3 t/2], 2.4*Sin[t] - 1.6 Sin[3 t/2]}];
p2 = Rationalize[
  Join[polys /. {Sin[t/2] -> s, Cos[t/2] -> c}, {s^2 + c^2 - 1}]]

 {-((12 c^2)/5) - (8 c^3)/5 + (12 s^2)/5 + (24 c s^2)/5 + x, 
  -((24 c s)/5) + (24 c^2 s)/5 - (8 s^3)/5 + y, -1 + c^2 + s^2}

implicit = First[GroebnerBasis[p2, {y}, {s, c}]]

 256 - 480 x^2 + 165 x^4 - 54 x^5 + 5 x^6 - 480 y^2 + 330 x^2 y^2 + 
 540 x^3 y^2 + 15 x^4 y^2 + 165 y^4 - 270 x y^4 + 15 x^2 y^4 + 5 y^6

NSolve[{implicit, D[implicit, x], D[implicit, y]} == 0]

{{y -> -3.804226065180617, x -> 1.236067977499793}, 
 {y -> -3.804226065180617, x -> 1.236067977499793}, 
 {y -> 2.351141009169893, x -> -3.236067977499793}, 
 {y -> 2.351141009169893, x -> -3.236067977499793},
 {y -> 3.804226065180523, x -> 1.236067977499697},
 {y -> 3.804226065180523, x -> 1.236067977499697}, 
 {y -> 0., x -> 4.000000000000001}, 
 {y -> 0., x -> 4.000000000000001},
 {y -> 0.9510565162951515,  x -> -0.3090169943749492}, 
 {y -> -0.5877852522924717, x -> 0.8090169943749461}, 
 {y -> -0.9510565162951551, x -> -0.3090169943749493}, 
 {y -> 0., x -> -0.9999999999999978}, 
 {y -> -2.351141009171024, x -> -3.236067977501426}, 
 {y -> -2.351141009171024, x -> -3.236067977501426},
 {y -> 0.5877852522924756, x -> 0.8090169943749494}}

Answer 3

Third solution

A slightly simpler and more geometric approach leads to a third form for the solution (including Artes' and my second) -- don't you just love trigonometric functions!

By symmetry, two points starting from a vertex of the hypocycloid (star) and going in opposite directions at the same speed will meet at one of the desired crossings.

If the points start at {4, 0}, then at time t the parameters will be t, 4 Pi - t. The crossing times of the points can be found by setting the parametrizations equal to each other and solving.

center = {(12 Cos[t])/5, (12 Sin[t])/5};
radius = {8/5 Cos[(3 t)/2], -(8/5) Sin[(3 t)/2]};
param = center + radius;

sol0 = {t, 4 Pi - t} /. 
  First@Solve[param == (param /. t -> 4 Pi - t) && 0 < t < 2 Pi, t]
(* {2 ArcCos[-(1/4)], 4 Pi - 2 ArcCos[-(1/4)]} *)

To get the others, add multiples of 1/5 of the period 4 Pi:

Table[Mod[Join[#, N@#] &@ (sol0 + 4 Pi/5 i), 4 Pi], {i, 0, 4}] // Grid

$$ \begin{array}{cc|cc} t_1 & t_2 & N[t_1] & N[t_2]\strut \\ \hline 2 \cos ^{-1}\left(-{1}/{4}\right) & 4 \pi -2 \cos ^{-1}\left(-{1}/{4}\right) & 3.64695 & 8.91942 \\ \textstyle \frac{4 \pi }{5}+2 \cos ^{-1}\left(-{1}/{4}\right) & \textstyle \frac{24 \pi }{5}-2 \cos ^{-1}\left(-{1}/{4}\right) & 6.16023 & 11.4327 \\ \textstyle \frac{8 \pi }{5}+2 \cos ^{-1}\left(-{1}/{4}\right) & \textstyle \frac{8 \pi }{5}-2 \cos ^{-1}\left(-{1}/{4}\right) & 8.6735 & 1.3796 \\ \textstyle \frac{12 \pi }{5}+2 \cos ^{-1}\left(-{1}/{4}\right) & \textstyle \frac{12 \pi }{5}-2 \cos ^{-1}\left(-{1}/{4}\right) & 11.1868 & 3.89287 \\ \textstyle-\frac{4 \pi }{5} + 2 \cos ^{-1}\left(-{1}/{4}\right) & \textstyle \frac{16 \pi }{5}-2 \cos ^{-1}\left(-{1}/{4}\right) & 1.13368 & 6.40614 \\ \end{array} $$

The equations are not hard to solve by hand either. Setting $t = 2\theta$, the condition $y = 0$ reduces to $2 \sin 3\theta = 3 \sin 2\theta$. Applying multiple-angle identities, one discovers the factor $1 + 4 \cos\theta$, from which the solution follows.

Here a movie illustrating the method:

hypoc = ParametricPlot[param, {t, 0, 4 Pi}, PlotRange -> 4.05];
wheel = {Circle[center, 8/5], PointSize[Large], Point[param],
   Line[{{center, param}, {{0, 0}, center}}], Opacity[0.5], 
   Line@Table[center + # & /@ ({radius, 0.9 radius} /. t -> t - 2 dt/3),
              {dt, Pi/8, 2 Pi - Pi/8, Pi/8}]};
Manipulate[
 Show[hypoc,
  Graphics@Dynamic[{
      Circle[{0, 0}, 4],
      Red, wheel /. t -> t + offset,
      Darker@Green, wheel /. t -> 4 Pi - t + offset
      } /. t -> t0]
  ],
 {{t0, First@sol0}, 0, 4 Pi, First@sol0/100},
 {offset, 4 Pi/5 Range[0, 4]}
 ]

Second solution

Knowing it's class work made me think along simpler lines than at the beginning.

param = {12/5 Cos[t] + 8/5 Cos[(3 t)/2], 12/5 Sin[t] - 8/5 Sin[(3 t)/2]};

sol = Solve[param[[2]] == 0, {t}]
(* {{t -> ConditionalExpression[4 \[Pi] C[1], 
                                C[1] \[Element] Integers]},
    {t -> ConditionalExpression[2 (\[Pi] + 2 \[Pi] C[1]), 
                                C[1] \[Element] Integers]},
    {t -> ConditionalExpression[2 (\[Pi] - ArcTan[Sqrt[15]] + 2 \[Pi] C[1]), 
                                C[1] \[Element] Integers]}, 
    {t -> ConditionalExpression[2 (-\[Pi] + ArcTan[Sqrt[15]] + 2 \[Pi] C[1]),
                                C[1] \[Element] Integers]}}  *)

The third solution is one of the crossings:

param /. sol /. {C[1] -> 0} // N
{{4., 0.}, {0.8, 0.}, {-1., 1.33227*10^-15}, {-1., -1.33227*10^-15}}

The next crossing will be 3 * 4 Pi / 5 further along.

{t, t + 3 * 4 Pi/5} /. sol[[3]] /. {C[1] -> 0}
(* {2 (Pi - ArcTan[Sqrt[15]]), (12 Pi)/5 + 2 (Pi - ArcTan[Sqrt[15]])} *)

% // N
(* {3.64695, 11.1868} *)

The points are passed through again, by symmetry, at these values of t:

{4 Pi, 4 Pi + 4 Pi/5} - %
(* {8.91942, 3.89287} *)

All intersections:

t1 = t + Range[0, 4 Pi - 1, 4 Pi/5] /. sol[[3]] /. {C[1] -> 0};
t2 = {4 Pi, 4 Pi, 0, 0, 0} + Range[0, 2 4 Pi - 1, 2 4 Pi/5] - t1;
Transpose[{t1, t2}] // Expand // Grid

$ \begin{array}{cc} 2 \pi -2 \tan ^{-1}\left(\sqrt{15}\right) & 2 \pi +2 \tan ^{-1}\left(\sqrt{15}\right) \\ \frac{14 \pi }{5}-2 \tan ^{-1}\left(\sqrt{15}\right) & \frac{14 \pi }{5}+2 \tan ^{-1}\left(\sqrt{15}\right) \\ \frac{18 \pi }{5}-2 \tan ^{-1}\left(\sqrt{15}\right) & \frac{18 \pi }{5}+2 \tan ^{-1}\left(\sqrt{15}\right) \\ \frac{22 \pi }{5}-2 \tan ^{-1}\left(\sqrt{15}\right) & \frac{22 \pi }{5}+2 \tan ^{-1}\left(\sqrt{15}\right) \\ \frac{26 \pi }{5}-2 \tan ^{-1}\left(\sqrt{15}\right) & \frac{26 \pi }{5}+2 \tan ^{-1}\left(\sqrt{15}\right) \\ \end{array} $

---

Original solution

[This method is a good way to find roots when the equations cannot be solve explicitly, or Solve/Reduce take a very long time.]

You can record the t values of the plot with EvaluationMonitor, Reap, and Sow.

{plot, {pts}} = 
  Reap @ ParametricPlot[{2.4*Cos[t] + 1.6*Cos[3 t/2], 2.4*Sin[t] - 1.6 Sin[3 t/2]},
         {t, 0, 4*Pi}, 
         EvaluationMonitor :>
          Sow[{t, 2.4*Cos[t] + 1.6*Cos[3 t/2],  2.4*Sin[t] - 1.6 Sin[3 t/2]}]];

Then we can construct a NearestFunction to find the values of t that produce points closest to the approximate crossing.

nf = Nearest[pts[[All, 2 ;; 3]] -> pts[[All, 1]]]
(* NearestFunction[{526, 2}, <>] *)

crossings = {{-0.3054, -0.9543}, {-1.007, -0.005534}};
(* {{11.1513, 3.8396}, {8.96306, 3.57175}} *)

Each approximate crossing produces two distinct values for t

nf[#, 2] & /@ crossings
(* {{11.1513, 3.8396}, {8.96306, 3.57175}} *)

We can set up starting points for FindRoot like this:

Transpose@{{t, s}, nf[crossings[[1]], 2]}
(* {{t, 11.1513}, {s, 3.8396}} *)

Then FindRoot will refine the estimates:

param = {2.4*Cos[t] + 1.6*Cos[3 t/2], 2.4*Sin[t] - 1.6 Sin[3 t/2]};

sol1 = FindRoot[param - (param /. t -> s), 
                Transpose@{{t, s}, nf[crossings[[1]], 2]}]
(* {t -> 11.1868, s -> 3.89287} *)

sol2 = FindRoot[param - (param /. t -> s), 
                Transpose@{{t, s}, nf[crossings[[2]], 2]}]
(* {t -> 8.91942, s -> 3.64695} *)

Show[plot, 
     Graphics[{PointSize[Large], Red, Point[param /. {sol1, sol2}]}]]

Answer 4

This is more like a comment, but it won't fit well in that tiny box. I see very complicated algebraic expressions for the intersections. But, following Micheal E2 observation, the solutions are more simply expressed as

expSols=Table[Exp[Mod[I Pi(1 + k 4/5 ), 2Pi]], {k, 0, 4}]

{-1, Exp[-I Pi/5], Exp[+I Pi/5],Exp[-3/5 I Pi], Exp[+3/5 I Pi]}

And in rectangular form:

rectSols = {Re[#], Im[#]} & /@ %

{ 
  {-1, 0}, 
  {(1 + Sqrt[5])/4, -Sqrt[(5 - Sqrt[5])/2]/2}, 
  {(1 + Sqrt[5])/4, +Sqrt[(5 - Sqrt[5])/2]/2}, 
  {(1 - Sqrt[5])/4, -Sqrt[(5 + Sqrt[5])/2]/2}, 
  {(1 - Sqrt[5])/4, +Sqrt[(5 + Sqrt[5])/2]/2}
}

EDIT: Perhaps this can be used to find a simpler form for the t-values?

Answer 5

##Graphics`Mesh`FindIntersections

func = {2.4*Cos[t] + 1.6*Cos[3 t/2], 2.4*Sin[t] - 1.6 Sin[3 t/2]};
pp = ParametricPlot[func, {t, 0, 4 Pi}];

intersections = Most@Block[{Annotation = # &}, Graphics`Mesh`FindIntersections[pp]];
TeXForm @ intersections

$\left( \begin{array}{cc} -1.00861 & -0.00278635 \\ -0.314208 & -0.955061 \\ -0.314117 & 0.953375 \\ 0.80902 & -0.587822 \\ 0.809027 & 0.588058 \\ \end{array} \right)$

Labeled[Show[pp, Frame -> True, Axes -> False, 
  Epilog -> {PointSize[.025], Red, Point[intersections]}], 
 Style[#, 20] &@Column[intersections, Frame -> All], Right]

Answer 6

x[t_] = 2.4*Cos[t] + 1.6*Cos[3 t/2] // Rationalize // Simplify;

y[t_] = 2.4*Sin[t] - 1.6 Sin[3 t/2] // Rationalize // Simplify;

param = Solve[{x[t1] == x[t2], y[t1] == y[t2], 
     0 <= t1 < t2 < 4 Pi}, {t1, t2}, Method -> Reduce] // N[#, 20] & //
   Quiet

(* {{t1 -> 3.6469531638739505454, t2 -> 8.9194174504852224084}, 
    {t1 -> 1.1336790410021159547, t2 -> 6.4061433276133878176}, 
    {t1 -> 1.3795950818697186361, t2 -> 8.6735014096176197270}, 
    {t1 -> 3.8928692047415532269, t2 -> 11.186775532489454318}, 
    {t1 -> 6.1602272867457851362, t2 -> 11.432691573357056999}} *)

pts = {x[t1], y[t1]} /. param // N

(* {{-1., 0.}, {0.809017, 0.587785}, {-0.309017, 0.951057}, 
    {-0.309017, -0.951057}, {0.809017, -0.587785}}

ParametricPlot[{x[t], y[t]}, {t, 0, 4*Pi},
 Epilog -> {Red, AbsolutePointSize[6], Point[pts]}]