Wolfram Cloud Document

This is a demonstration at the hypertorus

3



=

1

S

×

1

S

×

1

S

as embedded in

4



and compute its 3-dimensional cross-section with the

{w=0}

hyperplane. In the animation, the hypertorus is rotated while also being translated up and down along the w-axis. This is meant to be an illustration of a hypertorus passing though our 3-dimensional “Flatland”.

Initialization code


Animations

Tumbling through Flatland (600 frames)

This is a 600 frame loop with

In[]:=

Manipulate[Module[{rotationAngle,innerTorusGfx,outerTorusGfx,sliceGfx,graphics},rotationAngle=-frame/100.*2Pi;{innerTorusGfx,outerTorusGfx,sliceGfx}=makeHypertorusGraphics["Radius1"->2,"Radius3"->17,"InnerDivisions"->32,"OuterDivisions"->32,"SliceValues"->{0},"SliceDivisions"->{16,16,8}*2,"RotationMatrix"->RotationMatrix[rotationAngle/3,{{0,1,0,0},{0,0,0,1}}].RotationMatrix[-rotationAngle/2,{{1,0,0,0},{0,1,0,0}}],"TranslationVector"->{0,0,0,15*Cos[-rotationAngle/6]},"WProjectionVector"->{0,0,1}];graphics=Graphics3D[{{Specularity[1,40],Hue[0,.0,.7],EdgeForm[Thin],sliceGfx},{Specularity[.8,30],FaceForm[Opacity[0.2,White]],EdgeForm[Opacity[0.2]],innerTorusGfx},{FaceForm[],EdgeForm[Opacity[0.3,White]],outerTorusGfx},{Opacity[0.7,White],makeCoordinateGridGraphics[]},If[Not@SameQ[sliceGfx,Null],{FaceForm[],EdgeForm[{Thick,White}],sliceGfx[[1]]//CoordinateBounds//Transpose//Apply[Cuboid]}]},PlotRange->40,ViewAngle->.3,ViewPoint->Normalize[RotationMatrix[-rotationAngle/6,{{1,0,0},{0,1,0}}].{.5,2,.6}]*2.5,Boxed->False,Lighting->"Neutral",ImageSize->{512,512},Background->Black];graphics],{frame,0,600,1},TrackedSymbols:>{frame},SaveDefinitions->True]

Out[]=

frame

Equatorial rotation (120 frames)

In[]:=

Manipulate[Module[{rotationAngle,innerTorusGfx,outerTorusGfx,sliceGfx,graphics},rotationAngle=-frame/120.*2Pi;{innerTorusGfx,outerTorusGfx,sliceGfx}=makeHypertorusGraphics["Radius1"->2,"Radius3"->17,"InnerDivisions"->32,"OuterDivisions"->32,"SliceValues"->{0},"SliceDivisions"->{16,16,8}*2,"RotationMatrix"->RotationMatrix[rotationAngle,{{0,1,0,0},{0,0,0,1}}],"TranslationVector"->{0,0,0,0},"WProjectionVector"->{0,0,1}];graphics=Graphics3D[{{Specularity[1,40],Hue[0,.0,.7],EdgeForm[Thin],sliceGfx},{Specularity[.8,30],FaceForm[Opacity[0.2,White]],EdgeForm[Opacity[0.2]],innerTorusGfx},{FaceForm[],EdgeForm[Opacity[0.3,White]],outerTorusGfx},{Opacity[0.7,White],makeCoordinateGridGraphics[]},If[Not@SameQ[sliceGfx,Null],{FaceForm[],EdgeForm[{Thick,White}],sliceGfx[[1]]//CoordinateBounds//Transpose//Apply[Cuboid]}]},PlotRange->40,ViewAngle->.3,ViewPoint->Normalize[RotationMatrix[-rotationAngle,{{1,0,0},{0,1,0}}].{.5,2,.6}]*2.5,Boxed->False,Lighting->"Neutral",ImageSize->{512,512},Background->Black];graphics],{frame,0,120,1},TrackedSymbols:>{frame},SaveDefinitions->True]

Out[]=

frame

Manipulate

CITE THIS NOTEBOOK