(*^ ::[ Information = "This is a Mathematica Notebook file. It contains ASCII text, and can be transferred by email, ftp, or other text-file transfer utility. It should be read or edited using a copy of Mathematica or MathReader. If you received this as email, use your mail application or copy/paste to save everything from the line containing (*^ down to the line containing ^*) into a plain text file. On some systems you may have to give the file a name ending with ".ma" to allow Mathematica to recognize it as a Notebook. The line below identifies what version of Mathematica created this file, but it can be opened using any other version as well."; FrontEndVersion = "NeXT Mathematica Notebook Front End Version 2.2"; NeXTStandardFontEncoding; fontset = title, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e8, 24, "Times"; ; fontset = subtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e6, 18, "Times"; ; fontset = subsubtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, L1, e6, 14, "Times"; ; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, L1, a20, 18, "Times"; ; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, L1, a15, 14, "Courier"; ; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, L1, a12, 12, "Times"; ; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 10, "Times"; ; fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L1, 12, "Courier"; ; fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier"; ; fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, L1, 12, "Courier"; ; fontset = name, inactive, noPageBreakInGroup, nohscroll, preserveAspect, M7, italic, B65535, L1, 10, "Times"; ; fontset = header, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, L1, 12, "Times"; ; fontset = leftheader, 12; fontset = footer, inactive, nohscroll, noKeepOnOnePage, preserveAspect, center, M7, italic, L1, 12, "Times"; ; fontset = leftfooter, 12; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Courier"; ; fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; paletteColors = 128; automaticGrouping; currentKernel; ] :[font = title; inactive; preserveAspect; startGroup] Mathematica and Spirograph ;[s] 2:0,0;11,1;26,-1; 2:1,22,17,Times,3,24,0,0,0;1,21,16,Times,1,24,0,0,0; :[font = subtitle; inactive; preserveAspect; fontSize = 14; fontName = "Times"] By Matthew M. Thomas Department of Chemical Engineering Washington University in St. Louis St. Louis, MO 63130-4899 thomas@wuche2.wustl.edu :[font = subsubtitle; inactive; preserveAspect] Mathematica in Education Volume 3 Number 1 Winter 1994 (c) TELOS/Springer-Verlag :[font = section; inactive; Cclosed; preserveAspect; startGroup] Initialization :[font = input; preserveAspect] (* Author: John George Title: Spirograh.m Purpose: This package generates spirographs using Mathematica.*) ;[s] 3:0,0;100,1;111,2;114,-1; 3:1,10,8,Courier,1,12,0,0,0;1,10,8,Courier,3,12,0,0,0;1,10,8,Courier,1,12,0,0,0; :[font = input; initialization; preserveAspect] *) 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] ]; (* :[font = input; initialization; preserveAspect; endGroup] *) 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."; (* :[font = section; inactive; Cclosed; preserveAspect; startGroup] Figure 1 :[font = input; preserveAspect; endGroup] 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] :[font = section; inactive; Cclosed; preserveAspect; startGroup] Figure 2 :[font = input; preserveAspect; endGroup] 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] :[font = section; inactive; Cclosed; preserveAspect; startGroup] Figure 3 :[font = input; preserveAspect; endGroup] ParametricPlot[{Sin[t], Cos[t]}, {t, 0, 2Pi}] :[font = section; inactive; Cclosed; preserveAspect; startGroup] Figure 4 :[font = input; preserveAspect] spiros = Table[spirograph[1, 4, n, (Pi/2)-n, PlotStyle -> GrayLevel[n]], {n, .05, .8, .05}]; :[font = input; preserveAspect; endGroup] Show[GraphicsArray[Partition[spiros, 4]]]; :[font = section; inactive; Cclosed; preserveAspect; startGroup] Figure 5 :[font = input; preserveAspect] 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]; :[font = input; preserveAspect] spirogray[52, 105, N[48/105]]; :[font = input; preserveAspect] 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]; :[font = input; preserveAspect; endGroup] spirocolor[52, 105, N[48/105]]; :[font = section; inactive; Cclosed; preserveAspect; startGroup] Figure 6 :[font = input; preserveAspect] Table[spirograph[n, 7, (7 - n)/7, Pi/2, PlotStyle -> GrayLevel[n/7]], {n, 1, 6}] :[font = input; preserveAspect; endGroup] Show[GraphicsArray[Partition[%12, 3]]]; :[font = section; inactive; Cclosed; preserveAspect; startGroup] Figure 7 :[font = input; preserveAspect] fig4 = Table[spirograph[n, 7, (n/7), Pi/2, PlotStyle -> GrayLevel[n/7]], {n, 1, 6}]; :[font = input; preserveAspect; endGroup; endGroup] Show[GraphicsArray[Partition[fig4, 3]]] ^*)