As we all know, Mathematica has extensive built-in support for computations in free commutative algebras, AKA polynomials algebras. It's also not that hard to make computations in exterior algebras with a fixed set of generators. One possibility is to use NonCommutativeMultiply, follow the documentation to make it into a bilinear operation, and explicitly stating that the generators anti-commute:

ncm[(h : NonCommutativeMultiply)[a___, b_Plus, c___]] :=
Distribute[h[a, b, c], Plus, h, Plus, ncm[h[##1]] &]
ncm[a_Plus] := ncm /@ a
ncm[(h : NonCommutativeMultiply)[a___, b_Times, c___]] :=
Most[b]  ncm[h[a, Last[b], c]]

(* Skew-symmetry *)
generators = Array[e, 5];
(ncm[a___ ** # ** #2 ** b___] := -ncm[a ** #2 ** # ** b]) & @@@
Subsets[generators, {2}];
(ncm[___ ** # ** # ** ___] = 0) & /@ generators;

ncm[a_] := ExpandAll[a]
(* Examples *)
ncm[e[1] ** e[2] + e[2] ** e[1]]
(* 0 *)
ncm[e[3] ** e[2] ** e[3]]
(* 0 *)


This is cumbersome but it kind of works. A somewhat simpler possibility is to use the facilities for tensor computations, like here: Computations in the exterior algebra

Now, I'd like to have a graded commutative algebra: generators have a certain degree, and homogeneous elements satisfy $$xy = (-1)^{|x| \, |y|}yx.$$

It's also possible to massage the ncm function into making this work. For example, if I have three generators $$x,y,z$$ of respective degrees $$1,2,3$$, I can replace the section "Skew-symmetry" of the code with:

ncm[a___ ** x ** x ** b___] := 0
ncm[a___ ** z ** z ** b___] := 0
ncm[a___ ** y ** x ** b___] := ncm[a ** x ** y ** b]
ncm[a___ ** z ** x ** b___] := -ncm[a ** x ** z ** b]
ncm[a___ ** z ** y ** b___] := ncm[a ** y ** z ** b]


And this kind of works:

ncm[x ** z ** y + y ** z ** x]
(* 0 *)
ncm[y ** z ** y ** x]
(* 0 *)


But this is very cumbersome: I'm doing everything by hand in the definition. It feels like there must be a better way... Sure, I could automatize a little by defining the degrees somewhere and then iterating over pairs to create definitions, but that's not great. Basically, I'm working in the tensor algebra and explicitly adding relation for the graded commutativity of variables - but that's a very inefficient way of making computations. Gröbner bases and so on are much smaller when taking the commutativity right into the structure.

I also tried to do something analogous to Computations in the exterior algebra but I was unable to.

Is there a nice way to handle graded commutativity in Mathematica?

• You can use a representation in which you use the basis of monomials directly, so that, say, t[i,j,k,l] is the product of the generators in order each to the power I, j, k and l. If your algebra is strictly graded commutative, so that all squares of odd generators are zero, this is not too bad to work with, but the general case does work fine. It's not had to do a simple minded Groebner bases implemetation from this, for example. I usually use this to compute with quantum affine spaces and such things, and it's quite ok . Feb 16 at 1:10

I'll use CircleDot for multiplication:

Unprotect[CircleDot];
CircleDot[a___, 0, c___] := 0;
CircleDot[a___, q_?NumberQ b_, c___] := q CircleDot[a, b, c];
CircleDot[a___, b_Plus, c___] := CircleDot[a, #, c] & /@ b;
CircleDot[a_] := a;


Three generators of degrees 1, 2 and 3.

n = 3;
deg = {1, 2, 3};


I'll represent monomials $$e_1^{i_1}\dots e_n^{i_n}$$ as expressions of the form t[i1, …, in]. In particular, the generators are:

e[i_] := t @@ SparseArray[i -> 1, {n}];


Commutation coefficients and the multiplication rule

twists = SparseArray[{{i_, j_} /; i > j :> deg[[i]] deg[[j]]}, {n, n}];

t /: CircleDot[l___, a_t, b_t, r___] := (-1)^(
List @@ a . twists . List @@ b)
CircleDot[l, Inner[Plus, a, b, t], r]


Compute something:

In[656]:= e[1]\[CircleDot]e[3] + e[3]\[CircleDot]e[1]
Out[656]= 0
In[658]:= Fold[CircleDot, Table[e[1]+e[2]+e[3], {4}]] // Collect[#, _t]&
Out[658]= t[0,0,4]+4 t[0,1,3]+6 t[0,2,2]+4 t[0,3,1]+t[0,4,0]
+4 t[1,1,2]+4 t[1,3,0]+2 t[2,0,2]+4 t[2,1,1]+6 t[2,2,0]
+4 t[3,1,0]+t[4,0,0]


In this way you can work with any algebra for which you have some sort of PBW bases for which you have nice and simple product rules for monomials. For example, Weyl algebras of arbitrary rank work nicely, because there are not too terrible formulas, involving Stirling numbers, for the product of two monomials. Using rewriting rules coming out of a nc Groebner bases for such an algebra tends to be horribly inefficient in comparison, even if the algebra is Koszul quadratic, so "easy".

You can define an output format for the t[…] thingies using powers of generators, for readability.

• Thanks! I've started to try and actually use this, but now I realize that it doesn't handle the fact that odd generators should square to zero. In your example, e[1] \[CircleDot] e[1] yields t[2, 0, 0], where I would have liked 0. Do you have thoughts on how to handle that? Mar 29 at 8:30
• Ah! My algebras don't do that, that's why I did not include this. You can say something like t[___, k_/?k>1, ___] := 0 so that any t «monomial» with a any exponent greater that 1 anywhere is evaluated to zero, to get an exterior algebra. Mar 29 at 9:31
• If you put the even degree generators at the begining of the list and there are four of them, and all the rest are odd, you can say t[_,_,_,_,___,k_/;k>1,___] := 0 (There must be a way to avoid having to hardcode the four _ there…) Mar 29 at 9:36
• t[Sequence @@ Table[Blank[], {4}], ___, k_ /; k > 1, ___] := 0 works, actually! Mar 29 at 9:38
• Thanks! That works. Apr 2 at 15:22

You can define for each generator its degree and its position in the ordering of generators. Then a couple of rules suffice for the reversing of variables.

deg[x] = 1;
deg[y] = 2;
deg[z] = 3;
posn[x] = 1;
posn[y] = 2;
posn[z] = 3;
(* Handle distributing and ordinary Times *)
ncm[(h : NonCommutativeMultiply)[a___, b_Plus, c___]] :=
Distribute[h[a, b, c], Plus, h, Plus, ncm[h[##1]] &]
ncm[a_Plus] := ncm /@ a
ncm[(h : NonCommutativeMultiply)[a___, b_Times, c___]] :=
Most[b] ncm[h[a, Last[b], c]]
(* Impose the variable-swapping rules *)
ncm[a___ ** xx_ ** xx_ ** b___] /; OddQ[deg[xx]] := 0
ncm[a___ ** yy_ ** xx_ ** b___] /;
posn[yy] > posn[xx] := (-1)^(deg[xx]*deg[yy])*
ncm[a ** xx ** yy ** b]


Examples:

ncm[x ** z ** y + y ** z ** x]
ncm[y ** z ** y ** x]

(* Out[987]= 0

Out[988]= -ncm[x ** y ** y ** z] *)


Unless there is another rule I think that second result is correct, by the way.

• I already suggested this solution in my question, although I hadn't written down the implementation. I'm wondering if there is a better way. Jan 17 at 6:29