Repeated ReplacePart On Each Element of a Square Matrix for Eigenvalue Difference

Question

I have a large $n\times n$ square matrix, whose elements are all either 0 or 1. I want to see by how much the single largest eigenvalue of the matrix (which Mathematica gives as the first element in the list from Eigenvalues) changes when I change each element of the matrix individually, so that I can produce a list of this eigenvalue difference for each element. A $10\times 10$ matrix would thus give a list of 100 eigenvalue differences. By "changing each element", I mean switching the element to 1 if it's a 0 or to 0 if it's a 1 in the original.

For instance, if the matrix is {{0, 1, 0}, {1, 0, 1}, {1, 0, 0}}, finding the largest eigenvalue of {{1, 1, 0}, {1, 0, 1}, {1, 0, 0}}, then that of {{0, 0, 0}, {1, 0, 1}, {1, 0, 0}}, then that of {{0, 1, 1}, {1, 0, 1}, {1, 0, 0}} etc...

I experimented with Loops but since $i$ and $j$ need to increase independently I couldn't resolve that issue. I also thought of combining ReplacePart and If but can't find a neat way of doing this for very large matrices.

Answer 1

Note that switching from 1 to 0 or vice versa can be achieved by: 1-x. Furthermore, if you only want the abs. largest Eigenvalue you may use `Eigenvalues[mat,1].

E.g. to create a table of Eigenvalues of a 3x3 matrix with largest abs. values, we first create same data and calculate the eigenvalues:

m0 = RandomInteger[{0, 1}, {3, 3}];
res =
  Table[
   Eigenvalues[t = m0; t[[i, j]] =1- t[[i, j]]; t, 1]
   , {i, 3}, {j, 3}];
res = Map[Flatten, res, 2]
res // MatrixForm

This produces the output for our example:

Answer 2

First of all define a function that gets the first eigenvalue of a matrix:

getMaxEigenvalue = First@Eigenvalues[#] &

Then we define a function which gives us another function which by applying it to a matrix, swaps 1 with 0 in the i th row and j th column :

swap[i_, j_] := ReplacePart[#, {i, j} -> If[#[[i, j]] == 1, 0, 1]] &

Now suppose that the base matrix is called a; For example we have a matrix:

a = RandomInteger[{0, 1}, {3, 3}]

Now your answer could be obtained :

Table[getMaxEigenvalue[swap[i, j][a]], {i, Length[a]}, {j, Length[a]}] - getMaxEigenvalue[a]

Answer 3

Clear[calcE]
calcE[mat_] := Array[
   {{##}, 
     Chop@First@Eigenvalues[N@#, 1] &@
      ReplacePart[mat, {##} -> 1 - mat[[##]]]} &,
   Dimensions[mat]
   ]~Flatten~1

m = {{0, 1, 0}, {1, 0, 1}, {1, 0, 0}};
calcE[m]

(* Out:
{{{1, 1}, 1.83929},           {{1, 2}, 0},       {{1, 3}, 1.61803}, 
 {{2, 1}, -0.5 + 0.866025 I}, {{2, 2}, 1.83929}, {{2, 3}, -1.}, 
 {{3, 1}, -1.},               {{3, 2}, 1.61803}, {{3, 3}, 1.61803}}
*)

For larger matrices, you will probably want to specify Method -> "Arnoldi" in Eigenvalues. If you want the symbolic values, rather than the numerical ones, remove the N@ and Chop from the code.