6
$\begingroup$

I have a Mathematica Notebook for drawing an evolute (involute) like this:

a := 1
ex := a Cos[t] + a t Sin[t]
ey := a Sin[t] - a t Cos[t]
b := 1.5
cx := b Cos[t]
cy := b Sin[t]
c := 1
ix := c Cos[t]
iy := c Sin[t]
ParametricPlot[{{ex, ey}, {cx, cy}, {ix, iy}}, {t, 0, π/2}, 
  PlotLabel -> "Evolute", PlotLegends -> "Expressions"]

Output Image

I would like to find the intersection between the circle segment {cx, cy} and the evolute {ex, ey}. All of my attempts have gone terribly wrong.

$\endgroup$
  • 1
    $\begingroup$ There won't be a good closed form solution, since the underlying equations are transcendental. Will you be okay with an approximation? $\endgroup$ – J. M. is away Aug 8 '16 at 12:56
  • $\begingroup$ Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Take the tour! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! $\endgroup$ – Michael E2 Aug 8 '16 at 13:37
  • $\begingroup$ @J.M., sure. This is a architectural question for designing a 400m track&field course, here the waterfall starting line for the 1.000m to 10.000m races. Absolute accuracy is not necessary. Thank you! $\endgroup$ – Denis Giffeler Aug 8 '16 at 13:37
  • 2
    $\begingroup$ Just for everybody's clarification: the parametric equations implied by the pair {ex, ey} are the involute of a circle; that is, the circle implied by {ix, iy} is the evolute of the curve described by {ex, ey}. $\endgroup$ – J. M. is away Aug 8 '16 at 13:40
  • 1
    $\begingroup$ @J.M. Actually there are closed form solutions such as {Cos[Sqrt[5]/2] + 1/2 Sqrt[5] Sin[Sqrt[5]/2], -(1/2) Sqrt[5] Cos[Sqrt[5]/2] + Sin[Sqrt[5]/2]. But yeah, there was no compelling reason to expect them, at least nothing that is obvious to me. $\endgroup$ – Daniel Lichtblau Aug 8 '16 at 14:24
6
$\begingroup$
a = 1;
ex[t_] = a Cos[t] + a t Sin[t];
ey[t_] = a Sin[t] - a t Cos[t];
b = 3/2;
cx[t_] = b Cos[t];
cy[t_] = b Sin[t];
c = 1;
ix[t_] = c Cos[t];
iy[t_] = c Sin[t];

pt = {ex[t1], ey[t1]} /.
  FindRoot[
   {ex[t1] == cx[t2], ey[t1] == cy[t2]},
   {{t1, π/4}, {t2, π/4}}]

(*  {1.44283, 0.410157}  *)

ParametricPlot[
 {{ex[t], ey[t]}, {cx[t], cy[t]}, {ix[t], iy[t]}},
 {t, 0, π/2},
 PlotLabel -> "Evolute",
 PlotLegends -> "Expressions",
 Epilog -> {Red, AbsolutePointSize[4],
   Tooltip[Point[pt], pt]}]

enter image description here

$\endgroup$
  • 1
    $\begingroup$ Ah yes - I do understand this. Good approach. Thank you. $\endgroup$ – Denis Giffeler Aug 8 '16 at 14:02
8
$\begingroup$

I beg to differ :)

Using Bob Hanlon's set-up, an exact solution, numerically equal to Feyre's:

Block[{a, b, c, cy, ey, cx, ex, ix, iy},
 a = 1;
 ex[t_] = a Cos[t] + a t Sin[t];
 ey[t_] = a Sin[t] - a t Cos[t];
 b = 3/2;
 cx[t_] = b Cos[t];
 cy[t_] = b Sin[t];
 c = 1;
 ix[t_] = c Cos[t];
 iy[t_] = c Sin[t];

 sol = Solve[
  {ex[t1] == cx[t2], ey[t1] == cy[t2], 0 < t1 < Pi/2, 0 < t2 < Pi/2},
  {t1, t2}, Method -> Reduce]
 ];
sol
N[sol]

Mathematica graphics

Remarks: To get the intersection of two curves, you need two parameters as the other answers show. The best way, imo, is to make the expressions explicit functions of the parameters (but one could use ReplaceAll: ex /. t -> t1, etc.). Solving transcendental equations exactly is often not possible, but when trying, it helps to limit the domains of the variables and try Reduce[].

$\endgroup$
  • $\begingroup$ Hah, nice! But as you say, we are not always so lucky. $\endgroup$ – J. M. is away Aug 8 '16 at 14:02
  • 2
    $\begingroup$ @J.M. And given the application, FindRoot[] seems a better general strategy. $\endgroup$ – Michael E2 Aug 8 '16 at 14:03
  • $\begingroup$ @MichaelE2: Wow. One lives to learn...thank you. $\endgroup$ – Denis Giffeler Aug 8 '16 at 14:05
  • 1
    $\begingroup$ You just talked yourself out of 15 rep ;) $\endgroup$ – Feyre Aug 8 '16 at 14:09
  • 2
    $\begingroup$ @Feyre If rep were bitcoin.... But it's better for the site & its users if the better answer is accepted. I really only intended my answer as a sidelight on Mathematica's symbolic capabilities, given that it had been mentioned. For building things, usually only a few digits of accuracy are needed, and numerics generally beat symbolics in such a case. $\endgroup$ – Michael E2 Aug 8 '16 at 16:21
6
$\begingroup$

Redefine with different variables:

cx := b Cos[u]
cy := b Sin[u]

Minimize, like @J.M. said, this won't give exact results.

NMinimize[Sqrt[(cy - ey)^2 + (cx - ex)^2], {u, t}, Reals]

{6.59602*10^-10, {u -> 0.276965, t -> 1.11803}}

{ex, ey} /. {u -> 0.27696531800957025`, t -> 1.1180339888944713`}
{cx, cy} /. {u -> 0.27696531800957025`, t -> 1.1180339888944713`}

{1.44283, 0.410157}

{1.44283, 0.410157}

Returning to single parameter:

Show[ParametricPlot[{{ex, ey}, {cx, cy}, {ix, iy}}, {t, 0, π/2}, 
  PlotLabel -> "Evolute", PlotLegends -> "Expressions"], 
 Graphics[{Red, PointSize[0.02], 
   Point[{1.4428344948227565`, 0.41015682473030135`}]}]]

enter image description here

$\endgroup$
  • 1
    $\begingroup$ This is the approach I use when FindRoot[] & NSolve[] fail, or I have no idea of a good initial search point. If I did have a starting point, I would try FindMinimum[] first. (+1 a while ago, now). $\endgroup$ – Michael E2 Aug 8 '16 at 16:26

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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