# Plot differential equation system in a complex way

Based on this differential equation system:

\begin{align*} \dot{x}&=f(x,y)\\ \dot{y}&=g(x,y) \end{align*}

where

\begin{align*} f(x, y)&=x^2+y^2-25\\ g(x, y)&=x^2-y^2-7 \end{align*}

I have to show how these two differential equations (I've named them xdot and ydot) when they are equal $0$. I have to show with arrow symbols like on this picture:

The closest to the picture is this plot with lane curves. However I must show it with arrows like i have on the picture. Is this possible in Mathematica, if yes, how?

Clear[x, y, xdot, ydot, curves, zerocurves, specielarrows]
xdot = x^2 + y^2 - 25;
ydot = x^2 - y^2 - 7;
xmin = -6;
xmax = 6;
ymin = -6;
ymax = 6;
curves = 30;
specielarrows = {{{6, 0}, Directive[Orange, Thick]}};
{Append[specielarrows, curves]};

(* plots *)
zerocurves =
ContourPlot[{xdot == 0, ydot == 0}, {x, xmin, xmax}, {y, ymin, ymax},
ContourStyle -> {Directive[Red, Thick], Directive[Blue, Thick]},
Frame -> False, Axes -> True, AxesLabel -> {x, y}]

lanecurves =
VectorPlot[{xdot, ydot}, {x, xmin, xmax}, {y, ymin, ymax},
StreamPoints -> {Append[specielarrows, curves]},
StreamStyle -> Green, VectorStyle -> Black, Axes -> True,
Frame -> False, AxesLabel -> {x, y}]

Show[zerocurves, lanecurves]

• Differential equations? Commented Apr 19, 2013 at 7:02
• Yes. The lanes show which points are asymptotic stable and unstable of the differential equation system. Do you think it is a wrong tag?? Commented Apr 19, 2013 at 7:07
• No I meant that xdot and ydot are not differential equations but now I understand that those are the rhs of $\dot x$ and $\dot y$. Commented Apr 19, 2013 at 7:09
• The points that the two curves intersect are the equilibrium points of the system. Put what about the vectors? they seem to be positioned in a random fashion. Commented Apr 19, 2013 at 7:12
• @Spawn1701D I have added the differential equation system in the text so it should be more clear. Yes, the vectors are positioned in a random fashion. Commented Apr 19, 2013 at 7:18

Ok first of all lets define $f,g$:

f[x_, y_] = xdot
g[x_, y_] = ydot


next we define our two kind of arrows:

scale = 2 (* this determines how long the arrow will be*)

blueArrow[x_, y_,s:(-1 | 1)] := {
Graphics[Line[{{{-1/3, 1/6}, {0, 0}, {-1/3, -1/6}}}]]}}],
RGBColor[98/255, 150/255, 199/255], AbsoluteThickness[3],
Arrow[{{x, y}, {x, y + scale*s}}]
}

redArrow[x_, y_, s : (-1 | 1)] := {
Graphics[Line[{{{-1/2, 1/4}, {0, 0}, {-1/2, -1/4}}}]]}}],
RGBColor[203/255, 103/255, 98/255], AbsoluteThickness[3],
Arrow[{{x, y}, {x + scale*s, y}}]
}


with the next commands we get randomly n points

testPoints[n_Integer] := {RandomInteger[{1, 3}], #}&/@Thread[{RandomReal[{xmin+scale/2,
xmax-scale/2}, n],
RandomReal[{ymin+scale/2, ymax-scale/2}, n]}]


then we find the arrows at those points:

testArrows =   Switch[#1,
1 (* only the horizontal *), redArrow[Sequence @@ #2, Sign[f @@ #2]],
2(* only the vertical *), blueArrow[Sequence @@ #2, Sign[g @@ #2]],
3(* both *), {redArrow[Sequence @@ #2, Sign[f @@ #2]],
blueArrow[Sequence @@ #2, Sign[g@@#2]]}]&@@@testPoints[10];


Now we are ready to plot the final image

Show[zerocurves, testArrows // Graphics, PlotRange->All]


Note: because of the fact that the points are chosen randomly things mught not look nice, You can instead give your own list of points in place of testPoints[n]. The syntax is {{1|2|3,{x,y}}..} where when 1 you plot only the horizontal arrow, 2 the vertical and 3 both.

Just for fun:

 Manipulate[Show[zerocurves, Graphics[Switch[#1, 1 (*only the horizontal*),
redArrow[Sequence @@ #2, Sign[f @@ #2]], 2(*only the vertical*),
blueArrow[Sequence @@ #2, Sign[g @@ #2]],
3(*both*), {redArrow[Sequence @@ #2, Sign[f @@ #2]],
blueArrow[Sequence @@ #2, Sign[g @@ #2]]}] & @@@ {{3,
p}}]], {{p, {0, 0}}, Locator}]


Manipulate[Show[zerocurves, Graphics[Switch[#1, 1 (*only the horizontal*),
redArrow[Sequence @@ #2, Sign[f @@ #2]], 2(*only the vertical*),
blueArrow[Sequence @@ #2, Sign[g @@ #2]],
3(*both*), {redArrow[Sequence @@ #2, Sign[f @@ #2]],
blueArrow[Sequence @@ #2, Sign[g @@ #2]]}] & @@@ {{m,
p}}]], {{p, {0, 0}}, Locator}, {{m, 3, ""}, {1 -> "horizontal",2 -> "vertical",
3 -> "both"}}]


Finally, with this one you click and create a new point:

  Manipulate[pic[m, p], {{p, {0, 0}}, Locator}, {{m, 3, ""}, {1 -> "horizontal",
2 -> "vertical", 3 -> "both"}}, Initialization :> {points = {};
pic[m_, p_] :=  Module[{}, AppendTo[points, {m, p}]; Show[zerocurves,
Graphics[
Switch[#1, 1 (*only the horizontal*),
redArrow[Sequence @@ #2, Sign[f @@ #2]],
2(*only the vertical*),
blueArrow[Sequence @@ #2, Sign[g @@ #2]],
3(*both*), {redArrow[Sequence @@ #2, Sign[f @@ #2]],
blueArrow[Sequence @@ #2, Sign[g @@ #2]]}] & @@@
points]]]}]


• Nice answer! I would recommend not to indent your code that much. An indentation of 2 spaces is really enough. The important advantage is, that you can make your code so narrow, that you don't get the horizontal scrollbars underneath the blocks. Commented Apr 19, 2013 at 8:49
• I get the arrows, and they have the correct pointing. However, I wonder why my image turn red, as if there is a fault. What might this cause? Commented Apr 19, 2013 at 8:51
• Yes I was trying to keep also a "visual grouping". Commented Apr 19, 2013 at 8:51
• @JensJensen let me see for any typo Commented Apr 19, 2013 at 8:52
• @JensJensen the function testPoints needs := instead of =. Commented Apr 19, 2013 at 8:55