2
$\begingroup$

I am attempting to create an interactive animation using Manipulate[] that allows me to move a point(or small sphere) around in a vector field to illustrate divergence. As it moves through the vector field I would like the point (or sphere) to animate by repeatedly expanding or contracting at a rate proportional to the divergence at that point.

With this, my students will be able to see whether the divergence is positive (pulsating outward) or negative (pulsating inward) at that point. They will also have a rough idea of the magnitude of the divergence by noticing relative speed of the pulses.

Here is my base code. 

Manipulate[
 Show[VectorPlot3D[{x^2, y, z}, {x, -3, 3}, {y, -3, 3}, {z, -3, 3}, 
   VectorStyle -> {"Arrow3D", Opacity[.3]}, VectorPoints -> 5, 
   VectorScale -> {1/5, 1/5, Automatic}, Boxed -> False, 
   AxesOrigin -> {0, 0, 0}], 
  Graphics3D[{Red, PointSize[Large], Point[{xp, yp, zp}]}]], {xp, 0, 
  3}, {yp, 0, 3}, {zp, 0, 3}]

I'm guessing I need to animate the Pointsize[] to either expand or contract. And I should do this at a speed proportional to the divergence at its location. But I'm not sure how to do this. And not sure how to do an animation that repeatedly pulses. Or maybe I should go about this differently my using the Sphere primitive in Graphics3D?

For reference (From the Briggs Calculus Text), I would like my animation to look something like this.

enter image description here

Improve this question
$\endgroup$
5
  • 1
    $\begingroup$ As an alternative, why not just have the point change color depending on the divergence instead? $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Dec 9, 2015 at 23:47
  • $\begingroup$ This does help except it only illustrates whether the divergence is positive or negative. I'm trying to imitate an animation I found in the Briggs Calculus text shown in my edit above. I did notice that they used color which I will add in, but I'm more interested in the pulsating and the speed of pulsating. This will give my students a more intuitive feel of the divergence than just color. $\endgroup$
    – B flat
    Commented Dec 9, 2015 at 23:53
  • $\begingroup$ The thing is, what do you want to happen with your point in a region where the divergence is negative and large? Should it shrink to the point of disappearance? Similarly, do you want the point to blow up to the extent of the entire plot if it's in a region where the divergence is positive and large? $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Dec 9, 2015 at 23:56
  • $\begingroup$ @J.M. When it is large negative I would like the point to pulsate inward at a faster speed. If the divergence is small negative then it will pulsate inward at a slower speed. And yes, shrink to a small point or disappearance will suffice. I want it to blow up to a size about that in the animation above. I'm assuming I could change this size easily once I have a baseline code to work from. Good questions. Thank you! I hope the animation above helps clarify what I am looking for. $\endgroup$
    – B flat
    Commented Dec 9, 2015 at 23:59
  • $\begingroup$ I updated the animation above to show the relative pulsating speeds that are in line with the magnitude of the divergence at a point. Also, notice that the largest and smallest sizes of the spheres never change. They are constant at every point. The only thing that changes is the speed that it changes between the largest and smallest sizes. $\endgroup$
    – B flat
    Commented Dec 10, 2015 at 0:06

1 Answer 1

Reset to default
3
$\begingroup$

Not optimal, but you might start from here.

I precompute divergence and set pulse rate function by checking min and max of div.

div[{xp_, yp_, zp_}] := 2 + 2 xp;
pulse[{xp_, yp_, zp_}] := 
  Rescale[Abs[div[{xp, yp, zp}]], {2, 8}, {.5, 0}];

Now the main code:

Manipulate[
 Show[{VectorPlot3D[{x^2, y, z}, {x, -3, 3}, {y, -3, 3}, {z, -3, 3}, 
    VectorStyle -> {"Arrow3D", Opacity[.3]}, VectorPoints -> 5, 
    VectorScale -> {1/5, 1/5, Automatic}, Boxed -> False, 
    AxesOrigin -> {0, 0, 0}], 
   Graphics3D[{Red, 
     Sphere[{xp, yp, zp}, 
      If[update, 
        ControlActive[r, 
         Refresh[r = Mod[r + Sign[div[{xp, yp, zp}]] .01, .15], 
          TrackedSymbols :> {}, 
          UpdateInterval -> pulse[{xp, yp, zp}]]], r] + .1]}]}], {{xp,
    0}, -3, 3}, {{yp, 0}, -3, 3}, {{zp, 0}, -3, 
  3}, {{update, False, "Pulse"}, {True, False}}, {{r, .05}, 0, .5, 
  ControlType -> None}]
Improve this answer
$\endgroup$
4
  • $\begingroup$ Yes! This works great! I have been playing around with your code attempting to speed up the animation with more frames per second so that there is more of a fluid change in the size of the spheres, but it seems this may already be maximized. Thank you! $\endgroup$
    – B flat
    Commented Dec 10, 2015 at 7:50
  • 1
    $\begingroup$ Thanks again. So one thing I would like to be able to do but can't is rotate the graph with the mouse while it is pulsing. It seems the pulsating is using up all the processing power so it's not allowing me to rotate the graph with the mouse at all. Even if I take out the vector field it still doesn't work. In the Briggs Calculus animation (as shown above), you can rotate the graph and pulse at the same time. Any ideas? $\endgroup$
    – B flat
    Commented Dec 10, 2015 at 22:56
  • $\begingroup$ @MichaelMcCain what you mean by rotate? Do you mean move ball with slider or rotate whole graph by mouse? it works fine on my Mathematica (10.3). And I don't see any rotation in the animation. $\endgroup$
    – halmir
    Commented Dec 11, 2015 at 14:12
  • $\begingroup$ I meant rotate whole graph by mouse. When the pulses are on, I cannot rotate the whole graph using the mouse. Sounds like this may be isolated to my machine. I will check again. Thank you! $\endgroup$
    – B flat
    Commented Dec 11, 2015 at 15:59

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.