10
$\begingroup$

I want to create an animation like this one: https://www.youtube.com/watch?v=rvzZmNW2_70

After googling I have found just below informations about this issue: https://twitter.com/bencbartlett/status/1278424544848621578 https://twitter.com/InertialObservr/status/1175188246734573568

I am not sure about the mathematical background of the animation. One of the comments refers to Frenet–Serret formulas: https://en.wikipedia.org/wiki/Frenet-Serret_formulas.

The creator of the animation gave this information:

I put the camera at r(t-δt) + (r' × r'') and had it point toward r(t) + r'(t). The δt adds lag so you follow behind the path of the particle, the (r' × r'') offsets the camera above the plane normal to the particle's curvature, and the r(t) + r'(t) points to where it's going.

I need help with Mathematica commands relating to camera options.

$\endgroup$
4
+100
$\begingroup$

After some experiments I got similar picture, but final animation is too large for this forum. So I have created small animation just to show a principle of visualization. First we have created all needed vectors

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];

Then we make scene and frames

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]

Finally we create animation

ListAnimate[Table[Show[gr[t1 + .1], 
   ViewVector -> {(L - 3 n /Norm[n]) /. {t -> t1}, 
     L1 /. t -> t1 + .1}], {t1, 0.6, 1.65, .009}]]] 

Figure 1

| improve this answer | |
$\endgroup$
  • $\begingroup$ Your first solution was already good but after your edit it become fantastic. Thank you so much. $\endgroup$ – Mustafa Kösem Sep 6 at 14:56
  • $\begingroup$ @MustafaKösem You are welcome! $\endgroup$ – Alex Trounev Sep 6 at 17:42
7
$\begingroup$

If anyone wants to build on top of this answer, feel free. We start by draw the Lorentz attractor:

solutions[tmax_] := 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, y, z},
  {t, 0, tmax}
  ]

{xsol, ysol, zsol} = solutions[100];

plot[tend_, tmax_] := Rasterize@Show[
   ParametricPlot3D[
    {xsol[t], ysol[t], zsol[t]},
    {t, 0, tend},
    PlotRange -> {{-15, 15}, {-25, 25}, {-10, 50}},
    ColorFunction -> Function[
      {x, y, z, u},
      ColorData["SolarColors", 1 - (tend - u)/tmax]
      ],
    ColorFunctionScaling -> False,
    PlotPoints -> 100,
    Background -> Black,
    Boxed -> False,
    Axes -> False
    ],
   Graphics3D[{
     White,
     Sphere[{xsol[tend], ysol[tend], zsol[tend]}]
     }
    ]
   ]

