Efficient and fastest way to execute 4 nested loops

I have a question regarding the use of ParallelDo. I tried to parallelize the following code involving four nested Do loops by using ParallelDo to make it as fast as possible. For that I already tried parallelizing the outermost loop, but its slower than the original code without ParallelDo. Would you please help me with this?

t = 2;
ip = 0;
ar = ConstantArray[0, {t (t + 2), t (t + 2)}];
f[n_, m_, v_, u_] := KroneckerDelta[n, v] KroneckerDelta[m, u];
SetSharedVariable[ar, ip];
ParallelDo[Do[i = ip + n + m + 1; jp = 0;
Do[Do[j = jp + u + v + 1; ar[[i, j]] = f[n, m, v, u], {u, -v, v}];
jp = jp + 2 v + 1, {v, t}], {m, -n, n}]; ip = i, {n, t}];//AbsoluteTiming


Actually, this is a simple example of what I am trying to do, to figure out why the above code doesn't work so that I can apply it to my more complex problem.

• This problem is so small that the overhead associated with parallelizing it is likely to swamp any performance gains. Also, it's likely that your basic approach (using a bunch of nested loops to index into an array and set the values of its elements) is going to be slow in Mathematica. If that's the only way you can formulate the problem, you're better of with Compile. Also, I really suspect that having all the sub kernels write to a shared array is not the way to go. – Pillsy Nov 7 '15 at 14:57
• I agree with @Pillsy, if you really need to iterate like this, then you can try to compile to C, it should give you greater benefit than parallellization. – Marius Ladegård Meyer Nov 7 '15 at 14:58
• Table may be a better choice. – bbgodfrey Nov 7 '15 at 15:41
• If this is a simplified example of your problem as you say, you should not only rewrite your code for the sake of performance improvement but to make it more readable and maintainable as well. I can think of situations where a single loop or two is actually the best solution but if you need four nested loops your are just doing something wrong. – Sascha Jan 7 '16 at 11:29

Because the indices i and j are computed similarly, one would expect ar to be a symmetric matrix, but on my four-processor PC it is not.

\$Version
(* "10.3.0 for Microsoft Windows (64-bit) (October 9, 2015)" *)

(* {{0, 0, 0, 0, 0, 0, 0, 0},
{0, 1, 0, 0, 0, 0, 0, 0},
{0, 0, 1, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 1, 0},
{0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 1}} *)


Moreover, the result above sometimes varies. On the other hand, replacing ParallelDo by Do yields

(* {{1, 0, 0, 0, 0, 0, 0, 0},
{0, 1, 0, 0, 0, 0, 0, 0},
{0, 0, 1, 0, 0, 0, 0, 0},
{0, 0, 0, 1, 0, 0, 0, 0},
{0, 0, 0, 0, 1, 0, 0, 0},
{0, 0, 0, 0, 0, 1, 0, 0},
{0, 0, 0, 0, 0, 0, 1, 0},
{0, 0, 0, 0, 0, 0, 0, 1}} *)


Evidently, there is cross-talk among processors when ParallelDo is used in this case.

Now, as I remarked in my earlier comment, Table looks like a good alternative.

in = Flatten[Table[{v, u}, {v, t}, {u, -v, v}], 1]
(* {{1, -1}, {1, 0}, {1, 1}, {2, -2}, {2, -1}, {2, 0}, {2, 1}, {2, 2}} *)
f[{n_, m_}, {v_, u_}] := KroneckerDelta[n, v] KroneckerDelta[m, u];
ar = Table[f[in[[i]], in[[j]]], {i, 8}, {j, 8}]


gives the expected symmetric matrix. It is, moreover, about 1/3 faster than the nested Do loops (without ParallelDo).

Just for something different:

tab=Join @@ (Tuples[{{#}, Range[-#, #]}] & /@ Range[2]);
g[a_, b_] := Times @@ (1 - Unitize[a - b])
Outer[g, tab, tab, 1] // MatrixForm