# Speeding up BlockMap and Total for 2D array

I am optimizing the performance of my code, in a snippet I use lengthy 2D lists that involve BlockMap and Total function.

For example, for a very large list:

list = Table[i, {i, 1, 10^4}, {j, 1, 10^4}];


My computation is like this:

BlockMap[Total[#, 2] &, list, {3,3}]; // AbsoluteTiming


The timing result running on my PC is 7 sec.Which is not very quick I guess.

I am wondering if there is any other robust and efficient way to improve the speed. As fast as it could. Thank you!

This is my attempt to vectorize the operation.

list = RandomReal[{-1, 1}, {10^4, 10^4}];

a = BlockMap[Total[#, 2] &, list, {3, 3}]; // AbsoluteTiming // First
b = Nest[
With[{n = Length[#] - Mod[Length[#], 3]},
Transpose@
Plus[#[[1 ;; n ;; 3]], #[[2 ;; n ;; 3]], #[[3 ;; n ;; 3]]]
] &,
list,
2
]; // AbsoluteTiming // First
a == b


13.8097

1.41927

True

I also found a second one, involving a SparseArray and matrix-matrix-multiplication. You can also specify the block size.

ClearAll[f];
f[list_?MatrixQ, {d1_, d2_}] := Module[{A, B},
{n, d} \[Function] With[{m = Quotient[n, d]},
SparseArray @@ {Automatic, {n, m}, 0, {1, {
Join[Range[0, d m], ConstantArray[d m, n - d m]],
Partition[ Join @@ Transpose[{Range[1, m]}[[ConstantArray[1, d]]]], 1]}, ConstantArray[1, d m]}}
],
{Dimensions[list], {d1, d2}}];
Dot[Dot[Transpose[A], list], B]
];

c = f[list, {3, 3}]; // AbsoluteTiming // First
a == b == c


0.200843

True

• Hi! Thanks for the input! I like the second solution, however, the issue is the dimension of list, in some cases, it not working. For example, it is working when list = RandomReal[{-1, 1}, {121, 121}]; but when the dimension equals {120,120} it's not. I couldn't figure out the reason. May 4, 2018 at 18:39
• Hope I found the error. Please try again. May 4, 2018 at 18:52

Here is a simpler (to me) version of @Henrik's SparseArray approach:

sa = PadRight[
KroneckerProduct[IdentityMatrix[3333, SparseArray], Table[1,3]],
{3333,10^4}
]; //RepeatedTiming

r1 = sa . list . Transpose[sa]; //RepeatedTiming
r2 = f[list, {3, 3}]; //RepeatedTiming

r1 == r2


{0.00014, Null}

{0.197, Null}

{0.202, Null}

True

• Argh! You're so right! I really should remember this KroneckerProduct trick. May 4, 2018 at 18:53
• @HenrikSchumacher Feel free to update your answer to use KroneckerProduct and I will delete my answer. I debated commenting on your answer vs writing a new one, and narrowly ended up deciding to write an answer. May 4, 2018 at 19:14
• Everything is fine. Let it as it is. It's just not the first time that I learn about this use of KroneckerProduct. =) May 4, 2018 at 19:18

ListConvolve seems a bit faster, even though you need to discard about 88% of its output:

list = RandomInteger[{-5, 5}, {10^4, 10^4}];

(bmr = BlockMap[Total[#, 2] &, list, {3, 3}]); // AbsoluteTiming

{11.6426, Null}

(lcr = ListConvolve[{{1, 1, 1}, {1, 1, 1}, {1, 1, 1}}, list][[1 ;; -1 ;; 3, 1 ;; -1 ;; 3]]); // AbsoluteTiming

{4.76819, Null}

lcr == bmr

True