使用Mathematica制作Lorenz吸引子的轨道追踪视频
Lorenz奇异吸引子是混沌理论中最早被发现和研究的吸引子之一,它由Edward Lorenz在1963年研究确定性非周期流时提出。Lorenz吸引子以其独特的"蝴蝶"形状而闻名,是混沌系统和非线性动力学的经典例子。
L = NDSolveValue[{x'[t] == -3 (x[t] - y[t]), y'[t] == -x[t] z[t] + 26.5 x[t] - y[t], z'[t] == x[t] y[t] - z[t],x[0] == z[0] == 0, y[0] == 1}, {x[t], y[t], z[t]}, {t, 0, 100}, MaxStepSize -> 0.001];n = NDSolveValue[{x'[t] == -3 (x[t] - y[t]), y'[t] == -x[t] z[t] + 26.5 x[t] - y[t], z'[t] == x[t] y[t] - z[t],x[0] == z[0] == 0, y[0] == 1}, Cross[{x'[t], y'[t], z'[t]}, {x''[t], y''[t], z''[t]}], {t, 0, 100},MaxStepSize -> 0.001];
L1 = NDSolveValue[{x'[t] == -3 (x[t] - y[t]), y'[t] == -x[t] z[t] + 26.5 x[t] - y[t], z'[t] == x[t] y[t] - z[t],x[0] == z[0] == 0, y[0] == 1}, {x'[t], y'[t], z'[t]}, {t, 0, 100},MaxStepSize -> 0.001];LA = ParametricPlot3D[L, {t, 0, 60}, PlotRange -> All, Background -> Black, Boxed -> False, Axes -> False, ColorFunction -> Function[{x, y, z, u}, ColorData["NeonColors"][u]],PlotPoints -> {100, 100}]
gr[t1_] := Show[{LA, Graphics3D[{Specularity[White, 4], Sphere[L /. t -> t1, .3]}]},Background -> Black, ImageSize -> {300, 300}, SphericalRegion -> True, PlotRange -> All]
frames = Table[Show[gr[t1 + .1], ViewVector -> {(L - 3 n/Norm[n]) /. {t -> t1}, L1 /. t -> t1 + .1}], {t1, 0.6, 1.65, .009}];
ListAnimate[frames]
Export[FileNameJoin[{NotebookDirectory[], "Lorenz63_0.mp4"}], frames, "DisplayDurations" -> 50(*每帧显示0.5秒*)]