3
$\begingroup$

I have a function that transforms a ContourPlot with arguments given in polar coordinates into the desired plot in Cartesian coordinates, like so:

f[r_, th_] := r^2 Sin[2 th]
g[r_, th_] := {r Cos[th], r Sin[th]}
pl = ContourPlot[f[r, th], {r, 0, 3}, {th, 0, Pi/2}, 
        ContourShading -> None];
pl[[1, 1]] = g @@@ pl[[1, 1]];
pl

Now I would like to do the same with a StreamPlot, but the corresponding graphics object has a more complex structure. If I do

sp = StreamPlot[{4 r Cos[2 th], -4 r Sin[2 th]}, 
    {r, 0, 3}, {\[Theta], 0, Pi/2}, StreamStyle -> Darker[Pink]];

I can see that the crucial part is sp[[1, 2, 1, 3]], which has a structure like

{{Arrowheads[{{0.02000000000000001, 1.}}], 
  Arrow[{{3., 1.5437002295175233}, {2.9890855215045633, 
   1.543115802641102}, {2.9591182838349264, 1.5414321353734735}, 
   {2.9294510170829717, 1.5396817289664542}, {2.9000823597142626, 
   1.5378607501076507}, {2.8710109501943655, 1.53596536548467}, 
   {2.8422354269888443, 1.5339917417851185}, {2.813754428563265, 
   1.5319360456966038}, {2.7855665933831917, 1.5297944439067321}, 
   {2.7576705599141897, 1.5275631031031103}, {2.7522285961973623, 
   1.5271047868205019}}]}..

so I would like to replace the coordinates in the Arrow functions by their Cartesian transforms. I tried something like

sp[[1, 2, 1, 3]] /. 
 Arrow[{{r_, th_}..}] -> Arrow[{{r Cos[th], r Sin[th]} ..}]

but I can't get my pattern for the sequence of repeating arrow points right. Perhaps there's also a nifty use of Apply (as in the case of the contour plot above) that will work, but my problem is that I don't understand the syntax well enough.

Can someone (a) help me fix my code, and (b) explain exactly how to use Apply or an appropriate rule to do what I want?

$\endgroup$
  • $\begingroup$ sp /. Arrow[p_] :> Arrow[Function[{r, th}, {r Cos[th], r Sin[th]}] @@@ p]? $\endgroup$ – Michael E2 Oct 29 '16 at 13:22
  • $\begingroup$ @Michael E2: Hmm, it's doing something, but the plot looks wrong. I tried StreamPlot[{r, \[Theta]}, {r, 0, 3}, {\[Theta], 0, Pi/2}] with this, and it definitely isn't right. $\endgroup$ – Pirx Oct 29 '16 at 13:33
  • $\begingroup$ I don't understand what I am seeing right now. Simple tests like StreamPlot[{r, 0}, {r, 0, 3}, {th, 0, Pi/2}] and StreamPlot[{0, 1/r}, {r, 0, 3}, {th, 0, Pi/2}] look perfectly fine, but the case with {4 r Cos[2 th], -4 r Sin[2 th]} as the vector field definitely doesn't look right. I need to think about this. $\endgroup$ – Pirx Oct 29 '16 at 14:32
  • $\begingroup$ If you're trying to plot the vector field {4x, -4y}, then you've got an extra r in the theta component. Solve[{Dt[x] == 4 x, Dt[y] == -4 y} /. {x -> r Cos[t], y -> r Sin[t]}, {Dt[r], Dt[t]}] // TrigReduce. (See this.) $\endgroup$ – Michael E2 Oct 29 '16 at 14:46
  • $\begingroup$ @Michael E2: I must have some stupid error somewhere. I have the streamfunction psi[r_, \[Theta]_] := r^2 Sin[2 \[Theta]], which, with vr = 1/r D[psi[r, \[Theta]], \[Theta]], and vth = -D[psi[r, \[Theta]], r] gives 4r Cos[2 \[Theta]] and -4r Sin[2 \[Theta]], respectively, for the vector field. However, if I drop the factor r for the second component, I get a plot that looks about right. Trouble is, that factor r should be there, I think... $\endgroup$ – Pirx Oct 29 '16 at 15:03
5
$\begingroup$

Three ways:

sp /. Arrow[p_] :> Arrow[Function[{r, th}, {r Cos[th], r Sin[th]}] @@@ p]
sp /. Arrow[p_] :> Arrow[p[[All, 1]] Transpose[Through[{Cos, Sin}[p[[All, 2]]]]]]
sp /. Arrow[p_] :> Arrow[CoordinateTransform["Polar" -> "Cartesian", p]]

The second is fastest by a little bit and arguably the most obscure. The third is roughly 400-700 times slower than the other two but readable.

(* OP's sp, fixed per comments *)
sp = StreamPlot[{4 r Cos[2 th], -4 Sin[2 th]},
  {r, 0, 3}, {th, 0, Pi/2}, StreamStyle -> Darker[Pink], 
  GridLines -> {Range[5]/2, Range[6] Pi/12}]

polarbackground = PolarPlot[0, {t, 0, Pi/2},
   PolarAxes -> True, PolarAxesOrigin -> {0, 3.}, 
   PolarTicks -> {"Radians", Automatic}, PolarGridLines -> Automatic];

Show[
 polarbackground,
 psp = sp /. Arrow[p_] :> Arrow[Function[{r, th}, {r Cos[th], r Sin[th]}] @@@ p],
 PlotRange -> {{0, 3}, {0, 3}}]

  


Update: Join close arrows

arrowsp = Cases[psp, Arrow[p_] :> p, Infinity];
distance = 0.0012;
newarrows = FixedPoint[
    Function[{arrowsp},
     arrowsp /. With[
       {nf = Nearest[arrowsp[[All, 1]] -> arrowsp]},
       Cases[arrowsp, p_ :> With[{q = nf[Last@p, {1, distance}]},
           {p -> Join[p, First@q], First@q -> Nothing} /; q =!= {}],
         1, 1] /. {r_List} :> r]
     ],
    arrowsp
    ];

Show[
 polarbackground,
 psp /. Append[Arrow[p : {First[#], __}] :> Arrow[#] & /@ newarrows, _Arrow -> {}],
 PlotRange -> {{0, 3}, {0, 3}}]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Thanks again, and I like that polarbackground ;-) As a minor quibble, you can see that there's issues near r=0. I can fix that simply by staying a little bit away from r=0, which is acceptable, but I wonder if there's a more elegant way to do this. And, yeah, I know, this is to be expected due to the singularity of the transform at r=0. $\endgroup$ – Pirx Oct 29 '16 at 19:01
  • $\begingroup$ @Pirx You're welcome. One might quibble more and say that things are deformed too much when r is small. (Too many arrowheads even on the next line away from the origin.) I'm surprised it worked so well. In my experience StreamPlot is very hard to control, so many things being done automatically. You might try playing with StreamScale. $\endgroup$ – Michael E2 Oct 29 '16 at 19:28

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.