(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



BeginPackage["CliffSymNil2014a`"];
Needs["CliffMath2014a`"];

(* Define symmetric product for commutative algebra Subscript[Cl, p,q,r]^sym. Generators satisfy the following rules *)

(* Subscript[e, {j}] \[CirclePlus] Subscript[e, {k}] = Subscript[e, {k}] \[CirclePlus] Subscript[e, {y}]   k \[NotEqual] j  *)
(* Subscript[e, {j}] \[CirclePlus] Subscript[e, {j}] = 1 if 1 \[LessEqual] j \[LessEqual] p   *)
(* Subscript[e, {j}] \[CirclePlus] Subscript[e, {j}] = -1 if p+1 \[LessEqual] j \[LessEqual] p+q  *)
  (* Subscript[e, {j}] \[CirclePlus] Subscript[e, {j}] = 0 if p+q < j \[LessEqual] p+q+r *)

NilOut[u_]:=u/.{e->\[Zeta]};
Zeons[u_]:=u/.{e->\[Zeta]};
SymOut[u_]:=u/.{e->\[Sigma]};
IdemOut[u_]:=u/.{e->\[Epsilon]};

Unprotect[CirclePlus];(* symmetric Clifford product *)

Unprotect[SymProductSignatureMap];
SymProductSignatureMap[I_,J_]:=Module[{j},If[Mu[pPart+qPart,Intersection[I,J]]!=0,0,(-1)^(Mu[pPart,Intersection[I,J]])]];
Protect[SymProductSignatureMap];

Unprotect[CirclePlus];
ClearAll[CirclePlus];
SetAttributes[CirclePlus,{Flat, OneIdentity, Listable}];

CirclePlus[x_. Subscript[e, a_],y_. Subscript[e, b_]]:=Expand[x y SymProductSignatureMap[a,b]]Subscript[e, SetSymmetricDifference[a,b]]/. {
\!\(\*SubscriptBox[\(e\), \({}\)]\)->1};

CirclePlus[x_, y_]:=Expand[x y] /;(FreeQ[x,Subscript[e, _]]\[Or]FreeQ[y,Subscript[e, _]]);

CirclePlus=Symbol["CirclePlus"];
Protect[CirclePlus];

Unprotect[ClSymExpand];
ClearAll[ClSymExpand];
SetAttributes[ClSymExpand,Listable];
ClSymExpand[x_ + y_]:= Block[{$RecursionLimit=\[Infinity]},Simplify[ClSymExpand[x] + ClSymExpand[y]]];
ClSymExpand[x_?NumericQ  arg1_]:=x ClSymExpand[arg1];
ClSymExpand[arg1_]:= Module[{arg2},
arg2 = Distribute[ExpandAll[arg1],Plus, CirclePlus];
If[!FreeQ[arg2,_\[CirclePlus]_] && arg2  !=  arg1,
arg2 =  ClSymExpand[arg2];
];
Return[Collect[arg2,Subscript[e, _]]];
];
Protect[ClSymExpand];


(* Compute powers of Clifford elements *)
ClSymPower[x_,n_Integer]:=Module[{y},y=ClSymExpand[x];Switch[EvenQ[n],
True,If[n==0,Return[1],Return[ClSymPower[(y\[CirclePlus]y),n/2]]],
False,If[n==1,Return[y],Return[ClSymExpand[y\[CirclePlus]ClSymPower[(y\[CirclePlus]y),(n-1)/2]]]]];];

(* Procedure to multiply matrices with Cl^sym entries *)
ClSymMatrixProduct[A_,B_]:=Inner[CirclePlus, A, B, Plus];

(* A procedure for computing powers of matrices with Cl^sym entries. In this method, A^m is computed by recursive squaring ((A^2)^2...)A *)
ClSymMatrixPower[A_,m_]:=Module[{y},y=ClSymExpand[A];Switch[EvenQ[m],
True,If[m==0,Return[IdentityMatrix[Length[y]]],Return[ClSymMatrixPower[ClSymMatrixProduct[y,y],m/2]]],
False,If[m==1,Return[y],Return[ClSymExpand[ClSymMatrixProduct[ClSymMatrixPower[ClSymMatrixProduct[y,y],(m-1)/2],y]]]]]];

(* Define product for commutative algebra Subscript[Cl, n]^nil.  Generators satisfy the following conditions: *) 
(*Subscript[e, {j}] \[CircleMinus] Subscript[e, {k}] = Subscript[e, {k}] \[CircleMinus] Subscript[e, {j}]   k\[NotEqual]j *)
(* Subscript[e, {j}] \[CircleMinus] Subscript[e, {j}]=0                *)
  
Unprotect[CircleMinus];
ClearAll[CircleMinus];
SetAttributes[CircleMinus,{Flat, OneIdentity, Listable}];
CircleMinus[x_. Subscript[e, a_],y_. Subscript[e, b_]]:=If[Length[a\[Intersection]b]>0,0,Expand[x y Subscript[e, a\[Union]b]]];

CircleMinus[x_, y_]:=Expand[x y] /;(FreeQ[x,Subscript[e, _]]\[Or]FreeQ[y,Subscript[e, _]]);

CircleMinus=Symbol["CircleMinus"];
Protect[CircleMinus];

Unprotect[ClNilExpand];
ClearAll[ClNilExpand];
SetAttributes[ClNilExpand,Listable];
ClNilExpand[x_ + y_]:=Block[{$RecursionLimit=\[Infinity]}, Simplify[ClNilExpand[x] + ClNilExpand[y]]];
ClNilExpand[x_?NumericQ  arg1_]:=x ClNilExpand[arg1];
ClNilExpand[arg1_]:= Module[{arg2},
arg2 = Distribute[ExpandAll[arg1],Plus, CircleMinus];
If[!FreeQ[arg2,_\[CircleMinus]_] && arg2  !=  arg1,
arg2 =  ClNilExpand[arg2];
];
Return[Collect[arg2,Subscript[e, _]]];
];
Protect[ClNilExpand];

(* Compute powers of Cl^nil elements *)
ClNilPower[x_,n_Integer]:=Module[{y},y=ClNilExpand[x];Switch[EvenQ[n],
True,If[n==0,Return[1],Return[ClNilPower[(y\[CircleMinus]y),n/2]]],
False,If[n==1,Return[y],Return[ClNilExpand[y\[CircleMinus]ClNilPower[(y\[CircleMinus]y),(n-1)/2]]]]];];

(* Procedure to multiply matrices with Cl^nil entries *)
ClNilMatrixProduct[A_,B_]:=Inner[CircleMinus, A, B, Plus];

(* A procedure for computing powers of Cl^nil matrices. In this method, A^m is computed by recursive squaring ((A^2)^2...)A *)
ClNilMatrixPower[A_,m_]:=Module[{y},y=ClNilExpand[A];Switch[EvenQ[m],
True,If[m==0,Return[IdentityMatrix[Length[y]]],Return[ClNilMatrixPower[ClNilMatrixProduct[y,y],m/2]]],
False,If[m==1,Return[y],Return[ClNilExpand[ClNilMatrixProduct[ClNilMatrixPower[ClNilMatrixProduct[y,y],(m-1)/2],y]]]]]];

(* Define idempotent product for commutative algebra Subscript[Cl, MaxIndex]^idem. Generators satisfy the following rules *)
(* Subscript[e, {j}]\[Diamond]Subscript[e, {k}] = Subscript[e, {k}]\[Diamond]Subscript[e, {y}]   k \[NotEqual] j     *)
(* Subscript[e, {j}]\[Diamond]Subscript[e, {j}] = Subscript[e, {j}]   1 \[LessEqual] j \[LessEqual] MaxIndex *)
(* x\[Diamond]y is entered by typing x[ESC]dia[ESC]y *)  

Unprotect[Diamond];
ClearAll[Diamond];
SetAttributes[Diamond,{Flat, OneIdentity, Listable}];
Diamond[x_. Subscript[e, a_],y_. Subscript[e, b_]]:=Expand[x y ]Subscript[e, a\[Union]b]/. {
\!\(\*SubscriptBox[\(e\), \({}\)]\)->1};

Diamond[x_, y_]:=Expand[x y] /;(FreeQ[x,Subscript[e, _]]\[Or]FreeQ[y,Subscript[e, _]]);


Diamond=Symbol["Diamond"];
Protect[Diamond];

Unprotect[ClIdExpand];
ClearAll[ClIdExpand];
SetAttributes[ClIdExpand,Listable];
ClIdExpand[x_ + y_]:= Block[{$RecursionLimit=\[Infinity]},Simplify[ClIdExpand[x] + ClIdExpand[y]]];
ClIdExpand[x_?NumericQ  arg1_]:=x ClIdExpand[arg1];
ClIdExpand[arg1_]:= Module[{arg2},
arg2 = Distribute[ExpandAll[arg1],Plus, Diamond];
If[!FreeQ[arg2,_\[Diamond]_] && arg2  !=  arg1,
arg2 =  ClIdExpand[arg2];
];
Return[Collect[arg2,Subscript[e, _]]];
];
Protect[ClIdExpand];

(* Compute powers of Cl^sym elements *)
ClIdPower[x_,n_Integer]:=Module[{y},y=ClIdExpand[x];Switch[EvenQ[n],
True,If[n==0,Return[1],Return[ClIdPower[(y\[Diamond]y),n/2]]],
False,If[n==1,Return[y],Return[ClIdExpand[y\[Diamond]ClIdPower[(y\[Diamond]y),(n-1)/2]]]]];];

(* Procedure to multiply matrices with Cl^sym entries *)
ClIdMatrixProduct[A_,B_]:=Inner[Diamond, A, B, Plus];


(* A procedure for computing powers of matrices with Cl^sym entries. In this method, A^m is computed by recursive squaring ((A^2)^2...)A *)
ClIdMatrixPower[A_,m_]:=Module[{y},y=ClIdExpand[A];Switch[EvenQ[m],
True,If[m==0,Return[IdentityMatrix[Length[y]]],Return[ClIdMatrixPower[ClIdMatrixProduct[y,y],m/2]]],
False,If[m==1,Return[y],Return[ClIdExpand[ClIdMatrixProduct[ClIdMatrixPower[ClIdMatrixProduct[y,y],(m-1)/2],y]]]]]];


EndPackage[];

