# Obtain needed Kronecker products from output of Eigensystem[]

Eigensystem[M] gives a list of the eigenvalues and eigenvectors of the square matrix M, i.e.

{{val1,val2,...},{vec1,vec2,...}}.


I need a routine that will produce the Kronecker product of each eigenvector with itself, e.g. KroneckerProduct[vec1, vec1], KroneckerProduct[vec2, vec2], etc. And, in addition produce the Kronecker product of each eigenvector corresponding to degenerate eigenvalues, e.g. if

val2 == val3 == val4


produce

 KroneckerProduct[vec2,vec3]
KroneckerProduct[vec2,vec4]
KroneckerProduct[vec3,vec4]


and do this for as many degeneracies as there may be.

For the first and easy part of the question:

es = Eigensystem[{{{a, 0, 0, 0}, {0, a, 0, 0}, {0, 0, b, 0}, {0, 0, 0,
a}}}]


{{a, a, a, b}, {{0, 0, 0, 1}, {0, 1, 0, 0}, {1, 0, 0, 0}, {0, 0, 1, 0}}}

m1 = KroneckerProduct[#, #] & /@ es[[2]];
TeXForm[MatrixForm /@ m1]


$\left\{\left( \begin{array}{cccc} 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 1 \\ \end{array} \right),\left( \begin{array}{cccc} 0 & 0 & 0 & 0 \\ 0 & 1 & 0 & 0 \\ 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 \\ \end{array} \right),\left( \begin{array}{cccc} 1 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 \\ \end{array} \right),\left( \begin{array}{cccc} 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 \\ 0 & 0 & 1 & 0 \\ 0 & 0 & 0 & 0 \\ \end{array} \right)\right\}$

For the second part:

m2 = KroneckerProduct @@@ # & /@
(Subsets[#, {2}]&/@Select[GatherBy[Transpose[es], First][[All, All, 2]], Length@# > 1 &])
TeXForm[m2]


$\left( \begin{array}{ccc} \left( \begin{array}{cccc} 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 \\ 0 & 1 & 0 & 0 \\ \end{array} \right) & \left( \begin{array}{cccc} 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 \\ 1 & 0 & 0 & 0 \\ \end{array} \right) & \left( \begin{array}{cccc} 0 & 0 & 0 & 0 \\ 1 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 \\ \end{array} \right) \\ \end{array} \right)$

In versions 10+, you can use GroupBy

m2b = Select[Length@# > 1 &] @ Values @
GroupBy[Transpose[es], First -> Last,  KroneckerProduct @@@ Subsets[#, {2}] &]
m2b == m2


True