# Custom Matrix product

I have a list:

list1 = {{{a1, a2, a3}, {b1, b2, b3}}, {{c1, c2, c3}, {d1, d2, d3}}};


I want an operation that gives me:

Is there a built-in way of doing this? Basically, this is meant to be the ImageData of a picture and I want to double the resolution by increasing the number of pixels and doing further operations on it. I tried

KroneckerProduct[list1, {{1, 1}, {1, 1}}]


but it didn't give me what I wanted.

If there is no built-in method of doing this, what is the most efficient way to do this?

• Btw, I tried copying the matrix entries here, but neither the mathML nor the Latex worked. they all appeared in a way different to the way they show in Mathematica.
– Shb
Aug 11, 2013 at 19:37
• Welcome,you are repeating your list elements so just club them as {list1,list1,list1,list1} , Flatten than Sort than Split them. Try once it shall do. Also try to include code while posting. Aug 11, 2013 at 19:47
• @Blackbird Thanks. But sorting it ain't easy. These elements are random numbers, not a1, a2. How do I sort them?
– Shb
Aug 11, 2013 at 19:58
• Sorting will help you get all similar lists together.Than Split will get them separated and you can pick them using Part. Aug 11, 2013 at 20:01
• @Shb Is the matrix image in the question correct? It seems to be scaled 4 x 2 instead of 2 x 2. See the comments to my answer. Aug 12, 2013 at 11:47

You can also achieve your ultimate (or ulterior) goal with ImageResize:

imgdata = Array[0.2 #1 + 0.1 #2 - 0.2 + 0.01 #3 &, {2, 2, 3}]
(* {{{0.11, 0.12, 0.13}, {0.21, 0.22, 0.23}}, {{0.31, 0.32, 0.33}, {0.41, 0.42, 0.43}}} *)

img = Image @ imgdata;
img2 = ImageResize[img, Scaled[2]];

ImageData[img2] // MatrixForm


P.S. There are various Resampling algorithms built into Mathematica.

• Ha, nice! Why bother killing the bird when you can just order a cooked one at the restaurant... :)
– rm -rf
Aug 11, 2013 at 20:20
• by the way, you can use the Scaled symbol like this: ImageResize[img, Scaled[2]]
– amr
Aug 11, 2013 at 20:31
• @amr Thanks, I should have known. I guess I hurried too much. I edited it to include your suggestion - it seems better. Aug 11, 2013 at 23:04
• Wait a minute, this isn't the output shown in the question; it is a 2x2 rather than 2x4 scaling. This should be ImageResize[img, {Scaled[4], Scaled[2]}] Aug 12, 2013 at 7:15
• @Mr.Wizard Hmm...the words say "I want to double the resolution", but the matrix image suggests you may be right. I suppose the question needs clarifying. Aug 12, 2013 at 11:43

One of the most direct ways hasn't been shown yet, which is to expand each element at level 2 with e.g. ConstantArray and then ArrayFlatten the entire result. Edit: Actually Nasser did this manually, without Map and using the less efficient Table, but the idea is identical.

ArrayFlatten @ Map[ConstantArray[#, {2, 4}] &, list1, {2}]


Slightly more complicated but significantly faster is to expand the entire array and then Flatten as necessary:

ConstantArray[#, {2, 4}] ~Flatten~ {{3, 1}, {4, 2}} & @ list1


On my system this tests faster than any other code I have tried, including ImageResize (see below).

## Timings

Timings for all methods posted so far, in version 7.

Edit: Michael's ouput does not match the question or other answers. The code should be ImageResize[img, {Scaled[4], Scaled[2]}] which I will use below.

SetAttributes[timeAvg, HoldFirst]
timeAvg[func_] := Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0, 15}]

list1 = RandomInteger[99, {500, 500, 3}];

ArrayFlatten @ Map[ConstantArray[#, {2, 4}] &, list1, {2}]    // timeAvg
ConstantArray[#, {2, 4}] ~Flatten~ {{3, 1}, {4, 2}} & @ list1 // timeAvg

ArrayFlatten[
Transpose[Outer[Times, {{1, 1, 1, 1}, {1, 1, 1, 1}}, list1], {3, 4, 1, 2}]] // timeAvg

ImageData@ImageResize[Image@list1, {Scaled[4], Scaled[2]}] // timeAvg

Module[{f},
f[x_] := ArrayFlatten@Table[x, {2}, {4}];
ArrayFlatten@Map[f, list1, {2}]
] // timeAvg

With[{
grid = ArrayFlatten[Table[ConstantArray[Slot@n, {2, 4}], {n, 4}]~Partition~2]
},
grid & @@ Flatten[list1, 1]
] // timeAvg

With[{exp = {2, 4}},
Array[
Extract[list1, Ceiling[{#1, #2}/exp]] &,
exp Most@Dimensions[list1]
]
] // timeAvg


0.2714

0.03684

1.373

0.0512

1.529

0.0686

6.209

My second function takes first place, Michael's takes second, and rm-rf's takes third. Note that Michael's is less general, applying only to data that is handled by Image.

Observing the pattern in the desired output, you can construct something like this (extensible to larger grids):

With[{grid = ArrayFlatten[Table[ConstantArray[Slot@n, {2, 4}], {n, 4}] ~Partition~ 2]},
grid & @@ Flatten[list, 1]
] // MatrixForm


grid here is a pure function (well, only the slots) that looks like this, mimicking the structure of your output:

to which we pass the individual sublists as arguments.

• Oh darn, you beat me. Aug 11, 2013 at 20:12

Michael E2's answer may be the best from the point of view of dealing with images, but there is a Mathematica function designed to do this kind of thing, the generalized Outer product. Using the definition of list1 from above,

list1 = {{{a1, a2, a3}, {b1, b2, b3}}, {{c1, c2, c3}, {d1, d2, d3}}};
ArrayFlatten[Transpose[Outer[Times, {{1, 1, 1, 1}, {1, 1, 1, 1}}, list1],
{3, 4, 1, 2}]] // MatrixForm


The outer product almost gives the desired form, but a Transpose is needed followed by an ArrayFlatten to remove an extra set of parentheses.

Not too automated, but it is only a 2 by 2 matrix looking at the final matrix

f[x_] := ArrayFlatten@Table[x, {2}, {4}];
a = {a1, a2, a3};
b = {b1, b2, b3};
c = {c1, c2, c3};
d = {d1, d2, d3};
(mat = {{a, b}, {c, d}}) // MatrixForm


ArrayFlatten[{{f[a], f[b]}, {f[c], f[d]}}] // MatrixForm


• I realize that this is basically my "direct" method (though a bit less optimized), I just didn't recognize it. +1 Aug 12, 2013 at 6:27

Here is some "reverse" approach:

exp = {2, 4};

Array[
Extract[list1, Ceiling[{#1, #2}/exp]] &,
exp Most@Dimensions[list1]
]

• Couldn't you post that before I completed my timings? ;^) +1 for options, but this is notably slower than other methods. Aug 12, 2013 at 6:42
• @Mr.Wizard I was only curious. Not enough possibilities left to compete without stealing. :)
– Kuba
Aug 12, 2013 at 6:47

A judicious combination of Transpose[] and KroneckerProduct[] can do this:

Transpose[KroneckerProduct[#, ConstantArray[1, {2, 4}]] & /@
Transpose[list1, {2, 3, 1}], {3, 1, 2}]


If you want to use Flatten[] instead of Transpose[]:

Flatten[KroneckerProduct[#, ConstantArray[1, {2, 4}]] & /@
Flatten[l1, {{3}, {1}, {2}}], {{2}, {3}, {1}}]