0
$\begingroup$

I have been trying to plot bifurcation diagram for $R$ vs $X$ (or $Y$) for the following problem

    tab = Table[{sol, points} = 
    Reap@NDSolveValue[{Sqrt[-1]*x'[t] == 
    B*x[t] - R*x[t]*Abs[x[t]]^2 - A*y[t], 
    Sqrt[-1]*y'[t] == 
    B*y[t] - R*y[t]*Abs[y[t]]^2 - A*x[t] /. {A -> 1, B -> -2}, 
    x[0] == 0, y[0] == 0, 
    WhenEvent[x'[t] > 0, If[t > 4, Sow[y[t]]]]}, {x, y}, {t, 0.1, 
    20}]; {R, #} & /@ 
    Union[Flatten[points], SameTest -> (Abs[#1 - #2] < .02 &)], {R, 0,
    100, 2}];
    ListPlot[Re@Flatten[tab, 1], ImageSize -> Large, AxesLabel -> {R, x}]

I get no error messages but an empty plot. Parameters are flexible so I tried several variations with parameters but didn't succeed in plotting.

Improve this question
$\endgroup$
4
  • $\begingroup$ Nothing to plot, Flatten[tab, 1]={} is empty! $\endgroup$
    – Ulrich Neumann
    Jul 10, 2018 at 9:24
  • 1
    $\begingroup$ You are looking for complex solutions, so the condition $x'[t]>0$ can not be fulfilled. Can be replaced by $Re[x'[t]]>0$, but in this case tab is empty too. $\endgroup$
    – Alex Trounev
    Jul 10, 2018 at 10:48
  • $\begingroup$ Yes it keeps giving empty output when even restricting to only real solutions. $\endgroup$
    – AtoZ
    Jul 10, 2018 at 11:40
  • $\begingroup$ It has something to plot if i give it a nonzero initial condition say $x[0]=1, y[0]=0$ but then it gives errors NDSolveValue:Encountered non-numerical value for a derivative at t == 0.`. $\endgroup$
    – AtoZ
    Jul 10, 2018 at 12:10

1 Answer 1

Reset to default
3
$\begingroup$

I will show the working code and the result, perhaps this is what is required.

A = 1; B = -2; tab = 
 Table[{sol, points} = 
   Reap@NDSolveValue[{Sqrt[-1]*x'[t] == 
       B*x[t] - R*x[t]*Abs[x[t]]^2 - A*y[t], 
      Sqrt[-1]*y'[t] == B*y[t] - R*y[t]*Abs[y[t]]^2 - A*x[t], 
      x[0] == 1, y[0] == 0, 
      WhenEvent[Re[x'[t]] > 0, If[t > 4, Sow[y[t]]]]}, {x, y}, {t, 
      0.1, 20}]; {R, #} & /@ 
   Union[Flatten[points], SameTest -> (Abs[#1 - #2] < .02 &)], {R, 0, 
   100, 2}];
ListPlot[Re@Flatten[tab, 1], ImageSize -> Large, AxesLabel -> {R, x}]

fig1

Improve this answer
$\endgroup$
4
  • $\begingroup$ Could you say what was the problem with OP's code? $\endgroup$
    – Chris K
    Jul 10, 2018 at 12:59
  • 2
    $\begingroup$ there are two errors: 1) two equations, and a replacement /. {A -> 1, B -> -2} is made one; 2) the condition x '[t]> 0 is used for the complex function. $\endgroup$
    – Alex Trounev
    Jul 10, 2018 at 14:01
  • $\begingroup$ @Alex, yes it works. I have tried to modify the code with $A=10$ and $x[0]=1, y[0]=-1$ to actually see a better/clearer bifurcation behavior, It shows a plot but it is not a very clear bifurcation still. Is there a way to improve this? $\endgroup$
    – AtoZ
    Jul 11, 2018 at 6:36
  • $\begingroup$ A = 10; B = -2; tab = Table[{sol, points} = Reap@NDSolveValue[{Sqrt[-1]*x'[t] == B*x[t] - R*x[t]*Abs[x[t]]^2 - A*y[t], Sqrt[-1]*y'[t] == B*y[t] - R*y[t]*Abs[y[t]]^2 - A*x[t], x[0] == 1, y[0] == -1, WhenEvent[Re[x'[t]] > 0, If[t > 0.1, Sow[y[t]]]]}, {x, y}, {t, 0, 50}, MaxSteps -> Infinity]; {R, #} & /@ Union[Flatten[points], SameTest -> (Abs[#1 - #2] < .02 &)], {R, 0, 20, 0.01}]; ListPlot[Re@Flatten[tab, 1], AspectRatio -> .75/GoldenRatio, ImageSize -> Large, PlotStyle -> PointSize[Tiny], AxesLabel -> {R, x}] $\endgroup$
    – AtoZ
    Jul 11, 2018 at 6:46

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.