(* ::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.                                                         *)
(************************************************************************)



(* ::Input::Plain:: *)
<<CliffMath10`


(* ::Input::Plain:: *)
(* \[CircleDot] denotes the Clifford product *)

(* k^th right-lowering operator *)
Subscript[RightLower, k_][u_]:=Module[{j},Sum[GradeKPart[ClExpand[GradeKPart[u,j]\[CircleDot]
\!\(\*SubscriptBox[\(e\), \({k}\)]\)],j-1],{j,1,MaxIndex}]];

(* k^th right-raising operator *)

Subscript[RightRaise, k_][u_]:=Module[{j},Sum[GradeKPart[ClExpand[GradeKPart[u,j]\[CircleDot]
\!\(\*SubscriptBox[\(e\), \({k}\)]\)],j+1],{j,0,MaxIndex-1}]];

(* kth (left) lowering operator *)

Subscript[Lower, k_][u_]:=Module[{j},Sum[GradeKPart[ClExpand[
\!\(\*SubscriptBox[\(e\), \({k}\)]\)\[CircleDot]GradeKPart[u,j]],j-1],{j,1,MaxIndex}]];

(* k^th (left) raising operator *)

Subscript[Raise, k_][u_]:=Module[{j},Sum[GradeKPart[ClExpand[
\!\(\*SubscriptBox[\(e\), \({k}\)]\)\[CircleDot]GradeKPart[u,j]],j+1],{j,0,MaxIndex-1}]];

(* x-Lowering *)
XLowering[u_,x_]:=Module[{j},Sum[x[[j]] Subscript[Lower, j][u],{j,1,Length[x]}]];

(* x-Raising *)
XRaising[u_,x_]:=Module[{j},Sum[x[[j]] Subscript[Raise, j][u],{j,1,Length[x]}]];

(* Canonical lowering *)
Lower[u_]:=Module[{j1},Sum[Subscript[Lower, j1][u],{j1,1,MaxIndex}]];

(* Canonical raising *)
Raise[u_]:=Module[{j1},Sum[Subscript[Raise, j1][u],{j1,1,MaxIndex}]];

XLower[u_,\[CapitalLambda]_]:=Module[{j1},Sum[\[CapitalLambda][[j1]] Subscript[Lower, j1][u],{j1,1,MaxIndex}]];

XRaise[u_,\[CapitalLambda]_]:=Module[{j1},Sum[\[CapitalLambda][[j1]] Subscript[Raise, j1][u],{j1,1,MaxIndex}]];

(* Matrix rep of i^th lowering *)ithLoweringRep[ith_]:=Module[{m,B,rw,co,mulvr,mpr,mprs,A},B=ClBasis;A=Table[0,{rw,1,2^MaxIndex},{co,1,2^MaxIndex}];For[rw=1,rw<=2^MaxIndex,rw++,For[co=1,co<=rw,co++,mulvr=ClExpand[B[[rw]]\[CircleDot]B[[co]]];If[mulvr==
\!\(\*SubscriptBox[\(e\), \({ith}\)]\)||mulvr==-
\!\(\*SubscriptBox[\(e\), \({ith}\)]\),mpr=ClExpand[
\!\(\*SubscriptBox[\(e\), \({ith}\)]\)\[CircleDot]B[[rw]]];mprs=mpr/. {Subscript[e, _]->1};If[mprs==1,A[[rw,co]]=1,A[[rw,co]]=-1];]]];Return[A];];

(* Matrix rep of i^th raising *)ithRaisingRep[ith_]:=Module[{m,B,rw,co,mulvr,mpr,mprs,A},B=ClBasis;A=Table[0,{rw,1,2^MaxIndex},{co,1,2^MaxIndex}];For[rw=1,rw<=2^MaxIndex,rw++,For[co=rw,co<=2^MaxIndex,co++,mulvr=ClExpand[B[[rw]]\[CircleDot] B[[co]]];If[mulvr==
\!\(\*SubscriptBox[\(e\), \({ith}\)]\)||mulvr==-
\!\(\*SubscriptBox[\(e\), \({ith}\)]\),mpr=ClExpand[
\!\(\*SubscriptBox[\(e\), \({ith}\)]\)\[CircleDot]B[[rw]] ];mprs=mpr/. {Subscript[e, _]->1};If[mprs==1,A[[rw,co]]=1,A[[rw,co]]=-1];]]];Return[A];];

(* Matrix rep of canonical lowering *)
CanonicalLoweringRep:=Module[{i},Return[Sum[ithLoweringRep[i],{i,1,MaxIndex}]];];

(* Matrix rep of canonical raising *)
CanonicalRaisingRep:=Module[{i},Return[Sum[ithRaisingRep[i],{i,1,MaxIndex}]];];

(* Matrix rep for \[Lambda]-raising *)XRaisingRep[\[Lambda]_]:=Module[{j},If[Length[\[Lambda]]!=MaxIndex,Message[x::"length",MaxIndex];Abort[];,Sum[\[Lambda][[j]] ithRaisingRep[j],{j,1,Length[\[Lambda]]}]]];

(* Matrix rep for x-lowering *)XLoweringRep[\[CapitalLambda]_]:=Module[{j},If[Length[\[CapitalLambda]]!=MaxIndex,Message[x::"length",MaxIndex];Abort[];,Sum[\[CapitalLambda][[j]] ithLoweringRep[j],{j,1,Length[\[CapitalLambda]]}]]];

(* Return canonical lowering kernel as vector *)GetLoweringKernel:=Module[{CB,K,lp},CB=ClBasis;K=NullSpace[Transpose[CanonicalLoweringRep],Method->"OneStepRowReduction"];Return[Table[CB.K[[lp]],{lp,1,Length[K]}]];];

(* Return \[Lambda]-lowering kernel as vector *)
GetXLoweringKernel[lambda_]:=Module[{lp,K,CB},CB=ClBasis;K=NullSpace[Transpose[XLoweringRep[lambda]],Method->"OneStepRowReduction"];Return[Table[CB.K[[lp]],{lp,1,Length[K]}]];]

(* Return canonical raising kernel as vector *)GetRaisingKernel:=Module[{CB,K,lp},CB=ClBasis;K=NullSpace[Transpose[CanonicalRaisingRep],Method->"OneStepRowReduction"];Return[Table[CB.K[[lp]],{lp,1,Length[K]}]];];

(* Return x-raising kernel as vector *)GetXRaisingKernel[lambda_]:=Module[{lp,K,CB},CB=ClBasis;K=NullSpace[Transpose[XRaisingRep[lambda]],Method->"OneStepRowReduction"];Return[Table[CB.K[[lp]],{lp,1,Length[K]}]];]

(* Print canonical lowering kernel *)
PrintLoweringKernel:=Module[{K,CB,lp},CB=ClBasis;K=NullSpace[Transpose[CanonicalLoweringRep]];
T=Table[Simplify[Expand[CB.K[[lp]]]],{lp,1,Length[K]}];
Print["In ",Subscript[Cl, pPart,qPart],", Ker(\[CapitalLambda]) is spanned by :"];Print[T];
Print["-----------"];];

(* Print x-lowering kernel *)
PrintXLoweringKernel[\[Lambda]_]:=Module[{K,lp},Print["In ",Subscript[Cl, pPart,qPart],", Ker(\!\(\*SubscriptBox[\(\[CapitalLambda]\), \(x\)]\)) is spanned by :"];K=GetXLoweringKernel[\[Lambda]];For[lp=1,lp<=Length[K],lp++,Print[K[[lp]]];] Print["-----------"];];

(* Print canonical raising kernel *)
PrintRaisingKernel:=Module[{CB,K,lp},CB=ClBasis;K=NullSpace[Transpose[CanonicalRaisingRep]];Print["In ",Subscript[Cl, pPart,qPart],",  Ker(\[CapitalXi]) is spanned by :"];For[lp=1,lp<=Length[K],lp++,Print[CB.K[[lp]]];] Print["-----------"];];

(* Print x-raising kernel *)
PrintXRaisingKernel[A_]:=Module[{CB,K,lp},Print["In ",Subscript[Cl, pPart,qPart],", Ker(\!\(\*SubscriptBox[\(\[CapitalXi]\), \(x\)]\)) is spanned by :"];K=GetXRaisingKernel[A];For[lp=1,lp<=Length[K],lp++,Print[K[[lp]]];] Print["-----------"];];

PlotLowering:=Module[{L,lasym,lsym},L=CanonicalLoweringRep;
lsym=Abs[L+Abs[L]]/2;
lasym=Abs[L-Abs[L]]/2;
GraphPlot3D[lsym,EdgeRenderingFunction->(Cylinder[#1,.04]&),VertexRenderingFunction->({ColorData["Atoms"][RandomInteger[{1,117}]],Sphere[#1,.1]}&),PlotStyle->Directive[Specularity[White,20]],PlotLabel->"No Sign Changes"]
GraphPlot3D[lasym,EdgeRenderingFunction->(Cylinder[#1,.04]&),VertexRenderingFunction->({ColorData["Atoms"][RandomInteger[{1,117}]],Sphere[#1,.1]}&),PlotStyle->Directive[Specularity[White,20]],PlotLabel->"Sign Changes"]];

PlotRaising:=Module[{R,rsym,rasym},R=CanonicalRaisingRep;
rsym=Abs[R+Abs[R]]/2;
rasym=Abs[R-Abs[R]]/2;
GraphPlot3D[rsym,EdgeRenderingFunction->(Cylinder[#1,.05]&),VertexRenderingFunction->({ColorData["Atoms"][RandomInteger[{1,117}]],Sphere[#1,.15]}&),PlotStyle->Directive[Specularity[White,20]],PlotLabel->"No Sign Changes", Method->"SpringElectricalEmbedding"]
GraphPlot3D[rasym,EdgeRenderingFunction->(Cylinder[#1,.05]&),VertexRenderingFunction->({ColorData["Atoms"][RandomInteger[{1,117}]],Sphere[#1,.15]}&),PlotStyle->Directive[Specularity[White,20]],PlotLabel->"Sign Changes", Method->"SpringElectricalEmbedding"]
];

RBPlotLowering:=Module[{L,i,j,VC,vrts,n,it,CB,x,vplt,EPC},L=CanonicalLoweringRep;n=MaxIndex;CB=ClBasis;VC=Table[{Cos[N[(2 \[Pi] j)/2^n]],Sin[N[(2 \[Pi] j)/2^n]]},{j,1,2^n}];
vrts=Table[{Cos[N[(2 \[Pi] j)/2^n]],Sin[N[(2 \[Pi] j)/2^n]]},{j,1,2^n}];
it=1;For[i=1,i<=2^n,i++,For[j=1,j<=i,j++,If[L[[i,j]]==1,EPC[it]=ListPlot[{VC[[i]],VC[[j]]},PlotStyle->{RGBColor[1,0,0]},DisplayFunction->Identity,Joined->True,Axes->False];it++,If[L[[i,j]]==-1,EPC[it]=ListPlot[{VC[[i]],VC[[j]]},PlotStyle->{RGBColor[0,0,1]},DisplayFunction->Identity,Joined->True,Axes->False];it++,Null]]]];x=Table[EPC[j],{j,1,it-1}];Show[x,DisplayFunction->$DisplayFunction,BaseStyle->{FontFamily->Courier,FontSize->12},PlotRange->{{-2,2},{-1.4`,1.4`}}]];

RBPlotRaising:=Module[{R,n,i,j,VC,it,x,vplt,EPC},R=CanonicalRaisingRep;n=MaxIndex;VC:=Table[{Cos[N[(2 \[Pi] j)/2^n]],Sin[N[(2 \[Pi] j)/2^n]]},{j,1,2^n}];it=1;For[i=1,i<=2^n,i++,For[j=i,j<=2^n,j++,If[R[[i,j]]==1,EPC[it]=ListPlot[{VC[[i]],VC[[j]]},PlotStyle->{RGBColor[1,0,0]},DisplayFunction->Identity,Joined->True,Axes->False];it++,If[R[[i,j]]==-1,EPC[it]=ListPlot[{VC[[i]],VC[[j]]},PlotStyle->{RGBColor[0,0,1]},DisplayFunction->Identity,Joined->True,Axes->False];it++,Null]]]];x=Table[EPC[j],{j,1,it-1}];Show[x,DisplayFunction->$DisplayFunction,BaseStyle->{FontFamily->Courier,FontSize->12},PlotRange->{{-2,2},{-1.4`,1.4`}}]];

BladeLabel[n_]:=Module[{Binrep,Reftab,i,jl,A},Clear[Binrep,Reftab];If[n==0,Return[{0}],Binrep=Reverse[IntegerDigits[n,2]];Reftab=Table[i,{i,1,Length[Binrep]}] Binrep;A={};For[jl=1,jl<=Length[Reftab],jl++,If[Reftab[[jl]]!=0,A=Append[A,Reftab[[jl]]],Null];];Return[A];]];