(* :Title: 	NCMultiplication // Mathematica 1.2 and 2.0 *)

(* :Author: 	Unknown. *)

(* :Context: 	NonCommutativeMultiply` *)

(* :Summary:
*)

(* :Alias:
*)

(* :Warnings: 
*)

(* :History: 
   :9/21/92:    Added two lines of code which used to be in 
                NCUsage.m (mstankus)
*)
BeginPackage[ "NonCommutativeMultiply`" ]

Clear[CommutativeQ];

CommutativeQ::usage = 
     "CommutativeQ[x] is True if x is commutative (the default), \
     and False if x is non-commutative.  See SetCommutative, \
     SetNonCommutative and CommutativeAllQ.";

Clear[SetCommutative];

SetCommutative::usage = 
     "SetCommutative[a, b, c, ...] sets all the symbols a, b, c, ... \
      to be commutative. See SetNonCommutative and CommutativeQ.";

Clear[SetNonCommutative];

SetNonCommutative::usage = 
     "SetNonCommutative[a, b, c, ...] sets all the symbols a, b, c, ... \
      to be non-commutative. See SetCommutative and CommutativeQ.";

Clear[CommutativeAllQ];

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

Clear[ExpandNonCommutativeMultiply];

ExpandNonCommutativeMultiply::usage =
     "ExpandNonCommutativeMultiply[expr] expands out \
      NonCommutativeMultiply's in expr. It's aliases are \
      NCE,NCExpand and ExpandNC. For example, NCE[a**(b+c)] \
      will result in a**b + a**c.";

Clear[TimesToNCM];

TimesToNCM::usage =
     "TimesToNCM[expr] returns expr/.Times->NonCommutativeMultiply.";

Clear[CommuteEverything];

CommuteEverything::usage = 
     "Answers the question \"what does it sound like?\". \
      CommuteEverything[expr] returns \
      expr/.NonCommuativeMultiply->Times";

Clear[rt];

Clear[inv];

Begin[ "`Private`" ]

Unprotect[NonCommutativeMultiply];
ClearAttributes[NonCommutativeMultiply, {OneIdentity, Flat}]
(* ---------------------------------------------------------------- *)
(*  Set all varibles to be commutative by default.                  *)
(* ---------------------------------------------------------------- *)
CommutativeQ[_] := True;

CommutativeAllQ[s_Symbol] := CommutativeQ[s];
CommutativeAllQ[x_] := False /; Not[CommutativeQ[x]]
CommutativeAllQ[c_?NumberQ] := True;
CommutativeAllQ[f_[x___]] := 
     If[CommutativeQ[f], Apply[And,Map[CommutativeAllQ,{x}]]
                       , False
     ];

(* ---------------------------------------------------------------- *)
(*  Set commutative and non-commutative commands.                   *)
(* ---------------------------------------------------------------- *)
SetNonCommutative[a__] :=
 (Function[x, 
       Which[NumberQ[x]
          ,Print["Warning: Tried to set the number ",Format[x,InputForm],
                  " to be noncommutative."];
          ,Head[x]===Plus
          ,Print["Warning: Tried to set the expression",Format[x,InputForm],
                  " to be noncommutative."];
          ,Head[x]===Times
          ,Print["Warning: Tried to set the expression",Format[x,InputForm],
                  " to be noncommutative."];
          ,Head[x]===NonCommutativeMultiply
          ,Print["Warning: Tried to set the expression",Format[x,InputForm],
                  " to be noncommutative."];
          ,Head[x]===List
          , Map[SetNonCommutative,x];
(*
            Print["Warning: Tried to set the list ",Format[x,InputForm],
                  " to be noncommutative."];
*)
          ,True
          ,CommutativeQ[x] = False; 
           CommutativeQ[x[___]] = False]] /@ {a});

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

SetNonCommutative[NonCommutativeMultiply];

(* ---------------------------------------------------------------- *)
(*  NonCommutative Muliplication book-keeping.                      *)
(* ---------------------------------------------------------------- *)
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_, c___]] :=
 b NonCommutativeMultiply[a, c] /; CommutativeAllQ[b]
Literal[NonCommutativeMultiply[a_]] := a;
NonCommutativeMultiply[] := 1;

(* ---------------------------------------------------------------- *)
(*  We added Expand[] outside  the original Eran formula for ENCM,  *)
(*  this was neccessary to deal with commuting elements.	    *)
(* ---------------------------------------------------------------- *)

ExpandNonCommutativeMultiply[expr_] :=
 Expand[expr //. Literal[NonCommutativeMultiply[a___, b_Plus, c___]] :>
 (NonCommutativeMultiply[a, #, c]& /@ b)];


(* ---------------------------------------------------------------- *)
(*  This concludes material obtained from ERAN@SLACVM.BITNET at     *)
(*  Stanford Linear Accelerator                                     *)
(* ---------------------------------------------------------------- *)

TimesToNCM[expr_]:=expr/.Times->NonCommutativeMultiply;

CommuteEverything[v_]:=v//.{NonCommutativeMultiply -> Times,rt[x_]->x^(1/2),inv[x_]->x^(-1)};

End[]

EndPackage[]


