Canonical way to map a function to diagonal elements of a square matrix?

Question

What is the Canonical way to map a function to only the diagonal elements of a matrix?

For example, given

 A = {{E, 0}, {0, E}}

I wanted to take the log of the diagonal elements only to obtain {{1, 0}, {0, 1}}

I came up with these

 MapAt[Log[#] &, A, Table[{i, i}, {i, Length[A]}]]

  result = Log[Diagonal[A]];
  ReplacePart[A, {i_, i_} :> result[[i]]]

Since in Mathematica the rule of thumb is that there should be at least 10 different ways to do the same thing, I think there is room to find a better approach.

Answer 1

Using b.gates.you.know.what's idea:

With[{f = Log}, 
     MapIndexed[Function[{x, id}, If[Equal @@ id, f[x], x]], A, {2}]]

---

Using an undocumented function:

res = A;
With[{f = Log}, LinearAlgebra`Private`SetMatrixDiagonal[res, f[Diagonal[res]]]];
res

Note that this function modifies matrices given to it, so you'll need to make a copy if you still need the starting matrix.

Answer 2

I don't know if there are 10 different ways, but here's a third.

Start with A and subtract off the diagonal, modify the diagonal with your function (Log) and add it back in:

A - DiagonalMatrix[Diagonal[A]] + DiagonalMatrix[Log[Diagonal[A]]]

Answer 3

A modification of a method given by Leonid Shifrin in Mathematica programming: an advanced introduction

A// MapThread[ReplacePart, {#, Log@Diagonal[#], Range[Length@#]}]&

{{1, 0}, {0, 1}}

There is a discussion in this old SO question: Changing the Diagonals of a Matrix with Mathematica

Edit (Just for fun)

(UpperTriangularize[#, 1] + LowerTriangularize[#, -1] + 
LowerTriangularize[UpperTriangularize[Log[#]]]) &[A]

(* {{1, 0}, {0, 1}} *)

or

(UpperTriangularize[#, 1] + LowerTriangularize[#, -1] + 
LowerTriangularize[UpperTriangularize[#2[#]]]) &[A, Log]

(* {{1, 0}, {0, 1}} *)

Answer 4

A = {{"a", 0, 0}, {0, E, 0}, {0, 0, E}};

With ReplaceAt (new in 13.1) we can easily add conditions:

ReplaceAt[A, x_?NumericQ :> Log[x], {#, #} & /@ Range @ Length @ A]

{{"a", 0, 0}, {0, 1, 0}, {0, 0, 1}}

Answer 5

Just a variant:

func[f_, mat_] := 
 Fold[MapAt[f, #1, {#2, #2}] &, mat, 
  Range[Length[mat[[1]]]]]

For example:

i = E  IdentityMatrix[3];
func[Log, i]
func[g, {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}]

yields:

{{1, 0, 0}, {0, 1, 0}, {0, 0, 1}} {{g[1], 2, 3}, {4, g[5], 6}, {7, 8, g[9]}}

Answer 6

A = {{E, 0, 0}, {0, E, 0}, {0, 0, E}};

Using SubsetMap:

SubsetMap[Log@# &, #, Diagonal@Array[{##} &, Dimensions@#]] &@A

{{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}

Another way, using ArrayRules and SparseArray:

A = {{"a", 0, 0}, {0, E, 0}, {0, 0, E}}; (*@eldo's matrix*)

Normal@SparseArray@(Most@ArrayRules[A] /. 
Rule[{i_, i_}, a_ /; NumericQ[a]] :> Rule[{i, i}, Log@a])

{{"a", 0, 0}, {0, 1, 0}, {0, 0, 1}}