(* :Title: Examples of Polyhedra *) (* :Name: PolyhedraExamples.m *) (* :Author: Roman E. Maeder *) (* :Summary: This file contains definitions for all uniform polyhedra. *) (* :Context: *) (* :Package Version: 1.0.1 *) (* :Copyright: Copyright 1993, Roman E. Maeder. *) (* :History: Version 1.0.1 fixed small typos, December 1993. Version 1.0 for the Mathematica Journal, June 1993. *) (* :Keywords: uniform polyhedra, star polyhedra *) (* :Source: Zvi Har'El, Uniform solution for uniform polyhedra. Geometriae Dedicata, 47, pp. 57-110, 1993. Maeder, Roman E., Uniform Polyhedra. The Mathematica Journal, 3(4), 1993. *) (* :Requirement: UniformPolyhedra.m *) (* :Limitations: the polyhedra Nos. 69, 72, 74, and 75 cannot be shown with Display[] (usually used implicitly from within Show[]) because of limitations in the built-in renderer. They can be shown with Live[] on machines with suitable graphics hardware. *) (* :Mathematica Version: 2.2 *) Needs["UniformPolyhedra`"] NumberedPolyhedron::usage = "NumberedPolyhedron[n] gives polyhedron nr. n from the standard list." ShowPolyhedron::usage = "ShowPolyhedron[n] shows a labeled graphics of polyhedron nr. n." (* standard list of {name, Wythoff symbol} *) standard = { {"tetrahedron", w1[3, 2, 3]}, {"truncated tetrahedron", w2[2, 3, 3]}, {"octahemioctahedron", w2[3/2, 3, 3]}, {"tetrahemihexahedron", w2[3/2, 3, 2]}, {"octahedron", w1[4, 2, 3]}, {"cube", w1[3, 2, 4]}, {"cuboctahedron", w1[2, 3, 4]}, {"truncated octahedron", w2[2, 4, 3]}, {"truncated cube", w2[2, 3, 4]}, {"rhombicuboctahedron", w2[3, 4, 2]}, {"truncated cuboctahedron", w3[2, 3, 4]}, {"snub cube", w0[2, 3, 4]}, {"small cubicuboctahedron", w2[3/2, 4, 4]}, {"great cubicuboctahedron", w2[3, 4, 4/3]}, {"cubohemioctahedron", w2[4/3, 4, 3]}, {"cubitruncated cuboctahedron", w3[4/3, 3, 4]}, {"great rhombicuboctahedron", w2[3/2, 4, 2]}, {"small rhombihexahedron", w3[3/2, 2, 4]}, {"stellated truncated hexahedron", w2[2, 3, 4/3]}, {"great truncated cuboctahedron", w3[4/3, 2, 3]}, {"great rhombihexahedron", w3[4/3, 3/2, 2]}, {"icosahedron", w1[5, 2, 3]}, {"dodecahedron", w1[3, 2, 5]}, {"icosidodecahedron", w1[2, 3, 5]}, {"truncated icosahedron", w2[2, 5, 3]}, {"truncated dodecahedron", w2[2, 3, 5]}, {"rhombicosidodecahedron", w2[3, 5, 2]}, {"truncated icosidodechedon", w3[2, 3, 5]}, {"snub dodecahedron", w0[2, 3, 5]}, {"small ditrigonal icosidodecahedron", w1[3, 5/2, 3]}, {"small icosicosidodecahedron", w2[5/2, 3, 3]}, {"small snub icosicosidodecahedron", w0[5/2, 3, 3]}, {"small dodecicosidodecahedron", w2[3/2, 5, 5]}, {"small stellated dodecahedron", w1[5, 2, 5/2]}, {"great dodecahedron", w1[5/2, 2, 5]}, {"dodecadodecahedron", w1[2, 5/2, 5]}, {"truncated great dodecahedron", w2[2, 5/2, 5]}, {"rhombidodecadodecahedron", w2[5/2, 5, 2]}, {"small rhombidodecahedron", w3[2, 5/2, 5]}, {"snub dodecadodecahedron", w0[2, 5/2, 5]}, {"ditrigonal dodecadodecahedron", w1[3, 5/3, 5]}, {"great ditrigonal dodecicosidodecahedron", w2[3, 5, 5/3]}, {"small ditrigonal dodecicosidodecahedron", w2[5/3, 3, 5]}, {"icosidodecadodecahedron", w2[5/3, 5, 3]}, {"icositruncated dodecadodecahedron", w3[5/3, 3, 5]}, {"snub icosidodecadodecahedron", w0[5/3, 3, 5]}, {"great ditrigonal icosidodecahedron", w1[3/2, 3, 5]}, {"great icosicosidodecahedron", w2[3/2, 5, 3]}, {"small icosihemidodecahedron", w2[3/2, 3, 5]}, {"small dodecicosahedron", w3[3/2, 3, 5]}, {"small dodecahemidodecahedron", w2[5/4, 5, 5]}, {"great stellated dodecahedron", w1[3, 2, 5/2]}, {"great icosahedron", w1[5/2, 2, 3]}, {"great icosidodecahedron", w1[2, 5/2, 3]}, {"great truncated icosahedron", w2[2, 5/2, 3]}, {"rhombicosahedron", w3[2, 5/2, 3]}, {"great snub icosidodecahedron", w0[2, 5/2, 3]}, {"small stellated truncated dodecahedron", w2[2, 5, 5/3]}, {"truncated dodecadodecahedron", w3[5/3, 2, 5]}, {"inverted snub dodecadodecahedron", w0[5/3, 2, 5]}, {"great dodecicosidodecahedron", w2[5/2, 3, 5/3]}, {"small dodecahemicosahedron", w2[5/3, 5/2, 3]}, {"great dodecicosahedron", w3[5/3, 5/2, 3]}, {"great snub dodecicosidodecahedron", w0[5/3, 5/2, 3]}, {"great dodecahemicosahedron", w2[5/4, 5, 3]}, {"great stellated truncated dodecahedron", w2[2, 3, 5/3]}, {"great rhombicosidodecahedron", w2[5/3, 3, 2]}, {"great truncated icosidodecahedron", w3[5/3, 2, 3]}, {"great inverted snub icosidodecahedron", w0[5/3, 2, 3]}, {"great dodecahemidodecahedron", w2[5/3, 5/2, 5/3]}, {"great icosihemidodecahedron", w2[3/2, 3, 5/3]}, {"small retrosnub icosicosidodecahedron", w0[3/2, 3/2, 5/2]}, {"great rhombidodecahedron", w3[3/2, 5/3, 2]}, {"great retrosnub icosidodecahedron", w0[3/2, 5/3, 2]}, {"great dirhombicosidodecahedron", w0[3/2, 5/3, 3, 5/2]}, {"pentagonal prism", w2[2, 5, 2]}, {"pentagonal antiprism", w0[2, 2, 5]}, {"pentagrammic prism", w2[2, 5/2, 2]}, {"pentagrammic antiprism", w0[2, 2, 5/2]}, {"pentagrammic crossed antiprism", w0[2, 2, 5/3]} }; NumberedPolyhedron[n_Integer] /; 1 <= n <= Length[standard] := MakeUniform[ standard[[n, 2]] ] (* graphics with plot label *) ShowPolyhedron[n_, opts___] /; 1 <= n <= Length[standard] := Module[{poly, name, conf, wyt}, poly = NumberedPolyhedron[n]; name = standard[[n, 1]]; conf = VertexConfiguration[poly]; wyt = Wythoff[poly]; Show[ Graphics3D[poly, PlotLabel->ToString[StringForm["`1`: `2`\n", n, name]] <> ToString[StringForm["(`1`) `2`", wyt, InputForm /@ conf]] ], opts] ]