Message Boards Message Boards

GROUPS:

[GIF] Touch ’Em All (Hamiltonian cycle on the hypercube)

Posted 11 months ago
1343 Views
|
1 Reply
|
4 Total Likes
|

Hamiltonian cycle on the hypercube

Touch ’Em All

Consider the vertices of the hypercube as points on the 3-sphere. If we center a sphere of radius 0.2 at each vertex and stereographically project to $\mathbb{R}^3$, the result is the first frame in this animation.

Of course, to accomplish that we need a stereographic projection function:

Stereo[{x1_, y1_, x2_, y2_}] := {x1/(1 - y2), y1/(1 - y2), x2/(1 - y2)}

As well as the ProjectedSphere[] function from Inside (which I won't reproduce here due to its length and unpleasantness, but which produces the stereographic image of a given sphere in the 3-sphere).

Now, the animation shows a Hamiltonian cycle of the 1-skeleton of the hypercube (a.k.a., the hypercube graph). Now one can extract such a Hamiltonian cycle using FindHamiltonianCycle[HypercubeGraph[4]], but the coordinates of the vertices of HypercubeGraph[4] are only given in 2-D, so this doesn't help so much with actual visualization. So instead I construct the 1-skeleton of the hypercube, find a Hamiltonian cycle using FindHamiltonianCycle[], and then sort the vertices to appear in the order from the given cycle (by semi-coincidence, this actually turns out to be exactly the same Hamiltonian cycle as one gets from evaluating FindHamiltonianCycle[HypercubeGraph[4]]):

sortedHypercubeVertices = 
  Module[{v = Tuples[{1/2, -1/2}, {4}], M, Γ, cycle},
   M = Table[
     If[HammingDistance[v[[i]], v[[j]]] == 1, 1, 0],
     {i, 1, Length[v]}, {j, 1, Length[v]}];
   Γ = AdjacencyGraph[M];
   cycle = FindHamiltonianCycle[Γ];
   v[[#[[1]] & /@ (cycle[[1]] /. UndirectedEdge -> List)]]
   ];

With that all in place, then, we just need to rotate the $i$th vertex to the $(i+1)$st vertex (mod 16) up in the 3-sphere and then stereographically project (with a little help from the smoothstep function, which makes the transitions less jarring):

smoothstep[t_] := 3 t^2 - 2 t^3;

DynamicModule[{θ, pts = N[sortedHypercubeVertices], 
  cols = RGBColor /@ {"#41EAD4", "#B91372", "#011627"}},
 Manipulate[
  θ = π/3 smoothstep[t];
  Graphics3D[
   {Specularity[.4, 10],
    Table[
     ProjectedSphere[RotationMatrix[θ, {pts[[i]], pts[[Mod[i + 1, Length[pts], 1]]]}].pts[[i]], .2],
     {i, 1, Length[pts]}]},
   PlotRange -> 3, Boxed -> False, ViewPoint -> 1/2 {2, 1, 0}, ViewAngle -> π/4,
   Lighting -> {{"Directional", cols[[1]], {0, 0, 50}},
     {"Directional", cols[[2]], {0, 0, -50}},
     {"Ambient", cols[[-1]]}},
   Background -> cols[[-1]], ImageSize -> 540],
  {t, 0, 1}
  ]
 ]

enter image description here - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming!

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract