8
$\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?

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

10 Answers 10

15
$\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
$\endgroup$
  • $\begingroup$ THIS is what I was looking for!! $\endgroup$ – verse Apr 11 '15 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 Apr 11 '15 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 Apr 11 '15 at 0:51
  • $\begingroup$ In V8, your solution can not be executed. $\endgroup$ – xyz Apr 11 '15 at 7:33
  • $\begingroup$ @ShutaoTang That is true. Span operation within MapAt was not enabled until version 9; see: (31173) $\endgroup$ – Mr.Wizard Apr 11 '15 at 7:45
7
$\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]}} *)
$\endgroup$
  • $\begingroup$ this solution traverses the entire matrix. is there any way to only traverse the upper triangular part? $\endgroup$ – verse Apr 10 '15 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 Apr 10 '15 at 20:32
6
$\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

$\endgroup$
  • $\begingroup$ +1 on second - was about to post then saw yours. Probably the most efficient way - well done. $\endgroup$ – ciao Apr 10 '15 at 22:23
  • $\begingroup$ Within MapAt using Span is quite a bit faster than enumerating positions; see: (31173) $\endgroup$ – Mr.Wizard Apr 11 '15 at 1:03
  • $\begingroup$ Thank you @Mr.Wizard; I keep forgetting @Kuba's great discovery:) $\endgroup$ – kglr Apr 11 '15 at 1:07
4
$\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

$\endgroup$
3
$\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]]}} *)
$\endgroup$
  • $\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 Apr 11 '15 at 0:59
1
$\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]]}

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

For the case you gave:

f@UpperTriangularize@m
$\endgroup$
  • $\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 Apr 10 '15 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 Apr 10 '15 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
$\endgroup$
  • $\begingroup$ I believe that for this to work f needs to be Listable and also f[0] = 0. $\endgroup$ – Mr.Wizard Apr 11 '15 at 0:54
0
$\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

$\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.