12
$\begingroup$

I have a square $n \times n$ matrix $m$, and need to apply a function $f$ to all elements on and above the diagonal.

This is of course easy to do using a nested table:

 Table[Table[f @ m[[i,j]],{i,1,n}],{j,i,n}]

Is there a more elegant functional equivalent to this line? Something that would be more declarative in style?

Improve this question
$\endgroup$
2
  • $\begingroup$ Shouldn't that read Table[Table[f@m[[i, j]], {j, i, n}], {i, n}]? $\endgroup$
    – Jinxed
    Commented Apr 10, 2015 at 20:36
  • $\begingroup$ Somewhat related: (41362), (55659) $\endgroup$
    – Mr.Wizard
    Commented Apr 11, 2015 at 0:39

13 Answers 13

Reset to default
16
$\begingroup$

Example square matrix:

n = 4;

m = Range[n^2] ~Partition~ n;

m // MatrixForm

$\left( \begin{array}{cccc} 1 & 2 & 3 & 4 \\ 5 & 6 & 7 & 8 \\ 9 & 10 & 11 & 12 \\ 13 & 14 & 15 & 16 \\ \end{array} \right)$

Operation:

MapAt[f, m, {#, # ;;} & ~Array~ Length @ m]     // MatrixForm

$\left( \begin{array}{cccc} f(1) & f(2) & f(3) & f(4) \\ 5 & f(6) & f(7) & f(8) \\ 9 & 10 & f(11) & f(12) \\ 13 & 14 & 15 & f(16) \\ \end{array} \right)$

A hybrid method inspired by other answers:

MapAt[f, #, #2[[1]] ;;] & ~MapIndexed~ m
Improve this answer
$\endgroup$
5
  • $\begingroup$ THIS is what I was looking for!! $\endgroup$
    – verse
    Commented Apr 11, 2015 at 0:33
  • 1
    $\begingroup$ @verse Cool. I am still looking for a related question that may have other methods of interest. $\endgroup$
    – Mr.Wizard
    Commented Apr 11, 2015 at 0:35
  • $\begingroup$ @verse I failed to find anything closely related; perhaps my memory was bad. I did however find two questions that combined would suggest an alternative approach, though it would not be elegant. They are linked in a comment above. $\endgroup$
    – Mr.Wizard
    Commented Apr 11, 2015 at 0:51
  • $\begingroup$ In V8, your solution can not be executed. $\endgroup$
    – xyz
    Commented Apr 11, 2015 at 7:33
  • $\begingroup$ @ShutaoTang That is true. Span operation within MapAt was not enabled until version 9; see: (31173) $\endgroup$
    – Mr.Wizard
    Commented Apr 11, 2015 at 7:45
8
$\begingroup$

I would use MapIndexed, e.g.

data = Partition[Range[9], 3];
MapIndexed[If[LessEqual @@ #2, f@#1, #1] &, data, {2}]
(* {{f[1], f[2], f[3]}, {4, f[5], f[6]}, {7, 8, f[9]}} *)
Improve this answer
$\endgroup$
2
  • $\begingroup$ this solution traverses the entire matrix. is there any way to only traverse the upper triangular part? $\endgroup$
    – verse
    Commented Apr 10, 2015 at 20:28
  • $\begingroup$ Yes, it traverse the entire matrix, which may not be a bad thing, but it only applies f above the diagonal. So, it still minimizes how many times you execute f. $\endgroup$
    – rcollyer
    Commented Apr 10, 2015 at 20:32
8
$\begingroup$ 
mapAboveDiagonal1 = With[{dim = Dimensions[#2]}, 
 MapAt[#, #2, Join @@ Table[{i, j}, {i, dim[[1]]}, {j, i, dim[[2]]}]]] &

or

mapAboveDiagonal2 = MapAt[#, #2, 
  SparseArray[UpperTriangularize[
              ConstantArray[1, Dimensions[#2]]]]["NonzeroPositions"]]&;

mm = Array[m, {5, 5}];
Row[MatrixForm /@ {mm, mapAboveDiagonal1[f, mm]}]

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ +1 on second - was about to post then saw yours. Probably the most efficient way - well done. $\endgroup$
    – ciao
    Commented Apr 10, 2015 at 22:23
  • $\begingroup$ Within MapAt using Span is quite a bit faster than enumerating positions; see: (31173) $\endgroup$
    – Mr.Wizard
    Commented Apr 11, 2015 at 1:03
6
$\begingroup$

Another option is to take advantage of SparseArray index selection:

f[x_] := x^2;
n = 5;
(data = RandomInteger[10, {n, n}]) // MatrixForm

Mathematica graphics

And now apply the function f[x] above to only the top triangle

SparseArray[{{i_, j_} /; i <= j :> f@data[[i, j]], 
             {i_, j_} /; i > j :> data[[i, j]]}, {n, n}]

Mathematica graphics

Improve this answer
$\endgroup$
4
$\begingroup$

In case another way is needed:

matrix = Array[m, {5, 5}];

Fold[MapAt[f, #1, {#2, #2 ;;}] &, matrix, Range[5]]
(* {{f[m[1, 1]], f[m[1, 2]], f[m[1, 3]], f[m[1, 4]], 
  f[m[1, 5]]}, {m[2, 1], f[m[2, 2]], f[m[2, 3]], f[m[2, 4]], 
  f[m[2, 5]]}, {m[3, 1], m[3, 2], f[m[3, 3]], f[m[3, 4]], 
  f[m[3, 5]]}, {m[4, 1], m[4, 2], m[4, 3], f[m[4, 4]], 
  f[m[4, 5]]}, {m[5, 1], m[5, 2], m[5, 3], m[5, 4], f[m[5, 5]]}} *)
Improve this answer
$\endgroup$
1
  • $\begingroup$ You've got my +1 on this as it's nearly my own formulation. However Fold proves unnecessary and slightly less clean, IMHO. $\endgroup$
    – Mr.Wizard
    Commented Apr 11, 2015 at 0:59
3
$\begingroup$

Thanks everyone for contributing interesting suggestions.

I thought I'd also attach my own solution:

f[m[#1, #2]]& @@@ Select[Tuples[Range @ n, 2], #[[1]] <= #[[2]] &]

For n=5 the output is as follows:

{f[m[1, 1]], f[m[1, 2]], f[m[1, 3]], f[m[1, 4]], f[m[1, 5]], f[m[2, 2]], f[m[2, 3]], f[m[2, 4]], f[m[2, 5]], f[m[3, 3]], f[m[3, 4]], f[m[3, 5]], f[m[4, 4]], f[m[4, 5]], f[m[5, 5]]}

Improve this answer
$\endgroup$
1
  • 2
    $\begingroup$ Similar: Extract[m, Range@n~Tuples~2~Select~OrderedQ, f] $\endgroup$
    – Simon Woods
    Commented Apr 11, 2015 at 12:07
3
$\begingroup$ 
MapThread[Compose, {Array[If[#1 <= #2, f, Identity] &, Dimensions@m], m}, 2]
Improve this answer
$\endgroup$
1
  • 2
    $\begingroup$ Could also be written: Array[If[#1 <= #2, f, # &] @ m[[##]] &, Dimensions@m] $\endgroup$
    – Mr.Wizard
    Commented Apr 11, 2015 at 15:45
2
$\begingroup$

Just wanted to join party but not near computer...will check edit when I get chance 

ad[m_,f_]:= Module[{n =     Length[m[[1]]], mf = Flatten[m], nf}, 
nf = List /@ Flatten[NestList[n + Rest@# &, Range[n], n - 1]];
Partition[MapAt[f, mf, nf], n]]

Here m is square matrix and f function to be applied.

For example,

MatrixForm[#] -> MatrixForm[ad[#, f]] &@Partition[Range[25], 5]

enter image description here

Improve this answer
$\endgroup$
2
$\begingroup$ 
m = Partition[Range[16], 4];

Using ReplacePart

ReplacePart[m, {i_, j_} /; j >= i :> f @ m[[i, j]]] // MatrixForm

enter image description here

Improve this answer
$\endgroup$
2
$\begingroup$ 
m = Partition[Range[16], 4];

Another alternative using Table and TakeDrop:

Table[Join @@ {#1, f /@ #2} & @@ 
Reverse@TakeDrop[m[[i]], {i, UpTo[#]}], {i, #}] &@Length[m]// TeXForm

$\left( \begin{array}{cccc} f(1) & f(2) & f(3) & f(4) \\ 5 & f(6) & f(7) & f(8) \\ 9 & 10 & f(11) & f(12) \\ 13 & 14 & 15 & f(16) \\ \end{array} \right)$

Or using Fold and TakeDrop:

fun = Function[{acc, i}, 
      Append[acc, Join @@ {#1, f /@ #2} & @@ 
      Reverse@TakeDrop[#[[i]], {i, UpTo[Length@#]}]]] &;

Fold[fun@#, {}, Range[Length@#]] &@m // TeXForm

$\left( \begin{array}{cccc} f(1) & f(2) & f(3) & f(4) \\ 5 & f(6) & f(7) & f(8) \\ 9 & 10 & f(11) & f(12) \\ 13 & 14 & 15 & f(16) \\ \end{array} \right)$

Improve this answer
$\endgroup$
1
$\begingroup$ 
Clear["Global`*"];
n = 4;
m = Range[n^2]~Partition~n;

(res = Catenate[{m[[#, 1 ;; # - 1]], (f /@ m[[#, # ;;]])}] & /@ 
    Range[1, n]) // MatrixForm

$\left( \begin{array}{cccc} f(1) & f(2) & f(3) & f(4) \\ 5 & f(6) & f(7) & f(8) \\ 9 & 10 & f(11) & f(12) \\ 13 & 14 & 15 & f(16) \\ \end{array} \right)$

Improve this answer
$\endgroup$
0
$\begingroup$

For the case you gave:

f@UpperTriangularize@m
Improve this answer
$\endgroup$
2
  • $\begingroup$ doesn't UpperTriangularize simply replace the elements below the diagonal with zeros? If so, $f$ would still be evaluated for those elements, increasing the run time. In my specific case $f$ takes a substantial amount of time to evaluate, and I must keep the total number of evaluations to a minimum $\endgroup$
    – verse
    Commented Apr 10, 2015 at 20:24
  • $\begingroup$ @verse: You gave none of this information in your question. :| Can you provide an examplary matrix and the function f? On the other hand: Did you try my approach regarding timing? $\endgroup$
    – Jinxed
    Commented Apr 10, 2015 at 20:31
0
$\begingroup$

Building upon @Jinxed's insights, this may be one of the shortest code snippets, though admittedly it isn't efficient code:

(f[#] - #) & @ UpperTriangularize@m + m
Improve this answer
$\endgroup$
1
  • $\begingroup$ I believe that for this to work f needs to be Listable and also f[0] = 0. $\endgroup$
    – Mr.Wizard
    Commented Apr 11, 2015 at 0:54

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.