9
$\begingroup$

I want to assign a linear row of values to the elements of a lower triangular matrix,

i.e., if the row of values is {1,2,3,4}, then the matrix (4 X 4) should be:

{{1, 0, 0, 0}, {2, 1, 0, 0}, {3, 2, 1, 0}, {4, 3, 2, 1}}

I can do this with a (nested) For loop, but was wondering if there was any easier way.

Thank you for your help and time in advance

$\endgroup$
  • 2
    $\begingroup$ How about an arbitrary set of values, say {1.12, 2.45, 3.77, 4.23}. How would I transfer these to a lowertriangular matrix? Mr. Wizard's answer looks pertinent but any other way? Thanks $\endgroup$ – Jorge Jul 29 '13 at 12:52
  • $\begingroup$ Jorge, you shouldn't be so fast to Accept an answer. This question is still young. :-) $\endgroup$ – Mr.Wizard Jul 29 '13 at 13:09
  • 1
    $\begingroup$ Unfortunately I agree :P Also +1 for waking this site up :P $\endgroup$ – Kuba Jul 29 '13 at 13:13
  • $\begingroup$ First battery of timings added to my answer. $\endgroup$ – Mr.Wizard Jul 29 '13 at 13:25
5
$\begingroup$
vals = {1,2,3,4};
n = Length@vals

