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

1 Answer 1

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

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.