7
$\begingroup$

In Selwyn Hollis's CalcLabs with Mathematica, Multivariable Calculus, 5th ed., he does some nice initialization code for adding vectors to a plot:

Vector[{ip : {_, _}, vec : {_, _}}, styles___] := 
  Graphics[{Arrowheads[Medium], Thickness[Medium], styles, 
    Arrow[{ip, ip + vec}]}];
Vector[vec : {_, _}, styles___] := Vector[{{0, 0}, vec}, styles];
Vector[{ip : {_, _, _}, vec : {_, _, _}}, styles___] := 
  Graphics3D[{GrayLevel[.4], CapForm["Butt"], Arrowheads[Small], 
    styles, Arrow[Tube[{ip, ip + vec}]]}];
Vector[vec : {_, _, _}, styles___] := 
  Vector[{{0, 0, 0}, vec}, styles];

Sometimes they look quite nice (and they are a wonderful shortcut to use), but sometimes they look quite weird. For example, consider:

Vector[{{1, 1, 1}, {1, 2, -1}}]

Which gives a nice quick arrow:

enter image description here

However, as the coordinates get larger, the arrows can look quite weird. For instance:

Clear[x, y, f, gradf];
f[x_, y_] = x^2 + y^2 + 5;
gradf[x_, y_] = D[f[x, y], {{x, y}}];
surf = Plot3D[f[x, y], {x, 0, 9}, {y, 0, 9},
   Mesh -> None,
   PlotStyle -> Opacity[0.8],
   RegionFunction -> Function[{x, y, z}, x^2 + y^2 < 81]];
gradvec = Append[gradf[2, 2], 0];
tanvec = Append[gradf[2, 2], gradf[2, 2].gradf[2, 2]];
vecs = Vector /@ {{{2, 2, 0}, gradvec}, {{2, 2, f[2, 2]}, tanvec}};
Show[surf, vecs, AxesLabel -> {"x", "y", "z"}, 
 ViewPoint -> {2.4, -2.3, 0.2}]

Which produces this image:

enter image description here

After running the code, use your mouse to do a bit of rotation and you'll see some problems with arrowheads, etc.

I believe I've seen this before with arrows and arrowheads. What can be done with this example (and the vector definitions) in order to make them look nice in many situations?

Another nice question to ask is the vector command allows the user to add some styles. How do you do that though in this situation?

vecs = Vector /@ {{{2, 2, 0}, gradvec}, {{2, 2, f[2, 2]}, tanvec}};

Black Window Problem Again:

enter image description here

$\endgroup$
6
$\begingroup$

The reason for the squished appearance of the vectors in 3D is that Plot3D chooses an artificial value of the option BoxRatios by default, because the z axis would be much taller than the other axes if we set the scales equal for all axes. The Show command takes over this BoxRatios setting from Plot3D, because it is given as the first plot to be shown. Consequently, the subsequent 3D shapes contained in the definition of Vector are shown flattened.

But that's not all. In addition, the scale for Arrowheads is different from that for the shaft. The heads are scaled in relation to the width of the plot, and that gives you a very confusing mix of scales. And that's not all, either. In addition, the arrow heads don't resize correctly with the image, and this is just buggy. I've long ago given up using the built-in 3D arrows because they're a pain. The definition of Vector uses that built-in definition, and consequently it inherits these problems.

If you do want to keep using these vector definitions, the first thing you have to do is fix the BoxRatios of the combined plot to be Automatic, meaning that the scales are equal in all three Cartesian directions. Your application requires this anyway, because you're trying to show a tangent to the surface, and in general such tangents won't look right when plotted with a squished z axis scale. In addition, we need to do this because then the arrows have a chance of looking normal.

However, if you aren't satisfied with the scaling of the arrowheads, then you may want to go one step further and replace the function Vector entirely by the function arrowLine I define below:

ClearAll[arrowLine]
Options[arrowLine] = {Thickness -> .1, "HeadScale" -> 3};

