I am writing a code that computes arbitrary commutation relations. As part of this code is the following module that performs the associative part of the algebra:
Associate[list__] := Module[{ps, ic, l2, mlist},
mlist = list;
(* Where are the zeros which are not first or last (if they exist) *)
While[TrueQ[
Length[ps =
Complement[Flatten[Position[mlist, 0]], {1, Length[mlist]}]] >
0],
(* index to collapse *)
ic = Floor[ps[[1]]/2];
l2 = Partition[mlist, 2];
l2[[ic]] = l2[[ic]] + l2[[ic + 1]];
mlist = Flatten[Delete[l2, ic + 1]];
Print[mlist];
];
mlist
]
The parameter is a list that should be even-sized[1], and contains the powers of annihilation, creation pairs. So that {1, 2} refers to \(a^1a^{\dagger2}\). In this case there is nothing to simplify so the string is returned as such.
A nontrivial example is, e.g.,
Associate[{0, 1, 2, 0, 1, 0, 3, 0, 0, 1, 0, 2}]
which returns:
{0, 1, 6, 3}
This is the mathematical reduction that brings the rhs to the lhs:
\[a^{\dagger}a^2aa^3a^{\dagger}a^{\dagger2}=a^{\dagger}a^6a^{\dagger3}\,.\]