5
$\begingroup$

I am trying to create animations of a time dependent vector field $\vec v(t,x,y)$. The problem is that VectorPlot scales the vectors for each time $ t $ separately based on the minimal and maximal norm of the vector field at that time.

This answer shows how to solve this problem using VectorScale in the case in which the ratio of the max. norm for some time $ t$ and the the max. norm over all times is known. I suppose this could be found by evaluating $ \vec v $ on a $ (t,x,y) $ grid, but that makes for quite a lot of evaluations which I'd rather avoid. Surely there is a simpler way?

$\endgroup$
4
$\begingroup$

I finally found the time to revisit this problem. In the end, I went with determining the correct scaling factors manually. The code below takes a vector field (as a function $v(t,x,y)$), $x$ & $y$ ranges, $t$ range & number of frames as arguments and produces an array of suitably scaled vector plots. The range of scale parameters can be set with Options, as can all the default VectorPlot directives.

Options[vecAnimate] = {
   "scaleMin" -> 0.01, "scaleMax" -> 0.075, 
   "vecScaleFun" -> Automatic
   };
vecAnimate[v_, {x_, xmin_, xmax_}, {y_, ymin_, ymax_}, {tmin_, tmax_, 
   nFrames_}, opt : OptionsPattern[{vecAnimate, VectorPlot}]] :=

 Module[{
   evalPoints =  
    Reap[VectorPlot[v[0, x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
       EvaluationMonitor :> Sow[{x, y}]]][[-1, 1]],
   tR = Subdivide[tmin, tmax, nFrames][[;; -2]],
   scaleMin = OptionValue["scaleMin"], 
   scaleMax = OptionValue["scaleMax"],
   maxNorms, totalMaxNorm, scales 
   },
  maxNorms = Table[Max @ (Norm /@ (v[t, #1, #2] & @@@ evalPoints)), {t, tR}];
  totalMaxNorm = Max @ maxNorms;
  scales = maxNorms/totalMaxNorm;
  scales = scales * (scaleMax - scaleMin) + scaleMin;
  MapThread[
   VectorPlot[v[#1, x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
     VectorScale -> {#2, Automatic, OptionValue["vecScaleFun"]}, 
     Evaluate@FilterRules[{opt}, Options[VectorPlot]]] &, {tR, scales}]
  ]

Demo (Hertzian Dipole):

With[{ex = 5, r = Sqrt[#.#] &, 
  d0 = {0, 1}}, {v = Function[{t, x, y}, If[r[{x, y}] > .75, 
     Cos[t - r[{x, y}]] (d0/r[{x, y}] - ( {x, y}*({x, y}.d0))/r[{x, y}]^3),
     {0, 0}]]
 }, 
 ListAnimate[
  vecAnimate[v, {x, -ex, ex}, {y, -ex, ex}, {0, 2 \[Pi], 30}, 
   PlotRange -> 1.2 {{-ex, ex}, {-ex, ex}}]
 ]
]

yields

gif

The method above fails in the presence of poles. As in the example, this can be alleviated by just returning a zero vector in some region or above some vector field norm.

$\endgroup$
1
$\begingroup$

Try VectorScale this way:

Animate[
 VectorPlot[{Cos[2 \[Pi] x + t], Sin[2 \[Pi] y + t^2]},
  {x, -1, 1}, {y, -1, 1},
  VectorScale -> {Large, Scaled[1]}],
 {t, .1, 2, .05}]
$\endgroup$
  • $\begingroup$ But e.g. with the vector field 1/t {Cos[2 \[Pi] x + t], Sin[2 \[Pi] y + t^2]}, this will not reproduce the shrinking vector magnitudes correctly, which is what I am after. $\endgroup$ – Johannes R. Jan 6 at 22:56

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.