Function Repository Resource:

Spirograph

Source Notebook

Plot a spirograph

Contributed by: Wolfram Staff

ResourceFunction["Spirograph"][f,φ]

plots a spirograph for function f with variable φ.

ResourceFunction["Spirograph"][f,φ,φf]

plots a spirograph from 0 to φf.

Details and Options

Imagine a wheel rolling around a second wheel that is rolling around another wheel and so on. A point on the rim of the outermost wheel will trace an interesting curve in the plane. Let the radius and angular frequency of the jth wheel be rj and nj. The point will be at the position in the complex φ-plane. The function Spirograph generates a picture of the path of the point.
Assume that there is a closed parametrized curve in the plane. Find the points pk on the curve corresponding to a division of the parameter domain into m d parts, where m and d are positive integers. The d m-sided Maurer polygons (1989) are formed by joining the points pk,pk+d,pk+2d,,pk+(m-1)d,pk, for k=1,2,,d.
When the option "MaurerPolygons" is set to True, the default value for m and d is {100,400}.

Examples

Basic Examples (5) 

Plot a spirograph:

In[1]:=
ResourceFunction["Spirograph"][\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(5\)]
\*FractionBox[
SuperscriptBox[\(E\), \(j\ I\ \ \[CurlyPhi]\)], \(j + 1\)]\), \[CurlyPhi]]
Out[1]=

A more complicated spirograph:

In[2]:=
ResourceFunction["Spirograph"][\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(13\)]\(Cos[
\*SuperscriptBox[\(j\), \(2\)]]\ 
\*SuperscriptBox[\(E\), \(j\ I\ \ \[CurlyPhi]\)]\)\), \[CurlyPhi]]
Out[2]=

Half of the path of the spirograph:

In[3]:=
ResourceFunction["Spirograph"][\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(13\)]\(Cos[
\*SuperscriptBox[\(j\), \(2\)]]\ 
\*SuperscriptBox[\(E\), \(j\ I\ \ \[CurlyPhi]\)]\)\), \[CurlyPhi], \[Pi]]
Out[3]=

Convert the curve to a polygon:

In[4]:=
ResourceFunction["Spirograph"][\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(13\)]\(Cos[
\*SuperscriptBox[\(j\), \(2\)]]\ 
\*SuperscriptBox[\(E\), \(j\ I\ \ \[CurlyPhi]\)]\)\), \[CurlyPhi]] /. Line -> Polygon
Out[4]=

Spirographs with random values:

In[5]:=
GraphicsGrid[Table[ResourceFunction["Spirograph"][\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(12\)]\(RandomComplex[{\(-1\) - I, 1 + I}]\ 
\*SuperscriptBox[\(E\), \(j\ I\ \[CurlyPhi]\)]\)\), \[CurlyPhi]], {3}, {3}]]
Out[5]=

Options (5) 

ColorFunction (1) 

Choose a ColorFunction:

In[6]:=
\[ScriptS] = ResourceFunction["Spirograph"][\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(5\)]
\*SuperscriptBox[\(E\), \(j\ I\ \[CurlyPhi]\)]\), \[CurlyPhi], ColorFunction -> "Rainbow"]
Out[6]=

MaurerPolygons (2) 

Set explicit values for "MaurerPolygons":

In[7]:=
ResourceFunction["Spirograph"][\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(7\)]\(\((
\*FractionBox[\(j\), \(6\)] + Sin[j])\)\ 
\*SuperscriptBox[\(E\), \(j\ I\ \ \[CurlyPhi]\)]\)\), \[CurlyPhi], "MaurerPolygons" -> {100, 200}, ColorFunction -> "Rainbow"]
Out[7]=

Default values for "MaurerPolygons":

In[8]:=
ResourceFunction["Spirograph"][\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(7\)]\(\((
\*FractionBox[\(j\), \(6\)] + Sin[j])\)\ 
\*SuperscriptBox[\(E\), \(j\ I\ \ \[CurlyPhi]\)]\)\), \[CurlyPhi], "MaurerPolygons" -> True, ColorFunction -> "Rainbow"]
Out[8]=

ShowCircles (2) 

Show the "wheels" that generate the spirograph:

In[9]:=
ResourceFunction["Spirograph"][\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(5\)]
\*FractionBox[
SuperscriptBox[\(E\), \(j\ I\ \[CurlyPhi]\)], \(j + 1\)]\), \[CurlyPhi], \[Pi], "ShowCircles" -> True, ColorFunction -> "Rainbow", PlotRange -> {{-0.84, 1.45}, {-1.1, 1.1}}]
Out[9]=

Make an animation:

In[10]:=
Animate[ResourceFunction["Spirograph"][\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(5\)]
\*FractionBox[
SuperscriptBox[\(E\), \(j\ I\ \[CurlyPhi]\)], \(j + 1\)]\), \[CurlyPhi], \[CurlyPhi]f, "ShowCircles" -> True, ColorFunction -> "Rainbow", PlotRange -> {{-0.84, 1.45}, {-1.1, 1.1}}], {\[CurlyPhi]f, 0.1, 2 \[Pi]}]
Out[10]=

Applications (7) 

Spirographs had an important application in the 1940s, when they were used for the "manual" solution of polynomial equations of higher degree. To understand this, consider the following polynomial poly in the variable z:

In[11]:=
poly = z^6 - z^5 + 2 z^4 - z^3 + 2 z^2 - z + 2
Out[11]=

Replace the variable z by its polar form, r ⅇφ, where r and φ are the absolute value and phase or argument of z:

In[12]:=
poly1 = poly /. z -> r E^(I \[CurlyPhi])
Out[12]=

Show the spirographs for a range of values of r:

In[13]:=
Show[Table[
  ResourceFunction["Spirograph"][poly1, \[CurlyPhi], PlotStyle -> {Thickness[0.001], Hue[0.71 (r - 0.1)]}, FrameTicks -> True, PlotRange -> {{-10, 20}, {-15, 15}}], {r, 1.0, 1.2, 0.02}]]
Out[13]=

Zoom to a neighborhood of the origin:

In[14]:=
Show[%, PlotRange -> {{-1, 1}, {-1, 1}}]
Out[14]=

Here is an even closer look:

In[15]:=
Show[%, PlotRange -> {{-(1/10), 1/10}, {-(1/10), 1/10}}]
Out[15]=

These are absolute values and arguments of the zeros of the polynomial:

In[16]:=
{Abs[#], Arg[#]} & /@ (z /. NSolve[poly == 0, z])
Out[16]=

The spirograph curves corresponding to these absolute values all go through the origin:

In[17]:=
Show[ResourceFunction["Spirograph"][poly1 /. r -> #, \[CurlyPhi], PlotStyle -> {Thickness[0.001], Hue[0.7 #1]}] & /@ First /@ %, FrameTicks -> True, PlotRange -> {{-(1/2), 1/2}, {-(1/2), 1/2}}]
Out[17]=

An analog circuit was used to vary r and the corresponding spirographs were monitored using an oscilloscope. Further analysis to determine φ led to approximations of the zeros of the polynomial.

Requirements

Wolfram Language 11.3 (March 2018) or above

Version History

  • 1.0.0 – 17 April 2019

License Information