ROTATIONS OF 
THE CUBE

Programming

Off[General::"spell1"]

DualVertices[polyhedron_] :=Module[{vertices,faces,edges,k},
vertices = Vertices[polyhedron];
faces = Faces[polyhedron];
edges = Edges[polyhedron];
k = Length[faces[[1]]];
Apply[Plus, vertices[[#]]& /@ faces,1]/k
]


DualFace[v0_,polyhedron] := Module[{vertices, faces,tempfacelist,newface,facelist,newvertex},
vertices= Vertices[polyhedron];
faces = Faces[polyhedron];
(*Make a list of all faces containing the given vertex v0*)
tempfacelist = Select[faces, MemberQ[#,v0]&];
(*Select the first face from this list*)
newface = tempfacelist[[1]];
facelist = {newface};
tempfacelist = Complement[tempfacelist, facelist];
(*the selected face is an ordered list of vertices containing 
v0; get a vertex which shares an edge with v0,
by rotating v0  into the first position and 
then taking the vertex in position 2*)
newvertex = RotateLeft[newface,Position[newface,v0][[1,1]]-1][[2]];
While[tempfacelist !={}, 
newface = Select[tempfacelist, (MemberQ[#,v0] && MemberQ[#,newvertex])&][[1]];
facelist = Append[facelist,newface];
tempfacelist = Complement[tempfacelist,facelist];
newvertex = Module[{},
rotate = RotateLeft[newface,Position[newface,v0][[1,1]]-1];
If[rotate[[2]]!=newvertex,rotate[[2]], rotate[[Length[rotate]]]]
];
];
Position[faces, #][[1,1]]& /@ facelist
]

DualFaces[polyhedron_] :=Module[{vertices,faces},
vertices = Vertices[polyhedron];
faces = Faces[polyhedron];
Table[DualFace[i,polyhedron], {i,Length[vertices]}]
]

DualEdges[polyhedron_] :=Module[{vertices,faces,edges,k,
facesIncidentOn},
vertices = Vertices[polyhedron];
faces = Faces[polyhedron];
edges = Edges[polyhedron];
k = Length[faces[[1]]];
facesIncidentOn[edge_] :=
Select[faces,(MemberQ[#,edge[[1]]] && MemberQ[#,edge[[2]]])&] /; ListQ[edge];
DualEdge[edge_] := 
Position[faces, #][[1,1]] & /@ facesIncidentOn[edge];
Map[DualEdge, edges]
]


Cube/: Faces[Cube] := 
{{1, 2, 3, 4}, {1, 4, 6, 7}, {1, 7, 8, 2},
      {2, 8, 5, 3}, {5, 8, 7, 6}, {3, 5, 6, 4}};
Cube/: Vertices[Cube] := 
{{1, 1, 1}, {-1, 1, 1}, {-1, -1, 1}, {1, -1, 1},
      {-1, -1, -1}, {1, -1, -1}, {1, 1, -1}, {-1, 1, -1}};
Cube/: Edges[Cube] =
{{1,2}, {2,3}, {3,4}, {1,4}, {4,6}, {6,7}, {1,7},
{7,8},{2,8}, {5,8},{3,5},{5,6}};
Cube /: TripleAxes[Cube] ={{1,5},{2,6},{3,7}, {4,8}};

cubeDiagonals[color_] := Module[{lines,vertices},
lines = TripleAxes[Cube];
vertices = Vertices[Cube];
lines = Line /@ (vertices[[#]]&)/@ lines;
Graphics3D[{Thickness[.005],color,lines}]
]

cubeDiagonalAxis[color_] := Module[{lines,vertices},
lines = {{1,5}};
vertices = 1.5*Vertices[Cube];
lines = Line /@ (vertices[[#]]&)/@ lines;
Graphics3D[{Thickness[.005],color,lines}]
]

cubeFaceCenterAxis[color_] := Module[{vertices},
facecenters = {{1,0,0}, {-1,0,0}};
vertices = 1.8*facecenters;
origin = {0,0,0};
lines = Line  /@ ({origin,#}& /@ vertices);
points = Point /@ facecenters;
Graphics3D[{{Thickness[.005],color,lines},
{PointSize[.02],black, points}}]
]

cubeEdgeCenterAxis[color_] := Module[
{edges, vertices, edgeCenters, points,line},
edges = {{1,7}, {3,5}};
vertices = Vertices[Cube];
edges = vertices[[#]]& /@ edges;
edgeCenters  = Apply[Plus, edges,1]/2;
points = Point /@ edgeCenters;
line = Apply[Line , {1.8*edgeCenters}];
Graphics3D[{{Thickness[.005],color,line},
{PointSize[.02],black, points}}]
]

Octahedron /: Faces[Octahedron] =
     {{1, 2, 3}, {1, 3, 5}, {1, 5, 6}, {1, 6, 2},
      {2, 6, 4}, {2, 4, 3}, {4, 6, 5}, {3, 4, 5}};

Octahedron /: Vertices[Octahedron] = 
     {{0, 0, 1}, {1, 0, 0}, {0, 1, 0},
      {0, 0, -1}, {-1, 0, 0}, {0, -1, 0}};
      
Octahedron /: Edges[Octahedron] = 
{{1,2},{1,3},{1,5},{1,6}, {4,2}, {4,3}, {4,5}, 
{4,6}, {2,3}, {3,5}, {5,6}, {2,6}};

Tetrahedron /: Faces[Tetrahedron] =
     {{1, 2, 3}, {1, 3, 4}, {1, 4, 2}, {2, 4, 3}};
     
Tetrahedron /: Edges[Tetrahedron] = {{1,2}, {1,3}, {1,4},
{2,3}, {2,4}, {3,4}};

Tetrahedron /: Vertices[Tetrahedron] = N[
     {{0, 0, 3^(1/2)}, {0, (2*2^(1/2)*3^(1/2))/3, -3^(1/2)/3}, 
      {-2^(1/2), -(2^(1/2)*3^(1/2))/3, -3^(1/2)/3}, 
      {2^(1/2), -(2^(1/2)*3^(1/2))/3, -3^(1/2)/3}} ];
AnotherTetrahedron /: Faces[AnotherTetrahedron] =
Faces[Tetrahedron];
AnotherTetrahedron /: Edges[AnotherTetrahedron] =
Edges[Tetrahedron];

tetra3FoldAxis[color_] := Module[{vertices, facecenters, line},
vertices = Vertices[Tetrahedron];
facecenters = DualVertices[Tetrahedron];
line = Line[{1.5*vertices[[2]],3*facecenters[[2]]}];
points = Point/@ {facecenters[[2]]};
Graphics3D[{{Thickness[.005],color,line},
{PointSize[.02],black, points}}]
]

tetra2FoldAxis[color_] := Module[{edges, vertices, edgeCenters, points,line},
edges = {{1,2}, {3,4}};
vertices = Vertices[Tetrahedron];
edges = vertices[[#]]& /@ edges;
edgeCenters  = Apply[Plus, edges,1]/2;
points = Point /@ edgeCenters;
line = Apply[Line , {1.8*edgeCenters}];
Graphics3D[{{Thickness[.005],color,line},
{PointSize[.02],black, points}}]
]

red = RGBColor[.8,0,0];
blue = RGBColor[0,0,.8];
black = RGBColor[0,0,0];
green = RGBColor[0,.5,.2];

skeleton[poly_,vertexcolor_,edgecolor_] := Module[{vertices, edges,lines,points},
vertices = Vertices[poly];
edges = Edges[poly];
lines = Line /@ (vertices[[#]]&)/@ edges;
points = Point/@vertices;
Graphics3D[{{Thickness[.001],edgecolor,lines},
	{PointSize[.02],vertexcolor, points}} 
	 ]
]

surface[poly_]  :=
Module[{vertices, faces},
vertices = Vertices[poly];
faces = Faces[poly];
faces= Map[Polygon, (vertices[[#]]&)/@faces, {1}];
Graphics3D[faces]
]

Author's notice

This tutorial was written by 

Fred Goodman
Department of Mathematics
University of Iowa
Iowa City, IA 52242
goodman@math.uiowa.edu

This material may be freely copied and used for non-commercial purposes.
Please retain this author's notice, and do not distribute any altered version
of this material without the author's permission  (unless  the material is altered beyond recognition).


This material  supplements  the text  Algebra: Symmetry Groups, Rings, and Fields,
Prentice-Hall, 1997.

Axes of rotation

There are four  3-fold axes of rotation,   three  4-fold axes of rotation., and six  2-fold axes of rotation.  This gives a total of  1 + 4*2 + 3*3 + 6*1 rotations = 24 rotations.

Show[{skeleton[Cube,blue,black],cubeDiagonalAxis[red]},
Boxed->False,
ViewPoint->{0.756, -2.884, 1.600}]

Show[{skeleton[Cube,blue,black],cubeFaceCenterAxis[red]},
Boxed->False,
ViewPoint->{0.756, -2.884, 1.600}]

Show[{skeleton[Cube,blue,black],cubeEdgeCenterAxis[red]},
Boxed->False,
ViewPoint->{1.100, -2.954, 1.231}]

Cube and octahedron are dual polyhedra and have the same symmetry group.

Show[{skeleton[Cube,blue,black],
surface[Octahedron]},Boxed->False,
ViewPoint->{0.744, -3.088, 1.168}]

temp = Vertices[Octahedron];
Octahedron /: Vertices[Octahedron] = 
     3*{{0, 0, 1}, {1, 0, 0}, {0, 1, 0},
      {0, 0, -1}, {-1, 0, 0}, {0, -1, 0}};
Show[{skeleton[Octahedron,blue,black],
surface[Cube]},Boxed->False,
ViewPoint->{0.744, -3.088, 1.168}]
Octahedron /: Vertices[Octahedron] = 
     temp;

Considering the 4 diagonals of the cube shows that the rotation group is isomorphic to S_4

Rotations permute the four diagonals of the cube.  The action of the rotation group on the set of diagonals is faithful, so one has an injection of the rotation group into  S_4.  Since  the size of both groups is 24,  the rotation group is isomorphic to S_4.

Show[{skeleton[Cube,blue,black],cubeDiagonals[red]},
Boxed->False,
ViewPoint->{1.260, -2.702, 1.600}]

The rotation group of the tetrahedron is isomorphic to A_4

The tetrahedron has 4 3-fold axes of rotation through vertices and their opposite faces, and three 2-fold axes of rotation through opposite pairs of edges, giving
1 + 4*2 + 3 = 12  rotations in all.    The rotation group acts faithfully as permutations of the 4 vertices or the 4 faces, so there is an imbedding of the rotation group into S_4.   One can check that the image in S_4 consists of  the identity,  3-cycles, and products of two 2-cycles; that is the image is A_4.

Show[{skeleton[Tetrahedron,blue,black],
tetra3FoldAxis[red]},
Boxed->False,
ViewPoint->{2.572, -2.056, 0.779}]

Show[{skeleton[Tetrahedron,blue,black],
tetra2FoldAxis[red]},
Boxed->False,
ViewPoint->{2.572, -2.056, 0.779}]

The rotation group of the tetrahedron and that of the cube.

temp = Vertices[Tetrahedron];
Tetrahedron /: Vertices[Tetrahedron] = 
(Vertices[Cube][[#]]&)/@{2,4,5,7};
AnotherTetrahedron /:  Vertices[AnotherTetrahedron] =
(Vertices[Cube][[#]]&)/@{1,3,6,8};

Show[{skeleton[Cube,blue,black],surface[Tetrahedron],
cubeDiagonals[black]},
Boxed->False,
ViewPoint->{1.260, -2.702, 1.600}]

The inclusion of the tetrahedron in the cube also gives an inclusion of 
the rotation group   of the tetrahedron as a (normal) subgroup   N  of index 2 of the rotation group of the cube .

Show[{skeleton[Cube,blue,black],surface[Tetrahedron],
surface[AnotherTetrahedron],
cubeDiagonals[black]},
Boxed->False,
ViewPoint->{1.260, -2.702, 1.600}]
Tetrahedron /: Vertices[Tetrahedron] = temp;

Elements in the non-trivial coset of  N  interchange  two complementary 
tetrahedra imbedded in the cube.

The intersection of the two tetrahedra is the inscribed octahedron, whose vertices are at the midpoints of the faces of the cube.

The union of the two tetrahedra has the same symmetry group as the cube or
the octahedron.  It can be viewed as a stellated octahedron:  eight  small regular tetrahedra are glued on the faces of the octahedron.