6
$\begingroup$

This is a follow up on this question. Consider a matrix m1 as

m1 = {{1, 2, 3}, {4, 9, 5}, {6, 7, 8}};

In MatrixForm it looks like

enter image description here

I want to rearrange the elements in a way such that it looks like

enter image description here

Consider another example.

m2 = {{1, 2, 3, 4, 5}, {6, 17, 18, 19, 7}, {8, 20, 25, 21, 9}, {10, 22, 23, 24, 11}, {12, 13, 14, 15, 16}};

In MatrixForm,

enter image description here

And I want to transform this into

enter image description here

Basically, I want the boundary elements to be sorted in a counter clock-wise with the smallest element at the center-right.

How can I do this?

$\endgroup$
6
$\begingroup$

Update: extended to transform existing matrices.

Building on Paul Abbott's IntegerSpiral code from http://forums.wolfram.com/mathgroup/archive/2005/Apr/msg00853.html I cobbled together a solution. I expect that there is a cleaner way starting from scratch but this was expedient.

IntegerSpiral[n_Integer] :=
  Fold[Join[#, Last[#] - I^#2 Range[#2/2]] &, {0}, Range[n]] // ReIm

f1[n_?OddQ] :=
  Internal`PartitionRagged[
    Most[IntegerSpiral[2 n]] + ⌈n/2⌉, 
    Prepend[8 Range[⌈n/2⌉ - 1], 1]
  ] // MapIndexed[RotateLeft[#, #2 - 1] &] // Catenate

f2[n_?OddQ] := 
  SparseArray[Thread[f1[n] -> Reverse@Range[n^2]]]\[Transpose] // Normal

f2[old_?MatrixQ] := With[{dims = Dimensions[old]},
  Normal@SparseArray[Thread[f1[dims[[1]]] -> Reverse@Flatten[old]]]\[Transpose]
   /; Equal @@ dims && OddQ@First@dims]

Test:

Grid /@ f2 /@ {1, 3, 5} // Column

$\begin{array}{c} 1 \\ \end{array}$

$\begin{array}{ccc} 4 & 3 & 2 \\ 5 & 9 & 1 \\ 6 & 7 & 8 \\ \end{array}$

$\left( \begin{array}{ccccc} 7 & 6 & 5 & 4 & 3 \\ 8 & 20 & 19 & 18 & 2 \\ 9 & 21 & 25 & 17 & 1 \\ 10 & 22 & 23 & 24 & 16 \\ 11 & 12 & 13 & 14 & 15 \\ \end{array} \right)$

f2[{{"a", "b", "c"}, {"d", "e", "f"}, {"g", "h", "i"}}] // Grid

$\begin{array}{ccc} \text{d} & \text{c} & \text{b} \\ \text{e} & \text{i} & \text{a} \\ \text{f} & \text{g} & \text{h} \\ \end{array}$

$\endgroup$
3
$\begingroup$
ClearAll[layersF, allLayersF, spiralF]
layersF[n_?OddQ, k_] := Module[{m = Partition[Range[n^2], n]}, 
  Join[m[[k, k ;; -(k + 1)]], m[[k ;; -(k + 1), -k]], 
   m[[-k, -k ;; k + 1 ;; -1]], m[[-k ;; k + 1 ;; -1, k]], 
   If[k == (n + 1)/2, {m[[k, k]]}, {}]]]

allLayersF[n_] := layersF[n, #] & /@ Range[(n + 1)/2]
spiralF[n_?OddQ] := Partition[Range[n^2][[Ordering@Thread[Join @@ 
  MapIndexed[Reverse[RotateLeft[#, (3 n + 5)/2 - 3 #2]] &, allLayersF[n]]]]], n];

Examples:

Row[MatrixForm /@ spiralF /@ {3, 5, 7, 9}]

enter image description here

m = Partition[Array[A, 25], 5];
Row[{MatrixForm[m], MatrixForm[spiralF[Length@m] /. i_Integer :> Flatten[m][[i]]]}]

enter image description here

The function layersF is a modification of this answer by Henrik Shumacher.

$\endgroup$
0
$\begingroup$

This is similar to Mr Wizard's I think:

loop[n_] := Module[{a},
  a = 1 + Accumulate @ Catenate[ConstantArray[#, n - 1] & /@ {1, 0, -1, 0}];
  Transpose[RotateRight[a, #/2] & /@ {3 n - 1, 5 n - 3}]]

loop[1] = {{1, 1}};

mat[n_] := Normal @ SparseArray[
   Catenate[Table[i + loop[n - 2 i], {i, 0, (n - 1)/2}]] -> Range[n^2]]

mat[7] // MatrixForm

enter image description here

$\endgroup$

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.