frames = plot[#, 100] & /@ Subdivide[1, 100, 1000];

ListAnimate[frames]

Output

The animation only shows the first 100 frames, I had to cut it down in order to save space. Anyway, this is a plot of the Lorentz attractor where the curve fades in color over time (the further from the tip of the curve, the darker).

To position the camera, one can use ViewVector together with FrenetSerretSystem, as Tim suggests in his answer. That looks like this:

basis = Last[FrenetSerretSystem[{xsol[t], ysol[t], zsol[t]}, t]];

r = {xsol[#], ysol[#], zsol[#]} &;
origin[u_] := r[u - 0.1] + 0.1 (normal /. t -> u)
target[u_] := r[u] - 0.1 (tangent /. t -> u)

(* Put this into the plot function defined earlier *)
ViewVector -> {origin[tend], target[tend]},
ViewRange -> {-.01, 1000}

Flinty helped me out with ViewRange in a comment below. Without it, the line would be broken and it wouldn't look good.

I wish that I could here show a brilliant looking animation, but unfortunately it turns out that even when you have all the pieces in place, it's hard to get it to look good. The camera positioning given by origin and target will make the camera follow the tip of the curve, but that alone is not enough to make it really good looking. The author of the animation that you link to in your question must have spent a lot of time tuning things. Also, he seems to be using a nice framework that makes glow possible. The glow part would be very hard to implement in Mathematica.

| improve this answer | |
$\endgroup$
  • 3
    $\begingroup$ You can fix the clipping by adding ViewRange -> {-.01, 1000} $\endgroup$ – flinty Aug 30 at 17:14
  • $\begingroup$ @flinty Thank you! That's it. Seems like something needs to be done about the view vector but at least it works in principle now. $\endgroup$ – C. E. Aug 30 at 17:44
6
$\begingroup$

There are some examples of how to control the camera in the downloadable notebook of the Wolfram U tutorial Dynamic Visualization in the Wolfram Language. You probably want to use a combination of ViewVector, ViewVertical, and ViewAngle to control the camera. Use ViewVector to view ahead and ViewVertical to orient the camera. In the example below, I set the ViewVertical to be given by the normal of the FrenetSerretSystem.

knot = KnotData["Trefoil", "SpaceCurve"];
basis = Last[FrenetSerretSystem[knot[t], t]] // Simplify;
(* Space Curve Normal *)
n[t_] = basis[[2]];
{tangent, normal, binormal} = 
  Map[Arrow[{knot[t], knot[t] + #}] &, basis];
Manipulate[{Show[
    ParametricPlot3D[knot[s], {s, 0, 2 Pi}, PlotStyle -> Thick], 
    Graphics3D[{Thick, Blue, tangent, Red, normal, Purple, binormal}],
     PlotRange -> 3], 
   Show[ParametricPlot3D[knot[s], {s, 0, 2 Pi}, PlotStyle -> Thick], 
    PlotRange -> 6, ViewVector -> {knot[t - 0.01], knot[t]}, 
    ViewVertical -> n[t - 0.01], ViewAngle -> 90 Degree]} // 
  Evaluate, {t, 0, 2 Pi, Appearance -> {"Open"}}, 
 ControlPlacement -> Top]

enter image description here

| improve this answer | |
$\endgroup$
2
$\begingroup$

@Sumit. As can be seen from the code below, only the ViewPoint parameter is not enough. More camera parameters are required.

R = 1;
f[x_] := Sin[x];
w[x_] := Normalize[{1, f'[x], 0}];
u[x_] := Normalize[Cross[w[x], {0, 0, 1}]];
v[x_] := Cross[w[x], u[x]];
path1[x_] := {x, f[x], 0} + R u[x];
path2[x_] := {x, f[x], 0} - R u[x];
pipe = ParametricPlot3D[{x, f[x], 0} + R Cos[t] u[x] + 
    R Sin[t] v[x], {x, 0, 2 Pi}, {t, 0, 2 Pi}];
curve1 = ParametricPlot3D[{x, f[x], 0} + R u[x], {x, 0, 2 Pi}, 
   PlotStyle -> {Purple, Dashed, Thickness[0.02]}];
curve2 = ParametricPlot3D[{x, f[x], 0} - R u[x], {x, 0, 2 Pi}, 
   PlotStyle -> {Green, Dashed, Thickness[0.02]}];

Animate[
 Row[
  {Show[{pipe, curve1, curve2, 
     Graphics3D[{PointSize[.1], 
       Switch[Sign[Sin[x/2]], 
        1, {Purple, Point[path1[x]]}, -1, {Green, 
         Point[path2[x - 2 Pi]]}]}]}, ViewPoint -> {-0.8, 1.4, 3}, 
    ViewVertical -> {0.2, 1.8, 1}, ImageSize -> 400],
   Show[{pipe, curve1, curve2, 
     Graphics3D[{PointSize[.1], 
       Switch[Sign[Sin[x/2]], 
        1, {Purple, Point[path1[x]]}, -1, {Green, 
         Point[path2[x - 2 Pi]]}]}]}, 
    ViewPoint -> 
     Switch[Sign[Sin[x/2]], 1, path1[x], -1, path2[x - 2 Pi]], 
    ImageSize -> 400]}], {x, 0, 4 Pi}]
| improve this answer | |
$\endgroup$
  • 1
    $\begingroup$ You also need ViewCenter, or you can use ViewVector which combines the two of them. $\endgroup$ – C. E. Aug 31 at 6:40
1
$\begingroup$

You need ViewPoint

As an example here is how you move on a sphere along the great circle {Cos[a Pi], 0, Sin[a Pi]}

Manipulate[ SphericalPlot3D[1, {theta, 0, Pi}, {phi, 0, 2 Pi},
   ColorFunction -> "Rainbow", ViewPoint -> {Cos[a Pi], 0, Sin[a Pi]}], {a, 0, 2, 0.1}]

enter image description here

| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.