Defining a non-commutative operator algebra in Mathematica

Question

I am trying to develop a function(s) to do some commutator algebra to compute the enveloping algebra and ideals of a Lie algebra. For example if I have $SU(2)$ algebra generated by $L_i$ ($i=1,2,3$), I would like to evaluate commutators between polynomials of type $L_1^mL_2^nL_3^p$ where $m,n,p$ are integers.

Now I think I should start by defining a commutator function as a mapping which is:

(a) antisymmetric, (b) is a derivation (Leibniz property), and (c) satisfies Jacobi identity.

Since I do not want to plug in explicit realizations for the operators, defining commutator $[A,B] = AB - BA = C$ would not really help. I want to define commutator as a rule which would just assign $[A,B] \rightarrow C$ and when computing $[A,BC] \rightarrow [A,B]C + B[A,C]$ and so on. I tried by defining something with Leibniz property as follows:

Comm[a_**b_, c_**d_] := a**Comm[b, c]**d + a**c**Comm[b, d] + Comm[a, c]**d**b + 
                        c**Comm[a, d]**b;

This works fine for evaluating $[a,bcd]$ but it doesn't do anything to $[abc,d]$ for example. So I am wondering what should I do to correctly define this and how would I go about to define this mapping with the desired properties.

Answer 1

Here's a simple suggestion: define a function that expands commutators by applying the Leibnitz rule to each argument individually and using the distributive property of the ** operation. Since we can't apply commutativity, I have to spell out rules for different orders of factors. Then I apply the function to an example.

cExpand[
  expr_] := (expr //. { 
     Comm[a_ ** b_, c_] :> a ** Comm[b, c] + Comm[a, c] ** b, 
     Comm[a_, b_ ** c_] :> 
      Comm[a, b] ** c + b ** Comm[a, c]}) /. {Plus[x__] ** y_ :> 
    Distribute[Plus[x] ** y], 
   y_ ** Plus[x__] :> Distribute[y ** Plus[x]]
   }

cExpand[Comm[a ** b, c ** d]]

(*
==> a ** c ** Comm[b, d] + a ** Comm[b, c] ** d + 
 c ** Comm[a, d] ** b + Comm[a, c] ** d ** b
*)

cExpand[Comm[a ** b, c ** d ** e]]

(*
==> a ** c ** (d ** Comm[b, e] + Comm[b, d] ** e) + 
 c ** (d ** Comm[a, e] + Comm[a, d] ** e) ** b + 
 a ** Comm[b, c] ** d ** e + Comm[a, c] ** d ** e ** b
*)

In the definition of cExpand, I use //. (ReplaceRepeated) to simplify the commutators until it doesn't go any further.

Answer 2

Try this set of rules:

Unprotect[NonCommutativeMultiply];

NonCommutativeMultiply[a_Plus, b_] := Plus@@(NonCommutativeMultiply[#,b]&/@a)

NonCommutativeMultiply[a_, b_Plus] := Plus@@(NonCommutativeMultiply[a,#]&/@b)

NonCommutativeMultiply[Times[-1,a__], b_] := -NonCommutativeMultiply[Times[a],b]

NonCommutativeMultiply[a_, Times[-1,b__]] := -NonCommutativeMultiply[a,Times[b]]

Protect[NonCommutativeMultiply];
Comm[a:Except[_NonCommutativeMultiply],b:Except[_NonCommutativeMultiply]]/;!OrderedQ[{a,b}] := -Comm[b,a]

Comm[a:Except[_NonCommutativeMultiply],b_NonCommutativeMultiply] := -Comm[b,a]

Comm[NonCommutativeMultiply[a_,b_,r__],c_] := a**Comm[NonCommutativeMultiply[b,r],c]+NonCommutativeMultiply[Comm[a,c],r]

Comm[a_**b_,c_] := a**Comm[b,c]+Comm[a,c]**b

To clean the rules for NonCommutativeMultiply use:

Unprotect[NonCommutativeMultiply];
DownValues[NonCommutativeMultiply] = {};
Protect[NonCommutativeMultiply];

Using those rules I got

Comm[a ** b ** c, d]
Comm[a, d] ** c + a ** b ** Comm[c, d] + a ** Comm[b, d] ** c

,

Comm[a, b ** c ** d]
Comm[a, b] ** d + b ** c ** Comm[a, d] + b ** Comm[a, c] ** d

,

Comm[a ** b, d ** e]
a ** d ** Comm[b, e] + a ** Comm[b, d] ** e + d ** Comm[a, e] ** b + Comm[a, d] ** e ** b

and

Comm[a ** b ** c, d ** e]
d ** Comm[a, e] ** c + Comm[a, d] ** e ** c + a ** b ** d ** Comm[c, e] + a ** b ** Comm[c, d] ** e + a ** d ** Comm[b, e] ** c + a ** Comm[b, d] ** e ** c

The possibilities are limitless the trick is to try to teach Mathematica the notions you want and build on them!