1
$\begingroup$

I'm asking for your help in adding the points to a VectorPlot3D output as well as to its projection in the plane, I had tried with VectorPoint, but I don't get what I want; I would like to keep the orbits while adding the points. Please find attached my code. Thanks in advance.

Clear["Global`*"];
(*SEIRS model*)
s1 = \[CapitalLambda] - \[Beta] s i + \[Gamma]r r - \[Gamma]s s - \
\[Mu] s;
e1 = \[Beta] s i - e (\[Gamma]e + \[Mu]);
i1 =  e \[Gamma]e - \[Gamma] i - ( \[Mu] + \[Nu]) i;
r1 = \[Gamma] i - \[Gamma]r r + \[Gamma]s s - \[Mu] r;
n = {1, 1, 1};
 cn = {\[Epsilon] -> 98/100 , \[Beta] -> 3 , \[Gamma] -> 1/5, \[Nu] ->
     1/6, \[Mu] -> 98/400, \[CapitalLambda] -> 98/400, \[Gamma]r -> 
    1/10,  \[Gamma]s -> 1/10, \[Gamma]e -> 1/5};
equi = Solve[
    s1 == 0 &&  i1 == 0 && r1 == 0 && e1 == 0 , {s, e, i, r}] //. 
   cn // N
eql = Print["DFE=", 
  DFE = {s /. equi[[1]], i /. equi[[1]], e /. equi[[1]], 
    rdfe = r /. equi[[1]]}, " EE2= ", 
  EE2 = {s /. equi[[2]], i /. equi[[2]], e /. equi[[2]], 
      r /. equi[[2]]} //. cn // N]
Print["Points=", 
 points = {{DFE[[1]], DFE[[2]], DFE[[3]]}, {EE2[[1]], EE2[[2]], 
    EE2[[3]]}}]
(*point=Tuples[{DFE[[1]],DFE[[2]],DFE[[3]]},{3}];*)

po = Graphics[{PointSize[Large], Blue, Point[{DFE[[1]], DFE[[2]]}]}];
gr = Graphics3D[{PointSize[0.1], 
    Point[points, VertexColors -> {Red, Green}]}, PlotRange -> 1.2];
seirs3D = 
  VectorPlot3D[{s1, e1, i1} //. cn /. r -> 1 - i - s - e, {s, 0, 
    1}, {e, 0, 1}, {i, 0, 1}, PlotTheme -> "Default" ,(*VectorPoints->
   points,*)VectorScale -> .04, ImageSize -> 400, 
   VectorColorFunction -> Hue, VectorStyle -> Arrowheads[0.02], 
   ViewPoint -> Front,  VectorPoints -> Fine];

Row[{seirs3D, 
   Graphics3D[
    Epilog -> {Black, PointSize[Large], Point[points[[1]]]}]}, 
  Spacer[10]];
v1 = (# - # . n/n . n n) &[{1, 0, 0}];
v2 = (# - # . n/n . n n) &[{0, 1, 0}];
vp3 = VectorPlot3D[{s1, e1, i1} //. cn /. r -> 1 - i - s - e, {s, 0, 
     1}, {e, 0, 1}, {i, 0, 1}, VectorScale -> .035, ImageSize -> 400, 
    VectorColorFunction -> Hue, BoxRatios -> {0.5, 0.5, 0.5}] /. 
   Arrow[Tube[{a_, b_}, c_]] :> Arrow[{a, b}] ;
pl = vp3 /. {Graphics3D -> 
     Graphics, {s_Real, e_Real, i_Real} :> {# . v1, # . v2} &[{s, e, 
       i} - {s, e, i} . n/n . n n], VectorPoints -> points, 
    Epilog -> {Red, PointSize[Large], 
      Point[{EE2[[1]], EE2[[2]], EE2[[3]]}]}, AxesLabel -> {s, e, i}};
seirs3 = Row[{seirs3D, pl}, Spacer[10]]


$\endgroup$

1 Answer 1

1
$\begingroup$

