Is there any possibility to implement a structure like a ProgressIndicator into NDSolve?

Question

It is already formulated in the title. NDSolve takes sometimes a considerable piece of time. It would be very practical to have some information on how long it is still to wait. So, any ideas?

To be specific, here is the equation along with the boundary and initial conditions:

     Clear[s, bc1, bc2, ic, Lx, Ly, eq];
Lx = 90;
Ly = 90;
bc1 = z[t, x, -Ly] == z[t, x, Ly] == 0;
bc2 = z[t, -Lx, y] == z[t, Lx, y] == 0;
ic = z[0, x, y] == 0.5*Exp[-(x^2 + y^2)/10];
U[x_, y_] := -((
   y (-2 x + Sqrt[x^2 + y^2]) Sqrt[x + Sqrt[x^2 + y^2]])/(
   2 Sqrt[2] (x^2 + y^2 + 0.00001)^(3/2)));

mol = "MethodOfLines";

eq = D[z[t, x, y], t] == 
   D[z[t, x, y], {x, 2}] + 
    D[z[t, x, y], {y, 2}] - (0.03 - U[x, y])*z[t, x, y] - z[t, x, y]^3;

s = NDSolve[{eq, bc1, bc2, ic}, 
   z, {t, 0, 100}, {x, -Lx, Lx}, {y, -Ly, Ly}, Method -> mol][[1, 1]]

This equation solves nicely and rather fast. However, the maximum time is here chosen to be 100. It may, however, be necessary to solve it with the max time 10 to 30 fold greater. In this case I would like to have a visual indication of how far is the progress.

Answer 1

Here are a few versions I use:

1)

showStatus[status_] := 
  LinkWrite[$ParentLink, 
   SetNotebookStatusLine[FrontEnd`EvaluationNotebook[], 
    ToString[status]]];
clearStatus[] := showStatus[""];
clearStatus[]

NDSolve[{D[u[t, x], t] == D[u[t, x], x, x], u[0, x] == 0, 
  u[t, 0] == Sin[t], u[t, 5] == 0}, u, {t, 0, 10}, {x, 0, 5}, 
 EvaluationMonitor :> showStatus["t = " <> ToString[CForm[t]]]];

clearStatus[]

The status is reported in the lower left corner of the notebook.

2)

tEnd = 100;
ProgressIndicator[Dynamic[currentTime], {0, tEnd}]

currentTime = 0;
NDSolve[{D[u[t, x], t] == D[u[t, x], x, x], u[0, x] == 0, 
  u[t, 0] == Sin[t], u[t, 5] == 0}, u, {t, 0, tEnd}, {x, 0, 5}, 
 EvaluationMonitor :> (currentTime = t;)]

3)

Monitor[NDSolve[{D[u[t, x], t] == D[u[t, x], x, x], u[0, x] == 0, 
   u[t, 0] == Sin[t], u[t, 5] == 0}, u, {t, 0, 100}, {x, 0, 5}, 
  MaxStepSize -> 0.01, 
  EvaluationMonitor :> (monitor = Row[{"t = ", CForm[t]}])], monitor]

I hope you find something to your liking.

Answer 2

Monitor[NDSolve[{eq, bc1, bc2, ic}, 
  z, {t, 0, 100}, {x, -Lx, Lx}, {y, -Ly, Ly}, Method -> mol, 
  StepMonitor :> (time = t)], 
 ProgressIndicator[time/100]]

This doesn't appear to slow down the evaluation in any significant way:

RepeatedTiming[
  NDSolve[{eq, bc1, bc2, ic}, 
   z, {t, 0, 100}, {x, -Lx, Lx}, {y, -Ly, Ly}, Method -> mol], 60]

RepeatedTiming[
 Monitor[NDSolve[{eq, bc1, bc2, ic}, 
   z, {t, 0, 100}, {x, -Lx, Lx}, {y, -Ly, Ly}, Method -> mol, 
   StepMonitor :> (time = t)], ProgressIndicator[time/100]], 60]

RepeatedTiming[
 Monitor[NDSolve[{eq, bc1, bc2, ic}, 
   z, {t, 0, 100}, {x, -Lx, Lx}, {y, -Ly, Ly}, Method -> mol, 
   EvaluationMonitor :> (time = t)], ProgressIndicator[time/100]], 60]

11.46

12.

11.9

Answer 3

You should be aware of the fact that using either StepMonitor or EvaluationMonitor could considerably slow down the execution of NDSolve, so the progress indication might come at a price. As there might be several evaluations per step, StepMonitor will be excecuted less often than EvaluationMonitor so might be a better choice in most cases. It also is one of those cases where restricting the update of the progress indiciation might make sense. Of course, the more expensive a single step/evaluation within NDSolve is, the less will the percentual effort for the updates. Here are some example with which you can experiment, of course timings might be very different for different problems...

A simple example from the documentation:

 p = 20; tmax = 100;
 runNDSolve[opts___] := NDSolve[
   {x''[t] + x'[t]/10 + x[t]/(1 + x[t]^2) == Sin[t], x[0] == 1, 
   x'[0] == 0}, x, {t, 0, tmax},
   PrecisionGoal -> p, AccuracyGoal -> p, WorkingPrecision -> 2*p,
   MaxSteps -> Infinity, 
   Method -> {"ExplicitRungeKutta", "DifferenceOrder" -> 8},
   opts
]

you might adjust the precision to adjust runtimes to a few seconds so you can see what actually happens. Here is a run with no monitoring at all as a reference:

 AbsoluteTiming[runNDSolve[];]

Compare EvaluationMonitor to StepMonitor:

 AbsoluteTiming[runNDSolve[EvaluationMonitor :> (tt = t)];]
 AbsoluteTiming[runNDSolve[StepMonitor :> (tt = t)];]

For this example on my computer the restriction of dynamic updating doesn't make much difference, but I have seen examples where doing this was crucial to not slow down the evaluation unacceptably, which can easily happen if you do something more expensive than update a progressbar, like e.g. show a plot.

 tt = 0;
 PrintTemporary@ProgressIndicator[Dynamic[tt], {0, tmax}];
 AbsoluteTiming[runNDSolve[StepMonitor :> (tt = t)];]


 tt = 0;
 PrintTemporary@ProgressIndicator[Dynamic[
    Refresh[tt, UpdateInterval -> 1, TrackedSymbols :> {}]
 ], {0, tmax}];
 AbsoluteTiming[runNDSolve[StepMonitor :> (tt = t)];]

Here is a version of Feyre's elegant solution using Monitor which restricts the update to a given interval. AFAIK this is not really documented but doesn't come as a surprise when assuming that the second argument will be wrapped in a Dynamic at some point:

 AbsoluteTiming[
   Monitor[runNDSolve[StepMonitor :> (tt = t)], 
     Refresh[ProgressIndicator[tt/tmax], UpdateInterval -> 1, 
       TrackedSymbols :> {}]];]