2
$\begingroup$

I want to plot a phase portrait, I think I need to use StreamPlot to do this, $$x'=x(a-bx-cy)$$ $$y'=y(d-ex-fy)$$ I know how to plot this with manipulate

Manipulate[Plot[{a/c-b/cx,d/f-e/fx,0},{x,-10,10}],{a,1,10},{b,1,10},{c,1,10},{d,1,10},{e,1,10},{f,1,10}]

but i cannot get the vectors to show direction nor can i graph the nullcline $x=0$

Manipulate[
 StreamPlot[{0, a/c - b/c*x, d/f - e/f*x}, {x, -3, 3}, {y, -3, 3}, 
  StreamScale -> Large, 
  PlotLabel -> 
   Row[{"a = ", a, " , b = ", b , ", c = ", c , ", d = ", d , 
     ", e = ", e, ", f = ", f }]], {a, 1, 10}, {b, 1, 10}, {c, 1, 
  10}, {d, 1, 10}, {e, 1, 10}, {f, 1, 10}]

but this gives me no image. Thank you.

$\endgroup$
4
$\begingroup$
Manipulate[
 StreamDensityPlot[{x*(a - b*x - c*y), y*(d - e*x - f*y)}, {x, -3, 
   3}, {y, -3, 3}, StreamScale -> Large, 
  PlotLabel -> 
   Row[{"a = ", a, " , b = ", b, ", c = ", c, ", d = ", d, ", e = ", 
     e, ", f = ", f}]], {a, 1, 10}, {b, 1, 10}, {c, 1, 10}, {d, 1, 
  10}, {e, 1, 10}, {f, 1, 10}]

fig1

$\endgroup$
2
$\begingroup$

The dynamics at the non-trivial equilibrium point:

Needs["MaTeX`"]
<< c:\CurvesGraphics6\CurvesGraphics6.m

Non-trivial equilibrium is unstable

Non-trivial intersection of zero isoclines:

 a = 12; b = .04; c = 0.75; d = 3; e = .03; f = 0.1;

zeroisointersecx = ContourPlot[x (a - b x - c y) == 0, {x, 0, 330}, {y, 0, 32}, PlotRange -> {{Automatic, 330}, {-1, 32}}, ContourStyle ->{Thickness[0.003], Dashed, Darker[Red]}, LabelStyle -> Directive[Black, Tiny], PlotPoints -> 100, LabelStyle -> Directive[Black, Bold, Tiny], AxesStyle -> Directive[Black, Small], AspectRatio -> 0.7, ImageSize -> Medium];
zeroisointersecy = ContourPlot[y (d - e x - f y) == 0, {x, 0, 330}, {y, 0, 32}, PlotRange -> {{Automatic, 330}, {-1, 32}}, ContourStyle ->{Thickness[0.003], Dashed, Darker[Blue]}, LabelStyle -> Directive[Black, Tiny], PlotPoints -> 100, LabelStyle -> Directive[Black, Bold, Tiny], AxesStyle -> Directive[Black, Small], AspectRatio -> 0.7, ImageSize -> Medium];

Coordinates of the non-trivial equilibrium point:

P0 = {2100/37, 480/37};
point1 = Graphics[{PointSize[0.015], Black, Point[P0], Axes -> True, PlotRange -> All, ImageSize -> Large}]; 
point2 = Graphics[{PointSize[0.012], White, Point[P0], Axes -> True, PlotRange -> All, ImageSize -> Large}];

Equilibria on the invariant axes:

eqpx = {300, 0};
Px = Graphics[{PointSize[0.015], Black, Point[eqpx], Axes -> True, PlotRange -> All, ImageSize -> Large}];
eqpy = {0, 30};
Py = Graphics[{PointSize[0.015], Black, Point[eqpy], Axes -> True, PlotRange -> All, ImageSize -> Large}];

Labels for the non-trivial equilibrium and the four dynamic regions:

