使用Mathematica制作Lorenz吸引子的轨道追踪视频

news2025/5/17 5:51:42

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秒*)
 ]