# ColorFunction for StreamPlot

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}
]


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 :> {ϕ}]


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}}


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}]