电脑
Mathematica(8.0以上版本)
打开Mathematica,新建笔记本,输入如下代码:v = Tuples[{-1, 1}, 4];e = Select[Subsets[Range[Length[v]], {2}], Count[Subtract @@ v[[#]], 0] == 3 &];f = Select[Union[Flatten[#]] & /@ Subsets[e, {4}], Length@# == 4 &];f = f /. {a_, b_, c_, d_} :> {b, a, c, d};rotv[t_] = (RotationMatrix[ t, {{0, 0, 1, 0}, {0, 1, 0, 0}}].RotationMatrix[ 2 t, {{1, 0, 0, 0}, {0, 0, 0, 1}}].#) & /@ v;proj[t_] := Most[#]/(3 - Last[#]) & /@ rotv[t];Animate[Graphics3D[ GraphicsComplex[ proj[t], {Blue, Specularity[0.75, 10], Sphere[Range[16], 0.05], Tube[e, 0.03], Opacity[0.3], Polygon@f}], Boxed -> False, Background -> Orange, ImageSize -> 390, PlotRange -> 1], {t, 0.0, Pi/2.0, 0.075}] 运行以后,就会得到一个“四维立方体”,呵呵,其实就是动态图。
导出动态图的代码如下:v = Tuples[{-1, 1}, 4];e = Select[Subsets[Range[Length[v]], {2}], Count[Subtract @@ v[[#]], 0] == 3 &];f = Select[Union[Flatten[#]] & /@ Subsets[e, {4}], Length@# == 4 &];f = f /. {a_, b_, c_, d_} :> {b, a, c, d};rotv[t_] = (RotationMatrix[ t, {{0, 0, 1, 0}, {0, 1, 0, 0}}].RotationMatrix[ 2 t, {{1, 0, 0, 0}, {0, 0, 0, 1}}].#) & /@ v;proj[t_] := Most[#]/(3 - Last[#]) & /@ rotv[t];Export['C:\\Users\\Administrator\\Desktop\\超立方体0.gif', Table[Graphics3D[ GraphicsComplex[ proj[t], {Blue, Specularity[0.75, 10], Sphere[Range[16], 0.05], Tube[e, 0.03], Opacity[0.3], Polygon@f}], Boxed -> False, Background -> White, ImageSize -> {500, 500}, PlotRange -> 1], {t, 0.0, Pi/2.0, 0.075}]]
再来一个互动效果:IncDim[sg_, d_] := Map[Append[#, d] &, sg, {2}];DblSegments[l_] := Join[IncDim[l, -1], IncDim[l, 1]];ConnectPoints[l1_, l2_] := Table[{Flatten[l1, 1][[i]], Flatten[l2, 1][[i]]}, {i, Length[Flatten[l1, 1]]}];DblConnSegments[l_] := Union[ConnectPoints[IncDim[l, -1], IncDim[l, 1]]];UpDimShape[l_] := Join[DblSegments[l], DblConnSegments[l]];Sqr = UpDimShape[{{{-1}, {1}}}];Cube = UpDimShape[Sqr];Homogen[l_] := Map[Append[#, 1] &, l, {2}];Tes = UpDimShape[Cube];R4x[\[Theta]_] := {{1, 0, 0, 0, 0}, {0, Cos[\[Theta]], -Sin[\[Theta]], 0, 0}, {0, Sin[\[Theta]], Cos[\[Theta]], 0, 0}, {0, 0, 0, 1, 0}, {0, 0, 0, 0, 1}}R4y[\[Theta]_] := {{Cos[\[Theta]], 0, Sin[\[Theta]], 0, 0}, {0, 1, 0, 0, 0}, {-Sin[\[Theta]], 0, Cos[\[Theta]], 0, 0}, {0, 0, 0, 1, 0}, {0, 0, 0, 0, 1}}R4z[\[Theta]_] := {{Cos[\[Theta]], -Sin[\[Theta]], 0, 0, 0}, {Sin[\[Theta]], Cos[\[Theta]], 0, 0, 0}, {0, 0, 1, 0, 0}, {0, 0, 0, 1, 0}, {0, 0, 0, 0, 1}}R4k[\[Theta]_] := {{1, 0, 0, 0, 0}, {0, 1, 0, 0, 0}, {0, 0, Cos[\[Theta]], -Sin[\[Theta]], 0}, {0, 0, Sin[\[Theta]], Cos[\[Theta]], 0}, {0, 0, 0, 0, 1}}Rotate4X[l_, \[Theta]_] := Map[R4x[\[Theta]].# &, l, {2}]Rotate4Y[l_, \[Theta]_] := Map[R4y[\[Theta]].# &, l, {2}]Rotate4Z[l_, \[Theta]_] := Map[R4z[\[Theta]].# &, l, {2}]Rotate4K[l_, \[Theta]_] := Map[R4k[\[Theta]].# &, l, {2}]DropUnit[l_] := Map[Drop[#, -1] &, l, {2}]RotFigure4[l_, \[Theta]x_, \[Theta]y_, \[Theta]z_, \[Theta]k_] := DropUnit[Rotate4K[ Rotate4Z[ Rotate4Y[ Rotate4X[ Homogen[l], \[Theta]x], \[Theta]y], \[Theta]z], \[Theta]k]]PersPoint[pt_, d_] := Map[#/(Last[pt]/d) &, pt]Perspective[l_, d_] := Ortho[Map[PersPoint[#, d] &, l, {2}]]Mtr4[x_, y_, z_, k_] := {{1, 0, 0, 0, x}, {0, 1, 0, 0, y}, {0, 0, 1, 0, z}, {0, 0, 0, 1, k}, {0, 0, 0, 0, 1}}Trans5vec[l_, x_, y_, z_, k_] := Map[Mtr4[x, y, z, k].# &, l, {2}]Trans5[l_, x_, y_, z_, k_] := DropUnit[Trans5vec[Homogen[l], x, y, z, k]]Manipulate[ Graphics3D[{Darker@Red, CapForm['Round'], Specularity[White, 20], Tube[Perspective[ Trans5[RotFigure4[Tes, 0, 0, 0, a], 0, 0, 0, -3], -1], 0.04]}, PlotRange -> {{-.7, .7}, {-.7, .7}, {-.7, .7}}, Boxed -> False, Lighting -> 'Neutral', ImageSize -> 1.1 {400, 400}, SphericalRegion -> True], {{a, 0, '动起来'}, 0, 2*3.1416, .0001, Appearance -> 'Labeled'}, SaveDefinitions -> True 呵呵,这个动态图的自定义很多,而且我也不会导出动态图!自己慢慢理解吧!
把克莱因瓶涂成彩色格子。KleinBottle[a_, b_, xmesh_, ymesh_] := Module[{bx, by, rad, X, Y, Z, u, v}, bx = 6 Cos[u] (1 + Sin[u]); by = 16 Sin[u]; rad = 4 (1 - Cos[u]/2); X = If[Pi < u <= 2 Pi, bx + rad Cos[v + Pi], bx + rad Cos[u] Cos[v]]; Y = If[Pi < u <= 2 Pi, by, by + rad Sin[u] Cos[v]]; Z = rad Sin[v]; ParametricPlot3D[{X, Y, Z}, {u, 0, a}, {v, 0, b}, PlotRange -> {{-13, 10}, {-16, 20}, {-6, 6}}, MeshShading -> {{Red, Blue}, {Green, Yellow}}, MeshStyle -> None, Axes -> None, Boxed -> False, ViewVertical -> {0.44, -0.83, -1.40}, ViewPoint -> {1.62, -0.18, -2.96}, ImageSize -> {425, 425}, Mesh -> {xmesh, ymesh}] ];Manipulate[ KleinBottle[u, v, a, b], {{u, 2. Pi, 'draw'}, 1, 2. Pi, ImageSize -> Tiny}, {{v, Pi, 'cutaway'}, Pi, 2. Pi, ImageSize -> Tiny}, {{a, 1, 'mesh A'}, 1, 8, 1, ImageSize -> Tiny}, {{b, 1, 'mesh B'}, 1, 4, 1, ImageSize -> Tiny}, ControlPlacement -> Left, SaveDefinitions -> True
四维空间是难以想象的,听《三体》作者所说,四维空间没有我们的“透视原理”,不明就里!
四维空间的物体,表现在三维空间里,或者是动态的,或者是深度自交的。