point3 = Graphics[{PointSize[Tiny], White, Point[P0], Text[MaTeX["P_{0}", Magnification -> 0.8], P0 + {3, 1.4}]}, Axes -> True, PlotRange -> All, ImageSize -> Large, PlotRange -> All];
coordinate1 = {100, 17.5}; 
point4 = Graphics[{PointSize[Tiny], White, Point[coordenate1], Text[MaTeX["\\textbf{I}", Magnification -> 0.8], coordenate1 - {0.3, -0.15}]}, Axes -> True, PlotRange -> All, ImageSize -> Large, PlotRange -> All];
coordinate2 = {10, 17.5};
point5 = Graphics[{PointSize[Tiny], White, Point[coordenate2], Text[MaTeX["\\textbf{II}", Magnification -> 0.8], coordenate2 - {0.3, -0.15}]}, Axes -> True, PlotRange -> All, ImageSize -> Large, PlotRange -> All];
coordinate3 = {14, 6};
point6 = Graphics[{PointSize[Tiny], White, Point[coordenate3], Text[MaTeX["\\textbf{III}", Magnification -> 0.8], coordenate3 - {-6, -0.15}]}, Axes -> True, PlotRange -> All, ImageSize -> Large, PlotRange -> All];
coordinate4 = {100, 6};
point7 = Graphics[{PointSize[Tiny], White, Point[coordenate4], Text[MaTeX["\\textbf{IV}", Magnification -> 0.8], coordenate4 - {-2, -0.15}]}, Axes -> True, PlotRange -> All, ImageSize -> Large, PlotRange -> All];

The axes:

linex = ListLinePlot[{{0, 0}, {325, 0}}, PlotStyle -> {Black, Thickness[0.0015], Arrowheads[0.02]}, Oriented -> True, HowManyArrows -> 2, Axes -> False];
liney = ListLinePlot[{{0, 0}, {0, 31.2}}, PlotStyle -> {Black, Thickness[0.0015], Arrowheads[0.02]}, Oriented -> True, HowManyArrows -> 2 ,Axes -> False];

Phase portrait:

icv = {{220, 12}, {100, 28}, {10, 3}, {170, 18}, {160, 22}, {28, 11}, {35, 9.5}, {260, 24}, {5.67, 6}};
Table[{{u[j], v[j]}} = NDSolve[{x'[t] == x[t] (a - b x[t] - c y[t]), x[0] == icv[[j, 1]], y'[t] == y[t] (d - e x[t] - f y[t]), y[0] == icv[[j, 2]]}, {x[t],y[t]}, {t, 0, 10}], {j, 1, Length[icv]}];
t1 = Table[{Evaluate[x[t] /. u[j]], Evaluate[y[t] /. v[j]]}, {j, 1, Length[icv] - 2}];
t2 = Table[{Evaluate[x[t] /. u[j]], Evaluate[y[t] /. v[j]]}, {j, Length[icv] - 1, Length[icv]}];
g1 = ParametricPlot[t1, {t, 0, 9}, AxesOrigin -> {0, 0}, AspectRatio -> .7, PlotRange -> All, Oriented -> True, ArrowPositions -> {0.03, 0.4}, PlotStyle -> Directive[Thickness[0.003], Arrowheads[.02]]];
g2 = ParametricPlot[t2, {t, 0, 0.7}, AxesOrigin -> {0, 0}, AspectRatio -> .7,PlotRange -> All, Oriented -> True, HowManyArrows -> 2, PlotStyle -> {{Dashed, Black, Thickness[.003], Directive[Arrowheads[.02]]}}]; 
Show[zeroisointersecx, zeroisointersecy, g1, g2, linex, liney, Px, Py, point1, point2, point3, point4, point5, point6, point7, Ticks -> True, ImageSize -> Medium]

enter image description here

Population $x$ goes to extinction

Clear[a, b, c, d, e, f]

The zero-isoclines:

