20

I am fairly new to Mathematica, and I cannot figure out how to plot an epicycloid. I have plotted some neat looking things in my attempts, but I still can't make one. I am not looking to make an animation; I just want the plot of an epicycloid.

Would I use PolarPlot or ParametricPlot? How do I get a static picture of an epicycloid?

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
btalbot
  • 311
  • 2
  • 6

5 Answers5

38

I recreated the animation on Wikipedia:

enter image description here

Here is the Manipulate version:

R = 3; r = 1;

fx[θ_, a_: 1] := (R + r) Cos[θ] - a r Cos[(R + r) θ/r];
fy[θ_, a_: 1] := (R + r) Sin[θ] - a r Sin[(R + r) θ/r];

gridlines = Table[{x, GrayLevel[0.9]}, {x, -6, 6, 0.5}];

plot[max_] := ParametricPlot[
  {fx[θ], fy[θ]}, {θ, 0, max},
  PlotStyle -> {Red, Thick},
  Epilog -> {
    Thick,
    Blue, Circle[{0, 0}, R],
    Black, Circle[{fx[max, 0], fy[max, 0]}, r],
    Red, PointSize[Large], Point[{fx[max], fy[max]}],
    Black, Line[{{fx[max, 0], fy[max, 0]}, {fx[max], fy[max]}}]
    },
  GridLines -> {gridlines, gridlines},
  PlotRange -> {-6, 6}
  ]
Manipulate[plot[max], {max, 0.01, 2 Pi}]
C. E.
  • 70,533
  • 6
  • 140
  • 264
18

It is easiest to use ParametricPlot and RotationTransform.

ParametricPlot[
  RotationTransform[a][{1, 0}] + RotationTransform[4 a][{1/4, 0}],
  {a, 0, 2 Pi}, Evaluated -> True]

enter image description here

Evaluated -> True is not strictly necessary; it's there just to construct the equation once instead of for every point in the graph separately (... which is slow).

EDIT: Improved per comment from Mr.Wizard.

kirma
  • 19,056
  • 1
  • 51
  • 93
17

Epicycloids (and other roulette curves) are fun to play with using Manipulate. Here is one of many possible implementations.

Manipulate[
  ParametricPlot[{
    (1 + r)  Cos[theta] + a Cos[(1 + r) theta], 
    (1 + r) Sin[theta] + a Sin[(1 + r) theta]}, 
    {theta, 0, 2 Pi}],
  {{r, 1}, 1, 20, 1, Appearance -> "Labeled"},
  {{a, 1}, -10, 10, .2, Appearance -> "Labeled"}]

epicycloid.png


Edit

Although the question only calls for epicycloids, it is very easy to make interactive panel that allows the user to play with hypocycloids as well. Because there is a simple relationship between epicycloids and hypocycloids, doing so adds very little code.

Manipulate[
  ParametricPlot[{
      type r Cos[theta] + a Cos[type r theta], 
      type r Sin[theta] + a Sin[type  r theta]},
    {theta, 0, 2 Pi},
    PlotStyle -> {Red, Thick},
    ImageSize -> {400, 400}],
  {{type, 1}, {1 -> "epicycloid", -1 -> "hypocycloid"}},
  {{r, 1}, 1, 20, 1, Appearance -> "Labeled"},
  {{a, 1}, -10, 10, .1, Appearance -> "Labeled"}]

roulettes.png

m_goldberg
  • 107,779
  • 16
  • 103
  • 257
13

Looking up epicycloid we get the parametric equations describing it and then ParametricPlot does the rest of our work.

ParametricPlot[
     {3 3.1 Cos[θ] - 3 Cos[3.1 θ], 3 3.1 Sin[θ] - 3 Sin[3.1 θ]}, 
     {θ, 0, 20 π},
     ColorFunction -> "AtlanticColors"]

Plot

Sektor
  • 3,320
  • 7
  • 27
  • 36
10

