3
$\begingroup$

I want to draw a phase portrait where the density of arrows adapted (discretization ) adapts to the presence of funnels, saddle points, and other phenomena. For example, in the code attached, the aim is to shed the light on the saddle point in the interior of the domain and make the orbits adaptable and visible for the dynamical phenomena;

Clear["Global`*"];

cn = { \[Beta] -> 4, \[Gamma] -> 1/2 , \[Gamma]r -> 
    1/6,  \[CapitalLambda] -> 
    40/400, \[Mu] -> \[CapitalLambda] , \[Nu]i -> 5,  \[Gamma]s -> 
    38/10, tru -> 9/10, \[Nu]r -> 6, 
   R ->  \[Beta]/((\[Gamma] + \[Mu] + \[Nu]i))};
s1 = - \[Beta]  s i  - \[Gamma]s s +  \[Nu]i s i +  \[Nu]r s (1 - s - 
      i);
i1 =  \[Beta] s i - (\[Gamma] + \[Nu]i  ) i  +   \[Nu]i  i^2 +   \
\[Nu]r  i (1 - s - i);
dyn = {s1, i1};
var = {s, i};
vz = {0, 0};
dynn = {s1, i1} //. cn;
eqscR = Thread[dyn == vz]; equscR = Solve[eqscR, var] // FullSimplify;
equiscR = equscR //. cn // N;

EEs1R = {s /. equiscR[[3]] , i /. equiscR[[3]]};
Print["DFE=", DFE = {s /. equiscR[[1]], i /. equiscR[[1]]}, " , inv=",
  inv = {s /. equiscR[[2]], i /. equiscR[[2]]}, " , EEs2R=", 
 EEs2R = {s /. equiscR[[4]], i /. equiscR[[4]]}, " ,EEs1R= ", EEs1R]

epi = {{PointSize[Large], Style[Point[{DFE[[1]], DFE[[2]]}], Orange]},
     Text["DFE", 
     Offset[{0, 10}, {DFE[[1]], DFE[[2]]}]], {PointSize[Large], 
     Style[Point[{inv[[1]], inv[[2]]}], Red]}, 
    Text["sp", 
     Offset[{0, 10}, {inv[[1]], inv[[2]]}]], {PointSize[Large], 
     Style[Point[{Re[EEs1R[[1]]], Re[EEs1R[[2]]]}], Blue]}, 
    Text["EES", 
     Offset[{20, 0}, {Re[EEs1R[[1]]], Re[EEs1R[[2]]]}]], {PointSize[
      Large], Point[{EEs2R[[1]], EEs2R[[2]]}]}, 
    Text["EESp", Offset[{0, 10}, {EEs2R[[1]], EEs2R[[2]]}]]} //. cn;
bup1 = StreamPlot[dynn, {s, 0, 0.10}, {i, 0.3, 0.5}, 
     RegionFunction -> Function[{s, i}, s + i <= tru //. cn], 
     ImageSize -> 200, Epilog -> epi, StreamColorFunction -> Hue,  
     Frame -> True, Frame -> True, FrameLabel -> {"s", "i"}, 
     LabelStyle -> Directive[Black, Medium]] //. cn // N;
sp = StreamPlot[dynn, {s, 0, 1}, {i, 0, 1}, 
    RegionFunction -> Function[{s, i}, s + i <= tru //. cn], 
    Epilog -> epi, ImageSize -> 400, Frame -> True, 
    StreamColorFunction -> Hue,  FrameLabel -> {"s", "i"}, 
    LabelStyle -> Directive[Black, Medium], 
    Prolog -> Inset[bup1, {0.7, 0.7}]] //. cn // N

Thanks :)

Improve this question
$\endgroup$
2
  • 3
    $\begingroup$ StreamPlot has the option StreamPoints which allows you to manually add some specific initial points for the streams. If you know where your points of interest (POIs) lie, then you can generate points (e.g. with Table) around your POIs and feed them into StreamPoints. Is this what you are asking about? Or do you want Mathematica to somehow automatically find these POIs? $\endgroup$
    – Domen
    Jul 26, 2021 at 13:12
  • $\begingroup$ Dear Domen, thanks for your reply, My points are already fixed and included in the StreamPlot, my question is how can I improve the stream plot and more especially the density of arrows so that the dynamic phenomena like the saddle point and the funnels will be more visible, as well as the separatrix. $\endgroup$
    – Rim ADENANE
    Jul 26, 2021 at 13:45

1 Answer 1

Reset to default
2
$\begingroup$

You can try a different inset:

epi2 = {{PointSize[0.05], White, Point[{EEs2R[[1]], EEs2R[[2]]}]}, 
    Style[Text["EESp", Offset[{0, 30}, {EEs2R[[1]], EEs2R[[2]]}]], 
     White, FontSize -> 18]} //. cn;
LineIntegralConvolutionPlot[{dynn, {"noise", 500, 10}}, {s, 0, 
  0.10}, {i, 0.3, 0.5}, ColorFunction -> "Rainbow", 
 LightingAngle -> 90, Frame -> False, Epilog -> epi2]

enter image description here

Improve this answer
$\endgroup$
4
  • $\begingroup$ Dear Yarchik, it seems to be an interesting plot. Thank you so much for your answer. $\endgroup$
    – Rim ADENANE
    Jul 26, 2021 at 15:58
  • 1
    $\begingroup$ @RimADENANE I notice that you liked, but not yet accepted my answer. I wanted to ask how can I improve it to your needs? $\endgroup$
    – yarchik
    Jul 27, 2021 at 19:59
  • 1
    $\begingroup$ Thanks again, I've accepted your answer. It helped me to highlight the dynamic behavior through the density of the orbits, and it's fine. But, actually, now I want to see the phase portrait more improved and the flux of the arrows more visible and in interesting forms within the points, where some dynamic phenomena may arise. $\endgroup$
    – Rim ADENANE
    Jul 29, 2021 at 8:19
  • 1
    $\begingroup$ @RimADENANE Thank you! Just wanted to mention that on the stackexchange there two ways to feedback on an answer: 1) up/down vote (depicted as arrows pointing up/down) and 2) accept (depicted as a "tick" symbol below the arrows). If you click this symbol, it becomes green and the answer is accepted. Most probably, you upvoted my answer, which I really appreciate. You may also want to click that symbol :) $\endgroup$
    – yarchik
    Jul 29, 2021 at 8:40

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.