7
$\begingroup$

There is a gif from Wikipedia, The line integral over a scalar field $f$.

How to plot and animate this in Mathematica? enter image description here

$\endgroup$
  • 1
    $\begingroup$ What have you tried? You might start with a contour plot of a scalar field, then superimpose upon it a path. $\endgroup$ – murray Apr 9 '16 at 16:51
16
$\begingroup$

Here is one way:

noIn[y_, x_] = y;
noIn[Indeterminate, x_] = Round[x];
transIn[x_] = noIn[(1 + Erf[2 ArcTanh[2 x - 1]])/2, x];
transOut[x_] = noIn[(1 - Erf[2 ArcTanh[2 x - 1]])/2, x];

SeedRandom[15]
f[x_, y_] = RandomReal[{-1, 1}, 4].Sin[RandomReal[{-2, 2}, {4, 4}].{1, x, y, x^(4/3)}]/3;
r[t_] = {1/2 + Sin[t] + t^(3/2) - (t/2)^2, Sin[t] - t^2 + (2 t/3)^5 - 1 + t/2, 0};
g[t_] = {ReplacePart[r[t], 3 -> f @@ Most[r[t]]], r[t]};
S[t_] = s[t] /. NDSolve[{s'[t] == Sqrt[Total[r'[t]^2]], s[0] == 0}, s, {t, 0, 2}][[1]];

surf[q_] = Plot3D[f[x, y], {x, 0, S[2]}, {y, -2, 2}, Mesh -> None,
  ColorFunction -> (Hue[#3] &), PlotRange -> Full, PlotPoints -> 60,
    PlotStyle -> Opacity[2/3 q], BoundaryStyle -> Opacity[q]];
range = First[Cases[surf[0], (PlotRange -> n___) :> n, {0, \[Infinity]}]];
opt = Sequence[Boxed -> False, PlotRange -> range,
  BoxRatios -> Automatic, AxesOrigin -> {0, -2, 0}];

curv1[q_, k_] := curv1[q, k] = ParametricPlot3D[Evaluate[
  g[t][[1]] k + (1 - k) {S[t], -2, g[t][[1, 3]]}], {t, 0, 2},
    PlotStyle -> Directive[Red, Opacity[q]], PlotRange -> All];
curv2[q_, k_] := curv2[q, k] = ParametricPlot3D[Evaluate[
  g[t][[2]] k + (1 - k) {S[t], -2, g[t][[2, 3]]}], {t, 0, 2},
    PlotStyle -> Directive[Blue, Opacity[q]], PlotRange -> All];
area[q_, k_] := area[q, k] = ParametricPlot3D[Evaluate[{1 - s,
  s}.g[t] k + (1 - k) {{S[t], S[t]}, {-2, -2}, g[t][[All, 3]]}.{
    1 - s, s}], {t, 0, 2}, {s, 0, 1}, PlotRange -> All, Mesh -> None,
      PlotStyle -> Directive[Blue, Opacity[1/2]]] /. Opacity[n_] :> Opacity[n q];

optC[t_] = Sequence[opt, ViewVertical -> {0, Cos[\[Pi]/2 t^(1/12)], Sin[\[Pi]/2 t^(1/12)]},
  ViewAngle -> 35 \[Degree], ViewVector -> {Mean /@ range + {2 (t^12 - 1) + 3/2 - 2 t^12 +
    25 (t - t^2), -t^4 - 9 Sin[\[Pi]/2 t], 9 Cos[\[Pi]/2 t]}, {2 (1 - t^12) - 25 (t - t^2) +
     3 t^12, 9 Sin[\[Pi]/2 t], -9 Cos[\[Pi]/2 t]}}, ViewCenter -> {2, 0, 0} + Mean /@ range];

Now create the frames

Table[Show[surf[1], curv2[transIn[k], 1], optC[0]], {k, 0, 1, 1/5}]

Table[Show[surf[1], curv2[1, 1], optC[2/3 transIn[k]]], {k, 0, 1, 1/5}]

Table[Show[surf[1], curv2[1, 1], curv1[transIn[k], 1],
  area[transIn[k], 1], optC[2/3]], {k, 0, 1, 1/5}]

Table[Show[surf[transOut[k]], curv2[1, 1],
  curv1[1, 1], area[1, 1], optC[2/3]], {k, 0, 1, 1/5}]

Table[Show[surf[0], curv2[1, transOut[k]], curv1[1, transOut[k]],
  area[1, transOut[k]], optC[2/3]], {k, 0, 1, 1/5}]

Table[Show[surf[0], curv2[1, 0], curv1[1, 0], area[1, 0],
  optC[2/3 + transIn[k]/3]], {k, 0, 1, 1/5}]

enter image description here

$\endgroup$
  • $\begingroup$ A picture is worth a thousand upvotes... $\endgroup$ – LLlAMnYP Apr 11 '16 at 13:34
  • $\begingroup$ Excellent answer. Could I only suggest using these options in Plot3D to make the colouring look more similar to that in OP's animation? MeshFunctions -> {#3 &}, MeshShading -> Table[Hue[i/50], {i, 30}], Mesh -> 12 $\endgroup$ – thedude Apr 11 '16 at 14:04
  • $\begingroup$ @thedude It works using those with the following addition/change MeshStyle -> Opacity[2/3 q], MeshShading -> Table[Directive[Hue[i/50], Opacity[2/3 q]], {i, 30}]. Also i swapped the order of the curves relative to the gif in the question, which can be fixed by reversing the list in the definition of g[t]. $\endgroup$ – Coolwater Apr 11 '16 at 14:16
  • $\begingroup$ OMG ! A very interesting starting point for other similar projects. I love it... $\endgroup$ – José Antonio Díaz Navas Nov 8 '16 at 20:12

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.