Just for fun, here is a variation of C. E.'s animation, which demonstrates that an epicycloid can be constructed as an envelope of the diameter of a rolling circle:

With[{n = 3, r = 1, m = 31},
     Animate[ParametricPlot[ReIm[(n + 1) r E^(I t) - r E^(I (n + 1) t)],
                            {t, 0, 2 Denominator[n] π}, Axes -> None, 
                            Epilog -> {Circle[ReIm[(n + 2) r E^(I u)], 2 r],
                                       {Red, Line[{ReIm[(n + 2) r E^(I u) -
                                                        2 r E^(I (1 + n/2) u)], 
                                                   ReIm[(n + 2) r E^(I u) +
                                                        2 r E^(I (1 + n/2) u)]}]}}, 
                            Frame -> True, PlotRange -> (n + 4) r, 
                            PlotStyle -> Red, Prolog -> {Blue, Circle[{0, 0}, n r]}],
             {u, 0, 2 Denominator[n] π, (2 Denominator[n] π)/(m - 1)}]]

epicycloid as envelope

(Note the use of the complex form of the epicycloid.)

A slight modification of the code given above can be done to produce the multiple exposure version: multiple exposure

If one just wants to see the lines enveloping the epicycloid, the code is much simpler:

With[{n = 3, r = 1, m = 101}, 
     Graphics[{Opacity[1/5], 
               Table[InfiniteLine[{ReIm[(n + 2) r E^(I u) - 2 r E^(I (1 + n/2) u)], 
                                   ReIm[(n + 2) r E^(I u) + 2 r E^(I (1 + n/2) u)]}],
                     {u, 0, 2 Denominator[n] π, (2 Denominator[n] π)/(m - 1)}]}]]

just the envelope please, Louise


Still another neat demonstration is the Bernoulli-Euler double generation theorem: an epicycloid is equivalent to a pericycloid (which can be thought of as the locus of a point mounted on a "hula hoop").

With[{n = 3, r = 1, m = 31},
     Animate[{ParametricPlot[ReIm[(n + 1) r E^(I t) - r E^(I (n + 1) t)],
                             {t, -$MachineEpsilon, u}, Axes -> None, 
                             Epilog -> {Thick, Circle[ReIm[(n + 1) r E^(I u)], r], 
                                        Line[{ReIm[(n + 1) r E^(I u)], 
                                              ReIm[(n + 1) r E^(I u) -
                                                   r E^(I (n + 1) u)]}],
                                        {Directive[Red, PointSize[Large]], 
                                         Point[ReIm[(n + 1) r E^(I u) -
                                                    r E^(I (n + 1) u)]]}}, 
                             Frame -> True, PlotRange -> (n + 2) r, 
                             PlotStyle -> Directive[Red, Thick], 
                             Prolog -> {Directive[Blue, Thick], Circle[{0, 0}, n r]}], 
              ParametricPlot[ReIm[(n + 1) r E^(I t) - r E^(I (n + 1) t)],
                             {t, -$MachineEpsilon, u}, Axes -> None, 
                             Epilog -> {Thick, Circle[ReIm[-r E^(I (n + 1) u)],
                                                      (n + 1) r], 
                                        Line[{ReIm[-r E^(I (n + 1) u)], 
                                              ReIm[(n + 1) r E^(I u) -
                                                   r E^(I (n + 1) u)]}],
                                        {Directive[Red, PointSize[Large]], 
                                         Point[ReIm[(n + 1) r E^(I u) -
                                                    r E^(I (n + 1) u)]]}}, 
                             Frame -> True, PlotRange -> (n + 2) r, 
                             PlotStyle -> Directive[Red, Thick], 
                             Prolog -> {Directive[Blue, Thick], Circle[{0, 0}, n r]}]}
             // GraphicsRow, {u, 0, 2 Denominator[n] π, (2 Denominator[n] π)/(m - 1)}]]

double generation

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574