# Group Theory Background / Utilities

Suppose I give you a list G of matrices which represent some group, in that the matrices are closed under multiplication. In other words, I provide a list G of matrices which have

GroupRepresentationQ[matrixRepresentation_]:=And@@Flatten@Outer[
MemberQ[matrixRepresentation,FullSimplify[#1 . #2]]&,
matrixRepresentation,
matrixRepresentation,
1]


and GroupRepresentationQ[G]==True. We can compute the multiplication table via

MultiplicationTable[matrixRepresentation_]:=Outer[Position[matrixRepresentation,#][[1,1]]&@*Dot,matrixRepresentation,matrixRepresentation,1]


We can compute the conjugacy classes

GroupConjugateUnitary[X_][A_]:=FullSimplify[X . A . X\[ConjugateTranspose]]

(* NB: memoized for speed *)
ConjugacyClasses[matrixRepresentation_]:=ConjugacyClasses[matrixRepresentation]=With[
{conjugations = Flatten/@Table[
Position[matrixRepresentation,GroupConjugateUnitary[matrixRepresentation[[n]]][g]],
{g,matrixRepresentation},
{n,Range[Length[matrixRepresentation]]}
]
},
Part[matrixRepresentation,#]&/@Union[Union/@conjugations]
]


According to (for example) Dresselhaus, Dresselhaus, and Jorio, you can tell if a representation is irreducible by using

NIrreps=Length@*ConjugacyClasses;
IrrepQ[matrixRepresentation_]:=(Length[matrixRepresentation]==Total[Map[Length[#] Tr[#[[1]]]^2&,ConjugacyClasses[matrixRepresentation]]])


If the set G is Not@*IrrepQ then there exists a unitary transformation that exposes the fact all of the matrices in G may be simultaneously block-diagonalized. In other words, using

blockSplit[reducible_]:=Module[{
zeroQ=Map[EqualTo[0],reducible,{3}],
cols,rows,runs
},
cols=Max/@(Map[Map[Last[Position[#,False]][[1]]&,#]&,zeroQ]\[Transpose]);
rows=Max/@(Map[Map[Last[Position[#,False]][[1]]&,#\[Transpose]]&,zeroQ]\[Transpose]);
If[cols!=rows,Print["Problem with blocking!"];Return[0]];
runs=Partition[{0}~Join~Union[cols],2,1];
Map[reducible[[All,#[[1]]+1;;#[[2]],#[[1]]+1;;#[[2]]]]&,runs]
]


to 'pull apart' the direct sum, there exists a U such that IrrepQ/@blockSplit[GroupConjugateUnitary[U]/@G] is a vector of Trues.

# Question

Q: How can I find a/the unitary transformation U that maximally block-diagonalizes all of the matrices in G?

(By maximally, I mean the IrrepQ/@ statement.)

Note: I'm not going to tell you which group the matrices in G represent. If you can discover it somehow, great. But I found that MultiplicationTable[G] didn't match any I could find in Mathematica's built-in group theory knowledge (presumably because the matrices are not in the same order as the group elements), and the characters seem not to help because G might be extremely reducible.

For example, take the set of twelve 12x12 matrices

G = {{{1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0}, {0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0}, {0,
0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0}, {0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 1, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}}, {{0, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
0}, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0}, {1, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0}, {0, 1, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0}, {0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1}, {0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0,
0, 1, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}}, {{0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0}, {0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0}, {0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {0, 0, 1, 0, 0, 0, 0, 0,
0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0}, {1, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, {0, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
0}, {0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}}, {{0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0}, {0, 0, 0, 0,
0, 0, 0, 0, 0, 1, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0}, {0,
0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
0}, {0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0}, {0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0}}, {{0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0}, {0, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0}, {1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0}, {0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 1,
0, 0, 0, 0, 0, 0, 0}}, {{0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0,
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0}, {0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, {1, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0}, {0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {0, 0,
0, 0, 1, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,
0}, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0,
1, 0, 0, 0}}, {{0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
0}, {0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 1,
0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0}, {0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,
0}}, {{0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0,
0, 1, 0, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 1, 0}, {0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0}}, {{0,
0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0}, {0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0}, {0, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
0}, {1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0}, {0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}}, {{0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 1, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {0,
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
0}, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 1,
0, 0, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0,
1, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0}, {0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}}, {{0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0}, {0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0,
0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0}, {1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {0, 0, 1, 0, 0, 0, 0, 0,
0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0}, {0, 0, 0, 0, 1,
0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0}, {0, 0,
0, 0, 0, 0, 1, 0, 0, 0, 0, 0}}, {{0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
0}, {0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0}, {1, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0}, {0, 1, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0}, {0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,
0}, {0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 1}, {0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0}}}


which (using some manual insight that is not sustainable for all the cases in which I'm interested) comprises irreducible representations only of size 1 and 2.

# First Attempt

Let's not try to do "the whole thing" at once. In other words, it's enough to find a procedure that can block diagonalize the given reducible representation into two (or more) representations (reducible or irreducible).

I tried the following method

blockDiagonalize[reducible_, first_ : False] := Module[{
c = ConjugacyClasses[reducible],
m, eig, U, diagonalized
},
m = FullSimplify@
If[first, Total[reducible], c[[1, 1]] + Total@RandomChoice[c[[2 ;;]]]];
(* The above seems to often work, but it can get stuck, see below! *)
eig = FullSimplify@Eigensystem[m];
U = Join @@ Values[
GroupBy[eig\[Transpose], First,
FullSimplify@*Orthogonalize@*Last@*Transpose]];
diagonalized = GroupConjugateUnitary[U] /@ reducible;
Return[{U, FullSimplify /@ diagonalized}]]


and then

{U, d} = blockDiagonalize[G, True];
Map[MatrixPlot, d]


shows that G is now block diagonal.

You can get lists of the blocks using blockSplit,

b=FullSimplify[blockSplit[d]];


and the procedure yielded a set of 1x1 matrices and a set of 11x11 matrices (in this case):

b = {{{{1}}, {{1}}, {{1}}, {{1}}, {{1}}, {{1}}, {{1}}, {{1}}, {{1}},
{{1}}, {{1}}, {{1}}}, {... a set of matrices that put me over the length limit...}}


but IrrepQ/@b is {True, False}. Repeating this procedure on those where it is False often succeeds, but for the example G above it does not (it seems to get stuck on some reducible 4x4 matrices). Once I repeat the procedure enough to get all all IrrepQs, then I can use the Us returned by blockDiagonalize to build up the complete unitary transformation.

The "right" answer might be a more direct method or a method that leverages a better knowledge of group theory than I have leveraged :-P, especially in the blockDiagonalize method. It (presumably?) would not rely on RandomChoice and would always eventually get all the blocks to be IrrepQ.

• A package that helps accomplish this task is provided by Bischer, Döring, and Trautner, in the supplementary material for "Simultaneous block diagonalization of matrices of finite order" 2021 J. Phys. A: Math. Theor. 54 085203 doi.org/10.1088/1751-8121/abd979 Apr 5, 2022 at 9:31