# Animate the line integral over a scalar field

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

How to plot and animate this in Mathematica?

• What have you tried? You might start with a contour plot of a scalar field, then superimpose upon it a path. Apr 9, 2016 at 16:51

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


• A picture is worth a thousand upvotes... Apr 11, 2016 at 13:34
• 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 Apr 11, 2016 at 14:04
• @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]. Apr 11, 2016 at 14:16
• OMG ! A very interesting starting point for other similar projects. I love it... Nov 8, 2016 at 20:12