Polyhedral Map and Group Representations

Author

Ed Pegg
Wolfram Research, Inc.
Mar 14, 2002

Init

The following package is available at http://mathworld.wolfram.com/packages/PolyhedronOperations.m .

<< PolyhedronOperations`

The following package is available at http://mathworld.wolfram.com/packages/ConvexHull.m .

<< ConvexHull`

Making the Tetrahedral Group

The tetrahedral group is the rotations of an tetrahedron, so it's natural to form it from that.

verts  =  {{1, 1, 1}, {1, -1, -1}, {-1, 
            1, -1}, {-1, -1, 1}};
tris  =  {{1, 2, 3}, {1, 2, 4}, {1, 3, 4}, {2, 3, 
            4}};
face[a_List]  :=  {verts[[a[[1]]]], 
          verts[[a[[2]]]], 
          verts[[a[[3]]]]};
tri1  =  
        Inverse[face[tris[[1]]]] // 
          FullSimplify;
triAll  =  
        Flatten[Map[Permutations, tris], 1];
tetrahalf = 
        Map[Last, 
          Drop[Sort[
              Table[With[{temp = 
FullSimplify[
                        tri1  .  face[triAll[[qq]]]]}, {Det[temp], 
                    temp}], {qq, 1, 24}]], 12]];
tetra = Join[tetrahalf, -tetrahalf];

Making the Octahedral Group

The octahedral group is the rotations of an octahedron, so it's natural to form it from that.

verts  =  {{1, 0, 0}, {-1, 0, 0}, {0, 1, 0}, {0, -1, 
            0}, {0, 0, 1}, {0, 0, -1}};
tris  =  {{1, 3, 5}, {1, 3, 6}, {1, 4, 5}, {1, 4, 6}, {2, 3, 
            5}, {2, 3, 6}, {2, 4, 5}, {2, 4, 
            6}};
face[a_List]  :=  {verts[[a[[1]]]], 
          verts[[a[[2]]]], 
          verts[[a[[3]]]]};
tri1  =  
        Inverse[face[tris[[1]]]] // 
          FullSimplify;
triAll  =  
        Flatten[Map[Permutations, tris], 1];
octahalf = 
        Map[Last, 
          Drop[Sort[
              Table[With[{temp = 
FullSimplify[
                        tri1  .  face[triAll[[qq]]]]}, {Det[temp], 
                    temp}], {qq, 1, 48}]], 24]];
octa = Join[octahalf, -octahalf];

Making the Icosahedral Group

The icosahedral group is the rotations of an icosahedron, so it's natural to form it from that.

τ=(1 + Sqrt[5])/2;
verts = {{0,τ,1},{0,τ,-1},{0,-τ,1},{0,-τ,-1},{1,0,τ},{-1,0,τ},{1,0,-τ},{-1,0,-τ},{τ,1,0},{τ,-1,0},{-τ,1,0},{-τ,-1,0}};
tris  =  {{1, 2, 9}, {1, 2, 11}, {1, 
            5, 9}, {1, 5, 6}, {1, 6, 11}, {2, 7, 9}, {2, 8, 11}, {5, 9, 
            10}, {3, 5, 6}, {6, 11, 12}, {7, 9, 10}, {2, 7, 8},  {8, 11, 
            12}, {3, 5, 10},  {3, 6, 12},  {4, 7, 10}, {4, 7, 8},  {4, 8, 
            12}, {3, 4, 10}, {3, 4, 12}};
face[
          a_List]  :=  {verts[[a[[1]]]], verts[[a[[2]]]], 
          verts[[a[[3]]]]};
tri1  =  
        Inverse[face[tris[[1]]]] // 
          FullSimplify;
triAll  =  
        Flatten[Map[Permutations, tris], 
          1];
icoshalf = 
        Map[Last, 
          Drop[Sort[
              Table[With[{temp = 
FullSimplify[
                        tri1  .  face[triAll[[qq]]]]}, {Det[temp], 
                    temp}], {qq, 1, 120}]], 
            60]];
icos = 
        Join[icoshalf, -icoshalf];

What I call "icoshalf" is isomorphic to A5, the alternating group of order 60.  It is called the Icosahedral Group, or I. The full "icos" is of order 120.
 Handily, the vertices of the Small Rhombidodecahedron can be represented as I ∘{1, 2, τ}.

Archimedean Polyhedra in Single Vector Form

Vectors for the Tetrahedral Group polyhedra.

TruncatedTetrahedronVector = {1, 1, 
          3};
TetrahedronVector = {1, 1, 
          1};
IcosahedronVector={1,0,τ};
OctahedronVector = {1, 0, 
          0};
