7
$\begingroup$

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.

$\endgroup$
3
  • $\begingroup$ Related: Differential geometry add-ons for Mathematica. $\endgroup$
    – Jens
    Apr 6, 2013 at 17:13
  • $\begingroup$ I would probably define a separate function like commutatorExpand and/or commutatorReduce that does the transformations in the direction you want. $\endgroup$
    – Jens
    Apr 6, 2013 at 17:15
  • $\begingroup$ Possibly relevant: this and this and this $\endgroup$ Apr 6, 2013 at 17:16

2 Answers 2

5
$\begingroup$

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.

$\endgroup$
2
$\begingroup$

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!

$\endgroup$
1
  • 1
    $\begingroup$ The possibilities are limitless - that's the problem. The rules in this answer are clearly insufficient (no multiplication by base-field constants other than -1 for example) and I don't know how to fix them. I would never be confident that my rules weren't buggy. And it's an absurd exercise because Mathematica is supposed to be a CAS. Why do I have to implement my own CAS in it? The C stands for Computer, not Commutative. Why does Mathematica ship with a goat detector but no ability to prove a**(b+c) == a**b + a**c? $\endgroup$
    – benrg
    Oct 23, 2019 at 23:45

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.