# Defining rules for anti-commutative multiplication

I am trying to create products following an anti-commutative rules using the binary operator **. I define my rules the following way:

before___ ** a_ ** b_ ** after___ :>
If[OrderedQ[{a, b}] == True,
before ** a ** b ** after,
before ** ((-1)*b) ** a ** after],
NonCommutativeMultiply[x_] :> x


This does half the job that I want, since it transforms the following expression

$$o_{1,2}\text{**}o_{1,3}\text{**}o_{2,3}-o_{1,2}\text{**}o_{2,3}\text{**}o_{1,3}-o_{1,3}\text{**}o_{1,2}\text{**}o_{2,3}+o_{1,3}\text{**}o_{2,3}\text{**}o_{1,2}+o_{2,3}\text{**}o_{1,2}\text{**}o_{1,3}-o_{2,3}\text{**}o_{1,3}\text{**}o_{1,2}$$

into

$$2 o_{1,2}\text{**}o_{1,3}\text{**}o_{2,3}-2 o_{1,2}\text{**}o_{2,3}\text{**}o_{1,3}+2 o_{1,3}\text{**}o_{2,3}\text{**}o_{1,2}$$

I ultimately want to reduce the expression to

$$6 o_{1,2}\text{**}o_{1,3}\text{**}o_{2,3}$$

(Please add the appropriate tags for this question as I didn't find anything I deem suitable).

• It would be better to have actual input (in InputForm) that can be copy-pasted, rather than a LaTex rendering. Jun 6, 2019 at 17:29
• If[cond == True, ...] $\to$ If[cond, ...]. Jun 7, 2019 at 14:13

I suggest using CenterDot wrapper for the multiplication symbol instead of NonCommutativeMultiply. The former, just as the latter, does not commute terms by default, but it also has no pre-defined properties in Mathematica, which makes it easy to assign new properties to it:

ClearAll[CenterDot]
CenterDot[x___, CenterDot[y___], z___] := CenterDot[x, y, z]
CenterDot[x___, q_ CenterDot[y___], z___] :=q CenterDot[x, y, z]
CenterDot[x___, Times[-1, CenterDot[y___]], z___] :=- CenterDot[x, y, z]
CenterDot[x___, y_ + z_, q___] := CenterDot[x, y, q] + CenterDot[x, z, q]
CenterDot[x___, y_ Subscript[o_, a_, b_], z___] := y CenterDot[x, Subscript[o, a, b], z]
CenterDot[x___, Times[-1, Subscript[o_, a_, b_]], z___] := - CenterDot[x, Subscript[o, a, b], z]
CenterDot[x___,y_,z___]/;FreeQ[y,Subscript[o_, a_, b_]]:=y CenterDot[x,z]
CenterDot[x_]:=x
CenterDot[]:=1
CenterDot[x___] /; ! OrderedQ[{x}] := Signature[{x}] CenterDot[Sort[{x}] /. List -> Sequence]


Subscript[o, 1, 2] \[CenterDot] Subscript[o, 1, 3] \[CenterDot] Subscript[o, 2, 3] - Subscript[o, 1, 2] \[CenterDot] Subscript[o, 2, 3] \[CenterDot] Subscript[o, 1, 3] - • Hello. What new rule should I set if I get things like 1 \[CentralDot] Subscript[o,a,b] - Subscript[o,a,b] and -(1 \[CentralDot] Subscript[o,a,b]) + Subscript[o,a,b] ? Jun 7, 2019 at 12:33
• I have another problem now. I had the expression (-3*1 \[CenterDot] (-Subscript[t, 1, 2]) \[CenterDot] Subscript[t, 1, 3] \[CenterDot] (-Subscript[t, 2, 3]) + 3*1 \[CenterDot] Subscript[t, 1, 2] \[CenterDot] (-Subscript[t, 1, 3]) \[CenterDot] Subscript[t, 2, 3])/(24*Pi^2) with the previous set of rules. Now with these rules this term goes to 0 instead of 6 the expression Jun 7, 2019 at 13:44