(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 3.0, MathReader 3.0, or any compatible application. The data for the notebook starts with the line of stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 13189, 444]*) (*NotebookOutlinePosition[ 14272, 481]*) (* CellTagsIndexPosition[ 14228, 477]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{Cell[TextData["The Stellated Icosahedra"], "Title", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[StyleBox[ "by\nRoman E. Maeder\nETH Zurich\nInstitute of Theoretical Computer Science\n\ ETH Zentrum IFW\n8092 Zurich\nSWITZERLAND\nmaeder@inf.ethz.ch", Evaluatable->False, AspectRatioFixed->True, FontSize->14]], "Subtitle", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Mathematica in Education\nVolume 3 Number 1\nWinter 1994\n(c) \ TELOS/Springer-Verlag"], "Subsubtitle", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Abstract"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "The enumeration of all stellations of the icosahedron was accomplished in \ 1938. The geometric constructions and combinatorial algorithms used can \ easily be programmed\nin ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ ". Its symbolic and graphic capabilities make it well suited to render the \ solids in a variety of formats.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Reference"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Title"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["The Stellated Icosahedra"], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Author"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Roman E. Maeder"], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Summary"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Contains the code for the examples in the article \"The Stellated Icosahedra\ \"."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Package Version"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["1.1"], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Copyright"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["\[Copyright]", Evaluatable->False, AspectRatioFixed->True], StyleBox[ " Copyright 1994, Roman E. Maeder.\n\nPermission is granted to distribute \ this file for any purpose except for inclusion in commercial software or \ program collections. This copyright notice must remain intact..\n \nThe use \ of this code for the preparation of graphics images for publication or \ commercial purposes requires prior written permission by the author.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["History"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Version 1.1 for Mathematica in Education, Winter 1994."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Keywords"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Stellated Icosahedra, Stellation, Polyhedra"], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Source"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Maeder, Roman E. 1993. The Stellated Icosahedra. Mathematica in Education, \ 3(1)."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData[{ StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" Version", Evaluatable->False, AspectRatioFixed->True] }], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["2.2"], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Requirements"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Icosahedra.m"], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Graphics`Polyhedra`"], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Graphics`Shapes`"], "Input", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["Init"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["You may have to add the directory with ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Icosahedra.m", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" to your ", Evaluatable->False, AspectRatioFixed->True], StyleBox["$Path", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" or do something like this:", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["SetDirectory[\"", AspectRatioFixed->True], StyleBox["full path name of directory", AspectRatioFixed->True, FontSlant->"Italic"], StyleBox["\"];", AspectRatioFixed->True] }], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Imports"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Needs[\"Icosahedra`\"]"], "Input", InitializationCell->True, AspectRatioFixed->True], Cell[TextData["Needs[\"Graphics`Polyhedra`\"]"], "Input", InitializationCell->True, AspectRatioFixed->True], Cell[TextData["Needs[\"Graphics`Shapes`\"]"], "Input", InitializationCell->True, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Option Settings"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "SetOptions[GraphicsArray, GraphicsSpacing->0];\nSetOptions[Graphics3D, \ Boxed->False];"], "Input", InitializationCell->True, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Auxiliary Functions"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Show 3D image and planar map next to each other."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "plotit[n_, opts___] :=\nGraphicsArray[\n\t{ Icosahedra[n, opts],\n \ FaceGraphics[n, opts, Frame->True, FrameTicks->None]}\n]"], "Input", InitializationCell->True, AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["Examples from the Article (and More)"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Stella Octangula"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["The ", Evaluatable->False, AspectRatioFixed->True], StyleBox["stella octangula", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" is the only stellation of the octahedron.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "tetra = Polyhedron[Tetrahedron];\ndual = AffineShape[ tetra, {-1, -1, -1} \ ];"], "Input", AspectRatioFixed->True], Cell[TextData["Show[{tetra, dual}];"], "Input", AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Regular Star Polygons"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "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)."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "starpoly =\nMap[ Polyhedron,\n {{SmallStellatedDodecahedron, \ GreatStellatedDodecahedron},\n {GreatDodecahedron, GreatIcosahedron}\n \ }, {2} ];"], "Input", AspectRatioFixed->True], Cell[TextData["Show[ GraphicsArray[starpoly] ];"], "Input", AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Maps of Lines and Facets"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "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."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Show[ lineGraphics ];"], "Input", AspectRatioFixed->True], Cell[TextData["Show[ lineGraphicsInner ];"], "Input", AspectRatioFixed->True], Cell[TextData["The different kinds of facets are color coded."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Show[ faceGraphics ];"], "Input", AspectRatioFixed->True], Cell[TextData["Show[ faceGraphicsInner ];"], "Input", AspectRatioFixed->True], Cell[TextData["Here is an example of a planar map of a stellation."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Show[ FaceGraphics[59] ];"], "Input", AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Left and Right Forms"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Th left and right form of the compound of five tetrahedra."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Show[ GraphicsArray[{Icosahedra[36], Icosahedra[36, True]}] ];"], "Input", AspectRatioFixed->True], Cell[TextData[ "Their combination is another stellation: the compound of ten tentrahedra."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Show[ Icosahedra[18] ];"], "Input", AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["All 59 Pictures"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "This command produces all 59 pictures. To the left is a 3D view of the \ solid, to the right is its planar map."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Scan[ Show[plotit[#], PlotLabel->#]&,\n Range[Length[icosahedra]]\n]"], "Input", AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["The Cover Picture"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["The journal cover shows these twelve stellations:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "icosa = {\n\t{{ 2}, { 3}, {11}},\n\t{{36, False}, {18}, {36, True}},\n\t{{ \ 8}, {33}, {30}},\n\t{{23}, {45}, { 4}}\n};"], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["The data for ray tracing was derived from the following ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" graphics.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Show[ GraphicsArray[\n Apply[ Icosahedra[##, Boxed->False]&, icosa, {2} ]\n\ ] ] ;"], "Input", AspectRatioFixed->True]}, Open]]}, Open]] }, FrontEndVersion->"Macintosh 3.0", ScreenRectangle->{{0, 640}, {0, 460}}, AutoGeneratedPackage->None, WindowToolbars->{}, CellGrouping->Manual, WindowSize->{520, 365}, WindowMargins->{{36, Automatic}, {Automatic, 31}}, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False}, MacintoshSystemPageSetup->"\<\ AVU/IFiQKFD000000V7E<09QgO0000000OZ:d096/NP0AP1Y06`0I@1^0642HMD` 0V7N40000001nXZ`0TJaj000000000000000009QeC0000000000000000000000 00000000000000000000000000000000\>" ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1731, 51, 99, 2, 70, "Title", Evaluatable->False], Cell[1833, 55, 292, 7, 70, "Subtitle", Evaluatable->False], Cell[2128, 64, 167, 4, 70, "Subsubtitle", Evaluatable->False], Cell[CellGroupData[{ Cell[2318, 70, 85, 2, 70, "Section", Evaluatable->False], Cell[2406, 74, 603, 18, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[3041, 94, 86, 2, 70, "Section", Evaluatable->False], Cell[CellGroupData[{ Cell[3150, 98, 88, 2, 70, "Subsubsection", Evaluatable->False], Cell[3241, 102, 98, 2, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[3371, 106, 89, 2, 70, "Subsubsection", Evaluatable->False], Cell[3463, 110, 89, 2, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[3584, 114, 90, 2, 70, "Subsubsection", Evaluatable->False], Cell[3677, 118, 156, 4, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[3865, 124, 98, 2, 70, "Subsubsection", Evaluatable->False], Cell[3966, 128, 77, 2, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[4075, 132, 92, 2, 70, "Subsubsection", Evaluatable->False], Cell[4170, 136, 595, 14, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[4797, 152, 90, 2, 70, "Subsubsection", Evaluatable->False], Cell[4890, 156, 129, 3, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[5051, 161, 91, 2, 70, "Subsubsection", Evaluatable->False], Cell[5145, 165, 117, 2, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[5294, 169, 89, 2, 70, "Subsubsection", Evaluatable->False], Cell[5386, 173, 157, 4, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[5575, 179, 263, 10, 70, "Subsubsection", Evaluatable->False], Cell[5841, 191, 77, 2, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[5950, 195, 95, 2, 70, "Subsubsection", Evaluatable->False], Cell[6048, 199, 87, 2, 70, "Input", Evaluatable->False], Cell[6138, 203, 94, 2, 70, "Input", Evaluatable->False], Cell[6235, 207, 91, 2, 70, "Input", Evaluatable->False] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[6367, 211, 81, 2, 70, "Section", Evaluatable->False], Cell[6451, 215, 608, 22, 70, "Text", Evaluatable->False], Cell[7062, 239, 256, 9, 70, "Input"], Cell[CellGroupData[{ Cell[7341, 250, 87, 2, 70, "Subsection", Evaluatable->False], Cell[7431, 254, 103, 2, 70, "Input", InitializationCell->True], Cell[7537, 258, 111, 2, 70, "Input", InitializationCell->True], Cell[7651, 262, 108, 2, 70, "Input", InitializationCell->True] }, Open ]], Cell[CellGroupData[{ Cell[7791, 266, 95, 2, 70, "Subsection", Evaluatable->False], Cell[7889, 270, 169, 4, 70, "Input", InitializationCell->True] }, Open ]], Cell[CellGroupData[{ Cell[8090, 276, 99, 2, 70, "Subsection", Evaluatable->False], Cell[8192, 280, 122, 2, 70, "Text", Evaluatable->False], Cell[8317, 284, 212, 4, 70, "Input", InitializationCell->True] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[8570, 290, 113, 2, 70, "Section", Evaluatable->False], Cell[CellGroupData[{ Cell[8706, 294, 96, 2, 70, "Subsection", Evaluatable->False], Cell[8805, 298, 365, 13, 70, "Text", Evaluatable->False], Cell[9173, 313, 133, 3, 70, "Input"], Cell[9309, 318, 73, 1, 70, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[9414, 321, 101, 2, 70, "Subsection", Evaluatable->False], Cell[9518, 325, 266, 5, 70, "Text", Evaluatable->False], Cell[9787, 332, 212, 4, 70, "Input"], Cell[10002, 338, 85, 1, 70, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[10119, 341, 104, 2, 70, "Subsection", Evaluatable->False], Cell[10226, 345, 265, 5, 70, "Text", Evaluatable->False], Cell[10494, 352, 74, 1, 70, "Input"], Cell[10571, 355, 79, 1, 70, "Input"], Cell[10653, 358, 120, 2, 70, "Text", Evaluatable->False], Cell[10776, 362, 74, 1, 70, "Input"], Cell[10853, 365, 79, 1, 70, "Input"], Cell[10935, 368, 125, 2, 70, "Text", Evaluatable->False], Cell[11063, 372, 78, 1, 70, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[11173, 375, 100, 2, 70, "Subsection", Evaluatable->False], Cell[11276, 379, 133, 3, 70, "Text", Evaluatable->False], Cell[11412, 384, 116, 2, 70, "Input"], Cell[11531, 388, 151, 4, 70, "Text", Evaluatable->False], Cell[11685, 394, 76, 1, 70, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[11802, 397, 92, 2, 70, "Section", Evaluatable->False], Cell[11897, 401, 186, 4, 70, "Text", Evaluatable->False], Cell[12086, 407, 130, 3, 70, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[12248, 412, 94, 2, 70, "Section", Evaluatable->False], Cell[12345, 416, 123, 2, 70, "Text", Evaluatable->False], Cell[12471, 420, 174, 3, 70, "Input"], Cell[12648, 425, 380, 13, 70, "Text", Evaluatable->False], Cell[13031, 440, 137, 3, 70, "Input"] }, Closed]] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)