Efficient upsampling of multidimensional array

I would like to efficiently upsample a multidimensional array.

It's a 5000*5 matrix where each element is a submatrix 12*12 and it is that 12*12 matrix I want upsampled (to 24*24). The upsampling should just replicate the value.

I have some code to illustrate:

arr = Table[Random[], {5000}, {5}, {12}, {12}];

ans = Map[ArrayFlatten,
Map[{{#, #}, {#, #}} &, arr, {4}], {2}]; // AbsoluteTiming

(* {2.6501516, Null} *)

ans // Dimensions

(* {5000, 5, 24, 24} *)

ans[[3, 4, 1 ;; 5, 1 ;; 5]] // MatrixForm


Is there a faster way? I am using Mathematica version 8, but could be persuaded to upgrade if a new version makes this much faster.

I am also thinking of going down the GPU route at some point, so anything that was suitable for GPU would also be helpful.

• Have you looked into using Riffle[] if it's just a simple duplication you want? Commented Jul 30, 2015 at 12:07
• Alternatively, Mathematica 10 did introduce ArrayResample[] - reference.wolfram.com/language/ref/ArrayResample.html, although it actually seems slow... Commented Jul 30, 2015 at 12:13
• The Riffle documentation suggests it just Riffle's lists rather than arrays. Commented Jul 30, 2015 at 12:20
• I have seen the ArrayResample documentation for Mathematica 10, it looked from the documentation as if it padded the array by inserting zero's whereas I am looking for padded with the neighbouring value. Commented Jul 30, 2015 at 12:24
• @Julian, right, so you do a double riffle; riffle up each row, and then riffle the matrix to duplicate rows. Commented Jul 30, 2015 at 12:45

Using method that Guess who it is suggested I managed to get around 75% faster result.

Unsample[x_] := Nest[Riffle[#, #]\[Transpose] &, x, 2]

ans = Map[Unsample, arr, {2}]; // AbsoluteTiming


Your suggested solution evaluates in 1 to 1.2 sec on my machine, while this one evaluates in 0.63 s. I suspect that this method can be further improved.

Note by Mr.Wizard: code mildly refactored.

• Well, it was intended as a starting suggestion after all… :D Commented Jul 30, 2015 at 13:31
• Julian, consider marking question "answered" if you (indeed) find it to be answered sufficiently :) Commented Jul 30, 2015 at 13:50
• I have used Neven's code fragment. I think it's missing a Transpose in Unsample (at end), and replacing Table with the Map at level {2} I've got us down to .55 secs which is about 5X faster, so thanks guys! Commented Jul 30, 2015 at 13:50
• Ok, added Transpose which I missed first time. Sorry for that Commented Jul 30, 2015 at 13:53
• Done. Thanks for the link, and would upvote you if I had sufficient reputation points. But have accepted your answer. Commented Jul 30, 2015 at 14:07
arr=RandomReal[1,{5000,5,12,12}];

r1=Map[ArrayFlatten,Map[{{#,#},{#,#}}&,arr,{4}],{2}];//AbsoluteTiming
r2=Flatten[Map[{{#,#},{#,#}}&,arr,{4}],{{1},{2},{3,5},{4,6}}];//AbsoluteTiming
r3=Map[With[{t=Transpose@Riffle[#,#]},Transpose@Riffle[t,t]]&,arr,{2}];//AbsoluteTiming

cf = With[{code =
ArrayFlatten@
Map[{{#, #}, {#, #}} &,
Array[Quiet @ \[FormalA][[##]] &, {12, 12}], {2}]},
Compile[{{\[FormalA], _Real, 2}}, code, RuntimeAttributes -> Listable]];

r4=cf[arr];//AbsoluteTiming


• chyaong, I made a couple of changes to your code; I hope you do not mind. If you do please just revert the edit. Commented Aug 23, 2016 at 8:18
• I would appreciate your adding my method to your benchmark. Commented Aug 23, 2016 at 8:51
• @Mr.Wizard No problem. Commented Aug 23, 2016 at 11:28

I propose using Part itself to complete this transformation. In miniature:

m = {{a, b}, {c, d}};

m[[{1, 1, 2, 2}, {1, 1, 2, 2}]] // MatrixForm


$\left( \begin{array}{cccc} a & a & b & b \\ a & a & b & b \\ c & c & d & d \\ c & c & d & d \\ \end{array} \right)$

A function specific to your tensor dimensions:

fn1[m_] := m[[All, All, #, #]] & @ ⌈Range[24]/2⌉


This is about four times faster than the presently Accepted answer and competitive with chyaong's compiled function.

arr = RandomReal[1, {5000, 5, 12, 12}];

fn1[arr] // Dimensions // RepeatedTiming

{0.0324, {5000, 5, 24, 24}}


Generalization

This function may be generalized as follows:

upsample[a_?TensorQ, lev_] := a[[##]] & @@
Replace[_Integer :> All] /@
MapAt[⌈Range[2 #]/2⌉ &, Dimensions[a], List /@ lev]


upsample[arr, {3, 4}] // Dimensions // RepeatedTiming

{0.032, {5000, 5, 24, 24}}


But also:

t = ArrayReshape[Alphabet[], {2, 2, 2, 2}];

upsample[t, 1] // MatrixForm

upsample[t, 3] // MatrixForm

upsample[t, {2, 4}] // MatrixForm