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.

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

6 Answers 6

Reset to default
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]}

Improve this answer
$\endgroup$
2
  • $\begingroup$ You need Flatten @ beforehand, but otherwise, great! $\endgroup$
    – David G. Stork
    Dec 28, 2015 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, 2015 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.

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

Improve this answer
$\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]}

Improve this answer
$\endgroup$
1
  • $\begingroup$ OMG, who taught you to count that way? :) $\endgroup$
    – Dr. belisarius
    Dec 29, 2015 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]
Improve this answer
$\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
Improve this answer
$\endgroup$
3
  • $\begingroup$ Try it with m = Array[1 &, 3 {1, 1}]; $\endgroup$
    – Dr. belisarius
    Dec 28, 2015 at 20:39
  • $\begingroup$ @Dr.belisarius, now is should work. It is not short but readable :)) $\endgroup$
    – garej
    Dec 28, 2015 at 21:27
  • $\begingroup$ ufff, sorry. V9 here. Could someone else test it, please. (Catenate is v10) $\endgroup$
    – Dr. belisarius
    Dec 29, 2015 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.