# [GIF] All Day (Hamiltonian cycle on the 24-cell)

Posted 2 years ago
3115 Views
|
|
3 Total Likes
| All DaySame idea as Touch ’Em All: this is the stereographic image of a Hamiltonian cycle on the 24-cell. The idea behind the code is the same, so look back at that post for an explanation (as before, the definition of ProjectedSphere[] is not reproduced here; see Inside). Stereo[{x1_, y1_, x2_, y2_}] := {x1/(1 - y2), y1/(1 - y2), x2/(1 - y2)} smootherstep[t_] := 6 t^5 - 15 t^4 + 10 t^3; twenty4cellvertices = Normalize /@ DeleteDuplicates[ Flatten[ Permutations /@ ({-1, -1, 0, 0}^Join[#, {1, 1}] & /@ Tuples[{0, 1}, 2]), 1] ]; sorted24CellVertices = Module[{v = twenty4cellvertices, M, Γ, cycle}, M = Table[ If[v[[i]] != -v[[j]] && HammingDistance[v[[i]], v[[j]]] == 2, 1, 0], {i, 1, Length[v]}, {j, 1, Length[v]}]; Γ = AdjacencyGraph[M]; cycle = FindHamiltonianCycle[Γ]; v[[#[] & /@ (cycle[] /. UndirectedEdge -> List)]] ]; DynamicModule[{θ, viewpoint = 1/2 {-1, 1, 1}, pts = N[sorted24CellVertices], cols = RGBColor /@ {"#04E762", "#00A1E4", "#DC0073", "#011627"}}, Manipulate[ θ = π/3 smootherstep[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 -> 4.5, ViewAngle -> π/3, ViewPoint -> viewpoint, Boxed -> False, Background -> cols[[-1]], ImageSize -> 540, Lighting -> {{"Directional", cols[], 50 {1, -1, 2}}, {"Directional", cols[], 50 {1, 2, -1}}, {"Directional", cols[], 50 {-2, -1, -1}}, {"Ambient", cols[[-1]]}}], {t, 0, 1}] ] Answer - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming! Answer