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.

$\endgroup$
  • $\begingroup$ Nothing to plot, Flatten[tab, 1]={} is empty! $\endgroup$ – Ulrich Neumann Jul 10 '18 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 '18 at 10:48
  • $\begingroup$ Yes it keeps giving empty output when even restricting to only real solutions. $\endgroup$ – AtoZ Jul 10 '18 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 '18 at 12:10
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

$\endgroup$
  • $\begingroup$ Could you say what was the problem with OP's code? $\endgroup$ – Chris K Jul 10 '18 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 '18 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 '18 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 '18 at 6:46

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.