3
$\begingroup$

Wanted to see if anyone could help me out here.

I interested in seeing if it's possible to animate this vector plot I've created.

r[x_, y_] := Sqrt[x^2 + y^2];
R2[x_, y_] := r[x, y]^2 + 1 + 2/r[x, y];
phidot[x_, y_] := If[r[x, y] >= 2, 2/((r[x, y])^3 + r[x, y] + 2), 0];
vx[x_, y_] := -y phidot[x, y];
vy[x_, y_] := x phidot[x, y];
VectorPlot[{vx[x, y], vy[x, y]}, {x, -2 \[Pi], 2 \[Pi]}, {y, -2 \[Pi],
2 \[Pi]}]

The equation used to create this vector field describes the speed at which space is drug by an extreme Kerr black hole. As you get closer to the event horizon, r = 1, space is drug faster, hence the bigger vectors. If possible, what I'd like to do is to get the vectors to circle around the origin in a similar manner, with some representation of their magnitude, at least relative to each other. If anyone could offer some assistance, I'd really appreciate it.

As a bonus, it would be cool if any different colors or background were possible.

Thanks!

$\endgroup$
  • $\begingroup$ Please share your code as text instead of as an image so that people run it. $\endgroup$ – C. E. Apr 26 '19 at 20:19
  • $\begingroup$ Please do not post images of your work, especially when the images display at a size that make them difficult to read. Please post your actual Mathematica code in the form of text that can be copied and pasted into a Mathematica notebook. Without such, it will be difficult to reproduce your problem and to experiment with possible solutions. $\endgroup$ – m_goldberg Apr 26 '19 at 20:24
  • $\begingroup$ Sorry guys. Still new to this. Learning the etiquette as I go. $\endgroup$ – Nathan June Apr 26 '19 at 20:45
2
$\begingroup$

This answer is similar to @Edmund's, except with the rotation angle dependent on the radius:

pts2 = Table[
   Table[{x Sin[t], x Cos[t]}, {t, 0, 2 π, π/(2 x)}], {x, 1, 8}];
a = Table[VectorPlot[{vx[x, y], vy[x, y]}, {x, -2 π, 2 π}, {y, -2 π, 2 π}, 
    VectorPoints -> (Flatten[Table[RotationMatrix[ϕ/x].# & /@ pts2[[x]], {x, 1, 8}], 1])], {ϕ, 0, 2 π, π/20}];

Export["vectors.gif", a]

enter image description here

Edited to include an updated version in which it's easier to adjust the parameters:

numcircles = 20;
circlespacing = .5;
pointspacing = π/4;
frameinterval = π/20;

pts2 = Table[Table[{x Sin[t], x Cos[t]}, {t, 0, 2 π, pointspacing/x}], {x, 1, numcircles, circlespacing}];
a = Table[VectorPlot[{vx[x, y], vy[x, y]}, {x, -numcircles circlespacing, numcircles circlespacing}, {y, -numcircles circlespacing, numcircles circlespacing}, 
    VectorPoints -> (Flatten[
       Table[RotationMatrix[ϕ/n].# & /@ pts2[[n]], {n, Length[pts2]}], 1])], {ϕ, 0, 2 π - frameinterval, frameinterval}];

enter image description here

| improve this answer | |
$\endgroup$
  • $\begingroup$ Beat me too it. Though I was going to use CirclePoints (+1). $\endgroup$ – Edmund Apr 26 '19 at 23:17
  • $\begingroup$ @Edmund, yes CirclePoints would be better, or at least easier to read. It's not implemented in my ancient version of MMA (9)... $\endgroup$ – MelaGo Apr 26 '19 at 23:36
  • $\begingroup$ This is absolutely awesome and exactly what I've been looking for. I have one additional question about it. I have tried altering the code to include more vector points, 50, to be exact. But when I make this change, the gif it creates doesn't actually have any motion. Is there something else I need to do? All I did was add a VectorPoint -> 50, $\endgroup$ – Nathan June Apr 27 '19 at 1:39
  • $\begingroup$ @Nathan, I wasn't exactly sure what you meant by 50 points (50 total?) so I updated the answer with a version that is more generalized - you can adjust the number of "circles", spacing between them, and interval of points... see if you get something suitable. $\endgroup$ – MelaGo Apr 27 '19 at 2:56
  • $\begingroup$ That about does it. Thanks so much @MelaGo! I'm sorry if my previous note wasn't very clear. I'm pretty new to Mathematica, so I didn't even really know what I meant, specifically. But this takes care of it. Thank you so much! $\endgroup$ – Nathan June Apr 27 '19 at 3:24
1
$\begingroup$

You may use RotationMatrix with the VectorPoints option.

Using Tuples and Subdivide to get an initial set of VectorPoints.

vpoints = Tuples[ConstantArray[Subdivide[-3 \[Pi], 3 \[Pi], 25], 2]];

Then with Manipulate

Manipulate[
 VectorPlot[{vx[x, y], vy[x, y]}, {x, -2 \[Pi], 2 \[Pi]}, {y, -2 \[Pi], 2. \[Pi]},
  VectorPoints -> vpoints . RotationMatrix[r]],
 {{r, 0}, 0, -\[Pi]}
 ]

enter image description here

As VectorPlot mentions in its documentation, it has the same options as Graphics. Look there for options on background colours and more.

Hope this helps.

| improve this answer | |
$\endgroup$
  • $\begingroup$ I'm sorry, I wasn't 100% clear in my original post. I have edited it to be a bit more clear. Making the entire plot spin is nice, but what I'm really trying to do is to get each ring of vectors to spin with a magnitude relative to the magnitude of the other "rings". So the vectors in the ring with the smallest value of r would spin the fastest and they would move more slowly as r increases. $\endgroup$ – Nathan June Apr 26 '19 at 21:48

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.