0
$\begingroup$

For teaching purposes I want to generate a vectorfield on a surface an visualize the path of the gradient method.

The surface and the gradient are generated by

f[x_, y_] := Sin[x] Cos[y];
gr[x_, y_] := D[f[xx, yy], {{xx, yy}, 1}] /. {xx -> x, yy -> y};
a = 5;
xmin = -a; xmax = a;
ymin = -a; ymax = a;
nmax = 10;
mmax = 10;
dx = (xmax - xmin)/nmax;
dy = (ymax - ymin)/mmax;
grf = Table[xi = xmin + i*dx; yj = ymin + j*dy;
   v = {xi, yj};
   w = v + Evaluate@gr[xi, yj];
   Arrow[{v, w}],
   {i, 0, nmax}, {j, 0, mmax}];
pp = Plot3D[f[x, y], {x, xmin, xmax}, {y, ymin, ymax}, Mesh -> None, 
  PlotStyle -> {Orange, Opacity[0.75]}]
Graphics[grf]

The gradient field is transformed into a tangent vector field with

pp = Plot3D[f[x, y], {x, xmin, xmax}, {y, ymin, ymax}, Mesh -> None, 
   PlotStyle -> {Orange, Opacity[0.75]}];
grfplt = Table[xi = xmin + i*dx; yj = ymin + j*dy;
   v = {xi, yj, f[xi, yj]};
   gg = gr[xi, yj];
   w = v + {gg[[1]], gg[[2]], f[xi + gg[[1]], yj + gg[[2]]]};
   Graphics3D[{Arrowheads[.01], Arrow[{v, w}]}],
   {i, 0, nmax}, {j, 0, mmax}];
Show[pp,grfplt]

The gradient method paths should be generated by

gradmeth[f_, x0_, y0_] := 
 Table[xa = x0; ya = y0; gg = gr[xa, ya]; xb = xa + gg[[1]]; 
  yb = ya + gg[[2]]; v = {xa, ya, f[xa, ya]};
  w = {xb, yb, f[xb, yb]};
  xa = xb; ya = yb;
  Graphics3D[{Red, Thick, Arrowheads[.05], Arrow[{v, w}]}],
  {i, 0, 15}
  ];
gr1 = gradmeth[f, 2, 2];
gr2 = gradmeth[f, 2, 1];
Show[pp, grfplt, gr1, gr2]

But obviously the statement xa = xb; ya = yb; overwrite w each time.

Therefore, I used a module

gradmeth[f_, x0_, y0_, col_] := Module[{xa, xb, ya, yb, gg, v, w, ll},
  xa = x0; ya = y0; ll = {};
  For[i = 0, i <= 10, i++,
   gg = gr[xa, ya]; xb = xa + gg[[1]]; yb = ya + gg[[2]]; 
   v = {xa, ya, f[xa, ya]};
   w = {xb, yb, f[xb, yb]};
   (*AppendTo[ll,Graphics3D[{Red,Thick,Arrowheads[.05],Arrow[{v,
   w}]}]];*)
   AppendTo[ll, {col, Thick, Arrowheads[.05], Arrow[{v, w}]}];
   xa = xb; ya = yb;
   ];
  ll
  ]
gr1 = Graphics3D[gradmeth[f, 2, 2, Red]];
gr2 = Graphics3D[gradmeth[f, -2, -1, Blue]];
Show[pp, grfplt, gr1, gr2]

But this is very slow!

Can I repair the table approach?

Can I speedup the module approach?

Any help would be helpful!

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.