CuboctahedronVector = {1, 0, 
          1};

Vectors for the Octahedral Group polyhedra.

CubeVector = {1, 1, 1};
OctahedronVector = {1, 0, 0};
CuboctahedronVector = {1, 0, 1};
TruncatedOctahedronVector = {1,  0,  
          2};
TruncatedCubeVector = {1, 1, (Sqrt[2]) - 1};
SmallRhombicuboctahedronVector = {1, 1, (Sqrt[2]) + 1};
SnubCube = {1, Root[-1 + #1 + #(1^2) + #(1^3) &, 1], 
          Root[-1 + 3 #1 + #(1^2) + #(1^3) &, 
            1]};
GreatRhombicuboctahedronVector = {1, 3 - (Sqrt[2]), (Sqrt[2]) - 1};

Vectors for the Icosahedral Group polyhedra.

DodecahedronVector = {1, 1, 1};
IcosahedronVector={1,0,τ};
IcosidodecahedronVector = {1, 0, 
          0};
TruncatedDodecahedronVector={1,2,2-τ};
TruncatedIcosahedronVector={1, 0, 3 τ};
SmallRhombicosidodecahedronVector={1,2,τ};
SnubDodecahedronVector = {1, 
          Root[-1 - 7 #1 - 14 #(1^2) - 9 #(1^3) - 7 #(1^4) + 
                6 #(1^5) + #(1^6) &, 4], 
          Root[-1 + #1 + 2 #(1^2) + #(1^3) - #(1^4) - 2 #(1^5) + #(1^6) &, 
            4]};
GreatRhombicosidodecahedronVector={1,1,4τ+1};

Map[
        Show[With[{vec = #}, 
              Graphics3D[
                ConvexHull3D[
                  Union[Table[Simplify[octa[[n]] . vec], {n, 1, 24}]]], 
                Boxed ->  False]]] &, {CubeVector,  
          OctahedronVector,  CuboctahedronVector,  
          TruncatedOctahedronVector,  TruncatedCubeVector,  
          SmallRhombicuboctahedronVector,  SnubCube}];

Map[
        Show[With[{vec = #}, 
              Graphics3D[
                ConvexHull3D[
                  Union[Table[Simplify[icos[[n]] . vec], {n, 1, 60}]]], 
                Boxed ->  False]]] &, {DodecahedronVector, 
          IcosahedronVector,  IcosidodecahedronVector,  
          TruncatedDodecahedronVector,  TruncatedIcosahedronVector,  
          SmallRhombicosidodecahedronVector, 
          SnubDodecahedronVector}];

The Polyhedral Map (Icosahedral only)

Note:  The Great Rhombi points belong exclusively to order 120, while the Snub Dodec belongs to order 60.  The rest can be made via both orders, due to mirror symmetry.

Stored points -- Initialize

smallrhombipoints

smallrhombipoints  =  
        Map[Point[Reverse[Drop[N[#], 1]]] &, {{1, -2, 
              (1/2) (-1 - (Sqrt[5]))}, {1, -2, 
              (1/2) (1 + (Sqrt[5]))}, {1, -1, -2 - (Sqrt[5])}, {1, -1, 
              2 + (Sqrt[5])}, {1, 0, (1/10) (-5 - (Sqrt[5]))}, {1, 0, 
              (1/10) (5 + (Sqrt[5]))}, {1, 1, -2 - (Sqrt[5])}, {1, 1, 
              2 + (Sqrt[5])}, {1, 2, (1/2) (-1 - (Sqrt[5]))}, {1, 2, 
              (1/2) (1 + (Sqrt[5]))}, {1, -2 - (Sqrt[5]), -1}, {1, -2 - (Sqrt[5]), 1}, {1, (1/4) (-1 - (Sqrt[5])), -(1/2)}, {1, 
              (1/4) (-1 - (Sqrt[5])), (1/2)}, {1, 2 - (Sqrt[5]), 2 - (Sqrt[5])}, {1, 
              2 - (Sqrt[5]), -2 + (Sqrt[5])}, {1, (1/2) (5 - (Sqrt[5])), 0}, {1, 
              (1/2) (-5 + (Sqrt[5])), 0}, {1, -2 + (Sqrt[5]), 
              2 - (Sqrt[5])}, {1, -2 + (Sqrt[5]), -2 + (Sqrt[5])}, {1, 
              (1/2) (-1 + (Sqrt[5])), 1 - (Sqrt[5])}, {1, 
              (1/2) (-1 + (Sqrt[5])), -1 + (Sqrt[5])}, {1, -(2/(1 + (Sqrt[5]))), 1 - (Sqrt[5])}, {1, -(2/(1 + (Sqrt[5]))), -1 + (Sqrt[5])}, {1, 
              (1/4) (1 + (Sqrt[5])), -(1/2)}, {1, (1/4) (1 + (Sqrt[5])), 
              (1/2)}, {1, 2 + (Sqrt[5]), -1}, {1, 2 + (Sqrt[5]), 1}}];

truncdodecpoints

truncdodecpoints  =  
        Map[Point[Reverse[Drop[N[#], 1]]] &, {{1, -2, 
              (1/2) (3 - (Sqrt[5]))}, {1, -2, 
              (1/2) (-3 + (Sqrt[5]))}, {1, 0, (1/10) (5 - 3 (Sqrt[5]))}, {1, 
              0, (1/10) (-5 + 3 (Sqrt[5]))}, {1, 2, 
              (1/2) (3 - (Sqrt[5]))}, {1, 2, (1/2) (-3 + (Sqrt[5]))}, {1, 
              (1/2) (-5 - 3 (Sqrt[5])), 0}, {1, (1/4) (-3 - (Sqrt[5])), 
              (1/4) (-1 - (Sqrt[5]))}, {1, (1/4) (-3 - (Sqrt[5])), 
              (1/4) (1 + (Sqrt[5]))}, {1, 
              (1/2) (-3 - (Sqrt[5])), -3 - (Sqrt[5])}, {1, 
              (1/2) (-3 - (Sqrt[5])), 3 + (Sqrt[5])}, {1, (1/2) (1 - (Sqrt[5])), 
              3 - (Sqrt[5])}, {1, (1/2) (1 - (Sqrt[5])), -3 + (Sqrt[5])}, {1, 1 - (Sqrt[5]), 
              (1/2) (-1 - (Sqrt[5]))}, {1, 1 - (Sqrt[5]), 
              (1/2) (1 + (Sqrt[5]))}, {1, 
              (1/4) (3 - (Sqrt[5])), -(1/2)}, {1, (1/4) (3 - (Sqrt[5])), 
              (1/2)}, {1, (1/4) (-3 + (Sqrt[5])), -(1/2)}, {1, 
              (1/4) (-3 + (Sqrt[5])), (1/2)}, {1, (1/2) (-1 + (Sqrt[5])), 
              3 - (Sqrt[5])}, {1, 
              (1/2) (-1 + (Sqrt[5])), -3 + (Sqrt[5])}, {1, -1 + (Sqrt[5]), 
              (1/2) (-1 - (Sqrt[5]))}, {1, -1 + (Sqrt[5]), 
              (1/2) (1 + (Sqrt[5]))}, {1, (1/4) (3 + (Sqrt[5])), 
              (1/4) (-1 - (Sqrt[5]))}, {1, (1/4) (3 + (Sqrt[5])), 
              (1/4) (1 + (Sqrt[5]))}, {1, 
              (1/2) (3 + (Sqrt[5])), -3 - (Sqrt[5])}, {1, (1/2) (3 + (Sqrt[5])), 
              3 + (Sqrt[5])}, {1, (1/2) (5 + 3 (Sqrt[5])), 0}}];

truncicospointspoints

truncicospoints  =  
        Map[Point[Reverse[Drop[N[#], 1]]] &, {{1, 
              0, -(3/2) (1 + (Sqrt[5]))}, {1, 0, 
              (3/2) (1 + (Sqrt[5]))}, {1, -((Sqrt[5])/2), -(1/(1 + (Sqrt[5])))}, {1, -((Sqrt[5])/2), 
              (1/(1 + (Sqrt[5])))}, {1, ((Sqrt[5])/2), -(1/(1 + (Sqrt[5])))}, {1, ((Sqrt[5])/2), (1/(1 + (Sqrt[5])))}, {1, 4 - 2 (Sqrt[5]), (1/2) (3 - (Sqrt[5]))}, {1, 
              4 - 2 (Sqrt[5]), (1/2) (-3 + (Sqrt[5]))}, {1, 
              (1/2) (-3 - (Sqrt[5])), 1 - (Sqrt[5])}, {1, 
              (1/2) (-3 - (Sqrt[5])), -1 + (Sqrt[5])}, {1, 
              (1/4) (-1 - (Sqrt[5])), -1 - ((Sqrt[5])/2)}, {1, 
              (1/4) (-1 - (Sqrt[5])), 
              (1/2) (2 + (Sqrt[5]))}, {1, -1 - (Sqrt[5]), 
              (1/2) (-5 - (Sqrt[5]))}, {1, -1 - (Sqrt[5]), 
              (1/2) (5 + (Sqrt[5]))}, {1, (1/6) (1 - (Sqrt[5])), 0}, {1, 
              (1/10) (-5 + (Sqrt[5])), -(2/(Sqrt[5]))}, {1, 
              (1/10) (-5 + (Sqrt[5])), (2/(Sqrt[5]))}, {1, 2 (-2 + (Sqrt[5])), 
              (1/2) (3 - (Sqrt[5]))}, {1, 2 (-2 + (Sqrt[5])), 
              (1/2) (-3 + (Sqrt[5]))}, {1, (1/6) (-1 + (Sqrt[5])), 
              0}, {1, (1/4) (1 + (Sqrt[5])), -1 - ((Sqrt[5])/2)}, {1, 
              (1/4) (1 + (Sqrt[5])), (1/2) (2 + (Sqrt[5]))}, {1, 1 + (Sqrt[5]), 
              (1/2) (-5 - (Sqrt[5]))}, {1, 1 + (Sqrt[5]), 
              (1/2) (5 + (Sqrt[5]))}, {1, (1/2) (3 + (Sqrt[5])), 1 - (Sqrt[5])}, {1, 
              (1/2) (3 + (Sqrt[5])), -1 + (Sqrt[5])}, {1, 
              (2/(5 + (Sqrt[5]))), -(2/(Sqrt[5]))}, {1, (2/(5 + (Sqrt[5]))), 
              (2/(Sqrt[5]))}}];

icospoints

icospoints  =  
        Map[Point[Reverse[Drop[N[#], 1]]] &, {{1, 0, 
              (1/2) (-1 - (Sqrt[5]))}, {1, 0, (1/2) (1 + (Sqrt[5]))}, {1, 
              (1/2) (-1 + (Sqrt[5])), 0}, {1, -(2/(1 + (Sqrt[5]))), 
              0}}];

dodecpoints

dodecpoints  =  
        Map[Point[
              Reverse[Drop[N[#], 1]]] &, {{1, -1, -1}, {1, -1, 
              1}, {1, 0, (1/2) (-3 + (Sqrt[5]))}, {1, 0, 
              (2/(3 + (Sqrt[5])))}, {1, 1, -1}, {1, 1, 1}, {1, 
              (1/2) (-3 - (Sqrt[5])), 0}, {1, (1/2) (3 + (Sqrt[5])), 
              0}}];

icosidodecpoints

icosidodecpoints  =  
        Map[Point[Reverse[Drop[N[#], 1]]] &, {{1, 0, 0}, {1, 
              (1/2) (-1 - (Sqrt[5])), (1/2) (1 - (Sqrt[5]))}, {1, 
              (1/2) (-1 - (Sqrt[5])), (1/2) (-1 + (Sqrt[5]))}, {1, 
              (1/2) (3 - (Sqrt[5])), (1/2) (-1 + (Sqrt[5]))}, {1, 
              (1/2) (3 - (Sqrt[5])), -(2/(1 + (Sqrt[5])))}, {1, 
              (1/2) (-3 + (Sqrt[5])), (1/2) (-1 + (Sqrt[5]))}, {1, 
              (1/2) (-3 + (Sqrt[5])), -(2/(1 + (Sqrt[5])))}, {1, -(2/(-1 + (Sqrt[5]))), 
              (1/2) (-3 - (Sqrt[5]))}, {1, -(2/(-1 + (Sqrt[5]))), 
              (1/2) (3 + (Sqrt[5]))}, {1, (1/2) (1 + (Sqrt[5])), 
              (1/2) (-3 - (Sqrt[5]))}, {1, (1/2) (1 + (Sqrt[5])), 
              (1/2) (1 - (Sqrt[5]))}, {1, (1/2) (1 + (Sqrt[5])), 
              (1/2) (-1 + (Sqrt[5]))}, {1, (1/2) (1 + (Sqrt[5])), 
              (1/2) (3 + (Sqrt[5]))}}];

snubpoints

snubpoints  =  
        Map[Point[
              Reverse[#]] &, {{-6.4776802711860215`, -9.052583563992227`}, {-6.4776802711860215`, 
              9.052583563992227`}, {-6.33702206429486`, -1.1326619649523855`}, {-6.33702206429486`, 
              1.1326619649523855`}, {-3.0758132241962675`, -0.882875942640166`}, {-3.0758132241962675`, 
              0.882875942640166`}, {-1.996366886208322`, -1.9431512592438818`}, {-1.996366886208322`, 
              1.9431512592438818`}, {-1.9431512592438818`, -1.3015831209626594`}, {-1.9431512592438818`, 
              1.3015831209626594`}, {-1.3975039188426566`, -0.15437625170359118`}, {-1.3975039188426566`, 
              0.15437625170359118`}, {-1.1326619649523855`, -3.483856650344676`}, {-1.1326619649523855`, 
              3.483856650344676`}, {-0.9733437639483633`, -0.5009099313900609`}, {-0.9733437639483633`, 
              0.5009099313900609`}, {-0.882875942640166`, -5.594804328545855`}, {-0.882875942640166`, 
              5.594804328545855`}, {-0.7682951506473082`, -1.4929136894512849`}, {-0.7682951506473082`, 
              1.4929136894512849`}, {-0.6698310874003349`, -0.5146279762024906`}, {-0.6698310874003349`, 
              0.5146279762024906`}, {-0.5146279762024906`, -1.0273862504070566`}, {-0.5146279762024906`, 
              1.0273862504070566`}, {-0.28703821665597656`, -0.325117270493987`}, {-0.28703821665597656`, 
              0.325117270493987`}, {-0.17873726072917187`, -0.15780282755118874`}, {-0.17873726072917187`, 
              0.15780282755118874`}, {-0.11046570218668003`, -0.7155614996973678`}, {-0.11046570218668003`, 
              0.7155614996973678`}, {0.11046570218668003`, -0.7155614996973678`}, {0.11046570218668003`, 
              0.7155614996973678`}, {0.17873726072917187`, -0.15780282755118874`}, {0.17873726072917187`, 
              0.15780282755118874`}, {0.28703821665597656`, -0.325117270493987`}, {0.28703821665597656`, 
              
              0.325117270493987`}, {0.5146279762024906`, -1.0273862504070566`}, {0.5146279762024906`, 
              1.0273862504070566`}, {0.6698310874003349`, -0.5146279762024906`}, {0.6698310874003349`, 
              0.5146279762024906`}, {0.7682951506473082`, -1.4929136894512849`}, {0.7682951506473082`, 
              1.4929136894512849`}, {0.882875942640166`, -5.594804328545855`}, {0.882875942640166`, 
              5.594804328545855`}, {0.9733437639483633`, -0.5009099313900609`}, {0.9733437639483633`, 
              0.5009099313900609`}, {1.1326619649523855`, -3.483856650344676`}, {1.1326619649523855`, 
              3.483856650344676`}, {1.3975039188426566`, -0.15437625170359118`}, {1.3975039188426566`, 
              0.15437625170359118`}, {1.9431512592438818`, -1.3015831209626594`}, {1.9431512592438818`, 
              1.3015831209626594`}, {1.996366886208322`, -1.9431512592438818`}, {1.996366886208322`, 
              1.9431512592438818`}, {3.0758132241962675`, -0.882875942640166`}, {3.0758132241962675`, 
              0.882875942640166`}, {6.33702206429486`, -1.1326619649523855`}, {6.33702206429486`, 
              1.1326619649523855`}, {6.4776802711860215`, -9.052583563992227`}, {6.4776802711860215`, 
              9.052583563992227`}}];

greatrhombipoints

greatrhombipoints  =  
        Map[Point[
              Reverse[Drop[N[#], 
                  1]]] &, With[{jj  =  icos  . 
                          GreatRhombicosidodecahedronVector // 
                        FullSimplify // Union}, 
                Table[jj[[n]]/First[jj[[n]]], {n, 1, Length[jj]}]] // 
              FullSimplify // Union];

Picture

Show[
        Graphics[{ AbsolutePointSize[1], snubpoints, greatrhombipoints,  
            icosidodecpoints, dodecpoints, icospoints,  truncdodecpoints,  
            truncicospoints, smallrhombipoints}], 
        AspectRatio -> Automatic, PlotRange -> All];

It's easy to make more complex objects via groups.  For example, the inverse of the Great Rhombicosidodeahedron is comprised of 120 identical triangles.  By using the vertices of just one triangle, the full figure can be made.

120 Triangles

HexakisIcosahedronTriangle = {{0, (Sqrt[(1/10) (5 + (Sqrt[5]))]), (Sqrt[(1/10) (5 - (Sqrt[5]))])}, {0, 1, 
            0}, {(Sqrt[(1/6) (3 - (Sqrt[5]))]), (Sqrt[(1/6) (3 + (Sqrt[5]))]), 
            0}};

To see the full object, evaluate n from 1 to 120.

Show[
        Graphics3D[
          Table[Polygon[
              Simplify[HexakisIcosahedronTriangle . icos[[n]]]], {n, 1, 
              60}], Boxed ->  False]];