2
$\begingroup$

A delay-differential system for variables {y[t],z[t]} is defined by time-lag w

{y'[t] == (r (1 - y[t] - z[t]) - 1) y[t], 
 z'[t] == (y[t] - y[t - w])};

The important constraint is 0<z[t]<1. When z crosses 0, the lagged term y[t-w] should be switched off. I tried WhenEvent with discrete 'switch' variable c[t]->0, and 'switch timing' Tc[t] =(t+w), to prevent z-decay, when z becomes negative. So after time Tc, the 'switch' on the loss term -y[t-w] could be turned on (c[t]->1)

(case r=1.2; w=20)

 Ys = NDSolveValue[
      {{Derivative[1][y][t] == y[t] (-1 + 1.2` (1 - y[t] - z[t])),
        Derivative[1][z][t] == -c[t] y[-20 + t] + y[t]},
       {y[t /; t < 0], z[t /; t < 0]} == {.01, 0}, c[0] == 1, Tc[0] == 0,
       WhenEvent[t > 0 && z[t] == 0, {c[t] -> 0, Tc[t] -> t + 20}],
       WhenEvent[t == Tc[t], c[t] -> 1]},
      {x@t, y@t, z@t}, {t, 0, t1 = 100},
       DiscreteVariables -> {c, Tc}]

The code run, but ignored all event controls, and produce unphysical solution with z[t] crossing into negative range. Any suggestions welcome.

P.S. The system formulated in integro-differential form:

y'[t] == (r (1 - y[t] - z[t]) - 1) y[t]
z[t]=Integrate[y[s],{s,t-w,t}]

But I don't know if that would make it more tractable

$\endgroup$

1 Answer 1

3
$\begingroup$

The principal error raised in the question can be eliminated by deleting t > 0 from the first WhenEvent. This probably is related to the first example under Possible Issues in the WhenEvent documentation. There are, however, a few other issues that should be addressed:

  • y and z are defined for t < 0, whereas c and Tc are not. This produces a warning message when the code is run.
  • y and z are undefined for t == 0. Mathematica ignores this.
  • z[t] == 0 should be z[t] < 0, according to the documentation.
  • x@t is undefined.

With these changes, the code is

Ys = NDSolveValue[{y'[t] == y[t] (-1 + 6/5 (1 - y[t] - z[t])), 
    z'[t] == -c[t] y[-20 + t] + y[t], y[t /; t <= 0] == 1/100, 
    z[t /; t <= 0] == 0, c[t /; t <= 0] == 1, Tc[t /; t <= 0] == 0, 
    WhenEvent[z[t] < 0, {c[t] -> 0, Tc[t] -> t + 20}], 
    WhenEvent[t > Tc[t], c[t] -> 1]}, {y[t], z[t], c[t], Tc[t]}, 
    {t, 0, 100}, DiscreteVariables -> {c, Tc}];

which leads to the results,

Plot[{Ys[[1]], Ys[[2]]}, {t, 0, 100}, AxesLabel -> {t, "x,z"}, 
    LabelStyle -> {12, Bold, Black}]

enter image description here

It is prudent, at least initially, to plot c and Tc as well.

Plot[Ys[[3]], {t, 0, 100}, AxesLabel -> {t, c}, LabelStyle -> {12, Bold, Black}]
Plot[Ys[[4]], {t, 0, 100}, AxesLabel -> {t, Tc}, LabelStyle -> {12, Bold, Black}]

enter image description here

enter image description here

These seem consistent with the desired behavior of the two discrete variables as described in the question.

$\endgroup$
2
  • $\begingroup$ Thanks, it works nice and does the job. Much appreciated $\endgroup$
    – DavidG
    Commented Oct 10, 2023 at 3:16
  • $\begingroup$ I accept the answer $\endgroup$
    – DavidG
    Commented Oct 11, 2023 at 14:03

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.