10
$\begingroup$

Hopefully, this question is not too basic or obscure. I'd like an idea on how to extract this

{{1}, {5, 2}, {9, 6, 3}, {13, 10, 7, 4}}

from

m = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}, {13, 14, 15, 16}}

Naturally, the square matrix can grow in size, but I will need upper-left (reverse-triangular) information from it (including reverse-diagonal itself).

I thought this can be done by fist permuting (rotating) the matrix and then extracting upper or lower triangular, but not sure if Mathematica has the tools to follow on this approach or if there is a more natural/easier way.

Thanks in advance for a constructive idea or a reference to it.

$\endgroup$
  • $\begingroup$ Greetings! To make the most of Mma.SE please take the tour now. Help us to help you, write an excellent question. Edit if improvable, show due diligence, give brief context, include minimum working examples of code and data in formatted form. As you receive give back, vote and answer questions, keep the site useful, be kind, correct mistakes and share what you have learned. $\endgroup$ – rhermans Nov 13 '15 at 21:21
  • $\begingroup$ @rhermans . Thank you for suggestions and links. I will take the time to follow up on references and answers $\endgroup$ – Oleg Melnikov Nov 13 '15 at 21:57
6
$\begingroup$

Two functions to consider: Diagonal and Reverse

Your data:

m = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}, {13, 14, 15, 16}}

Solution

Reverse@Table[
  Reverse@Diagonal[Reverse /@ m, k], {k, 0, Length[m] - 1}]
{{1}, {5, 2}, {9, 6, 3}, {13, 10, 7, 4}}

Function:

lut[m_] := 
 Reverse@Table[
   Reverse@Diagonal[Reverse /@ m, k], {k, 0, Length[m] - 1}]

or as pointed by J. M.

 lut[m_] := Table[Diagonal[Reverse[m], k], {k, 1 - Length[m], 0}]

Extended example

