5
$\begingroup$

I wrote:

indmat[n_] := Module[{b, c},
  b = Transpose[{{1, 1}/2}];
  c = Transpose[{{1, -1}/2}];
  While[Min[Dimensions[b]] < n/2,
   b = ArrayFlatten[{{b, 0}, {0, b}}]];
  While[Min[Dimensions[c]] < n/2,
   c = ArrayFlatten[{{c, 0}, {0, c}}]];
  ArrayFlatten[{{b, c}}]
  ]

For example, with $n=8$,

MatrixForm[c1 = indmat[8]]

produces:

$$ \left( \begin{array}{cccccccc} \frac{1}{2} & 0 & 0 & 0 & \frac{1}{2} & 0 & 0 & 0 \\ \frac{1}{2} & 0 & 0 & 0 & -\frac{1}{2} & 0 & 0 & 0 \\ 0 & \frac{1}{2} & 0 & 0 & 0 & \frac{1}{2} & 0 & 0 \\ 0 & \frac{1}{2} & 0 & 0 & 0 & -\frac{1}{2} & 0 & 0 \\ 0 & 0 & \frac{1}{2} & 0 & 0 & 0 & \frac{1}{2} & 0 \\ 0 & 0 & \frac{1}{2} & 0 & 0 & 0 & -\frac{1}{2} & 0 \\ 0 & 0 & 0 & \frac{1}{2} & 0 & 0 & 0 & \frac{1}{2} \\ 0 & 0 & 0 & \frac{1}{2} & 0 & 0 & 0 & -\frac{1}{2} \\ \end{array} \right) $$

I am wondering if there is a cute Mathematica way, maybe using SparseArray, to produce the same matrices as my function?

$\endgroup$
7
$\begingroup$

I guess something like this works:

Block[{n = 8},
  SparseArray[{Band[{1, 1}, Automatic, {2, 1}] -> 1/2, 
    Band[{2, 1}, Automatic, {2, 1}] -> 1/2, 
    Band[{1, n/2 + 1}, Automatic, {2, 1}] -> 1/2, 
    Band[{2, n/2 + 1}, Automatic, {2, 1}] -> -1/2}, {n, n}]
  ] // MatrixForm

Mathematica graphics

| improve this answer | |
$\endgroup$
  • $\begingroup$ Thanks for a great answer. And I'd like to also thank all of the other folks for the wonderful answers on this page. I am learning a lot. $\endgroup$ – David Sep 4 '16 at 19:47
2
$\begingroup$

Here's another way using iteration:

cMMatrix[n_] := 
 Module[{f, t}, t = Flatten[ConstantArray[{1/2, 1/2, 1/2, -1/2}, n]] ;
   f = Flatten[
    Table[{{i, Floor[i/2 + 1/2]}, {i, Floor[i/2 + 1/2] + n}}, {i, 
      2 n}], 1];
  SparseArray[Thread[f -> t]] // MatrixForm]

Where cMMatrix[4] gives your standard form. But in case it is of interest, the form can be easily expanded to higher orders, to $2n\times2n$ matrix.

cMMatrix[16]

enter image description here

| improve this answer | |
$\endgroup$
2
$\begingroup$

In case it is of interest, here is how the matrix can be computed in a factorised form

indmat[n_?EvenQ] := Module[{a, ix, perm, id},
  a = {{1, 1}, {1, -1}}/2;
  ix = Join[Range[1, n - 1, 2], Range[2, n, 2]]; 
  perm = SparseArray[Transpose[{ix, Range[n]}] -> 1];
  id = IdentityMatrix[n/2, SparseArray];
  KroneckerProduct[id, a].perm
  ]

The factorisation may be of interest in understanding your problem, even if there are equally good ways of calculating the matrix.

As an example, obtaining the inverse matrix in a similarly factored form is very simple

indinvmat[n_?EvenQ] := Module[{a, ix, perm, id},
  a = {{1, 1}, {1, -1}}/2;
  ix = Join[Range[1, n - 1, 2], Range[2, n, 2]]; 
  perm = SparseArray[Transpose[{ix, Range[n]}] -> 1];
  id = IdentityMatrix[n/2, SparseArray];
  Transpose[perm].KroneckerProduct[id, Inverse[a]]
  ]

indmat[8].indinvmat[8] == IdentityMatrix[8]
(* True *)
| improve this answer | |
$\endgroup$
  • $\begingroup$ I seem to have subconsciously stolen your first sentence part. $\endgroup$ – Feyre Sep 4 '16 at 12:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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