Absolute VectorPlot scaling

Question

I'm trying to visualize the vector components of a rotation matrix with absolute vector lengths. VectorScale help states that

When using an explicit sfun, positive values are automatically scaled to lie between 0 and 1.

I wonder if there's a way to circumvent this. Capturing the max vector norm for every angle in advance and feeding it to VectorScale's first parameter also seems not optimal.

Manipulate[
{
  VectorPlot[{x - (x Cos[θ] - y Sin[θ]), y - (x Sin[θ] + y Cos[θ])}, 
  {x, -π, π}, {y, -π, π}, 
  Axes -> True, ImageSize -> Large, 
  VectorScale -> {Automatic, Automatic, #5 &}]
},
{{θ, 0}, -π, π}, 
{{n, 0.1}, 0.1, 3}]

Answer 1

The first argument of VectorScale is the "unit scale to use, given as a fraction of the diagonal of the overall bounding box", according to the documentation, so if we dynamically rescale the fraction we use so it is equal to the maximum length vector at each $\theta$ (occurs at the points in the corners), we can get the desired behavior.

With[
 {xi = -π,
  xf = π,
  yi = -π,
  yf = π,
  xmin = -3π,
  xmax = 3π,
  ymin = -3π,
  ymax = 3π},
 Manipulate[
  Module[{fx, fy, n},
   fx[x_, y_, θ_] := (x Cos[θ] - y Sin[θ]) - x;
   fy[x_, y_, θ_] := (x Sin[θ] + y Cos[θ]) - y;

   n = Sqrt[((xmax - xmin) (ymax - ymin))/((xf - xi) (yf - yi))];

   VectorPlot[{fx[x, y, θ], fy[x, y, θ]}, {x, xi, xf}, {y, yi, yf},
    Axes -> True,
    ImageSize -> Large,
    VectorScale -> { 
      n Norm[{fx[xf, yf, θ], fy[xf, yf, θ]}]/Norm[{xmax - xmin, ymax - ymin}],
      Scaled[0.1],
      Automatic
     },
    VectorPoints -> 8,
    PlotRange -> {{xmin, xmax}, {ymin, ymax}}
   ] /. Arrow[x_] :> Translate[Arrow[x], Mean[x] - First[x]]
  ],
  {{θ, π/2}, -π, π}]
 ]

I don't know why we need the n factor in front of the ratio of norms, but the lengths don't work out unless it is there. Perhaps it has something to do with how Mathematica is calculating the "diagonal of the overall bounding box."

Thanks to @kguler in this question for a good method of translating the vectors to start from their points.

The plot gets cluttered really quickly, which is, I suppose, why Mathematica automatically tries to rescale the vectors to a smaller length.

Answer 2

I'm interpreting your question as asking how to display all the vectors in your plot scaled to the same length as the vectors in the corners of the plot range. You can do that as follows:

With[{max = N[π]}, 
  Manipulate[
    VectorPlot[{x - (x Cos[θ] - y Sin[θ]), y - (x Sin[θ] + y Cos[θ])}, 
      {x, -max, max}, {y, -max, max},
      Axes -> True,
      VectorScale -> {Automatic, Automatic, (max n[θ] &)}],
    {{θ, 0}, -max, max},
    Initialization :> (
      n[θ_] := Norm[{1 - (Cos[θ] - Sin[θ]), 1 - (Sin[θ] + Cos[θ])}])]]

Answer 3

myVectorPlot[x__]:=
VectorPlot[x] /. Arrow[{p_, q_}]:>Arrow[{p + (q - p)/2, q + (q - p)/2}]; 

Manipulate[
{
sample = Table[
  {x - (x*Cos[θ] - y*Sin[θ]), 
   y - (x*Sin[θ] + y*Cos[θ])},
  {x, -Pi, Pi, 1}, {y, -Pi, Pi, 1}
]; 
scale = Max[Map[Norm, sample, {2}]]; 
myVectorPlot[{-x + (x*Cos[θ] - y*Sin[θ]), -y + (x*Sin[θ] + y*Cos[θ])}, 
{x, -Pi, Pi}, {y, -Pi, Pi}, Axes -> True, ImageSize -> Large, 
VectorScale -> {0.1*scale + 0.001, 0.2}, Frame -> False, 
PlotRange -> {-4, 4}]}, 
{{θ, 0}, 0, Pi/2}
]

---

Edit - What I was after:

With[
 {xi = -π, xf = π, yi = -π, yf = π, xmin = -3 π, 
 xmax = 3 π, ymin = -3 π, ymax = 3 π, vpoints = 6},
 Manipulate[
  Module[
   {fx, fy, n},
   fx[x_, y_, θ_] := (x Cos[θ] - y Sin[θ]) - x;
   fy[x_, y_, θ_] := (x Sin[θ] + y Cos[θ]) - y;
   n = Sqrt[((xmax - xmin) (ymax - ymin))/((xf - xi) (yf - yi))];
   vp := VectorPlot[ 
      { fx[x, y, θ], fy[x, y, θ] },
      {x, xi, xf}, {y, yi, yf},
      Axes -> True, ImageSize -> Large, 
      VectorScale -> {n Norm[{fx[xf, yf, θ], 
            fy[xf, yf, θ]}]/Norm[{xmax - xmin, ymax - ymin}], 
        Scaled[0.1], Automatic}, 
      VectorStyle -> {Black, Directive[Dashed, Blue], 
        Directive[Dashed, Red]}, VectorPoints -> vpoints, 
      PlotRange -> {{xmin, xmax}, {ymin, ymax}}
      ] /. Arrow[x_] :> Translate[Arrow[x], Mean[x] - First[x]]];
  components := Graphics[
    {
     {Blue, Arrow[{{0, 0}, xc = {x Cos[θ], x Sin[θ]}}]},
     {Red, Translate[Arrow[{{0, 0}, {-y Sin[θ], y Cos[θ]}}], xc]},
     Inset[
      Style[{"x Cos(θ)", "x Sin(θ)"} // MatrixForm, Blue], {7, 8}],
     Inset[
      Style[{"-y Sin(θ)", "y Cos(θ)"} // MatrixForm, Red], {7, 6.5}],
     Inset[Style[{"x Cos(θ) - y Sin(θ)", 
      "x Sin(θ) + y Cos(θ)"} // MatrixForm, Black], {7, 5}]
     }
    ];
  Show[vp, components],
  {{θ, 0.314}, -π, π}, {{x, xf}, xi, 
   xf, (xf - xi)/(vpoints - 1)}, {{y, yf}, yi, 
   yf, (yf - yi)/(vpoints - 1)}]
 ]