Animate the line integral over a scalar field

Question

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

How to plot and animate this in Mathematica?

Answer 1

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