(***********************************************************************
This file was generated automatically by the Mathematica front end.
It contains Initialization cells from a Notebook file, which typically
will have the same name as this file except ending in ".nb" instead of
".m".

This file is intended to be loaded into the Mathematica kernel using
the package loading commands Get or Needs.  Doing so is equivalent to
using the Evaluate Initialiation Cells menu command in the front end.

DO NOT EDIT THIS FILE.  This entire file is regenerated automatically 
each time the parent Notebook file is saved in the Mathematica front end.
Any changes you make to this file will be overwritten.
***********************************************************************)











\!\(DualVertices[polyhedron_] := 
    Module[{vertices, faces, edges, k}, vertices = Vertices[polyhedron]; 
      faces = Faces[polyhedron]; edges = Edges[polyhedron]; 
      k = Length[faces\[LeftDoubleBracket]1\[RightDoubleBracket]]; 
      Apply[Plus, 
          \((vertices\[LeftDoubleBracket]#1\[RightDoubleBracket]&)\)/@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\[LeftDoubleBracket]1\[RightDoubleBracket];
    facelist={newface};tempfacelist=Complement[tempfacelist,facelist];
    newvertex=
      RotateLeft[newface,
          Position[newface,v0]\[LeftDoubleBracket]1,1\[RightDoubleBracket]-1]
          \[LeftDoubleBracket]2\[RightDoubleBracket];
    While[tempfacelist\[NotEqual]{},
      newface=Select[tempfacelist,MemberQ[#1,v0]&&MemberQ[#1,newvertex]&]
            \[LeftDoubleBracket]1\[RightDoubleBracket];
      facelist=Append[facelist,newface];
      tempfacelist=Complement[tempfacelist,facelist];
      newvertex=
        Module[{},
          rotate=RotateLeft[newface,
              Position[newface,v0]\[LeftDoubleBracket]1,1
                  \[RightDoubleBracket]-1];
          If[rotate\[LeftDoubleBracket]2
                \[RightDoubleBracket]\[NotEqual]newvertex,
            rotate\[LeftDoubleBracket]2\[RightDoubleBracket],
            rotate\[LeftDoubleBracket]Length[rotate]
                \[RightDoubleBracket]]];];(
        Position[faces,#1]\[LeftDoubleBracket]1,1\[RightDoubleBracket]&)/@
      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\[LeftDoubleBracket]1\[RightDoubleBracket]];
    facesIncidentOn[edge_]:=
      Select[faces,
          MemberQ[#1,edge\[LeftDoubleBracket]1\[RightDoubleBracket]]&&
              MemberQ[#1,edge\[LeftDoubleBracket]2\[RightDoubleBracket]]&]/;
        ListQ[edge];
    DualEdge[edge_]:=(
          Position[faces,#1]\[LeftDoubleBracket]1,1\[RightDoubleBracket]&)/@
        facesIncidentOn[edge];DualEdge/@edges]





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

skeleton[poly_,vertexcolor_,edgecolor_]:=
  Module[{vertices,edges,lines,points},vertices=Vertices[poly];
    edges=Edges[poly];
    lines=Line/@(vertices\[LeftDoubleBracket]#1\[RightDoubleBracket]&)/@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\[LeftDoubleBracket]#1\[RightDoubleBracket]&)/@
          faces,{1}];Graphics3D[faces]]
faceToEdges[face_]:=
  Module[{edgelist,n,i},edgelist={};n=Length[face];
    For[i=1,i<n,i++,
      edgelist=Append[edgelist,
          If[face\[LeftDoubleBracket]i\[RightDoubleBracket]<
              face\[LeftDoubleBracket]i+1\[RightDoubleBracket],{
              face\[LeftDoubleBracket]i\[RightDoubleBracket],
              face\[LeftDoubleBracket]i+1\[RightDoubleBracket]},{
              face\[LeftDoubleBracket]i+1\[RightDoubleBracket],
              face\[LeftDoubleBracket]i\[RightDoubleBracket]}]]];
    edgelist=Append[edgelist,
        If[face\[LeftDoubleBracket]1\[RightDoubleBracket]<
            face\[LeftDoubleBracket]n\[RightDoubleBracket],{
            face\[LeftDoubleBracket]1\[RightDoubleBracket],
            face\[LeftDoubleBracket]n\[RightDoubleBracket]},{
            face\[LeftDoubleBracket]n\[RightDoubleBracket],
            face\[LeftDoubleBracket]1\[RightDoubleBracket]}]]]





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











\!\(\(Tetrahedron /: 
    Faces[Tetrahedron] = {{1, 2, 3}, {1, 3, 4}, {1, 4, 2}, {2, 4, 3}}; \)\n
  \(Tetrahedron /: 
    Edges[Tetrahedron] = {{1, 2}, {1, 3}, {1, 4}, {2, 3}, {2, 4}, {3, 4}}; 
  \)\n
  \(Tetrahedron /: Vertices[Tetrahedron] = 
    N[{{0, 0, \@3}, {0, \(2\ \@2\ \@3\)\/3, \(-\(\@3\/3\)\)}, {\(-\@2\), 
          \(-\(1\/3\)\)\ \((\@2\ \@3)\), \(-\(\@3\/3\)\)}, {\@2, 
          \(-\(1\/3\)\)\ \((\@2\ \@3)\), \(-\(\@3\/3\)\)}}]; \)\n
  \(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}}; \)\n
  \(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\)}}; \)\n
  Cube /: Faces[Cube] := Faces[Hexahedron]\n
  Cube /: Vertices[Cube] := Vertices[Hexahedron]\n
  \(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}}; \)\n
  \(Cube /: TripleAxes[Cube] = {{1, 5}, {2, 6}, {3, 7}, {4, 8}}; \)\n
  \(SphericalToCartesian[{theta_, phi_}] := {Sin[theta]\ Cos[phi], 
      Sin[theta]\ Sin[phi], Cos[theta]}; \)\n
  \(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}}; \)\n
  \(Icosahedron /: Vertices[Icosahedron] := 
    \((Icosahedron /: Vertices[Icosahedron] = 
        N[N[SphericalToCartesian/@{{0, 0}, {ArcTan[2], 0}, {ArcTan[2], 
                    \(2\ \[Pi]\)\/5}, {ArcTan[2], \(4\ \[Pi]\)\/5}, {
                    ArcTan[2], \(6\ \[Pi]\)\/5}, {ArcTan[2], 
                    \(8\ \[Pi]\)\/5}, {\[Pi] - ArcTan[2], \[Pi]\/5}, {
                    \[Pi] - ArcTan[2], \(3\ \[Pi]\)\/5}, {\[Pi] - ArcTan[2], 
                    \(5\ \[Pi]\)\/5}, {\[Pi] - ArcTan[2], \(7\ \[Pi]\)\/5}, {
                    \[Pi] - ArcTan[2], \(9\ \[Pi]\)\/5}, {\[Pi], 0}}/
              \((\@\(1\/2 + 1\/2\ Cos[ArcTan[2]]\))\), 2\ Precision[1.0]]])
      \); \)\n
  \(If[\(\[InvisibleSpace]\(! \((ValueQ[Edges[Icosahedron]])\)\)\), 
    Icosahedron /: Edges[Icosahedron] = 
      Union[Flatten[faceToEdges/@Faces[Icosahedron], 1]]]; \)\)

dualcube/:Vertices[dualcube]=DualVertices[Cube];
dualcube/:Faces[dualcube]=DualFaces[Cube];
dualcube/:Edges[dualcube]=DualEdges[Cube];

Show[{skeleton[Cube,blue,black],surface[dualcube]},Boxed\[Rule]False,
  ViewPoint\[Rule]{0.744,-3.088,1.168}]





dualdualcube/:Vertices[dualdualcube]=DualVertices[dualcube];
dualdualcube/:Faces[dualdualcube]=DualFaces[dualcube];
dualdualcube/:Edges[dualdualcube]=DualEdges[dualcube];
Show[{{skeleton[dualcube,blue,black],surface[dualdualcube]}},
  Boxed\[Rule]False,ViewPoint\[Rule]{0.744,-3.088,1.168}]







Dodecahedron/:Vertices[Dodecahedron]=DualVertices[Icosahedron];
Dodecahedron/:Faces[Dodecahedron]=DualFaces[Icosahedron];
Dodecahedron/:Edges[Dodecahedron]=DualEdges[Icosahedron];

Show[{{skeleton[Icosahedron,green,red],surface[Dodecahedron]}},
  Boxed\[Rule]False]





dualdodecahedron/:Vertices[dualdodecahedron]=DualVertices[Dodecahedron];
dualdodecahedron/:Faces[dualdodecahedron]=DualFaces[Dodecahedron];
dualdodecahedron/:Edges[dualdodecahedron]=DualEdges[Dodecahedron];

Show[{{skeleton[Dodecahedron,blue,black],surface[dualdodecahedron]}},
  Boxed\[Rule]False]