Column@Array[MatrixForm@lut@Partition[Range[# #], #] &, 7]

Mathematica graphics


Documentation

Mathematica graphics

Mathematica graphics

$\endgroup$
  • 2
    $\begingroup$ The same idea, but only one reverse: Reverse@m~Diagonal~# & /@ Range[1 - Length@m, 0] $\endgroup$ – ybeltukov Nov 13 '15 at 22:57
  • 2
    $\begingroup$ At that point, I'd have used an explicit Table[], tho: Table[Diagonal[Reverse[m], k], {k, 1 - Length[m], 0}] $\endgroup$ – J. M. is away Nov 14 '15 at 2:33
6
$\begingroup$
m = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}, {13, 14, 15, 16}};

MapThread[m[[##]] &, {Reverse@Range@#, Range@#}] & /@ Range@Length@m

{{1}, {5, 2}, {9, 6, 3}, {13, 10, 7, 4}}

$\endgroup$
6
$\begingroup$

Just to show a less elegant way :)

f[m_] := Apply[m[[##]] &, Table[{i - j + 1, j}, {i, Length@m}, {j, i}], {2}]
f@m
(*{{1}, {5, 2}, {9, 6, 3}, {13, 10, 7, 4}}*)
$\endgroup$
  • $\begingroup$ @"belisaurius has settled" I copied and pasted the definition twice but am getting an error message Part specification ... is longer than the depth of the object. $\endgroup$ – Jack LaVigne Nov 13 '15 at 22:50
  • $\begingroup$ I get the same error as @JackLaVigne! I used Extract instead of Part for this type of solution to avoid exactly that problem, I think. $\endgroup$ – march Nov 13 '15 at 23:16
  • $\begingroup$ Ah! Fixed it: m[[##]] & @@@ # & /@ Table[{i - j + 1, j}, {i, Length@m}, {j, i}]. Now, have you ever before used a construction like f @@@ #& /@ list? $\endgroup$ – march Nov 14 '15 at 0:00
  • $\begingroup$ @march, at that point I use an explicit Apply[] rather than appeal to a baroque construction. ;) $\endgroup$ – J. M. is away Nov 14 '15 at 2:24
  • 1
    $\begingroup$ @march Thanks! surely a copy-paste-mess error $\endgroup$ – Dr. belisarius Nov 14 '15 at 3:46
5
$\begingroup$

Here's a different version, much more verbose.

m = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}, {13, 14, 15, 16}};

DeleteCases[#, 0]&@*Reverse /@ Transpose @ UpperTriangularize @ MapThread[RotateRight[#1, #2] &, {m, Range[0, Length@m - 1]}]

Here's another one, slightly less verbose:

MapIndexed[Reverse@#1[[;; First@#2]] &, Transpose@MapThread[RotateRight[#1, #2] &, {m, Range[0, Length@m - 1]}]]

Even less verbose:

Extract[m, #] & /@ Table[{n - j + 1, j}, {n, 1, Length@m}, {j, 1, n}]
$\endgroup$
3
$\begingroup$
upperOffTriag[m_] := With[
 {i = Table[Table[{n, k + 1 - n}, {n, k, 1, -1}], {k, 1, First@Dimensions[m]}]},
 Map[Part[m, Sequence @@ #] &, i, {2}]
]

upperOffTriag[m]

{{1}, {5, 2}, {9, 6, 3}, {13, 10, 7, 4}}

$\endgroup$
2
$\begingroup$

We want to extract the index of the upper left triangular position using the positions:

{1,1}
{2,1}
{1,2}
{3,1}
{2,2}
{1,3}
  ⋮

The following function using Table uses the algorithm so that the row increments and then decrements as the column increments (not sure the words make sense but look at the algorithm below).

lut1[m_] := Table[
  Table[
   m[[j - i + 1, i]],
   {i, 1, j}
  ],
  {j, Length@m}
  ]

So now with

m = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}, {13, 14, 15, 16}}

lut1[m] produces

{{1}, {5, 2}, {9, 6, 3}, {13, 10, 7, 4}}

Timing

Let's take a quick look at timing for a large matrix.

bigM = Table[i + j, {i, 1000}, {j, 1000}];

Applying rherman's first solution

lut[m_] := 
 Reverse@Table[
   Reverse@Diagonal[Reverse /@ m, k], {k, 0, Length[m] - 1}]

lut[bigM]; // Timing
(* {4.00923, Null} *)

The solution in this answer:

lut1[bigM]; // Timing
(* {0.577204, Null} *)

is a bit faster.

But if you are looking for blinding speed, nothing beats March's second answer:

lut2[m_] := 
 MapIndexed[Reverse@#1[[;; First@#2]] &, 
  Transpose@
   MapThread[RotateRight[#1, #2] &, {m, Range[0, Length@m - 1]}]]

lut2[bigM]; // Timing
(* {0.0156001, Null} *)

Update

Since submitting the answer two more answers have appeared.

Suba Thomas

upperOffTriag[m_] := With[
 {i = Table[Table[{n, k + 1 - n}, {n, k, 1, -1}], {k, 1, First@Dimensions[m]}]},
 Map[Part[m, Sequence @@ #] &, i, {2}]
]

upperOffTriag[bigM]; // Timing
(* {1.46641, Null} *)

Eldo

lutEldo[m_] := 
 MapThread[m[[##]] &, {Reverse@Range@#, Range@#}] & /@ Range@Length@m

lutEldo[bigM]; // Timing
(* {0.592804, Null} *)
$\endgroup$
  • $\begingroup$ I find it surprising that my second solution is faster than my third. Interesting. $\endgroup$ – march Nov 13 '15 at 23:51
  • $\begingroup$ @march I get it is about 25 times slower ~ 0.4 compared to 0.0156. I don't know if this is related to the selection of 1000 x 1000 for the size. $\endgroup$ – Jack LaVigne Nov 14 '15 at 0:41
  • $\begingroup$ Yeah, me too. I just think it's weird. And I checked that the construction of the list of coordinates is essentially instantaneous. Since (I think) Map takes advantage of vectorized operations, there must be a lot of overhead for each call to Extract. $\endgroup$ – march Nov 14 '15 at 0:43
2
$\begingroup$

Very verbose but I was trying to find a different way :)

Reverse[Flatten@
    Pick[m, Normal@
      SparseArray[{{i_, j_} /; Abs[j + i] == # -> 1}, {4, 4}], 1] & /@
   Range[2, 5], 2]
$\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.