9
$\begingroup$

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.

Improve this question
$\endgroup$
5
  • 1
    $\begingroup$ Have you looked into using Riffle[] if it's just a simple duplication you want? $\endgroup$
    – J. M.'s eventual burnout ♦
    Jul 30, 2015 at 12:07
  • $\begingroup$ Alternatively, Mathematica 10 did introduce ArrayResample[] - reference.wolfram.com/language/ref/ArrayResample.html, although it actually seems slow... $\endgroup$
    – dr.blochwave
    Jul 30, 2015 at 12:13
  • $\begingroup$ The Riffle documentation suggests it just Riffle's lists rather than arrays. $\endgroup$
    – Julian Francis
    Jul 30, 2015 at 12:20
  • $\begingroup$ 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. $\endgroup$
    – Julian Francis
    Jul 30, 2015 at 12:24
  • 1
    $\begingroup$ @Julian, right, so you do a double riffle; riffle up each row, and then riffle the matrix to duplicate rows. $\endgroup$
    – J. M.'s eventual burnout ♦
    Jul 30, 2015 at 12:45

3 Answers 3

Reset to default
7
$\begingroup$

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.

Improve this answer
$\endgroup$
7
  • 2
    $\begingroup$ Well, it was intended as a starting suggestion after all… :D $\endgroup$
    – J. M.'s eventual burnout ♦
    Jul 30, 2015 at 13:31
  • $\begingroup$ Julian, consider marking question "answered" if you (indeed) find it to be answered sufficiently :) $\endgroup$
    – Neven Caplar
    Jul 30, 2015 at 13:50
  • $\begingroup$ 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! $\endgroup$
    – Julian Francis
    Jul 30, 2015 at 13:50
  • $\begingroup$ Ok, added Transpose which I missed first time. Sorry for that $\endgroup$
    – Neven Caplar
    Jul 30, 2015 at 13:53
  • 1
    $\begingroup$ Done. Thanks for the link, and would upvote you if I had sufficient reputation points. But have accepted your answer. $\endgroup$
    – Julian Francis
    Jul 30, 2015 at 14:07
3
$\begingroup$ 
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

enter image description here

Improve this answer
$\endgroup$
3
  • 1
    $\begingroup$ chyaong, I made a couple of changes to your code; I hope you do not mind. If you do please just revert the edit. $\endgroup$
    – Mr.Wizard
    Aug 23, 2016 at 8:18
  • $\begingroup$ I would appreciate your adding my method to your benchmark. $\endgroup$
    – Mr.Wizard
    Aug 23, 2016 at 8:51
  • 1
    $\begingroup$ @Mr.Wizard No problem. $\endgroup$
    – chyanog
    Aug 23, 2016 at 11:28
2
$\begingroup$

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]

Applied to your case:

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

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.