Hamiltonian

Just as in Exchange, in which small cubes trace out a Hamiltonian cycle on the skeleton of a big cube, this shows 6 octahedra centered at the 6 vertices of a large octahedron which trace out a Hamiltonian cycle on the skeleton of the big octrahedron.

There are two different types of Hamiltonian cycle on the octahedron, and just by chance the first one FindHamiltonianCycle finds is of the type I like better (originally I wanted to do an icosahedron -- which has lots of distinct Hamiltonian cycles -- in this style, but the image was way too cluttered).

Anyway, here's the code:

smootherstep[t_] := 6 t^5 - 15 t^4 + 10 t^3;
smootheststep[t_] := -20 t^7 + 70 t^6 - 84 t^5 + 35 t^4;

DynamicModule[{pol = "Octahedron", clist, v, e, graph, cycle, s,
  cols = Append[ColorData["BrightBands"] /@ Range[0, 1, 1/6], 
    RGBColor["#2A363B"]]},
 v = PolyhedronData[pol, "VertexCoordinates"];
 e = PolyhedronData[pol, "Edges"][[2]];
 graph = PolyhedronData[pol, "SkeletonGraph"];
 cycle = VertexList[PathGraph[First[FindHamiltonianCycle[graph]]]];
 Manipulate[
  s = smootheststep[Mod[t, 1]];
  Graphics3D[{Thickness[.007], 
    Table[{cols[[Mod[i - Floor[t], 6, 1]]],
      GraphicsComplex[
       2 ((1 - s) v[[cycle[[i]]]] + 
             s*v[[ RotateLeft[cycle][[i]]]]) + # & /@ 
        RotationTransform[(-1)^i ?/2 s, {0, 0, 1}][2 v/3], e]}, 
       {i, 1, Length[v]}]},
   Boxed -> False, PlotRange -> 2, ImageSize -> 540, 
   ViewPoint -> 10 {.8, -2.8, .5}, ViewVertical -> {0, 0, 1}, 
   ViewAngle -> ?/70, SphericalRegion -> True, 
   Background -> cols[[-1]]],
  {t, 0., 6}]
 ]