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

(* :Author: 	Unknown. *)

(* :Context: 	NonCommutativeMultiply` *)

(* :Summary:
*)

(* :Alias:
*)

(* :Warnings:   With the code as implemented, 
                inv[a]**inv[b] - inv[b]**inv[a] will not turn into 
                zero if a commutes with b. For possible future 
                improvements, see the ideas of ExpandQ and LeftQ. 
*)

(* :History: 
   :7/02/91:  Added extra condition to inv[a] commuting with b 
              statement so as to avoid an infinite loop. (mstankus)
   :4/21/93:  Added inv/: invR/: and invL/: to some commands. (mstankus)
   :9/21/93:  Replaced the code involving Id for efficiency. (mstankus)
              Also commented out redundent inverse code. (mstankus)
*)

BeginPackage[ "NonCommutativeMultiply`" ]

Clear[invR];

invR::usage =
     "Right inverse -- a**invR[a]=Id. See SetInv,invQ and OverrideInverse.";

Clear[invL];

invL::usage =
     "Left inverse -- invL[a]**a=Id. See SetInv,invQ and OverrideInverse.";

Clear[Id];

Id::usage =
     "Identity element. Actually Id is now set=1.";

(* :Note: inv is Cleared and used in NCMultiplication.m which
          preceeds this file.
*)
(* Clear[inv]; *)

inv::usage =
     "inv[x] is a 2-sided identity of x. If invQ is true,then \
      invR[x] and invL[x] will be replaced by inv[x] (unless \
      OverrideInverse is True).";

Clear[OverrideInverse];

OverrideInverse::usage = 
     "When OverrideInverse is set to True, then the replacement of \
      invL and invR by inv when x is invertible is suppressed.\
      The default value is False.";

Clear[NCInverseForward];

NCInverseForward::usage = 
     "NCInverseForward[expr] applies the rules \
      B**inv[Id-A**B] -> inv[Id-B**A]**B and \
      inv[B]**inv[Id-B**A] -> inv[Id-B**A]**inv[A] to expr.";

Clear[NCInverseBackward];

NCInverseBackward::usage = 
     "NCInverseBackward[expr] applies the rules \
     inv[Id-B**A]**B -> B**inv[Id-A**B]  and \
     inv[Id-B**A]**inv[A] -> inv[A]**inv[Id-A**B] to expr.";

Clear[NCExpandInverse];

NCExpandInverse::usage = 
     "See NCAntihomo and ExpandQ. ExpandQ[inv] is the variable to set.";

Clear[SetInverseTp];

SetInverseTp::usage = 
     "Ask for explination of SetCommutingFunctions. The variable to \
      set is LeftQ[inv,tp].";

Clear[SetInvRightTp];

SetInvRightTp::usage = 
     "If SetInvRight Tp is set to True,then the rule \
      tp[invL[a_]]:=invR[tp[a]]; will \
      be executed and if False, then the reverse rule \
      invR[tp[a_]]:=tp[invL[a]]; will be executed.";

Begin[ "`Private`" ]

SetNonCommutative[invR,invL,inv];
SetNonCommutative[a,b,c,d];

OverrideInverse = False;

(* -----------------------------------------------------------------*)
(*		First we define the identity         	            *)
(* -----------------------------------------------------------------*)
(* Commented out 9/21/93
Literal[NonCommutativeMultiply[a___,b_,Id,c___]]:=
   NonCommutativeMultiply[a,b,c];
Literal[NonCommutativeMultiply[a___,Id,b_,c___]]:=
   NonCommutativeMultiply[a,b,c];
*)
(* Added code 9/21/93 *)
Literal[NonCommutativeMultiply[a___,Id,c___]]:=
   NonCommutativeMultiply[a,c];

Id=1;


(* -----------------------------------------------------------------*)
(*	Rules for inverses                                          *)
(* -----------------------------------------------------------------*)
(* Commented out unnec. code 9/21/93
inv[a_*b___]:=inv[b]/a /; NumberQ[a];
*)
inv[a_*b___]:=inv[a]*inv[b] /; CommutativeQ[a];
inv[a_]:=1/a /; NumberQ[a];

(* -----------------------------------------------------------------*)
(*     Left and right inverses                                      *)
(* -----------------------------------------------------------------*)
invR/:Literal[NonCommutativeMultiply[b___,a_,invR[a_],c___]]:=
    NonCommutativeMultiply[b,Id,c] /; Not[OverrideInverse];
invR/:Literal[NonCommutativeMultiply[b___,f_[x___],invR[f_[x___]],c___]]:=
    NonCommutativeMultiply[b,Id,c] /; Not[OverrideInverse];

invR/:Literal[Times[b___,a_,invR[a_],c___]]:=
    Times[b,Id,c] /; Not[OverrideInverse];
invR/:Literal[Times[b___,f_[x___],invR[f_[x___]],c___]]:=
    Times[b,Id,c] /; Not[OverrideInverse];

invL/:Literal[NonCommutativeMultiply[b___,invL[a_],a_,c___]]:=
   NonCommutativeMultiply[b,Id,c] /; Not[OverrideInverse];
invL/:Literal[NonCommutativeMultiply[b___,invL[f_[x___]],f_[x___],c___]]:=
   NonCommutativeMultiply[b,Id,c] /; Not[OverrideInverse];

invL/:Literal[Times[b___,invL[a_],a_,c___]]:=
   Times[b,Id,c] /; Not[OverrideInverse];
invL/:Literal[Times[b___,invL[f_[x___]],f_[x___],c___]]:=
   Times[b,Id,c] /; Not[OverrideInverse];

(* -----------------------------------------------------------------*)
(*     invQ                                                         *)
(* -----------------------------------------------------------------*)
invQ[___]:=False
invR[a_]:=inv[a] /; invQ[a] && Not[OverrideInverse] 
invL[a_]:=inv[a] /; invQ[a] && Not[OverrideInverse]

invR[-a_] := -invR[a];
invL[-a_] := -invL[a];
inv[-a_] := -inv[a];


(* -----------------------------------------------------------------*)
(*     Two-sided inverses                                           *)
(* -----------------------------------------------------------------*)
inv/:Literal[NonCommutativeMultiply[b___,a_,inv[a_],c___]]:=
   NonCommutativeMultiply[b,Id,c];
inv/:Literal[NonCommutativeMultiply[b___,f_[x___],inv[f_[x___]],c___]]:=
   NonCommutativeMultiply[b,Id,c]; 

inv/:Literal[Times[b___,a_,inv[a_],c___]]:=
   Times[b,Id,c];
inv/:Literal[Times[b___,f_[x___],inv[f_[x___]],c___]]:=
   Times[b,Id,c]; 

inv/:Literal[NonCommutativeMultiply[b___,inv[a_],a_,c___]]:=
   NonCommutativeMultiply[b,Id,c];
inv/:Literal[NonCommutativeMultiply[b___,inv[f_[x___]],f_[x___],c___]]:=
   NonCommutativeMultiply[b,Id,c];

inv/:Literal[Times[b___,inv[a_],a_,c___]]:=
   Times[b,Id,c];
inv/:Literal[Times[b___,inv[f_[x___]],f_[x___],c___]]:=
   Times[b,Id,c];

SetIdempotent[inv];

inv/:Literal[NonCommutativeMultiply[inv[a_],b_]] :=
              NonCommutativeMultiply[b,inv[a]] /; 
                 Not[Head[b]==inv] && 
                 NonCommutativeMultiply[a,b] == NonCommutativeMultiply[b,a]



ExpandQ[inv] := True;

Literal[inv[NonCommutativeMultiply[a___,b_,c_,d___]]] := 
	NonCommutativeMultiply[inv[NonCommutativeMultiply[c,d]], 
                               inv[NonCommutativeMultiply[a,b]]] /; 
                                                     ExpandQ[inv] == True;

inv/:Literal[NonCommutativeMultiply[a___,inv[b_],inv[c_],d___]] :=
	NonCommutativeMultiply[a,inv[NonCommutativeMultiply[c,b]],d] /; 
                                                       ExpandQ[inv] == False;

inv/:Literal[NonCommutativeMultiply[inv[b_],inv[c_]]] :=
	inv[NonCommutativeMultiply[c,b]] /; ExpandQ[inv] == False;

NCInverseForward[exp_] :=
     Block[{Faa,Fbb,Fcc,Fdd,Fee,Ftempexp,Frulem,Frulep,Fruleinvp,Fruleinvm},
        SetNonCommutative[Faa,Fbb,Fcc,Fdd,Fee];
        Frulep = Fdd___**Fbb_**inv[Id+Fcc_**Fbb_]**Fee___ :> 
                     Fdd**inv[Id+Fbb**Fcc]**Fbb**Fee;
        Frulem = Fdd___**Fbb_**inv[Id-Fcc_**Fbb_]**Fee___ :> 
                     Fdd**inv[Id-Fbb**Fcc]**Fbb**Fee;
        Fruleinvp = Fdd___**inv[Fcc_]**inv[Id+Fcc_**Fbb_]**Fee___ :> 
                     Fdd**inv[Id+Fbb**Fcc]**inv[Fcc]**Fee;
        Fruleinvm = Fdd___**inv[Fcc_]**inv[Id-Fcc_**Fbb_]**Fee___ :> 
                     Fdd**inv[Id-Fbb**Fcc]**inv[Fcc]**Fee;
        Ftempexp= exp //. {Frulep,Frulem,Fruleinvp,Fruleinvm};
        Return[Ftempexp]
];


NCInverseBackward[exp_] :=
	Block[{Baa,Bbb,Bcc,Bdd,Bee,Btempexp,Brulep,Brulem,Bruleinvp,Bruleinvm},
            SetNonCommutative[Baa,Bbb,Bcc,Bdd,Bee];
            Brulep = Bdd___**inv[Id+Bbb_**Bcc_]**Bbb_**Bee___ :> 
                  Bdd**Bbb**inv[Id+Bcc**Bbb]**Bee;
            Brulem = Bdd___**inv[Id-Bbb_**Bcc_]**Bbb_**Bee___ :> 
                  Bdd**Bbb**inv[Id-Bcc**Bbb]**Bee;
            Bruleinvp = Bdd___**inv[Id+Bbb_**Bcc_]**inv[Bcc_]**Bee___ :> 
                     Bdd**inv[Bcc]**inv[Id+Bcc**Bbb]**Bee;
            Bruleinvm = Bdd___**inv[Id-Bbb_**Bcc_]**inv[Bcc_]**Bee___ :> 
                    Bdd**inv[Bcc]**inv[Id-Bcc**Bbb]**Bee;
            Btempexp= exp //. {Brulep,Brulem,Bruleinvp,Bruleinvm};
	    Return[Btempexp]
];

End[]

EndPackage[]
