1
$\begingroup$

Is there a way to speed up NDSolve with WhenEvent in this example (many state variables and many events)?

n = 555;
vars = Table[f[i], {i, n}];
eqs = Table[f[i]'[t] == 0, {i, n}];
inis = Table[f[i][0] == 0, {i, n}];
action = Table[f[i][t] -> f[i][t] + 1, {i, n}];
AbsoluteTiming[sol = NDSolve[Flatten[{eqs, inis, WhenEvent[t == 1, Evaluate[action]]}], vars, {t, 0, 2}];][[1]]
(*3.62943*)
$\endgroup$
4
$\begingroup$

You need vectorization.

Let's make the ODE a bit more interesting:

n = 555;
vars = Table[f[i], {i, n}];
eqs = Table[f[i]'[t] == Sin[i t/10], {i, n}];
inis = Table[f[i][0] == 0, {i, n}];
action = Table[f[i][t] -> f[i][t] + 1, {i, n}];
AbsoluteTiming[
  sol = NDSolveValue[Flatten[{eqs, inis, WhenEvent[t == 1, Evaluate[action]]}], 
     vars, {t, 0, 2}];][[1]]
(* 2.739674 *)

The following is the vectorized version:

sol2 = NDSolveValue[
    Flatten[{f'[t] == Sin[Range@n/10 t], f[0] == ConstantArray[0, n], 
      WhenEvent[t == 1, f[t] -> f[t] + 1]}], f, {t, 0, 2}]; // AbsoluteTiming
(* {0.143942, Null} *)

Finally, a comparison:

Plot[{sol[[50]][t], sol2[t][[50]]}, {t, 0, 2}, PlotStyle -> {{Thick, Dashed}, Red}]

Mathematica graphics

Plot[sol[[50]][t] - sol2[t][[50]], {t, 0, 2}, PlotStyle -> {{Thick, Dashed}, Red}, 
 PlotRange -> All]

Mathematica graphics

As one can see, the results are in full agreement.

$\endgroup$

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.