# 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 '13 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. – Rorschach Aug 11 '13 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 '13 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. – Rorschach Aug 11 '13 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. – Michael E2 Aug 12 '13 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... :) – R. M. Aug 11 '13 at 20:20
by the way, you can use the Scaled symbol like this: ImageResize[img, Scaled[2]] – amr Aug 11 '13 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. – Michael E2 Aug 11 '13 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]}] – Mr.Wizard Aug 12 '13 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. – Michael E2 Aug 12 '13 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. – Michael E2 Aug 11 '13 at 20:12

Micahel E2s 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 – Mr.Wizard Aug 12 '13 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. – Mr.Wizard Aug 12 '13 at 6:42
@Mr.Wizard I was only curious. Not enough possibilities left to compete without stealing. :) – Kuba Aug 12 '13 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}}]

-