Understanding a slowdown associated with wrapping a set of nested Do loops with a ParallelDo expression

Question

I have a set of set of nested Do loops that require data from three different arrays (though the position from each array is fixed per cycle of the outer Do loop). Let's call these arrays: ListA, ListB, ListC. My attempts at parallelizing the outer Do loop (i.e. using ParallelDo) seem to work, but there is a ~100x slowdown on a 12 core processor. I was hoping someone here could help me understand why.

Here's some nonsense pseudocode that should capture the structure of the bit of code I evaluated:

Do[
   Do[
      Do[
         ListA[[i]] = Append[ListA[[i]], ListB[[i, a]] + ListB[[i, b]]];
        , {b, (a+1), M}
        ];
     , {a, 1, M}
     ];


ListA[[i]] = Sort[ListA[[i]]];


   Do[
        If[Abs[ListA[[i, j]] - ListA[[i, j + 1]]] < ListC[[i]],
             ListC[[i]] = Abs[ListB[[i, j]] - ListB[[i, j + 1]]];
          ];
      , {j, 1, Length[PairwiseSums[[i]]] - 1}
     ];


, {i, 1, Length[AllSubsets]}
];

Previously defining ListA, ListB, and ListC, and writing:

SetSharedVariable[ListA]
SetSharedVariable[ListB]
SetSharedVariable[ListC]

ParallelDo[
   Do[
      Do[
         ListA[[i]] = Append[ListA[[i]], ListB[[i, a]] + ListB[[i, b]]];
        , {b, (a+1), M}
        ];
     , {a, 1, M}
     ];


ListA[[i]] = Sort[ListA[[i]]];


   Do[
        If[Abs[ListA[[i, j]] - ListA[[i, j + 1]]] < ListC[[i]],
             ListC[[i]] = Abs[ListB[[i, j]] - ListB[[i, j + 1]]];
          ];
      , {j, 1, Length[PairwiseSums[[i]]] - 1}
     ];


, {i, 1, Length[AllSubsets]}
];

Yields the ~100x slowdown on a 12 core processor. Why?

Answer 1

The slow down is because the shared variables cause a lot of inter-process communication between the subkernels and the main kernel. You do a lot of writing to ListA and ListC and each time subkernel has to communicate with the main kernel. See the documentation on "Virtual Shared Memory."

You didn't provide working example code, so I made something up, which is similar.

L = 20;
M = 100;

SeedRandom[1];
ListA = Table[{}, {L}];
ListB = RandomReal[{0, 1}, {L, M}];
ListC = RandomReal[{0, 1}, {L}];
Do[
   Do[
    Do[ListA[[i]] = Append[ListA[[i]], ListB[[i, a]] + ListB[[i, b]]];,
      {b, 1, M}];,
    {a, 1, M}];
   ListA[[i]] = Sort[ListA[[i]]];
   Do[
    If[Abs[ListA[[i, j]] - ListA[[i, j + 1]]] < ListC[[i]],
      ListC[[i]] = Abs[ListB[[i, j]] - ListB[[i, j + 1]]];];,
    {j, 1, M - 1}];,
   {i, 1, L}]; // AbsoluteTiming

(* {9.353435, Null} *)

nonParallelA = ListA; nonParallelC = ListC;

I got around having to change the variables often by using ParallelMap and returning the changes en masse. The changes are accumulated in local variables in each subkernel using Module. You can then overwrite ListA and ListC.

SeedRandom[1];
ListA = Table[{}, {L}];
ListB = RandomReal[{0, 1}, {L, M}];
ListC = RandomReal[{0, 1}, {L}];
mapOut = ParallelMap[
    Module[{partA = ListA[[#]], partC = ListC[[#]]},
      Do[
       Do[partA = Append[partA, ListB[[#, a]] + ListB[[#, b]]];,
         {b, 1, M}];,
       {a, 1, M}];
      partA = Sort[partA];
      Do[
       If[Abs[partA[[j]] - partA[[j + 1]]] < partC,
         partC = Abs[ListB[[#, j]] - ListB[[#, j + 1]]];];,
       {j, 1, M - 1}];
      {partA, partC}
      ] &,
    Range[L]]; // AbsoluteTiming

(* {4.644118, Null} *)

Transpose@mapOut == {nonParallelA, nonParallelC}

(* True *)

I get a 2x speed-up because I have only 2 cores. To overwrite ListA and ListC, just set

{ListA, ListC} = Transpose@mapOut;