(***********************************************************************
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]\n
  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]\n
  DualFaces[polyhedron_] := 
    Module[{vertices, faces}, vertices = Vertices[polyhedron]; 
      faces = Faces[polyhedron]; 
      Table[DualFace[i, polyhedron], {i, Length[vertices]}]]\n
  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]\n
  \(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}}; \)\n
  \(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\)}}; \)\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
  cubeDiagonals[color_] := 
    Module[{lines, vertices}, lines = TripleAxes[Cube]; 
      vertices = Vertices[Cube]; 
      lines = Line/@
          \(\((vertices\[LeftDoubleBracket]#1\[RightDoubleBracket]&)\)/@lines
            \); Graphics3D[{Thickness[.005], color, lines}]]\)

cubeDiagonalAxis[color_]:=
  Module[{lines,vertices},lines={{1,5}};vertices=1.5 Vertices[Cube];
    lines=Line/@(vertices\[LeftDoubleBracket]#1\[RightDoubleBracket]&)/@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,#1}&)/@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\[LeftDoubleBracket]#1\[RightDoubleBracket]&)\)/@
          edges; edgeCenters = 1\/2\ Apply[Plus, edges, 1]; 
      points = Point/@edgeCenters; line = 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}}; \)\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
  \(AnotherTetrahedron /: Faces[AnotherTetrahedron] = Faces[Tetrahedron]; \)\n
  
  \(AnotherTetrahedron /: Edges[AnotherTetrahedron] = Edges[Tetrahedron]; \)\)

tetra3FoldAxis[color_]:=
  Module[{vertices,facecenters,line},vertices=Vertices[Tetrahedron];
    facecenters=DualVertices[Tetrahedron];
    line=Line[{1.5 vertices\[LeftDoubleBracket]2\[RightDoubleBracket],
          3 facecenters\[LeftDoubleBracket]2\[RightDoubleBracket]}];
    points=Point/@{facecenters\[LeftDoubleBracket]2\[RightDoubleBracket]};
    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\[LeftDoubleBracket]#1\[RightDoubleBracket]&)\)/@
          edges; edgeCenters = 1\/2\ Apply[Plus, edges, 1]; 
      points = Point/@edgeCenters; line = 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\[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]]









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





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





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







Show[{skeleton[Cube,blue,black],surface[Octahedron]},Boxed\[Rule]False,
  ViewPoint\[Rule]{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\[Rule]False,
  ViewPoint\[Rule]{0.744,-3.088,1.168}]
Octahedron/:Vertices[Octahedron]=temp;









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









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





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







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

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







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





