Skip to main content

Tesseract

This demo illustrates the projection and rotation of a 4-dimensional hypercube (tesseract) into 3-dimensional space, using a series of animated frames. The code performs several steps to create this visualization:


  1. Vertex and Edge Creation: Defines vertices in 4D space using tuples of  and constructs edges based on the condition that exactly three coordinates are identical between connected vertices.
  2. Face Selection: Generates unique sets of four edges to represent 2D faces within the 4D structure, enforcing that each face includes four unique vertices to maintain structure.
  3. Rotation and Projection: Applies rotation in two planes to simulate the tesseract’s 4D rotation, which is then projected into 3D for visualization.
  4. Animation Setup: A frame-based update handler updates vertex positions on each frame to create a continuous rotation effect, visually representing the shifting geometry.
  5. 3D Rendering and Animation: Renders the evolving 3D projection of the tesseract with adjustable material properties (like transparency and thickness) for a glass-like effect. The animation provides a vivid sense of the higher-dimensional rotation projected into a 3D experience

Code design by Vitaliy Kaurov

Download original notebook 
(*BB[*)(* Define Vertex Generation and Edge Selection *)(*,*)(*"1:eJxTTMoPSmNhYGAo5gcSAUX5ZZkpqSn+BSWZ+XnFaYwgCS4g4Zyfm5uaV+KUXxEMUqxsbm6exgSSBPGCSnNSg9mAjOCSosy8dLBYSFFpKpoKkDkeqYkpEFXBILO1sCgJSczMQVYCAOFrJEU="*)(*]BB*)

vertices = Tuples[{-1, 1}, 4];
edges = Select[Subsets[Range[Length[vertices]], {2}], Count[Subtract @@ vertices[[#]], 0] == 3 &];

(*BB[*)(* Generate Unique Sets of Four Edges *)(*,*)(*"1:eJxTTMoPSmNhYGAo5gcSAUX5ZZkpqSn+BSWZ+XnFaYwgCS4g4Zyfm5uaV+KUXxEMUqxsbm6exgSSBPGCSnNSg9mAjOCSosy8dLBYSFFpKpoKkDkeqYkpEFXBILO1sCgJSczMQVYCAOFrJEU="*)(*]BB*)
faceSets = Select[Union[Flatten[#]] & /@ Subsets[edges, {4}], Length@# == 4 &];
faceSets = faceSets /. {a_, b_, c_, d_} :> {b, a, c, d};

(*BB[*)(* Define Rotation and Projection Functions *)(*,*)(*"1:eJxTTMoPSmNhYGAo5gcSAUX5ZZkpqSn+BSWZ+XnFaYwgCS4g4Zyfm5uaV+KUXxEMUqxsbm6exgSSBPGCSnNSg9mAjOCSosy8dLBYSFFpKpoKkDkeqYkpEFXBILO1sCgJSczMQVYCAOFrJEU="*)(*]BB*)

ClearAll[rotateVertices, projectVertices];

rotateVertices[t_] := Module[{rotated},
  rotated = (RotationMatrix[t, {{0, 0, 1, 0}, {0, 1, 0, 0}}] .
             RotationMatrix[2 t, {{1, 0, 0, 0}, {0, 0, 0, 1}}] . #) & /@ vertices;
  rotated
];

projectVertices[t_] := Most[#] / (3 - Last[#]) & /@ rotateVertices[t];

(*BB[*)(* Set Animation and Frame Update *)(*,*)(*"1:eJxTTMoPSmNhYGAo5gcSAUX5ZZkpqSn+BSWZ+XnFaYwgCS4g4Zyfm5uaV+KUXxEMUqxsbm6exgSSBPGCSnNSg9mAjOCSosy8dLBYSFFpKpoKkDkeqYkpEFXBILO1sCgJSczMQVYCAOFrJEU="*)(*]BB*)

time = 0;
EventHandler[
 "tesserframe",
 Function[Null,
   tubes = With[{projection = projectVertices[time]},
     Map[Map[Function[i, projection[[i]]], #] &, edges]
   ];
   poly = projectVertices[time];
   time += 0.01;
 ]
];

EventFire["tesserframe", True];

(*BB[*)(* 3D Graphics Setup *)(*,*)(*"1:eJxTTMoPSmNhYGAo5gcSAUX5ZZkpqSn+BSWZ+XnFaYwgCS4g4Zyfm5uaV+KUXxEMUqxsbm6exgSSBPGCSnNSg9mAjOCSosy8dLBYSFFpKpoKkDkeqYkpEFXBILO1sCgJSczMQVYCAOFrJEU="*)(*]BB*)

Graphics3D[{
   {Cyan, Table[With[{i = i}, Tube[tubes[[i]] // Offload, 0.02]], {i, Length[tubes]}]},
   GraphicsComplex[
     poly // Offload, {
      Graphics3D`Materials["Glass"], Cyan,
      Directive["MaterialThickness" -> 0.02, "Roughness"->0.2],
      Polygon @ faceSets
     }
   ],
   AnimationFrameListener[poly // Offload, "Event" -> "tesserframe"]
 }
, ImageSize->500]
(*VB[*)(FrontEndRef["1e2507db-fcae-4f46-8fed-a46a2449a8cb"])(*,*)(*"1:eJxTTMoPSmNkYGAoZgESHvk5KRCeEJBwK8rPK3HNS3GtSE0uLUlMykkNVgEKG6YamRqYpyTppiUnpuqapJmY6VqkpaboJpqYJRqZmFgmWiQnAQCRaRZk"*)(*]VB*)