An expression for the “perimeter elements” of a matrix

For example (5x5):

m = Array[x[##] &, 5 {1, 1}];
MatrixForm@m

I want to get a clockwise ordered list with the "perimeter" elements (they could be any kind of objects). In this case:

(* {x[1, 1], x[1, 2], x[1, 3], x[1, 4], x[1, 5],
x[2, 5], x[3, 5], x[4, 5], x[5, 5],
x[5, 4], x[5, 3], x[5, 2], x[5, 1],
x[4, 1], x[3, 1], x[2, 1]}*)

The (circular) list may start at any element, no requirements about that.

It can be done easily by things like:

Join @@ {m[[1, All]], m[[2 ;; -1, -1]], m[[-1, -2 ;; 1 ;; -1]],  m[[-2 ;; 2 ;; -1, 1]]}

But I want nicer ways (In case of doubt, "nicer" means "more nice")

Edit, note:

The solution should work for example with

m = Array[1 &, 5 {1, 1}];

So, using DeleteDuplicates[ ] is not straightforward.

• I think your solution is "nice enough." (In case of doubt "nice enough" means "enough nice.") – David G. Stork Dec 28 '15 at 18:59
• @DavidG.Stork Ha! Thanks a lot for the explanation :) – Dr. belisarius Dec 28 '15 at 19:03
• loosely related: Generating an Ulam spiral – Kuba Dec 28 '15 at 19:55
• The last argument m[[2 ;; -2, 1]] is wrong. Run it on a 4x4 matrix. – eldo Dec 28 '15 at 20:16
• @eldo Thanks! I believe it's fixed now – Dr. belisarius Dec 28 '15 at 20:23

6 Answers

Not sure if it's efficient, but it's short:

rotate90 = Reverse[Transpose[#]] &;
Flatten[NestList[rotate90, m, 3][[All, 1, 1 ;; -2]], 1]

{x[1, 1], x[1, 2], x[1, 3], x[1, 4], x[1, 5], x[2, 5], x[3, 5], x[4, 5], x[5, 5], x[5, 4], x[5, 3], x[5, 2], x[5, 1], x[4, 1], x[3, 1], x[2, 1]}

• You need Flatten @ beforehand, but otherwise, great! – David G. Stork Dec 28 '15 at 21:05
• nice indeed. I made a small correction for the case when m is made of lists – Dr. belisarius Dec 28 '15 at 21:13

Updated for equal values on the perimeter.

m = Array[x[##] &, 5 {1, 1}];

Flatten@MapAt[
Rest@*Most,
m[[Sequence @@ #]] & /@
{{1, All}, {All, -1}, {-1, -1 ;; 1 ;; -1}, {-1 ;; 1 ;; -1, 1}},
{{2}, {4}}]

(*
{x[1, 1], x[1, 2], x[1, 3], x[1, 4], x[1, 5], x[2, 5], x[3, 5],
x[4, 5], x[5, 5], x[5, 4], x[5, 3], x[5, 2], x[5, 1], x[4, 1],
x[3, 1], x[2, 1]}
*)

And rectangular matrices.

m = Array[x[##] &, {5, 3}];

Flatten@MapAt[
Rest@*Most,
m[[Sequence @@ #]] & /@
{{1, All}, {All, -1}, {-1, -1 ;; 1 ;; -1}, {-1 ;; 1 ;; -1, 1}},
{{2}, {4}}]

(*
{x[1, 1], x[1, 2], x[1, 3], x[2, 3], x[3, 3], x[4, 3], x[5, 3],
x[5, 2], x[5, 1], x[4, 1], x[3, 1], x[2, 1]}
*)

This one deletes the duplicates.

DeleteDuplicates@Flatten[
m[[Sequence @@ #]] & /@
{{1, All}, {All, -1}, {-1, -1 ;; 1 ;; -1}, {-1 ;; 1 ;; -1, 1}}]

Hope this helps.

• Please try it with m = Array[1 &, 5 {1, 1}]; – Dr. belisarius Dec 29 '15 at 0:12
• Ah, the DeleteDuplicates. Let me look into that. – Edmund Dec 29 '15 at 0:16
Join @@ (Most /@ {First@#1, Last@#2, Reverse@Last@#1,
Reverse@First@#2} & @  Sequence[#, Transpose@# ]) &@
Array[a, {4, 5}]

{a[1, 1], a[1, 2], a[1, 3], a[1, 4], a[1, 5], a[2, 5], a[3, 5], a[4, 5], a[4, 4], a[4, 3], a[4, 2], a[4, 1], a[3, 1], a[2, 1]}

n = 5;
o = n^2;
p = o - n + 1;
m = Array[x[##] &, n {1, 1}];

Flatten[m][[Flatten[Range @@@ {{n}, {n + n, o - n, n}, {o, p, -1}, {p - n, n + 1, -n}}]]]

{x[1, 1], x[1, 2], x[1, 3], x[1, 4], x[1, 5], x[2, 5], x[3, 5], x[4, 5], x[5, 5], x[5, 4], x[5, 3], x[5, 2], x[5, 1], x[4, 1], x[3, 1], x[2, 1]}

• OMG, who taught you to count that way? :) – Dr. belisarius Dec 29 '15 at 1:21

This same approach can also be used to do spiral traversal of matrices (although it becomes a bit more complicated and one has to introduce counters to figure out when to turn, as well as decrease the side lengths appropriately):

Clear[next, state, xdim, ydim]

m = Array[x[##] &, 5 {1, 1}];

next[matrix_][state[{x_, y_}, {dx_, dy_}, {lengthx_, lengthy_}, _]] := state[{x + dx, y + dy}, {dx, dy}, {lengthx, lengthy}, matrix[[x + dx, y + dy]]]
state[{lengthx_, 1}, {1, 0}, {lengthx_, lengthy_}, element_] := state[{lengthx, 1}, {0, 1}, {lengthx, lengthy}, element]
state[{lengthx_, lengthy_}, {0, 1}, {lengthx_, lengthy_}, element_] := state[{lengthx, lengthy}, {-1, 0}, {lengthx, lengthy}, element]
state[{1, lengthy_}, {-1, 0}, {lengthx_, lengthy_}, element_] := state[{1, lengthy}, {0, -1}, {lengthx, lengthy}, element]

{xdim, ydim} = Dimensions[m];
Last /@ NestList[next[m],state[{1, 1}, {1, 0}, {xdim, ydim}, m[[1, 1]]], 2 xdim + 2 ydim - 5]

straightforward for V10+

Catenate[Most/@ {#[[1]],Transpose[#][[-1]],Reverse[#[[-1]]],Reverse[Transpose[#][[1]]]}]&@m

One may start from any corner by rotating elements, say:

Catenate[Most/@{Transpose[#][[-1]],Reverse[#[[-1]]],Reverse[Transpose[#][[1]]],#[[1]]}]&@m
• Try it with m = Array[1 &, 3 {1, 1}]; – Dr. belisarius Dec 28 '15 at 20:39
• @Dr.belisarius, now is should work. It is not short but readable :)) – garej Dec 28 '15 at 21:27
• ufff, sorry. V9 here. Could someone else test it, please. (Catenate is v10) – Dr. belisarius Dec 29 '15 at 0:07