(*^ ::[ 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, "Times"; ; 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, noPageBreakBelow, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M21, N23, bold, L1, 12, "Courier"; ; fontset = output, output, inactive, noPageBreakBelow, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M21, N23, L-5, 12, "Courier"; ; fontset = message, inactive, noPageBreakBelow, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M21, N23, L1, 12, "Courier"; ; fontset = print, inactive, noPageBreakBelow, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M21, N23, L1, 12, "Courier"; ; fontset = info, inactive, noPageBreakBelow, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M21, N23, L1, 12, "Courier"; ; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l16, w444, h299, L1, 12, "Courier"; ; fontset = name, inactive, noPageBreakInGroup, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, B65535, L1, 10, "Times"; ; fontset = header, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = leftheader, nohscroll, cellOutline, 12; fontset = footer, inactive, nohscroll, noKeepOnOnePage, preserveAspect, center, M7, L1, 12; fontset = leftfooter, cellOutline, blackBox, 12; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 10, "Times"; ; 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] The Stellated Icosahedra :[font = subtitle; inactive; preserveAspect] by Roman E. Maeder ETH Zurich Institute of Theoretical Computer Science ETH Zentrum IFW 8092 Zurich SWITZERLAND maeder@inf.ethz.ch ;[s] 1:0,0;130,-1; 1:1,12,9,Times,1,14,0,0,0; :[font = subsubtitle; inactive; preserveAspect] Mathematica in Education Volume 3 Number 1 Winter 1994 (c) TELOS/Springer-Verlag :[font = section; inactive; Cclosed; preserveAspect; startGroup] Abstract :[font = text; inactive; preserveAspect; endGroup] The enumeration of all stellations of the icosahedron was accomplished in 1938. The geometric constructions and combinatorial algorithms used can easily be programmed in Mathematica. Its symbolic and graphic capabilities make it well suited to render the solids in a variety of formats. ;[s] 3:0,0;170,1;181,2;462,-1; 3:1,11,8,Times,0,12,0,0,0;1,10,8,Times,2,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = section; inactive; Cclosed; preserveAspect; startGroup] Reference :[font = subsubsection; inactive; preserveAspect; startGroup] Title :[font = text; inactive; preserveAspect; endGroup] The Stellated Icosahedra :[font = subsubsection; inactive; preserveAspect; startGroup] Author :[font = text; inactive; preserveAspect; endGroup] Roman E. Maeder :[font = subsubsection; inactive; preserveAspect; startGroup] Summary :[font = text; inactive; preserveAspect; endGroup] Contains the code for the examples in the article "The Stellated Icosahedra". :[font = subsubsection; inactive; preserveAspect; startGroup] Package Version :[font = text; inactive; preserveAspect; endGroup] 1.1 :[font = subsubsection; inactive; preserveAspect; startGroup] Copyright :[font = text; inactive; preserveAspect; endGroup] ã Copyright 1994, Roman E. Maeder. Permission is granted to distribute this file for any purpose except for inclusion in commercial software or program collections. This copyright notice must remain intact.. The use of this code for the preparation of graphics images for publication or commercial purposes requires prior written permission by the author. ;[s] 2:0,0;1,1;359,-1; 2:1,0,0,Symbol,0,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = subsubsection; inactive; preserveAspect; startGroup] History :[font = text; inactive; preserveAspect; endGroup] Version 1.1 for Mathematica in Education, Winter 1994. :[font = subsubsection; inactive; preserveAspect; startGroup] Keywords :[font = text; inactive; preserveAspect; endGroup] Stellated Icosahedra, Stellation, Polyhedra :[font = subsubsection; inactive; preserveAspect; startGroup] Source :[font = text; inactive; preserveAspect; endGroup] Maeder, Roman E. 1993. The Stellated Icosahedra. Mathematica in Education, 3(1). :[font = subsubsection; inactive; preserveAspect; startGroup] Mathematica Version ;[s] 2:0,0;11,1;20,-1; 2:1,10,8,Times,3,12,0,0,0;1,10,8,Times,1,12,0,0,0; :[font = text; inactive; preserveAspect; endGroup] 2.2 :[font = subsubsection; inactive; preserveAspect; startGroup] Requirements :[font = input; inactive; preserveAspect] Icosahedra.m :[font = input; inactive; preserveAspect] Graphics`Polyhedra` :[font = input; inactive; preserveAspect; endGroup; endGroup] Graphics`Shapes` :[font = section; inactive; Cclosed; preserveAspect; startGroup] Init :[font = text; inactive; preserveAspect] You may have to add the directory with Icosahedra.m to your $Path or do something like this: ;[s] 5:0,0;39,1;51,2;60,3;65,4;93,-1; 5:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect] SetDirectory["full path name of directory"]; ;[s] 3:0,0;14,1;41,2;45,-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 = subsection; inactive; preserveAspect; startGroup] Imports :[font = input; initialization; preserveAspect] *) Needs["Icosahedra`"] (* :[font = input; initialization; preserveAspect] *) Needs["Graphics`Polyhedra`"] (* :[font = input; initialization; preserveAspect; endGroup] *) Needs["Graphics`Shapes`"] (* :[font = subsection; inactive; preserveAspect; startGroup] Option Settings :[font = input; initialization; preserveAspect; endGroup] *) SetOptions[GraphicsArray, GraphicsSpacing->0]; SetOptions[Graphics3D, Boxed->False]; (* :[font = subsection; inactive; preserveAspect; startGroup] Auxiliary Functions :[font = text; inactive; preserveAspect] Show 3D image and planar map next to each other. :[font = input; initialization; preserveAspect; endGroup; endGroup] *) plotit[n_, opts___] := GraphicsArray[ { Icosahedra[n, opts], FaceGraphics[n, opts, Frame->True, FrameTicks->None]} ] (* :[font = section; inactive; Cclosed; preserveAspect; startGroup] Examples from the Article (and More) :[font = subsection; inactive; autoActive; Cclosed; preserveAspect; startGroup] Stella Octangula :[font = text; inactive; preserveAspect] The stella octangula is the only stellation of the octahedron. ;[s] 3:0,0;4,1;20,2;63,-1; 3:1,11,8,Times,0,12,0,0,0;1,10,8,Times,2,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect] tetra = Polyhedron[Tetrahedron]; dual = AffineShape[ tetra, {-1, -1, -1} ]; :[font = input; preserveAspect; endGroup] Show[{tetra, dual}]; :[font = subsection; inactive; autoActive; Cclosed; preserveAspect; startGroup] Regular Star Polygons :[font = text; inactive; preserveAspect] The first three of these are the only stellations of the dodecahedron. The fourth is a stellation of the icosahedron known to Poinsot. All of them are regular polyhedra (but not cconvex). :[font = input; preserveAspect] starpoly = Map[ Polyhedron, {{SmallStellatedDodecahedron, GreatStellatedDodecahedron}, {GreatDodecahedron, GreatIcosahedron} }, {2} ]; :[font = input; preserveAspect; endGroup] Show[ GraphicsArray[starpoly] ]; :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] Maps of Lines and Facets :[font = text; inactive; preserveAspect] The first two show the intersection figures of all planes of the icosahedron. The inner graphics leaves out the outermost points and allows a better view into the complicated interior. :[font = input; preserveAspect] Show[ lineGraphics ]; :[font = input; preserveAspect] Show[ lineGraphicsInner ]; :[font = text; inactive; preserveAspect] The different kinds of facets are color coded. :[font = input; preserveAspect] Show[ faceGraphics ]; :[font = input; preserveAspect] Show[ faceGraphicsInner ]; :[font = text; inactive; preserveAspect] Here is an example of a planar map of a stellation. :[font = input; preserveAspect; endGroup] Show[ FaceGraphics[59] ]; :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] Left and Right Forms :[font = text; inactive; preserveAspect] Th left and right form of the compound of five tetrahedra. :[font = input; preserveAspect] Show[ GraphicsArray[{Icosahedra[36], Icosahedra[36, True]}] ]; :[font = text; inactive; preserveAspect] Their combination is another stellation: the compound of ten tentrahedra. :[font = input; preserveAspect; endGroup; endGroup] Show[ Icosahedra[18] ]; :[font = section; inactive; Cclosed; preserveAspect; startGroup] All 59 Pictures :[font = text; inactive; preserveAspect] This command produces all 59 pictures. To the left is a 3D view of the solid, to the right is its planar map. :[font = input; preserveAspect; endGroup] Scan[ Show[plotit[#], PlotLabel->#]&, Range[Length[icosahedra]] ] :[font = section; inactive; autoActive; Cclosed; preserveAspect; startGroup] The Cover Picture :[font = text; inactive; preserveAspect] The journal cover shows these twelve stellations: :[font = input; preserveAspect] icosa = { {{ 2}, { 3}, {11}}, {{36, False}, {18}, {36, True}}, {{ 8}, {33}, {30}}, {{23}, {45}, { 4}} }; :[font = text; inactive; preserveAspect] The data for ray tracing was derived from the following Mathematica graphics. ;[s] 3:0,0;56,1;67,2;78,-1; 3:1,11,8,Times,0,12,0,0,0;1,10,8,Times,2,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect; endGroup; endGroup] Show[ GraphicsArray[ Apply[ Icosahedra[##, Boxed->False]&, icosa, {2} ] ] ] ; ^*)