# Rolling Disk Animation

I am trying to create an animation in Mathematica of a rolling disk outside a disk of equal radius. The following coding is what I have tried but without the one circle staying in a fixed position I am having a hard time seeing what is going on.

Manipulate[
Show[{
Graphics[{
Circle[{0,0},1],
Circle[{2 Cos[Theta],2 Sin[Theta]},1],
{Blue,PointSize[0.012],Point[{Cos[Theta],Sin[Theta]}]},
{Green, PointSize[0.012],Point[{2 Cos[Theta],2 Sin[Theta]}]},
Line[{{2 Cos[Theta],2 Sin[Theta]},{Cos[Theta],Sin[Theta]}}]
}]
}]
,{Theta,0.0000001,2 Pi}
]


I also cannot figure out the how to make it trace the point that is rotating.

• Use the PlotRange option to keep the stationary circle from moving around in the frame. In order to plot the path you should use ParametricPlot to plot the coordinate for the second circle over time. You can combine the ParametricPlot with your graphics using Show. – C. E. Apr 28 '15 at 23:13
• Stan Wagon's Mathematica in Action features an animation that involves rolling a (simulated) penny on another. If you can see a copy of that book, go do so. – J. M.'s torpor May 3 '15 at 0:24

Is this something like what you want?

Manipulate[Show[
Graphics[{
Circle[{0, 0}, 1],
Circle[{2 Cos[t], 2 Sin[t]}, 1], {Blue, PointSize[0.012],
Point[{Cos[t], Sin[t]}]}, {Green, PointSize[0.012],
Point[{2 Cos[t], 2 Sin[t]}]},
Line[{{2 Cos[t],
2 Sin[t]}, {2 Cos[t], 2 Sin[t]} + {Cos[Pi + 2 t], Sin[Pi + 2 t]}}]
}, PlotRange -> {{-3.1, 3.1}, {-3.1, 3.1}}],
ParametricPlot[{2 Cos[t], 2 Sin[t]} + {Cos[Pi + 2 t], Sin[Pi + 2 t]},
{t, 0, 2 Pi}]], {t, 0, 2 Pi}]


You need to set a fixed PlotRange to stop the graphics from jumping around. A ParametricPlot can be used to show the path it traces out, but you need to work out the formula yourself.

Here's an approach using ParametricPlot, where ListAnimate permits smooth animation.

 testparaNew[α_] := Show[{
ParametricPlot[
{{Cos[θ], Sin[θ]},
{2 Cos[α] + Cos[θ],
2 Sin[α] + Sin[θ]}},
{θ, 0, 2 π},
PlotRange -> 3,
Axes -> False,
Frame -> False
],
ParametricPlot[
{{2 Cos[α] + r Cos[2 α + π],
2 Sin[α] + r Sin[2 α + π]}},
{r, 0, 1},
PlotRange -> 3,
Frame -> False,
PlotStyle -> {Thick, Red}
],
ParametricPlot[
{{2 Cos[β] + Cos[2 β + π],
2 Sin[β] + Sin[2 β + π]}},
{β, 0, 2 π},
PlotRange -> 3,
Frame -> False,
PlotStyle -> {Red, Thin}
]
}]
list4 = Table[testparaNew[α], {α, 0, 2 π - π/60, π/60}]
ListAnimate[list4]