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]]
Improve this question
$\endgroup$

1 Answer 1

Reset to default
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]] ```
Improve this answer
$\endgroup$
1
  • $\begingroup$ Dear Schulz, Thank you so much for your quick help! :) $\endgroup$ Commented Jul 8, 2021 at 11:09

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.