The Show[ ] command combines the graphic output of different commands, such as VectorPlot3D and Graphics3D. The graphic outputs being combined must be all 2D or all 3D graphics. See the code for comments and edits.

Clear["Global`*"];
(*SEIRS model*)

s1 = \[CapitalLambda] - \[Beta] s i + \[Gamma]r r - \[Gamma]s s - 
\[Mu] s;
e1 = \[Beta] s i - e (\[Gamma]e + \[Mu]);
i1 = e \[Gamma]e - \[Gamma] i - (\[Mu] + \[Nu]) i;
r1 = \[Gamma] i - \[Gamma]r r + \[Gamma]s s - \[Mu] r;
n = {1, 1, 1};
cn = {\[Epsilon] -> 98/100, \[Beta] -> 3, \[Gamma] -> 1/5, \[Nu] -> 
    1/6, \[Mu] -> 98/400, \[CapitalLambda] -> 98/400, \[Gamma]r -> 
    1/10, \[Gamma]s -> 1/10, \[Gamma]e -> 1/5};
equi = Solve[
    s1 == 0 && i1 == 0 && r1 == 0 && e1 == 0, {s, e, i, r}] //. cn // N
eql = Print["DFE=", 
  DFE = {s /. equi[[1]], i /. equi[[1]], e /. equi[[1]], 
    rdfe = r /. equi[[1]]}, " EE2= ", 
  EE2 = {s /. equi[[2]], i /. equi[[2]], e /. equi[[2]], 
      r /. equi[[2]]} //. cn // N]
Print["Points=", 
 points = {{DFE[[1]], DFE[[2]], DFE[[3]]}, {EE2[[1]], EE2[[2]], 
    EE2[[3]]}}]
(*point=Tuples[{DFE[[1]],DFE[[2]],DFE[[3]]},{3}];*)

(* ES: Assuming po is to be combined with pl and gr is to be combined with seirs3D. 
I prefer to use AbsolutePointSize[pt] to set the size of points. 
There is no need for the PlotRange option in gr. *)

po = Graphics[{AbsolutePointSize[10],Blue,Point[{DFE[[1]], DFE[[2]]}]}];
gr = Graphics3D[{AbsolutePointSize[10],Point[points, VertexColors -> {Red, Green}]}];

(* ES: Use Show to combine the VectorPlot3D output and gr *)

seirs3D = 
Show[{
  VectorPlot3D[{s1, e1, i1} //. cn /. r -> 1 - i - s - e, 
    {s, 0, 1}, {e, 0, 1}, {i, 0, 1}, 
    PlotTheme -> "Default", VectorScale -> .04, ImageSize -> 400, 
    VectorColorFunction -> Hue, VectorStyle -> Arrowheads[0.02], 
    ViewPoint -> Front,VectorPoints -> Fine],
  gr}];

v1 = (# - # . n/n . n n) &[{1, 0, 0}];
v2 = (# - # . n/n . n n) &[{0, 1, 0}];
vp3 = VectorPlot3D[{s1, e1, i1} //. cn /. r -> 1 - i - s - e, {s, 0, 
     1}, {e, 0, 1}, {i, 0, 1}, VectorScale -> .035, ImageSize -> 400, 
    VectorColorFunction -> Hue, BoxRatios -> {0.5, 0.5, 0.5}] /. 
   Arrow[Tube[{a_, b_}, c_]] :> Arrow[{a, b}];

(* ES: Use Show to combine the modified vp3 output and po. 
Remove the VectorPoints, Epilog, and AxesLabel options. *)

pl = 
Show[{
  vp3 /. {Graphics3D -> Graphics, {s_Real, e_Real, i_Real} :> {# . v1, # . v2} &[{s, e, i} - {s, e, i} . n/n . n n]},
  po}];
seirs3 = Row[{seirs3D, pl}, Spacer[10]]
```
$\endgroup$
1
  • $\begingroup$ Dear Schulz, Thank you so much for your quick help! :) $\endgroup$ Jul 8, 2021 at 11:09

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.