1
$\begingroup$

I would like to color all lines witch have a positive vertical component in red and the other in blue. How can I do that?

μ0 = 4 Pi 10^-7;
(*1 magnet*)
r1[x_, y_, z_] := {x, y, z};
m1[θ1_, ϕ_, p_ ] := p {Sin[ϕ] Cos[θ1], Sin[ϕ] Sin[θ1], Cos[ϕ]};
(*2 magnet*)
r2[x_, y_, z_] := {x, y, z};
m2[θ1_, ϕ_, p_ ] := p {Sin[ϕ] Cos[θ1], Sin[ϕ] Sin[θ1], Cos[ϕ]};
M = 16.7 10^-3;
g = 9.81;

Field[x_, y_, z_, θ1_, ϕ1_, p1_] := μ0/(4 π ) ((3 m1[θ1, ϕ1, p1] . r2[x, y, z])/Norm[r2[x, y, z]]^5 r2[x, y, z] - m1[θ1, ϕ1, p1]/Norm[r2[x, y, z]]^3)

Manipulate[
 Show[
  StreamPlot[
   Field[x, 0, z, ϕ, Pi/2,  2.07][[1 ;; 3 ;; 2]],
   {x, -0.05, 0.05},  {z, -0.05, 0.05},
    ImageSize -> Medium, FrameLabel -> {"x", "z"}, 
   StreamColorFunctionScaling -> False]
  ], {ϕ, 0, 2 Pi}
 ]
$\endgroup$

2 Answers 2

2
$\begingroup$

With all other code the same as in the question, use the option StreamColorFunction

Manipulate[
 StreamPlot[
  Field[x, 0, z, ϕ, Pi/2, 2.07][[1 ;; 3 ;; 2]],
  {x, -0.05, 0.05}, {z, -0.05, 0.05},
  ImageSize -> Medium,
  FrameLabel -> {"x", "z"},
  StreamColorFunction ->
   Function[{x, z, vx, vz, n}, If[vz > 0, Red, Blue]],
  StreamColorFunctionScaling -> False],
 {{ϕ, 0}, 0, 2 Pi, 0.01, Appearance -> "Labeled"},
 TrackedSymbols :> {ϕ}]

enter image description here

$\endgroup$
1
$\begingroup$

This is a little bit of a kluge, because in StreamPlot, the arrows are curved, so I had to make a choice as to what constituted "up" and what constituted "down. Here's how I made the choice. The arrows in the plot are stored internally in the form of

Arrow[listOfPoints]

where listOfPoints is the list of points that define the curve of the arrow. I took the last two points in the list, and if the y-value of the last element was less than or equal to the y-value of the second-to-last element, I made the arrow blue by making the replacement

Arrow[lst_] :> {Blue, Arrow[lst]}

Then, I set all of the rest of the arrows red in the same way. One could make a different choice. For instance, we could replace the condition I chose with one that averages over the length of the curve, and if it is "mostly" pointing down, then make it blue.

Code follows:

μ0 = 4 Pi 10^-7;
(*1 magnet*)
r1[x_, y_, z_] := {x, y, z};
m1[θ1_, ϕ_, p_ ] := p {Sin[ϕ] Cos[θ1], Sin[ϕ] Sin[θ1], Cos[ϕ]};
(*2 magnet*)
r2[x_, y_, z_] := {x, y, z};
m2[θ1_, ϕ_, p_ ] := p {Sin[ϕ] Cos[θ1], Sin[ϕ] Sin[θ1], Cos[ϕ]};
M = 16.7 10^-3;
g = 9.81;

Field[x_, y_, z_, θ1_, ϕ1_, p1_] := μ0/(4 π ) ((3 m1[θ1, ϕ1, p1] . r2[x, y, z])/Norm[r2[x, y, z]]^5 r2[x, y, z] - m1[θ1, ϕ1, p1]/Norm[r2[x, y, z]]^3)

Manipulate[
 Show[
  StreamPlot[
   Field[x, 0, z, ϕ, Pi/2,  2.07][[1 ;; 3 ;; 2]],
   {x, -0.05, 0.05},  {z, -0.05, 0.05},
    ImageSize -> Medium, FrameLabel -> {"x", "z"}, 
   StreamColorFunctionScaling -> False]
  ], {ϕ, 0, 2 Pi}
 ]

Normal@p1 /. {Arrow[lst_] /; lst[[-1, 2]] - lst[[-2, 2]] >= 0 :> {Blue, Arrow[lst]}, x_Arrow :> {Red, x}}

enter image description here

TO make this work in Manipulate, do

Manipulate[
 p1 = Show[
   StreamPlot[Field[x, 0, z, ϕ, Pi/2, 2.07][[1 ;; 3 ;; 2]],
   {x, -0.05, 0.05}, {z, -0.05, 0.05},
   ImageSize -> Medium, FrameLabel -> {"x", "z"}, StreamColorFunctionScaling -> False]
   ];
 Normal@p1 /. {Arrow[lst_] /; lst[[-1, 2]] - lst[[-2, 2]] >= 0 :> {Blue, Arrow[lst]} , x_Arrow :> {Red, x}},
 {ϕ, 0, 2 Pi}]
$\endgroup$

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.