a = 10; b = 0.04; c = 0.75; d = 2; e = 2/375; f = 0.1;
zeroisointersecx2 = ContourPlot[x (a - b x - c y) == 0, {x, 0, 410}, {y, 0, 32}, PlotRange -> {{Automatic, 410}, {-1, 32}}, ContourStyle -> {Thickness[0.003], Dashed, Darker[Red]}, LabelStyle -> Directive[Black, Tiny], PlotPoints -> 100, LabelStyle -> Directive[Black, Bold, Tiny], AxesStyle -> Directive[Black, Small], AspectRatio -> 0.7, ImageSize -> Medium];
zeroisointersecy2 = ContourPlot[y (d - e x - f y) == 0, {x, 0, 410}, {y, 0, 32}, PlotRange -> {{Automatic, 410}, {-1, 32}}, ContourStyle -> {Thickness[0.003], Dashed, Darker[Blue]}, LabelStyle -> Directive[Black, Tiny], PlotPoints -> 100, LabelStyle -> Directive[Black, Bold, Tiny], AxesStyle -> Directive[Black, Small], AspectRatio -> 0.7, ImageSize -> Medium];

Equilibria on the invariant axes:

eqpx2 = {250, 0};
Px2 = Graphics[{PointSize[0.015], Black, Point[eqpx2], Axes -> True, PlotRange -> All, ImageSize -> Large}];
Px3 = Graphics[{PointSize[0.012], White, Point[eqpx2], Axes -> True, PlotRange -> All, ImageSize -> Large}];
eqpy2 = {0, 20};
Py2 = Graphics[{PointSize[0.015], Black, Point[eqpy2], Axes -> True, PlotRange -> All, ImageSize -> Large}];

Labels for the equilibria and the three dynamic regions:

coordinate5 = {21, 10};
point8 = Graphics[{PointSize[Tiny], White, Point[coordenate5], Text[MaTeX["\\textbf{I}", Magnification -> 0.8], coordenate5 - {0.3, 0}]}, Axes -> True, PlotRange -> All, ImageSize -> Large, PlotRange -> All];
coordinate6 = {140, 10};
point9 = Graphics[{PointSize[Tiny], White, Point[coordenate6], Text[MaTeX["\\textbf{II}", Magnification -> 0.8], coordenate6 - {0.3, 0}]}, Axes -> True, PlotRange -> All, ImageSize -> Large, PlotRange -> All];
coordinate7 = {300, 10};
point10 = Graphics[{PointSize[Tiny], White, Point[coordenate7], Text[MaTeX["\\textbf{III}", Magnification -> 0.8], coordenate7 - {-6, 0}]}, Axes -> True, PlotRange -> All, ImageSize -> Large, PlotRange -> All];

The axes:

solx = NDSolve[{x'[t] == x[t] (a - b x[t] - c y[t]), x[0] == 0.1, y'[t] == y[t] (d - e x[t] - f y[t]), y[0] == 0}, {x[t], y[t]}, {t, -10, 50}];
linex2 = ParametricPlot[Evaluate[{x[t], y[t]} /. First[solx]], {t, 0, 10}, AxesOrigin -> {0, 0}, AspectRatio -> .7, PlotRange -> All, Oriented -> True, HowManyArrows -> 2, Axes -> False, PlotStyle -> {Black, Thickness[.0025], Directive[Arrowheads[.02]]},ImageSize -> Large];
solx2 = NDSolve[{x'[t] == x[t] (a - b x[t] - c y[t]), x[0] == 0, y'[t] == y[t] (d - e x[t] - f y[t]), y[0] == 31}, {x[t], y[t]}, {t, 0, 10}];
linex22 = ParametricPlot[Evaluate[{x[t], y[t]} /. First[solx2]], {t, 0, 10}, AxesOrigin -> {0, 0}, AspectRatio -> .7, PlotRange -> All, Oriented -> True, HowManyArrows -> 2, Axes -> False, PlotStyle -> {Black, Thickness[.0025], Directive[Arrowheads[.02]]},ImageSize -> Large];
soly = NDSolve[{x'[t] == x[t] (a - b x[t] - c y[t]), x[0] == 0, y'[t] == y[t] (d - e x[t] - f y[t]), y[0] == 0.1}, {x[t], y[t]}, {t, -10, 10}];
liney2 = ParametricPlot[Evaluate[{x[t], y[t]} /. First[soly]], {t, 0, 10}, AxesOrigin -> {0, 0}, AspectRatio -> .7, PlotRange -> All, Oriented -> True, HowManyArrows -> 2, Axes -> False, PlotStyle -> {Black, Thickness[.0025], Directive[Arrowheads[.02]]}, ImageSize -> Large];
soly2 = NDSolve[{x'[t] == x[t] (a - b x[t] - c y[t]), x[0] == 410, y'[t] == y[t] (d - e x[t] - f y[t]), y[0] == 0}, {x[t], y[t]}, {t,0, 10}];
liney22 = ParametricPlot[Evaluate[{x[t], y[t]} /. First[soly2]], {t, 0, 10}, AxesOrigin -> {0, 0}, AspectRatio -> .7, PlotRange -> All, Oriented -> True, HowManyArrows -> 2, Axes -> False, PlotStyle -> {Black, Thickness[.0025], Directive[Arrowheads[.02]]},ImageSize -> Large];