NestList[PadLeft[#, n+1][[ ;; -2]] &, vals, n-1] // Transpose
{{1, 0, 0, 0}, {2, 1, 0, 0}, {3, 2, 1, 0}, {4, 3, 2, 1}}

30% faster approach:

NestList[ArrayPad[#, {-1, 1}] &, Reverse@vals, n - 1] // Reverse
$\endgroup$
  • $\begingroup$ It appears we were thinking alike. +1 I'll be interested to see how this one performs. $\endgroup$ – Mr.Wizard Jul 29 '13 at 13:07
  • $\begingroup$ @Mr.Wizard Comparison could be interesting :) I like @sebhofer `s array because I was approaching to this with MapIndexed, it wasn't pretty. $\endgroup$ – Kuba Jul 29 '13 at 13:11
  • $\begingroup$ Oh, I think the MapIndexed solution is kind of cute :) $\endgroup$ – sebhofer Jul 29 '13 at 13:12
  • $\begingroup$ See my timings; I found one faster but it was inspired by your method. $\endgroup$ – Mr.Wizard Jul 29 '13 at 13:44
  • 1
    $\begingroup$ I also added a note regarding the mass application of PadRight that I think will interest you. $\endgroup$ – Mr.Wizard Jul 29 '13 at 14:17
4
$\begingroup$

one way

(m = Table[If[i >= j, i - j + 1, 0], {i, 4}, {j, 4}]) // MatrixForm

Mathematica graphics

answer comment:

 r = {3, 99, 27, 49};
(m = Table[If[i >=  j, r[[i - j + 1]], 0], {i, 4}, {j, 4}]) // MatrixForm

Mathematica graphics

$\endgroup$
  • 1
    $\begingroup$ How about an arbitrary set of values, say {1.12, 2.45, 3.77, 4.23}. How would I transfer these to a lowertriangular matrix? $\endgroup$ – Jorge Jul 29 '13 at 12:51
7
$\begingroup$

I propose these:

vals = {1, 2, 3, 4};

n = 4;

SparseArray[Array[Band[{#, 1}] -> vals[[#]] &, n], n] // Normal

Reverse @ PadRight @ NestList[Rest, Reverse @ vals, n-1]

PadLeft @ NestList[Most, vals, n-1] ~Reverse~ {1, 2}

UpperTriangularize[NestList[RotateRight, vals, n-1]] ~Reverse~ {1, 2}

With[{r = Reverse@vals}, PadLeft[r, n, 0, n - #] & ~Array~ n]

#@Partition[#@vals, n, 1, 1, 0] &[Reverse]

PadRight[#, n] & /@ NestList[Rest, Reverse @ vals, n - 1] // Reverse

Table[
  v = Prepend[Most@v, vals[[i]]],
  {v, {ConstantArray[0, n]}},
  {i, n}
] // First

All produce:

{{1, 0, 0, 0}, {2, 1, 0, 0}, {3, 2, 1, 0}, {4, 3, 2, 1}}

Notes:

Something I've known for a while but didn't account for here is that PadLeft/PadRight on a ragged array of packed lists unpacks. My second and third methods have this problem. By using PadRight on each packed vector these can be greatly improved for that specific case.


Timings

Alright, I believe we have enough options for the first timing comparison. Using my flavor of Timo's timeAvg:

SetAttributes[timeAvg, HoldFirst]

timeAvg[func_] := Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0, 15}]

And this (packed) data:

n = 1500;
vals = RandomInteger[9999, 1500];

The timings for my proposals:

SparseArray[Array[Band[{#, 1}] -> vals[[#]] &, n], n]                   // timeAvg
Reverse@PadRight@NestList[Rest, Reverse @ vals, n - 1]                  // timeAvg
PadLeft@NestList[Most, vals, n - 1] ~Reverse~ {1, 2}                    // timeAvg
UpperTriangularize[NestList[RotateRight, vals, n - 1]] ~Reverse~ {1, 2} // timeAvg
With[{r = Reverse@vals}, PadLeft[r, n, 0, n - #] & ~Array~ n]           // timeAvg
#@Partition[#@vals, n, 1, 1, 0] &[Reverse]                              // timeAvg
PadRight[#, n] & /@ NestList[Rest, Reverse @ vals, n - 1] // Reverse    // timeAvg
Table[
  v = Prepend[Most@v, vals[[i]]],
  {v, {ConstantArray[0, n]}},
  {i, n}
] // First // timeAvg

1.669

0.1342

0.1778

0.0362

0.003744

0.008112

0.004992

0.003992

And other's proposals:

f[i_, j_] /; i < j := 0
f[i_, j_] := vals[[i - j + 1]]
Array[f, {n, n}] // timeAvg

Table[If[i >= j, vals[[i - j + 1]], 0], {i, n}, {j, n}] // timeAvg

NestList[PadLeft[#, n + 1][[ ;; -2]] &, vals, n - 1] // Transpose // timeAvg

NestList[ArrayPad[#, {-1, 1}] &, Reverse@vals, n - 1] // Reverse // timeAvg

Reverse /@ ListConvolve[ConstantArray[1, Length@vals], vals, 1, 0, Times, List] // timeAvg

LowerTriangularize@MapIndexed[RotateRight, ConstantArray[Reverse@vals, n]] // timeAvg

Array[vals[[#1 - #2 + 1]] UnitStep[#1 - #2] &, {n, n}] // timeAvg

1.981

1.576

0.010608

0.006864

0.2246

0.134

3.573

I expected Band to perform better which is why I led with it, but it actually scales very poorly. Kuba's method is faster than any of my four original ones but it inspired my fifth method which is the fastest so far on this test. I'll update timings as more options come in and with more detailed tests.


panda-34 get's his own special section for these beautiful incantations; the fastest yet!

Reverse @ HankelMatrix @ Reverse @ vals      // timeAvg
LowerTriangularize @ ToeplitzMatrix @ vals   // timeAvg

0.002872

0.002496

$\endgroup$
  • $\begingroup$ I like yours the best btw, especially the NestList ones $\endgroup$ – sebhofer Jul 29 '13 at 13:00
  • $\begingroup$ @sebhofer Thank you. $\endgroup$ – Mr.Wizard Jul 29 '13 at 13:24
  • $\begingroup$ Could you test my MapIndexed solution? I think it should be reasonably fast... $\endgroup$ – sebhofer Jul 29 '13 at 13:37
  • $\begingroup$ @sebhofer Sorry, I missed your adding that. I'll get working on it. $\endgroup$ – Mr.Wizard Jul 29 '13 at 13:40
  • 2
    $\begingroup$ See if you can beat LowerTriangularize@ToeplitzMatrix@vals (I added it to my answer) $\endgroup$ – panda-34 Jul 29 '13 at 17:15
5
$\begingroup$

I recommend Array since it is faster than Table and UnitStep (faster than If)

(m = Array[(#1 - #2 + 1) UnitStep[#1 - #2] &, {4, 4}]) // MatrixForm

enter image description here

If there is an input vector e.g.

v = {3, 5, 7, 11};

we can reformulate existing approach to this form:

Array[ v[[#1 - #2 + 1]] UnitStep[#1 - #2] &, {4, 4}] // MatrixForm

enter image description here

$\endgroup$
  • $\begingroup$ Perhaps I misunderstand but I assumed that the OP wanted an arbitrary vector for values. $\endgroup$ – Mr.Wizard Jul 29 '13 at 12:45
  • $\begingroup$ @Mr.Wizard Now that I reread the question I think you are right $\endgroup$ – sebhofer Jul 29 '13 at 12:47
  • $\begingroup$ It should be clear enough to beginners that one can play with pure functions inside Array to define different vectors. $\endgroup$ – Artes Jul 29 '13 at 12:49
  • 1
    $\begingroup$ So give us an example. :-) $\endgroup$ – Mr.Wizard Jul 29 '13 at 12:51
  • 1
    $\begingroup$ @Mr.Wizard Exempli gratia: Array[(#1^2 - 2 #2 + 3) UnitStep[#1 - #2] &, {4, 4}] $\endgroup$ – Artes Jul 29 '13 at 12:54
5
$\begingroup$

Variation of Nasser's code (which I find a bit cleaner, although it is longer)

f[i_, j_] /; i < j := 0
f[i_, j_] := i - j + 1
Array[f, {4, 4}] // MatrixForm

For arbitrary values one could adapt this and do

vals={1,3,5,7};
f[i_, j_] /; i < j := 0
f[i_, j_] := vals[[i - j + 1]]

And another one, just to be silly (and to not let Mr. Wizard win with all his NestList based solutions ;)

vals={1,3,5,7};
LowerTriangularize@MapIndexed[RotateRight, ConstantArray[Reverse@vals, Length@vals]]
$\endgroup$
  • $\begingroup$ I really like Array; you could also write Array[If[# >= #2, # - #2 + 1, 0] &, {4, 4}] which is closer to Nasser's. $\endgroup$ – Mr.Wizard Jul 29 '13 at 12:48
  • $\begingroup$ @Mr.Wizard I thought about adding your suggestion but Artes has it in his answer, so I guess it's not necessary... $\endgroup$ – sebhofer Jul 29 '13 at 12:58
10
$\begingroup$
vals = {1, 2, 3, 4};
Reverse /@ 
 ListConvolve[ConstantArray[1, Length@vals], vals, 1, 0, Times, List]

And a couple of special forces functions:

Reverse@HankelMatrix@Reverse@vals
LowerTriangularize@ToeplitzMatrix@vals

(added by J. M.)

The problem with LowerTriangularize @ ToeplitzMatrix @ vals, altho it is compact, is that one is stuffing a matrix with values that are then set to zero later, which is a waste of effort. It is better to construct the lower triangular Toeplitz matrix outright with specially chosen vectors, like so:

ToeplitzMatrix[#, SparseArray[1 -> First[#], Length[#]]] & @ vals
$\endgroup$
  • $\begingroup$ Wow! I've never used those (esoteric?) matrix functions before. +1! $\endgroup$ – Mr.Wizard Jul 29 '13 at 20:54
2
$\begingroup$

Also:

ClearAll[toLTM]
toLTM[n_Integer] := Composition[Transpose, PadLeft, Range, Reverse, Range]@n
(* or toLTM[n_Integer] := Reverse /@ PadLeft @ Range @ Range @ n *)

toLTM[v_List] := Transpose @ 
  PadLeft @ Extract[v, List /@ Range @ Reverse @ Range @ Length @ v]

toLTM @ 4 // TeXForm

$\left( \begin{array}{cccc} 1 & 0 & 0 & 0 \\ 2 & 1 & 0 & 0 \\ 3 & 2 & 1 & 0 \\ 4 & 3 & 2 & 1 \\ \end{array} \right)$

toLTM @ CharacterRange["a", "d"] // TeXForm

$\left( \begin{array}{cccc} \text{a} & 0 & 0 & 0 \\ \text{b} & \text{a} & 0 & 0 \\ \text{c} & \text{b} & \text{a} & 0 \\ \text{d} & \text{c} & \text{b} & \text{a} \\ \end{array} \right)$

$\endgroup$
1
$\begingroup$
PadRight[Take[RotateRight[Reverse@list, #], #], 4] & /@ Range[Length[list]]

or

    NestList[RotateRight, Reverse@list, 
   Length@list][[-Length@list ;; -1]] // LowerTriangularize
$\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.