Monitor progress of each kernel within ParallelTable

Question

I am generating a table using ParallelTable and for each table entry a Do loop is required. I want to monitor the progress of both the overall table and the progress of each Do loop.

I have an example code below where I am able monitor the progress of the table construction.

   LaunchKernels[];
   iCount = 0;
   SetSharedVariable[iCount];

   Monitor[
   table = ParallelTable[
     iCount++;
     ans = 0;
     Do[
      ans += j;
      , {j, 1, i}];
     {ans}
     , {i, {10^1, 10^2, 10^3, 10^4, 10^5, 10^6}}];
  , iCount];

How can I modify this to also monitor the progress of j on each subkernal in the Do loop?

Answer 1

You may use the ParallelSubmit pattern detailed in this answer (19542).

With

progress[current_, total_] := 
 Column[{
   StringRiffle[ToString /@ {current, total}, " of "], 
   ProgressIndicator[current, {0, total}]
  }, 
  Alignment -> Center]

and

k = LaunchKernels[];
status = Association @@ 
  ParallelTable[$KernelID -> <|"Label" -> "", "Monitor" -> ""|>, {i, $KernelCount}]

<|4 -> <|"Label" -> "", "Monitor" -> ""|>, 
  3 -> <|"Label" -> "", "Monitor" -> ""|>, 
  2 -> <|"Label" -> "", "Monitor" -> ""|>, 
  1 -> <|"Label" -> "", "Monitor" -> ""|>|>

Then define the worker function that also updates the status.

doWork[jvalue_Integer] :=
 Module[{ans = 0, stepProgress = 0},
  status[[Key[$KernelID]]] = <|
    "Label" -> "j Value: " <> ToString@jvalue, 
    "Monitor" -> progress[stepProgress, jvalue]|>;
  Do[
   stepProgress++;
   ans += j;
   status[[Key[$KernelID], "Monitor"]] = progress[stepProgress, jvalue];,
   {j, 1, jvalue}];
  status[[Key[$KernelID], "Label"]] = status[[Key[$KernelID], "Label"]] <> "  is done.";
  {ans}
  ]

Distribute definitions

DistributeDefinitions[progress, doWork];
SetSharedVariable[status];

and setup the jobs

jobs =
 Table[
  ParallelSubmit[{i}, doWork[i]],
  {i, {10^1, 10^2, 10^3, 10^4, 10^5, 10^6}}]

Evaluate jobs in parallel and wile tracking progress.

PrintTemporary[
  Dynamic[Row[
    Riffle[Column[#, Alignment -> Center] & /@ 
      Query[Values, Values]@Select[#"Monitor" =!= "" &]@status, 
     Spacer[5]]]]];
WaitAll[jobs]

Clean up

UnsetShared[progress, doWork, status];
CloseKernels[k];

Hope this helps.

Answer 2

Developed from my monitorParallelMap function (19542). Same concepts but slightly adjusted from ParallelMap to ParallelTable.

ClearAll[monitorParallelTable];
monitorParallelTable[expr_, iter__List, opts : OptionsPattern[ParallelTable]] :=
 Module[{res, iterCount, progress = 0},
  LaunchKernels[];
  SetSharedVariable[progress];
  iterCount =
   Times @@
    Map[If[VectorQ[#, NumericQ], Length@*Range @@ #, Length@Flatten@#] &]@
     Map[Rest, {iter}];
  res = Monitor[
    ParallelTable[
     (
      progress++;
      expr
      ),
     iter, opts],
    Column[{ToString@progress <> " of " <> ToString@iterCount, 
      ProgressIndicator[progress, {0, iterCount}]}, 
     Alignment -> Center]];
  UnsetShared[progress];
  res]

Then

r1 =
  monitorParallelTable[i j k,
   {i, 5},
   {j, 10, 100, 10},
   {k, 10^{1, 2, 3, 4}}
   ];

displays an updating ProgressIndicatoras it evaluates

With a longer version of the OP calculation.

r2 = monitorParallelTable[
   Sum[i, {i, j}],
   {j, 10^Range@500},
   Method -> "CoarsestGrained"
   ];

monitorParallelTable takes the same options as ParallelTable. The calculation of the number of iterations is not robust. It only calculates correctly if the iterators are independent of one another. For example, ..., {i, 10}, {j, i}, ... will calculate 10 instead of 55. iterCount's calculation can be changed to Length@Flatten@Table[1, iter] for a more robust (an more costly) iteration calculation solution.

For heavier parallel processing with monitoring you may find this answer (19542) interesting.

Hope this helps.