Phase portrait:

icv2 = {{220, 12}, {100, 28}, {170, 18}, {160, 22}, {26, 7}, {35, 9.5}, {30, 6}, {50, 3}, {40, 5}, {360, 5}};
Table[{{u[j], v[j]}} = NDSolve[{x'[t] == x[t] (a - b x[t] - c y[t]), x[0] == icv2[[j, 1]], y'[t] == y[t] (d - e x[t] - f y[t]), y[0] == icv2[[j, 2]]}, {x[t], y[t]}, {t, 0, 20}], {j, 1, Length[icv2]}];
t3 = Table[{Evaluate[x[t] /. u[j]], Evaluate[y[t] /. v[j]]}, {j, 1, Length[icv2] - 2}];
t4 = Table[{Evaluate[x[t] /. u[j]], Evaluate[y[t] /. v[j]]}, {j, Length[icv2] - 1, Length[icv2]}];
g3 = ParametricPlot[t3, {t, 0, 9}, AxesOrigin -> {0, 0}, AspectRatio -> .7, PlotRange -> All, Oriented -> True, HowManyArrows -> 1, PlotStyle -> Directive[Thickness[0.0025], Arrowheads[.02]], ImageSize -> Large];
g4 = ParametricPlot[t4, {t, 0, 3}, AxesOrigin -> {0, 0}, AspectRatio -> .7, PlotRange -> All, Oriented -> True, HowManyArrows -> 1, PlotStyle -> {{Thickness[.0025], Directive[Arrowheads[.02]]}}, ImageSize -> Large];
Show[zeroisointersecx2, zeroisointersecy2, g3, g4, linex2, linex22, liney2, liney22, Px2, Px3, Py2, point8, point9, point10, RotateLabel -> True, FrameLabel -> {MaTeX["\\text{Population}\\hspace{0.1cm}x", Magnification -> 0.9], MaTeX["\\text{Population}\\hspace{0.1cm}y", Magnification -> 0.9]}, ImageSize -> Medium]

enter image description here

Population $y$ goes to extinction

a = 22; b = 1/10; c = 75/100; d = 15/10; e = 1/100; f = 1/10;

Non-trivial equilibrium is stable

a = 22; b = 3/10; c = 75/100; d = 15/10; e = 6/1000; f = 1/10;

The qualitative analysis of this system is trivial. However, I recommend reviewing the book Population Biology (Alan Hastings).

For more details about CurvesGraphics6 see: Gianluca Gorni

For more details about MaTeX see: Szabolcs Horvát

$\endgroup$
1
  • $\begingroup$ Can you, please, provide a means to obtain the code you use in this answer? It will be better if it can be self contained. As it is now, this does not seem to be of use to anyone without the seemingly custom code you load. $\endgroup$ – CA Trevillian Mar 14 at 5:17

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.