8
$\begingroup$

For example (5x5):

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

Mathematica graphics

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.

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

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]}

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

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.

$\endgroup$
  • $\begingroup$ Please try it with m = Array[1 &, 5 {1, 1}]; $\endgroup$ – Dr. belisarius Dec 29 '15 at 0:12
  • $\begingroup$ Ah, the DeleteDuplicates. Let me look into that. $\endgroup$ – Edmund Dec 29 '15 at 0:16
3
$\begingroup$
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]}

$\endgroup$
2
$\begingroup$
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]}

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

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]
$\endgroup$
2
$\begingroup$

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
$\endgroup$
  • $\begingroup$ Try it with m = Array[1 &, 3 {1, 1}]; $\endgroup$ – Dr. belisarius Dec 28 '15 at 20:39
  • $\begingroup$ @Dr.belisarius, now is should work. It is not short but readable :)) $\endgroup$ – garej Dec 28 '15 at 21:27
  • $\begingroup$ ufff, sorry. V9 here. Could someone else test it, please. (Catenate is v10) $\endgroup$ – Dr. belisarius Dec 29 '15 at 0:07

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.