arrowLine[{p1_, p2_}, 
  OptionsPattern[]] :=
   (*p1 and p2 are 3D points.They are passed as a 
    list,to conform with the version >6 syntax for Cylinder[] *)
 Module[{p3, scale2, norm, pyramidHeight = 3/2}, 
  scale2 = OptionValue["HeadScale"]*OptionValue[Thickness];
  norm = Norm[p2 - p1];
  If[norm > scale2*pyramidHeight, 
   p3 = p1 + (p2 - p1)/norm (norm - scale2 pyramidHeight);
   {EdgeForm[], Cylinder[{p1, p3}, OptionValue[Thickness]], 
    GeometricTransformation[
     GraphicsComplex[{{0, 0, pyramidHeight}, {0, -1, 0}, {0, 1, 
        0}, {-1, 0, 0}, {1, 0, 0}}, 
      Polygon[{{3, 4, 1}, {4, 2, 1}, {2, 5, 1}, {5, 3, 1}, {5, 2, 4, 
         3}}]], Composition[TranslationTransform[p3], 
      Quiet[RotationTransform[{{0, 0, 1}, 
         p2 - p1}], {RotationMatrix::degen, RotationTransform::spln}],
       ScalingTransform[scale2 {1, 1, 1}]]]}, {}]]

Clear[x, y, f, gradf];
f[x_, y_] = x^2 + y^2 + 5;
gradf[x_, y_] = D[f[x, y], {{x, y}}];
surf = Plot3D[f[x, y], {x, 0, 9}, {y, 0, 9}, Mesh -> None, 
   PlotStyle -> Opacity[0.8], 
   RegionFunction -> Function[{x, y, z}, x^2 + y^2 < 81]];
gradvec = Append[gradf[2, 2], 0];
tanvec = Append[gradf[2, 2], gradf[2, 2].gradf[2, 2]];

vecs = arrowLine /@ {{{2, 2, 0}, gradvec}, {{2, 2, f[2, 2]}, tanvec}};

Show[surf, Graphics3D[{Red, vecs}], AxesLabel -> {"x", "y", "z"}, 
 ViewPoint -> {2.4, -2.3, 0.2}, BoxRatios -> Automatic, 
 PlotRange -> {{0, 9}, {0, 9}, {0, 40}}]

plot3D

Here, I defined the arrow heads as pyramidal objects that scale the same way as the shaft (i.e., in relation to the radius of the Tube). The ratio is given by the option "HeadScale". The radius of the shaft is specified by the option Thickness. Other than that, arrowLine is used just like Arrow (or your Vector) in 3D.

To change the arrow head, do e.g.:

vecs = arrowLine[#, "HeadScale" -> 6] & /@ {{{2, 2, 0}, 
     gradvec}, {{2, 2, f[2, 2]}, tanvec}};

Alternatively, you can also specify new defaults using

SetOptions[arrowLine, Thickness -> .15, "HeadScale" -> 9]

This allows you to keep using arrowLine without further option specifications as it was done in the first example.

$\endgroup$
  • $\begingroup$ I must say I'm repeatedly somehow surprised of BoxRatios and AspectRatio being chosen by default automatically, but that setting not being the same as Automatic... $\endgroup$ – kirma Jul 18 '15 at 5:17
  • $\begingroup$ @Jens Cause me to experience Black Window when resizing or rotating image. See example in my original post. Haven't experienced this in some time. This last one is the third time it has occurred after shutting down Mathematica two times and restarting. Some clickable error messages occurred, which I sent to Wolfram. $\endgroup$ – David Jul 18 '15 at 15:43
  • $\begingroup$ @David Yes, I've had crashes related to arrows before, too. But not this particular one you're seeing... my frustration is part of the reason I initially wrote this page where the code for this answer came from, too. $\endgroup$ – Jens Jul 18 '15 at 16:11

Your Answer

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

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