# 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]