5
$\begingroup$

I am new to Mathematica and currently learning how to visualize mathematical functions and their gradients. I am trying to reproduce a specific image that illustrates the gradient of a two-variable function. The image contains a 3D plot of the function's surface and vectors that represent the gradient at various points on the surface.

enter image description here

Unfortunately, I don't have the exact function used to generate the original plot, nor do I have experience in creating such detailed visualizations in Mathematica.

Any help on how to approach this problem, or any examples that are similar to the image I am trying to replicate, would be greatly appreciated.

$\endgroup$
1
  • $\begingroup$ Welcome to Mathematica.SE, Azermatt! I suggest the following: 1) Take the tour and check the faqs. 2) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! 3) As you receive help, try to give it too, by answering questions in your area of expertise. $\endgroup$
    – Chris K
    Mar 1 at 2:12

3 Answers 3

6
$\begingroup$
  • To shading the mesh we use the trick by @kglr
/. {(VertexColors -> None) -> (VertexColors -> 
       Automatic)}
  • For F[x,y]={x,y,f[x,y]}, the two partial vector is D[{x, y, f[x, y]}, x]=={1,0,D[f[x,y],x]} and D[{x, y, f[x, y]}, y] == {0, 1, D[f[x, y], y]} respectively.

  • I belive that the original illustration on the right below intend to 2D since $\nabla f(x,y)$ is a 2D vector instead of 3D vector.

  • We can also use normal to express $\nabla f(x,y)$ since the normal of the piece is $(\nabla f(x,y),-1)$

Clear["Global`*"];
f[x_, y_] := -E^-(x^2 + y^2);
F[x_, y_] := {x, y, f[x, y]};
n = 5;
a = -2;
b = 2;
plot0 = Plot3D[f[x, y], {x, a, b}, {y, a, b}, 
    ColorFunction -> ColorData["Rainbow"], PlotStyle -> None, 
    Mesh -> {n, 
      n}] /. {(VertexColors -> None) -> (VertexColors -> Automatic)};
fig[i_, j_] := 
  Module[{x0, y0, g, Fx, Fy, normal, piece, piece1}, 
   x0 = Subdivide[a, b, n + 1][[i]];
   y0 = Subdivide[a, b, n + 1][[j]];
   piece = 
    Plot3D[f[x, y], {x, x0, x0 + (b - a)/(n + 1)}, {y, y0, 
      y0 + (b - a)/(n + 1)}, Mesh -> None, 
     PerformanceGoal -> "Quality", 
     PlotStyle -> Directive@{Opacity[.5], Green}];
   g = Show[plot0, piece, ImageSize -> 300];
   Fx = Derivative[1, 0][F][x0, y0];
   Fy = Derivative[0, 1][F][x0, y0];
   normal = Cross[Fx, Fy];
   piece1 = 
    Graphics3D[{piece[[1]], Red, Arrow[{F[x0, y0], F[x0, y0] + Fx}], 
      Blue, Arrow[{F[x0, y0], F[x0, y0] + Fy}], Brown, 
      Arrow@Tube[{F[x0, y0], F[x0, y0] + normal}]}, Boxed -> False, 
     ImageSize -> 300];
   Grid[{{g, piece1}, { , }}]];
ani = Manipulate[
  fig[i, j], {{i, 3}, 1, n + 1, 1}, {{j, 3}, 1, n + 1, 1}, 
  ControlPlacement -> Top]

(* fig[3,3] *)

enter image description here

$\endgroup$
3
  • $\begingroup$ Nice. Note the gradient in the original is drawn "in the plane", that is, representing a vector in the domain, which is appropriate. But it's still wrong. The scaling of the basis vectors $\bf i$ and $\bf j$ miraculously agrees with the grid spacing, and the gradient points in a direction in which the function is decreasing. $\endgroup$
    – Goofy
    Mar 1 at 12:27
  • $\begingroup$ Thank you so much; I deeply value your help. Could you advise if it's possible to include both the lines and comments within the same diagram? I haven't managed to find a solution for this yet. $\endgroup$
    – Azermatt
    Mar 1 at 17:16
  • $\begingroup$ I made another attempt, but I'm still unsure about how to incorporate arrows and text boxes for annotations. Any guidance on this would be immensely helpful. Thank you very much in advance! $\endgroup$
    – Azermatt
    Mar 1 at 18:42
4
$\begingroup$

Here is something to get you started:

f[x_, y_] = x^2 + y^2;
grad[x_, y_] = Grad[f[x, y], {x, y}];
vecs = Flatten[
   Table[Arrow[{{x, y, f[x, y]}, tmp = {x, y} + 0.15 grad[x, y]; 
      Append[tmp, f @@ tmp]}], {x, -1, 1, 0.2}, {y, -1, 1, 0.2}], 1];
Show[
 Plot3D[f[x, y], {x, -1, 1}, {y, -1, 1}, ColorFunction -> "Rainbow"],
 Graphics3D[{Thickness[0.0001], Arrowheads[0.03], vecs}]
 ]

enter image description here

$\endgroup$
2
  • $\begingroup$ thank you! One last question: is there a way of coloring one cell of mesh ? many thanks $\endgroup$
    – Azermatt
    Feb 29 at 17:26
  • $\begingroup$ I do not know a simple way to do this. You would need an overlay and hand create this cell. $\endgroup$ Feb 29 at 17:44
0
$\begingroup$

Approximates the plot:

Plot3D[-200 (4 - x^2) (4 - y^2) - 300, {x, -2, 2}, {y, -2, 2}, 
 Mesh -> 20, MeshStyle -> Thick, 
 BoundaryStyle -> Directive[Thick, Brown], PlotStyle -> White, 
 ColorFunction -> "Rainbow", Lighting -> {{"Ambient", White}}, 
 FaceGrids -> {{{-1, 0, 0}, {Range[-2, 2], 
     Range[-3500, 0, 500]}}, {{0, 1, 0}, {Range[-1, 2], 
     Range[-3500, 0, 500]}}, {{0, 0, -1}, {Range[-2, 1], 
     Range[-1, 2]}}}, FaceGridsStyle -> Directive[Thick, Dotted], 
 Ticks -> {Range[-2, 2], Range[-2, 2], Range[-3500, 0, 500]}, 
 PlotRange -> {{-2, 2}, {-2, 2}, {-3500, 0}}, 
 BoxRatios -> {1, 1, 0.6}, Boxed -> False, 
 DisplayFunction -> 
  Function[g, 
   g /. {bdy : {Directive[Thick, Brown], _Line} :> 
       bdy, (VertexColors -> None) -> (VertexColors -> Automatic)} /. 
    p_Polygon :> Append[p, VertexColors -> None]]]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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