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

Improve this question
$\endgroup$

1 Answer 1

Reset to default
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.

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.