SYMMETRIES OF THE DODECAHEDRON

Programming

\(\(
Needs["GLExplorer`GLRenderer`"]
\)\)

Programming for dual polyhedra

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

DualFace[v0_, polyhedron_] := 
      Module[{vertices, faces, tempfacelist, newface, facelist, newvertex}, 
        vertices = Vertices[polyhedron]; faces = Faces[polyhedron]; 
        tempfacelist = Select[faces, MemberQ[#1, v0]&]; 
        newface = tempfacelist[[1]]; 
        facelist = {newface}; 
        tempfacelist = Complement[tempfacelist, facelist]; 
        newvertex = 
          RotateLeft[newface, 
              Position[newface, v0][[1, 1
                  ]] - 1][[2
            ]]; 
        While[tempfacelist ≠ {}, 
          newface = 
            Select[tempfacelist, MemberQ[#1, v0] && MemberQ[#1, 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, 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[#1, edge[[1]]] && 
                  MemberQ[#1, 
                    edge[[2]]]&] /; 
            ListQ[edge]; 
        DualEdge[edge_] := 
          (Position[faces, #1][[1, 1
                  ]]&)/@facesIncidentOn[edge]; 
        DualEdge/@edges]

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

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

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

\(surface[poly_] := 
      Module[{vertices, faces, polylist}, vertices = Vertices[poly]; 
        faces = Faces[poly]; 
				
        polylist = 
          Map[Polygon, 
            \((vertices[[#1]]&)\)/@
              faces, {1}]; Graphics3D[polylist]]
\)\(polylist[poly_] := 
      Module[{vertices, faces, polylist}, vertices = Vertices[poly]; 
        faces = Faces[poly]; 
				
        polylist = 
          Map[Polygon, 
            \((vertices[[#1]]&)\)/@
              faces, {1}]; polylist]
\)faceToEdges[face_] := 
      Module[{edgelist, n, i}, edgelist = {}; n = Length[face]; 
        For[i = 1, i < n, i++, 
          edgelist = 
            Append[edgelist, 
              If[face[[i]] < 
                  face[[i + 1]], {
                  face[[i]], 
                  face[[i + 1]]}, {
                  face[[i + 1]], 
                  face[[i]]}]]]; 
        edgelist = 
          Append[edgelist, 
            If[face[[1]] < 
                face[[n]], {
                face[[1]], 
                face[[n]]}, {
                face[[n]], 
                face[[1]]}]]]

edgeCenters[polyhedron_] := 
      Module[{vertices, faces, edges}, vertices = Vertices[polyhedron]; 
        faces = Faces[polyhedron]; edges = Edges[polyhedron]; 
        (1/2) Apply[Plus, 
            (vertices[[#1]]&)/@
              edges, 1]]

Norm[vector_] := (Sqrt[Plus])@@(#(1^2)&)/@vector

Data for icosahedron, dodecahedron

Hexahedron /: 
      Faces[Hexahedron] = {{1, 2, 3, 4}, {1, 4, 6, 7}, {1, 7, 8, 2}, {2, 8, 
          5, 3}, {5, 8, 7, 6}, {3, 5, 6, 4}}; Hexahedron /: 
      Vertices[Hexahedron] = {{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 /: Faces[Cube] := Faces[Hexahedron]Cube /: Vertices[Cube] := Vertices[Hexahedron]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}}; SphericalToCartesian[{theta_, phi_}] := {Sin[theta] Cos[phi], 
        Sin[theta] Sin[phi], Cos[theta]}; Icosahedron /: 
      Faces[Icosahedron] = {{1, 3, 2}, {1, 4, 3}, {1, 5, 4}, {1, 6, 5}, {1, 
          2, 6}, {2, 3, 7}, {3, 4, 8}, {4, 5, 9}, {5, 6, 10}, {6, 2, 11}, {7, 
          3, 8}, {8, 4, 9}, {9, 5, 10}, {10, 6, 11}, {11, 2, 7}, {7, 8, 12}, {
          8, 9, 12}, {9, 10, 12}, {10, 11, 12}, {11, 7, 12}}; Icosahedron /: Vertices[Icosahedron] := 
      (Icosahedron /: Vertices[Icosahedron] = 
          N[N[SphericalToCartesian/@{{0, 0}, {ArcTan[2], 0}, {ArcTan[2], 
                      ((2 π)/5)}, {ArcTan[2], ((4 π)/5)}, {
                      ArcTan[2], ((6 π)/5)}, {ArcTan[2], 
                      ((8 π)/5)}, {π - ArcTan[2], (π/5)}, {
                      π - ArcTan[2], ((3 π)/5)}, {
                      π - ArcTan[2], ((5 π)/5)}, {
                      π - ArcTan[2], ((7 π)/5)}, {
                      π - ArcTan[2], ((9 π)/5)}, {π, 0}}/
                ((Sqrt[(1/2) + (1/2) Cos[ArcTan[2]]])), 2 Precision[1.0]]])
        ; If[! (ValueQ[Edges[Icosahedron]]), 
      Icosahedron /: Edges[Icosahedron] = 
        Union[Flatten[faceToEdges/@Faces[Icosahedron], 1]]]Dodecahedron /: Vertices[Dodecahedron] = DualVertices[Icosahedron]; 
    Dodecahedron /: Faces[Dodecahedron] := DualFaces[Icosahedron]; Dodecahedron /: Edges[Dodecahedron] = DualEdges[Icosahedron];

Some graphics programming

vertices = Vertices[Dodecahedron]; edges = Edges[Dodecahedron]; faces = Faces[Dodecahedron]; lines = 
      Line/@(vertices[[#1]]&)/@
          edges; points = Point/@vertices;

verticesAdjacent[edge_] := 
      Complement[
        Flatten[Select[edges, #1 ⋂ edge ≠ {}&], 1], 
        edge]diagonalsNear[edge_] := {
        Complement[
          Flatten[Select[edges, 
              MemberQ[#1, edge[[1]]]&]], 
          edge], Complement[
          Flatten[Select[edges, 
              MemberQ[#1, edge[[2]]]&]], 
          edge]}

specialedges = 
      (edges[[#1]]&)/@
          Flatten[Position[dotproducts, 0. ]] ⋃ 
        (edges[[#1]]&)/@
          Flatten[Position[dotproducts, Max[dotproducts]]]; specialedgecenters = 
      (1/2) Apply[Plus, 
          (vertices[[#1]]&)/@
            specialedges, 1]; origin = {0, 0, 0}; cartesianaxes = 
      Line/@({origin, #1}&)/@(1.5 specialedgecenters);

cubeedges = Flatten[diagonalsNear/@specialedges, 1]; cubelines = 
      Line/@(vertices[[#1]]&)/@
          Flatten[diagonalsNear/@specialedges, 1]; edgevectors = 
      (#1[[1]] - #1
                [[2]]&)/@
        (vertices[[#1]]&)/@edges
          ; dotproducts = 
      (edgevectors[[1]] . #1&)/@
        edgevectors;

verticesAdjacent[edge_] := 
      Complement[
        Flatten[Select[edges, #1 ⋂ edge ≠ {}&], 1], 
        edge]diagonalsNear[edge_] := {
        Complement[
          Flatten[Select[edges, 
              MemberQ[#1, edge[[1]]]&]], 
          edge], Complement[
          Flatten[Select[edges, 
              MemberQ[#1, edge[[2]]]&]], 
          edge]}

cubefaces = 
      Module[{}, 
        face[edge_] := 
          (Flatten[diagonalsNear[edge]][[#1
                  ]]&)/@{1, 2, 4, 3}; 
        (face[#1]&)/@specialedges];

InCube /: Faces[InCube] = cubefaces; InCube /: Vertices[InCube] = 1.01 vertices; InCube /: Edges[InCube] = cubeedges;

\(surfacepicture0 := 
      Show[{surface[Dodecahedron], 
          Graphics3D[{{Thickness[0.006], green, lines}, {Thickness[0.01], 
                black, cubelines}}]}, Boxed -> False, 
		
        ViewPoint -> {2.817, 1.560, 1.040}, 
	
        LightSources -> {
{{1, 0, 0}, \ RGBColor[1,  .5,  .5]}, 
            
{{0, 1, 0}, RGBColor[ .5,  .1,  .5]\ }, 
            
{{0, 0, 1}, RGBColor[ .5,  .5, 1]\ }, 
            
{{\(-1\), \(-1\), \(-1\)}, \ RGBColor[ .5, 1,  .75]}
}, \ 
        DisplayFunction\  -> \ Identity]
\)\(surfacepicture\  := \ 
      GLShow[surfacepicture0, 
		\ DisplayFunction\  -> \ $DisplayFunction]
        
\)

\(incubepicture0 := 
      Show[surface[InCube], heavyskeleton[Dodecahedron, black, black], 
        ViewPoint -> {2.817, 1.560, 1.040}, Boxed -> False, 
		
        LightSources -> {
{{1, 0, 0}, \ RGBColor[1,  .5,  .5]}, 
            
{{0, 1, 0}, RGBColor[ .5,  .1,  .5]\ }, 
            
{{0, 0, 1}, RGBColor[ .5,  .5, 1]\ }, 
            
{{\(-1\), \(-1\), \(-1\)}, \ RGBColor[ .5, 1,  .75]}
}, 
	
        DisplayFunction\  -> \ Identity]
\)\(incubepicture\  := \ 
      GLShow[incubepicture0, \ 
		\ 
        DisplayFunction\  -> \ $DisplayFunction]

\)

forwardedges = 
      Flatten[faceToEdges/@
          (faces[[#1]]&)/@{2, 3, 7}
              , 1]; forwardedges = 
      Line/@(vertices[[#1]]&)/@
          forwardedges; framepicture := 
      Show[Graphics3D[{{Thickness[ .002], blue, lines}, {Thickness[ .004], 
              black, forwardedges}, {Thickness[0.003], red, cubeedges}}], 
        ViewPoint -> {2.817, 1.560, 1.040}, Boxed -> False]edgecenterpicture := 
      Show[Graphics3D[{{Thickness[ .002], blue, lines}, {Thickness[ .004], 
              black, forwardedges}, {PointSize[ .015], red, 
              Point/@specialedgecenters}}], 
        ViewPoint -> {2.817, 1.560, 1.040}, Boxed -> False]

edgepaircenters = 
      (({#1, -#1}&)/@{
              (1/2) Plus@@
                  (vertices[[#1]]&)
                      /@edges[[1]]})
          [[1]]; origin = {0, 0, 0}; edgepairline = 
      Line/@({origin, #1}&)/@(1.5 edgepaircenters);

\(twoFoldAxisPicture0 := 
      Show[{surface[Dodecahedron], \ 
          Graphics3D[{{Thickness[ .002], blue, lines}, 

              				{PointSize[ .015], red, Point/@edgepaircenters}, {
                Thickness[ .004], red, edgepairline}}]}, 
        ViewPoint -> {2.817, 1.560, 1.040}, Boxed -> False, 
			
        LightSources -> {
{{1, 0, 0}, \ RGBColor[1,  .5,  .5]}, 
            
{{0, 1, 0}, RGBColor[ .5,  .1,  .5]\ }, 
            
{{0, 0, 1}, RGBColor[ .5,  .5, 1]\ }, 
            
{{\(-1\), \(-1\), \(-1\)}, \ RGBColor[ .5, 1,  .75]}
}, 
	
        DisplayFunction\  -> \ Identity]
\)\(twoFoldAxisPicture\ \  := \ 
      GLShow[twoFoldAxisPicture0, 
		
        DisplayFunction\  -> \ $DisplayFunction]
\)\(transparentTwoFold\  := 
	
      GLShow[twoFoldAxisPicture0, 
		Transparency\  -> \  .5, 
		
        DisplayFunction\  -> \ $DisplayFunction]\)

oppositevertices = {
        vertices[[1]], 
        -vertices[[1]]}; vertexpairline = 
      Line/@({origin, #1}&)/@(1.5 oppositevertices);

\(threeFoldAxisPicture0 := 
      Show[{surface[Dodecahedron], 
          Graphics3D[{{Thickness[ .002], blue, lines}, {Thickness[ .004], 
                black, forwardedges}, {PointSize[ .015], red, 
                Point/@oppositevertices}, {Thickness[ .004], red, 
                vertexpairline}}]}, ViewPoint -> {2.817, 1.560, 1.040}, 
        
		Boxed -> False, 	
		
        LightSources -> {
{{1, 0, 0}, \ RGBColor[1,  .5,  .5]}, 
            
{{0, 1, 0}, RGBColor[ .5,  .1,  .5]\ }, 
            
{{0, 0, 1}, RGBColor[ .5,  .5, 1]\ }, 
            
{{\(-1\), \(-1\), \(-1\)}, \ RGBColor[ .5, 1,  .75]}
}, 
	
        DisplayFunction\  -> \ Identity]
\)\(threeFoldAxisPicture\ \  := \ 
      GLShow[threeFoldAxisPicture0, 
		
        DisplayFunction\  -> \ $DisplayFunction]
\)\(transparentThreeFold\  := 
	
      GLShow[threeFoldAxisPicture0, 
		Transparency\  -> \  .5, 
		
        DisplayFunction\  -> \ $DisplayFunction]\)

facepaircenters = 
      (({#1, -#1}&)/@{
              (1/5) Plus@@
                  (vertices[[#1]]&)
                      /@faces[[1]]})
          [[1]]; origin = {0, 0, 0}; facepairline = 
      Line/@({origin, #1}&)/@(1.5 facepaircenters);

\(fiveFoldAxisPicture0 := 
      Show[{surface[Dodecahedron], 
          Graphics3D[{{Thickness[ .002], blue, lines}, {Thickness[ .004], 
                black, forwardedges}, {PointSize[ .015], red, 
                Point/@facepaircenters}, {Thickness[ .004], red, 
                facepairline}}]}, ViewPoint -> {2.817, 1.560, 1.040}, 
        Boxed -> False, 
		
        LightSources -> {
{{1, 0, 0}, \ RGBColor[1,  .5,  .5]}, 
            
{{0, 1, 0}, RGBColor[ .5,  .1,  .5]\ }, 
            
{{0, 0, 1}, RGBColor[ .5,  .5, 1]\ }, 
            
{{\(-1\), \(-1\), \(-1\)}, \ RGBColor[ .5, 1,  .75]}
}, 
	
        DisplayFunction\  -> \ Identity]
\)\(fiveFoldAxisPicture\ \  := \ 
      GLShow[fiveFoldAxisPicture0, 
		
        DisplayFunction\  -> \ $DisplayFunction]
\)\(transparentFiveFold\  := 
	
      GLShow[fiveFoldAxisPicture0, 
		Transparency\  -> \  .5, 
		
        DisplayFunction\  -> \ $DisplayFunction]\)

\(
twoFoldAxisPicture\)transparentTwoFold

threeFoldAxisPicturetransparentThreeFold

fiveFoldAxisPicturetransparentFiveFold

surfacepictureincubepicture