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, and contains the powers of annihilation, creation pairs. So that {1, 2} refers to $a^1{a}^{†2}$. 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^{†}{a}^{2}a{a}^3{a}^{†}{a}^{†2}=a^{†}{a}^6{a}^{†3}.$

to be continued...