(*
Date: 22 Jan 90   11:38 PST
From: ERAN@SLACVM.BITNET (Eran Yehudai)
To: XINWEI@JESSICA.STANFORD.EDU
Subject: Re: noncommutative algebra

note:  Eran Yehudai has written packages useful for
computations in high energy physics.  If you're interested,
please contact him by email, or at 415-926-2765.

*)
BeginPackage["NonCommutativeMultiply`"];

Unprotect[NonCommutativeMultiply]

Clear[NonCommutativeMultiply, CommutativeQ, SetNonCommutative,
 CommutativeAllQ, Commutator, Commute]

 CommutativeQ::usage = "CommutativeQ[x] is True if x is commutative
 (the default), and False if x is non-commutative."

 SetNonCommutative::usage = "SetNonCommutative[a, b, c, ...] sets all
 the symbols a, b, c, ... to be non-commutative."

 CommutativeAllQ::usage = "CommutativeAllQ[expr] is True if expr does not
 have any non-commuting sub-expressions, and False otherwise."

 Commutator::usage = "Commutator[a, b] is an equivalent expression to
 a**b, with a and b interchanged (e.g. Commutator[a, b] = b**a + [a, b]."

 Commute::usage = "Commute[expr, {a, b}] commutes a and b everywhere in
 expr."

ClearAttributes[NonCommutativeMultiply, {OneIdentity, Flat}]

Begin["`Private`"];

CommutativeQ[_] := True

CommutativeAllQ[s_Symbol] := CommutativeQ[s]
CommutativeAllQ[x_] := False /; !CommutativeQ[x]
CommutativeAllQ[c_?NumberQ] := True
CommutativeAllQ[f_[x___]] := CommutativeQ[f] &&
 And @@ (CommutativeAllQ /@ {x})

SetNonCommutative[a__] :=
 (Function[x, CommutativeQ[x] = False; CommutativeQ[x[___]] = False] /@ {a});

Literal[NonCommutativeMultiply[a___, NonCommutativeMultiply[b__], c___]] :=
 NonCommutativeMultiply[a, b, c]
Literal[NonCommutativeMultiply[a___, b_ c_, d___]]:=
 b NonCommutativeMultiply[a, c, d] /; CommutativeAllQ[b]
Literal[NonCommutativeMultiply[a___, b_Plus, c___]] :=
 (NonCommutativeMultiply[a, #, c]& /@ b)
Literal[NonCommutativeMultiply[a___, b_, c___]] :=
 b NonCommutativeMultiply[a, c] /; CommutativeAllQ[b]
Literal[NonCommutativeMultiply[a_]] := a
NonCommutativeMultiply[] := 1

Commute[expr_, {a_, b_}] :=
 expr /. Literal[NonCommutativeMultiply[f___, a, b, g___]] :>
  NonCommutativeMultiply[f, Commutator[a, b], g]

Commutator[x_, x_] := x ** x

End[];

EndPackage[]