-
Notifications
You must be signed in to change notification settings - Fork 1
/
noncommutativeframework.m
213 lines (169 loc) · 10.7 KB
/
noncommutativeframework.m
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
(* ::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::Initialization:: *)
BeginPackage["noncommutativeframework`"];
(* ::Input::Initialization:: *)
Notation`AutoLoadNotationPalette=False;
If[$FrontEnd=!=Null,Needs["Notation`"];]
InfixNotation[ParsedBoxWrapper["\[CenterDot]"],noncommp];
Notation[ParsedBoxWrapper[TemplateBox[{"a_", "b_"}, "comm", DisplayFunction :> (RowBox[{"[", RowBox[{#, ",", #2}], "]"}]& ), SyntaxForm -> "symbol", Tooltip -> Automatic]] \[DoubleLongLeftRightArrow] ParsedBoxWrapper[RowBox[{"comm", "[", RowBox[{"a_", ",", "b_"}], "]"}]]];
Notation[ParsedBoxWrapper[SubscriptBox["\[Eta]", RowBox[{"a_", ",", "b_"}]]] \[DoubleLongLeftRightArrow] ParsedBoxWrapper[RowBox[{"\[Eta]", "[", RowBox[{"a_", ",", "b_"}], "]"}]]];
AddInputAlias["comm"->ParsedBoxWrapper[TemplateBox[{"\[Placeholder]", "\[SelectionPlaceholder]"}, "comm", DisplayFunction :> (RowBox[{"[", RowBox[{#, ",", #2}], "]"}]& ), SyntaxForm -> "symbol", Tooltip -> Automatic]]];
(* ::Input::Initialization:: *)
EmptyQ::usage = "EmptyQ[args] returns False.
EmptyQ[] returns True.";
noncommp::usage = "noncommp[obj1,obj2,...] is the non-commutative product function. It satisfies associativity and linearity, where constants or commuting objects are pulled out. To define constant or commutative objects use ConstQ and CommQ respectively.";
ConstQ::usage = "ConstQ[arg] returns true if arg is a constant.";
ConstList::usage = "ConstList[{a1,a2,...}] makes the elements of the list ai constants.";
CommQ::usage = "CommQ[arg] returns true if arg is a commutative object.";
CommList::usage = "CommList[{a1,a2,...}] makes the elements of the list ai commutative objects.";
\[Eta]::usage = "\[Eta][\[Mu],\[Nu]] is the flat metric in 2h dimensions. When multiplying an expression with matching index (\[Mu] or \[Nu]) it'll perform the contraction automatically.";
comm::usage = "comm[a,b] is a Lie bracket. It satisfies bilinearity (with respect to ConstQ), alternativity, and anticommutativity. Furthermore it's zero for elements of the center (CommQ) and satisfies identities from the commutator: commutator of the product (with respect to both Times and noncommp)";
Pass::usage = "Pass[operator,expression] moves the rightmost instance of operator in expression by one positions. It uses the commutator identity. Pass[operator,expression,steps] moves the operator by steps positions. steps can be Infinity.";
BatchPass::usage = "BatchPass[{{operator1,steps1},...},expression] applies the function Pass for every operator in the list. operatori is moved stepsi. stepsi can be negative in which case the operator is moved to the left";
LPass::usage = "LPass[operator,expression] same as Pass but moves the operator to the left.";
LBatchPass::usage = "LBatchPass[{{operator1,steps1},...},expression] left version of BatchPass. Deprecated, use negative values of stepsi in BatchPass.";
CommutatorToCode::usage = "CommutatorToCode[symboliccomm,symboltopatternreplacementList,commelementreplacementList,postcommelementreplacementList,postcommelementfuncOptional,notebookOptional] creates higher level commutator identities from basic ones. symboliccomm is a commutator of objects that we want to compute, symboltopatternreplacementList is a list of replacements to convert symbols to patterns in the left hand side of the commutator identity, commelementreplacementList is a list of replacements that converts the symbols in symboliccomm to functions whose commutators are known (i.e. to compute the rhs of the identity), postcommelementreplacementList is a list of replacements that is applied once the rhs has been computed, postcommelementfuncOptional is a function that is applied to the rhs of the identity (by default it's the identity function), and notebookOptional is an optional parameter that indicates to which notebook the identities will be written (created by CreateNotebook[]); by default it creates a new notebook.";
One::usage="";
h::usage="";
noncommmp::usage="";
commm::usage="";
B::usage="";
Begin["`Private`"];
(* ::Input::Initialization:: *)
EmptyQ[a__]:=False
EmptyQ[] := True
(* ::Input::Initialization:: *)
noncommp[l___,b_noncommp,r___]:=noncommp[l,Sequence@@b,r];
noncommp[l___,c_?ConstQ,r___]:=c noncommp[l,r]/;!EmptyQ[l,r];
noncommp[l___,Times[a_,Longest[c__]?ConstQ],r___]:=Times[c] noncommp[ l,a,r];
(*noncommp[l___,(a_+b_),r___]:=noncommp[l,a,r]+noncommp[l,b,r];*)
noncommp[a_?ConstQ]:=a;
noncommp[l___,a_?CommQ,b_?CommQ,r___]:=noncommp[l,a b,r]/;!EmptyQ[l,r];
noncommp[a_?CommQ,b_?CommQ]:=a b;
(* ::Input::Initialization:: *)
SetOptions[Simplify,TransformationFunctions->{Automatic,Function[{x},x//.(k1_:1)noncommp[l1_,b_,r___]+(k2_:1)noncommp[l2_,b_,r___]:>noncommp[k1 l1+k2 l2,b,r]//.(k1_:1)noncommp[l1__,b_,r___]+(k2_:1)noncommp[l2__,b_,r___]:>noncommp[k1 noncommp[l1]+k2 noncommp[l2],b,r]],Function[{x},x//.(k1_:1)noncommp[l___,b_,r1_]+(k2_:1)noncommp[l___,b_,r2_]:>noncommp[l,b,k1 r1+k2 r2]//.(k1_:1)noncommp[l___,b_,r1__]+(k2_:1)noncommp[l___,b_,r2__]:>noncommp[l,b,k1 noncommp[r1]+k2 noncommp[r2]]]}]
(* ::Input::Initialization:: *)
Unprotect[Expand];
Expand[aa_]/;!FreeQ[aa,noncommp[l___,(e_:1)(a_+b_),r___]]:=Expand[aa//.noncommp[l___,(e_:1)(a_+b_),r___]:>noncommp[l,Expand[e(a+b)],r]//.noncommp[l___,a_+b_,r___]:>noncommp[l, a,r]+noncommp[l, b,r]];
Protect[Expand];
Print["Warning: Expand was modified"];
(* ::Input::Initialization:: *)
ConstQ[args_Times]:=And @@ ConstQ /@ List @@ args;
ConstQ[args_Plus]:=And @@ ConstQ /@ List @@ args;
ConstQ[c_^n_]:=ConstQ[c]\[And]ConstQ[n];
ConstQ[_?NumberQ]:=True;
ConstQ[\[Eta][__]]:=True;
ConstQ[_]:=False;
ConstQ[h]=True;
(* ::Input::Initialization:: *)
ConstList[arg_List]:=(ConstQ[#]=True)&/@arg;
(* ::Input::Initialization:: *)
CommQ[a_?ConstQ]:=True;
CommQ[args_Times]:=And @@ CommQ /@ List @@ args;
CommQ[args_Plus]:=And @@ CommQ /@ List @@ args;
CommQ[c_^n_]:=CommQ[c]\[And]ConstQ[n];
CommQ[_?NumberQ]:=True;
CommQ[\[Eta][__]]:=True;
CommQ[_]:=False;
(* ::Input::Initialization:: *)
CommList[arg_List]:=(CommQ[#]=True)&/@arg;
(* ::Input::Initialization:: *)
Attributes[\[Eta]]={Orderless};
\[Eta]/:(a_ \[Eta][\[Mu]_,\[Nu]_]/;(!FreeQ[a,\[Mu]])):=(a/.\[Mu]->\[Nu]);
\[Eta]/:(a_ \[Eta][\[Mu]_,\[Nu]_]/;(!FreeQ[a,\[Nu]])):=(a/.\[Nu]->\[Mu]);
\[Eta][a_,a_]:=2h;
(* ::Input::Initialization:: *)
comm[a_?ConstQ,b_]:=0;
comm[a_,b_?ConstQ]:=0;
comm[A_,Times[C_,Longest[B__]?ConstQ]]:=Times[B] comm[A,C];
comm[ Times[B_,Longest[A__]?ConstQ],C_]:=Times[A] comm[B,C];
comm[a_?CommQ,b_?CommQ]:=0;
comm[a_+b_,c_]:=comm[a,c]+comm[b,c];
comm[a_,b_+c_]:=comm[a,b]+comm[a,c];
comm[a_,a_]:=0;
comm[a_,noncommp[b_,c_]]:=noncommp[comm[a,b],c]+noncommp[b,comm[a,c]];
comm[noncommp[a_,b_],c_]:=noncommp[a,comm[b,c]]+noncommp[comm[a,c],b];
comm[a_,noncommp[b_,LL__]]:=noncommp[comm[a,b],noncommp[LL]]+noncommp[b,comm[a,noncommp[LL]]];
comm[noncommp[a_,LL__],c_]:=noncommp[a,comm[noncommp[LL],c]]+noncommp[comm[a,c],noncommp[LL]];
comm[noncommp[a_],b_]:=comm[a,b];
comm[a_,noncommp[b_]]:=comm[a,b];
comm[a_,Times[b_, c_]]:=noncommp[comm[a,b],c]+noncommp[b,comm[a,c]];
comm[Times[a_, b_],c_]:=noncommp[a,comm[b,c]]+noncommp[comm[a,c],b];
comm[a_,Times[b_,Longest[LL__]]]:=noncommp[comm[a,b],Times[LL]]+noncommp[b,comm[a,Times[LL]]];
comm[Times[a_,Longest[LL__]],c_]:=noncommp[a,comm[Times[LL],c]]+noncommp[comm[a,c],Times[LL]];
comm[a_,b_]/;!OrderedQ[{a,b}]:=-comm[b,a];
(* ::Input::Initialization:: *)
(*Pass[op_,exp_,rec_:1]:=Module[{expp,c,np,i},
expp=exp;
Do[
expp=expp/.{noncommp\[Rule]np}/.{np[a___,opp_,b_,c___]/;MatchQ[opp,op]\[RuleDelayed]np[a,comm[opp,b],c]+np[a,b,opp,c]}/.{np\[Rule]noncommp};
,{i,1,rec}];
Return[expp];
];*)
Pass[op_,exp_,rec_:1]:=Module[{expp,c,np,i},
expp=exp;
Do[
expp=expp/.{noncommp->np}/.{np[Longest[a___],opp_,b_,c___]/;MatchQ[opp,op]:>np[a,comm[opp,b],c]+np[a,b,opp,c]}/.{np->noncommp};
,{i,1,rec}];
Return[expp];
];
Pass[op_,exp_,Infinity]:=FixedPoint[Pass[op,#,1]&,exp];
BatchPass[op_List,exp_]:=Module[{i,expp},
expp=exp;
Do[
expp=If[op[[i]][[2]]<0,LPass[op[[i]][[1]],expp,-op[[i]][[2]]],Pass[op[[i]][[1]],expp,op[[i]][[2]]]];
,{i,1,Length[op]}];
Return[expp];
];
(* ::Input::Initialization:: *)
(*LPass[op_,exp_,rec_:1]:=Module[{expp,c,np,i},
expp=exp;
Do[
expp=expp/.{noncommp\[Rule]np}/.{np[a___,b_,opp_,c___]/;MatchQ[opp,op]\[RuleDelayed]np[a,comm[b,opp],c]+np[a,opp,b,c]}/.{np\[Rule]noncommp};
,{i,1,rec}];
Return[expp];
];*)
LPass[op_,exp_,rec_:1]:=Module[{expp,c,np,i},
expp=exp;
Do[
expp=expp/.{noncommp->np}/.{np[a___,b_,opp_,Longest[c___]]/;MatchQ[opp,op]:>np[a,comm[b,opp],c]+np[a,opp,b,c]}/.{np->noncommp};
,{i,1,rec}];
Return[expp];
];
LPass[op_,exp_,Infinity]:=FixedPoint[LPass[op,#,1]&,exp];
LBatchPass[op_List,exp_]:=Module[{i,expp},
expp=exp;
Do[
expp=LPass[op[[i]][[1]],expp,op[[i]][[2]]];
,{i,1,Length[op]}];
Return[expp];
];
(* ::Input::Initialization:: *)
CommutatorToCode[symboliccomm_,symboltopatternreplacement_List,commelementreplacement_List,postcommelementreplacement_List,postcommelementfunc_:(#&),notebook_:1]:=
Module[{nb,EqualityToBoxes,eq},
If[notebook===1,nb=CreateNotebook[];,nb=notebook];
EqualityToBoxes=Function[{equality},
NotebookWrite[nb,Cell[BoxData[#],"Input"]]&@(RowBox[{ToBoxes[equality[[1]],StandardForm],":=",If[Head[equality[[2]]]=!=Integer,ToBoxes[equality[[2]],StandardForm],ToString[equality[[2]]]],";"}]/."commm"->"comm"/."noncommmp"->"noncommp")];
eq=((commm@@symboliccomm)/.symboltopatternreplacement)==(*(Simplify[symboliccomm/.commelementreplacement/.Boole\[Rule]B]/.B\[Rule]Boole/.noncommp\[Rule]noncommmp/.postcommelementreplacement)*)
(postcommelementfunc[Simplify[Expand[symboliccomm/.commelementreplacement]/.Boole->B]/.B->Boole/.noncommp->noncommmp/.postcommelementreplacement]);
EqualityToBoxes[eq];
]
(* ::Input::Initialization:: *)
End[];
EndPackage[];