Spirograph

Adam Rumpf, 10/27/2016

Introduction

This Notebook contains a variety of Manipulate environments that display interactive version of a Spirograph. A Spirograph is a toy consisting of a small gear that can be rotated inside of a larger gear, while a pen attached to the smaller gear draws its path on a piece of paper. This process can be used to define some important plane curves like the hypocycloid.

With a physical Spirograph the small gear can only ever rotate inside the large gear, but in this program we can also move the small gear outside of the large gear to get other plane curves, like the cardioid. We can even extend the pen’s position outside of the small gear.

Two separate Manipulate tools are included below. The first displays the top view of a small disk rolling around a large disk, while the second displays the side view of a disk rolling on its edge around in a circle. Both trace the path of a pen attached to the disk.

The “roll angle” option controls the current position of the small disk, and can be used to display an animation of the small disk rolling. The “max roll angle” option is simply an upper bound for the roll angle, and can be increased to allow the animation to play for longer before restarting, or to allow more of a curve to be drawn. The “disk radius” controls the radius of the small disk. It can be made positive to place the disk on the outside, or negative to place it on the inside. The “pen arm” option controls the length of the imaginary arm holding a pen from the center of the disk.

Code

Interactive Spirograph

Manipulate[Module[{g1,g2={},c,f,g},
c[t_]:={(1+r)Cos[t],(1+r)Sin[t]};
f[t_]:={d Cos[Pi+((1+r)/r)t],d Sin[Pi+((1+r)/r)t]};
g[t_]:=c[t]+f[t];
g1={Graphics[{White,Rectangle[{-1-r-d,-1-r-d},{1+r+d,1+r+d}]}],ParametricPlot[g[t],{t,0,a},PlotStyle->Red]};
If[lines==True,
g2={Graphics[{Blue,Thick,Circle[{0,0},1],Black,Circle[c[a],Abs[r]],Thin,Line[{c[a],g[a]}],PointSize[Large],Point[c[a]],Red,Point[g[a]]}]};
];
Show[Join[g1,g2]]],{{b,2Pi,"max roll angle"},2Pi,16Pi},{{a,2Pi,"roll angle"},0.001,b},{{r,1,"disk radius"},-5,5},{{d,1,"pen arm"},-10,10},{lines,{True,False}}]

Rolling Disk from Side

Manipulate[Module[{g1,g2={},g3,f},
f[t_]:={Sin[t]+d Cos[t]Sin[t/r],r+d Cos[t/r]};
g1={Graphics[{White,Rectangle[{-1.1-r,0},{1.1+r,r+0.1}]}]};
g3={ParametricPlot[f[t],{t,0,a},PlotStyle->{Thick,Red}]};
If[disk==True,
g2={Graphics[{Black,Line[{{-1,0},{1,0}}],If[Cos[a]≥0,Gray,LightGray],Disk[{Sin[a],r},{Abs[r Cos[a]],r}],Black,Line[{{Sin[a],r},f[a]}],Red,PointSize[Large],Point[f[a]]}]};
];
Show[Join[g1,g2,g3]]
],{{b,2Pi,"max roll angle"},2Pi,16Pi},{{a,2Pi,"roll angle"},0.001,b},{{r,(1/2),"disk radius"},(1/4),4},{{d,(1/2),"pen arm"},0,6},{disk,{True,False}}]