There is a gif from Wikipedia, The line integral over a scalar field $f$.
How to plot and animate this in Mathematica? 
$\begingroup$ $\endgroup$
1 
- 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– murray2016-04-09 16:51:22 +00:00Commented Apr 9, 2016 at 16:51
Add a comment |
1 Answer
$\begingroup$ $\endgroup$
4 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}] 
- $\begingroup$ A picture is worth a thousand upvotes... $\endgroup$LLlAMnYP– LLlAMnYP2016-04-11 13:34:25 +00:00Commented Apr 11, 2016 at 13:34
- $\begingroup$ Excellent answer. Could I only suggest using these options in
Plot3Dto make the colouring look more similar to that in OP's animation?MeshFunctions -> {#3 &}, MeshShading -> Table[Hue[i/50], {i, 30}], Mesh -> 12$\endgroup$Baran Cimen– Baran Cimen2016-04-11 14:04:34 +00:00Commented Apr 11, 2016 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 ofg[t]. $\endgroup$Coolwater– Coolwater2016-04-11 14:16:52 +00:00Commented Apr 11, 2016 at 14:16 - $\begingroup$ OMG ! A very interesting starting point for other similar projects. I love it... $\endgroup$José Antonio Díaz Navas– José Antonio Díaz Navas2016-11-08 20:12:28 +00:00Commented Nov 8, 2016 at 20:12