Mathematica and Spirograph

By
Matthew M. Thomas
Department of Chemical Engineering
Washington University in St. Louis
St. Louis, MO  63130-4899
thomas@wuche2.wustl.edu

Mathematica in Education
Volume 3 Number 1
Winter 1994
(c) TELOS/Springer-Verlag

Initialization

(* 	Author: John George
	Title: Spirograh.m
	Purpose: This package generates 
			 spirographs using Mathematica.*)

spirograph[p_Integer,q_Integer,a_,start_:0,opts___Rule] :=
	Module[{m=(q-p)/q, n=(q-p)/p, x=Cos[start], y=Sin[start]},
		ParametricPlot[{
			x(m Cos[t]+a Cos[n t])-y(m Sin[t]-a Sin[n t]),
        	y(m Cos[t]+a Cos[n t])+x(m Sin[t]-a Sin[n t])},
        {t, 0, 2 p Pi}, 
        opts, AspectRatio -> Automatic,
        PlotPoints -> 24, Axes -> None]
	];

spirograph::usage="spirograph[p, q, a, rot:0, (optionlist)]
displays the spirograph design formed by an outer wheel of
radius one and an inner wheel of radius p/q, with a pen
placed a units from the center; beginning at start radians
above the x-axis.";

Figure 1

ParametricPlot[
	{(4-1) Cos[t] + 0.5 Cos[t (4-1)/1],
	 (4-1) Sin[t] + 0.5 Sin[t (4-1)/1]},
 {t, 0, 2Pi}, AspectRatio -> 1]

Figure 2

ParametricPlot[
	{(2+1) Cos[t] - 0.5 Cos[t (2+1)/1],
	 (2+1) Sin[t] - 0.5 Sin[t (2+1)/1]},
 {t, 0, 2Pi}, AspectRatio -> 1]

Figure 3

ParametricPlot[{Sin[t], Cos[t]},
	{t, 0, 2Pi}]

Figure 4

spiros = Table[spirograph[1, 4, n, (Pi/2)-n,
   PlotStyle -> GrayLevel[n]],
   {n, .05, .8, .05}];

Show[GraphicsArray[Partition[spiros, 4]]];

Figure 5

spirogray[p_, q_, a_] :=
   ParametricPlot3D[
      {((q - p)/q) Cos[t] + a Cos[((q - p)/p) t],
       ((q - p)/q) Sin[t] - a Sin[((q - p)/p) t],
       0,
     GrayLevel[Abs[Sin[3 t]]]},
     {t, 0, Denominator[Rationalize[q/p]]*2*Pi},
     Axes -> None, ViewPoint -> {0, 0, 10},
     Boxed -> False, PlotPoints -> 1440];

spirogray[52, 105, N[48/105]];

spirocolor[p_, q_, a_] :=
   ParametricPlot3D[
      {((q - p)/q) Cos[t] + a Cos[((q - p)/p) t],
       ((q - p)/q) Sin[t] - a Sin[((q - p)/p) t],
       0,
     Hue[Abs[Sin[3 t]], 1-(t/(2*p*Pi)), 1]},
     {t, 0, Denominator[Rationalize[q/p]]*2*Pi},
     Axes -> None, ViewPoint -> {0, 0, 10},
     Boxed -> False, PlotPoints -> 1440];

spirocolor[52, 105, N[48/105]];

Figure 6

Table[spirograph[n, 7, (7 - n)/7, Pi/2,
         PlotStyle -> GrayLevel[n/7]],
{n, 1, 6}]

Show[GraphicsArray[Partition[%12, 3]]];

Figure 7

fig4 = Table[spirograph[n, 7, (n/7), Pi/2,
         PlotStyle -> GrayLevel[n/7]],
       {n, 1, 6}];

Show[GraphicsArray[Partition[fig4, 3]]]