-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathPowerCount.wl
67 lines (48 loc) · 4.48 KB
/
PowerCount.wl
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
(* ::Package:: *)
BeginPackage["PowerCount`"]
Print["Copyright (C) Xiaonu Xiong, Forschungszentrum J\[UDoubleDot]lich, 2017"];
IsCnt::usage="IsCount[x,y,z,..] sets the symbols being included in power counting."
NoCnt::usage="NoCount[a,b,c,..] sets the symbols being excluded from power counting."
CntQ::usgae="CntQ[x] returns whether x is included in power counting."
NCntQ::usgae="NCntQ[x] returns whether x is excluded from in power counting."
SetScl::usage="SetScl[{{\!\(\*SubscriptBox[\(x\), \(1\)]\),\!\(\*SubscriptBox[\(x\), \(2\)]\),...},{\!\(\*SubscriptBox[\(y\), \(1\)]\),\!\(\*SubscriptBox[\(y\), \(2\)]\),...},...},{\!\(\*SubscriptBox[\(s\), \(1\)]\),\!\(\*SubscriptBox[\(s\), \(2\)]\),...}] sets the symbols \!\(\*SubscriptBox[\(x\), \(i\)]\) with scale \!\(\*SubscriptBox[\(s\), \(i\)]\)."
Pwr::usage="Pwr[x] gives the scale of symbol x."
SetHrchy::usage="SetHrcy[\!\(\*SubscriptBox[\(\[CapitalLambda]\), \(1\)]\)>\!\(\*SubscriptBox[\(\[CapitalLambda]\), \(2\)]\)>\!\(\*SubscriptBox[\(\[CapitalLambda]\), \(3\)]\)>...] sets the hierarchy of scales, with all scales are postive. Gives assumption=\!\(\*SubscriptBox[\(\[CapitalLambda]\), \(1\)]\)>0\[And]\!\(\*SubscriptBox[\(\[CapitalLambda]\), \(2\)]\)>0\[And]\!\(\*SubscriptBox[\(\[CapitalLambda]\), \(3\)]\)>0...\[And]\!\(\*SubscriptBox[\(\[CapitalLambda]\), \(1\)]\)>\!\(\*SubscriptBox[\(\[CapitalLambda]\), \(2\)]\)>\!\(\*SubscriptBox[\(\[CapitalLambda]\), \(3\)]\)>..."
PwrCnt::usage="PwrCnt gives the power counting of expression x."
ToPwr::usage="ToPwr[\[CapitalLambda]] convert \[CapitalLambda] to O[\[CapitalLambda]]."
SrtPwr::usage="SrtPwr[exp] sort the powers of each term in expression exp, whose Head is Plus, according to the power counting, with terms in the order of decending power counting."
SclHrchy::usage="SclHrchy restores the hirachy of the scales, which is used as an assumption in sort an expression by power counting."
ShowPwr::usgae="ShowPwr[exp] arranges terms in exp in an expression by their powers, and dispalay as subscripts"
SrtByPwr::usage="SrtPwr[exp] sort expression exp's terms, whose Head is Plus, by its power counting (in the order of decending power counting)."
PwrLst::usage="PwrLst[exp] gives a table summerize the power counting and corresponding terms."
Begin["Private`"]
CntQ[x_?NumericQ]:=False
NCntQ[x_?NumericQ]:=True
CntQ[Times[a_,b_]]/;And@@(CntQ/@{a,b}):=True
CntQ[X_^n_]/;CntQ[X]:=True
NCntQ[X_^n_]/;NCntQ[X]:=True
NCntQ[Times[a_,b_]]/;And@@(NCntQ/@{a,b}):=True
NCntQ[Plus[a_,b_]]/;And@@(NCntQ/@{a,b}):=True
NCntQ[f_[x__]]/;And@@(NCntQ/@List[x]):=True
IsCnt[X__]:={(CntQ[#]=True)&/@List[X];(NCntQ[#]=False)&/@List[X];};
NoCnt[X__]:={(CntQ[#]=False)&/@List[X];(NCntQ[#]=True)&/@List[X];};
SetScl[X__,S__]:=MapThread[Map[Function[x,x/:Pwr[x]:=#]&[#2],#1]&,{X,S}];
SetHrchy[X__]:=(SclHrchy=X)
Pwr[X_^n_]:=Assuming[SclHrchy,Simplify[Pwr[X]^n]]
Pwr[X_-Y_]:=Pwr[X+Y]
Pwr[X_Plus]:=Assuming[SclHrchy,Pwr/@X]
Pwr[X_Times]:=Assuming[SclHrchy,Simplify[Pwr/@X]]
Pwr[X_?NCntQ]:=1
PwrCnt[X_]:=(Pwr[X]//.{a__*X1__^n_./;(NCntQ[a]&&CntQ[X1]):>X1^n})
ToPwr/:MakeBoxes[ToPwr[X_],TraditionalForm]:=StyleBox[RowBox[{StyleBox["O", 14,Bold,Blue, FontFamily -> "Lucida Handwriting"]," ","(",ToBoxes[X,TraditionalForm][[1]],")"}],SpanMaxSize->Infinity]
ToPwr[X_Plus]:=ToPwr/@X
ToPwr[ToPwr[X__]]:=ToPwr[X]
SetAttributes[ToPwr,Listable];
SetAttributes[PwrCnt,Listable];
SrtPwr[X_]:=Module[{XPWRLst=PwrCnt/@List@@(Expand[X])},Inactive[Plus]@@ToPwr[Assuming[SclHrchy,Sort[XPWRLst,Simplify[#1>=#2]&]]]]
SrtByPwr[X_,f_:Identity]:=Inactive[Plus]@@Assuming[SclHrchy,(f[Plus@@#]&)/@Sort[GatherBy[List@@(Expand[X]),PwrCnt],Simplify[First[Union[PwrCnt[#1]]]>=First[Union[PwrCnt[#2]]]]&]]
SrtByPwr[X_,f_:Identity]:=Module[{tmp=Assuming[SclHrchy,(f[Plus@@#]&)/@Sort[GatherBy[List@@(Expand[X]),PwrCnt],Simplify[First[Union[PwrCnt[#1]]]>=First[Union[PwrCnt[#2]]]]&]]},If[Length[tmp]>1,Inactive[Plus]@@tmp,Plus@@tmp]]
ShowPwr[X_,f_:Identity]:=Module[{tmp=(Subscript[Framed[Assuming[SclHrchy,f[#]],RoundingRadius->5,FrameStyle->{Thick,Gray,DotDashed},Background->LightGreen],ToPwr[PwrCnt[#]]]&/@(Plus@@#&)/@Sort[GatherBy[List@@(Expand[X]),PwrCnt],Assuming[SclHrchy,Simplify[First[Union[PwrCnt[#1]]]>=First[Union[PwrCnt[#2]]]]]&])},If[Length[tmp]>1,Inactive[Plus]@@tmp,Plus@@tmp]]
PwrLst[X_,f_:Identity]:=Assuming[SclHrchy,Grid[MapIndexed[{#2[[1]],(ToPwr@*PwrCnt)[#],f[#]}&,((Plus@@#&)/@Sort[GatherBy[List@@(Expand[X]),PwrCnt],Assuming[SclHrchy,Simplify[First[Union[PwrCnt[#1]]]>=First[Union[PwrCnt[#2]]]]]&])],Frame->All,FrameStyle->Directive[LightGray,Thick],Alignment->Left]]
End[];
EndPackage[];