Pensieve header: Testing Zip 1,2,3 of BabyDoPeGDO. Continues pensieve://2020-03/.

Startup

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\BabyDoPeGDO"];
<< Engine.m

Utilities

HL[ℰ_] := Style[ℰ, Background -> If[TrueQ@ℰ,,]];

Generic Perturbations:

GenericPerturbation[d_Integer, vars_List, gc_] := Total[Map[
(Subscript[gc, Sequence@@#])Times@@((vars^(#)))&,
Join@@(Permutations /@ IntegerPartitions[d+Length@vars,{Length@vars}])-1
]];
GenericPerturbation[{m_}, vars_List, gc_] := Prepend[0][ϵSeries@@Table[GenericPerturbation[2d+2,vars,gc],{d,m}]]

GenericPerturbation[2,{x,y},c]

GenericPerturbation[{2},{x,y},c]

Preliminary Definitions

Unprotect[SeriesData];
Expand[sd_SeriesData] ^:= MapAt[Expand,sd,3];
Protect[SeriesData];

Act and Contract:

(Subscript[Ev, k_])@(Subscript[\[LeftBracketingBar]F_,𝔼[ω_,Q_,P_]\[RightBracketingBar], B_]):=Module[{ℰ,d},
ℰ=ω (E^(Q+Sum[P[[d+1]](ϵ^d),{d,0,Length[P]-1}]));
Expand[Total[
CoefficientRules[Normal@Series[(E^((SuperStar[B]).F.(SuperStar[B])/2)),{ℏ,0,k}],(SuperStar[B])] /. (ps_->c_) :> c D[ℰ,Sequence@@Thread[{B,ps}]]
]+((O[ℏ])^(k+1))]
];
(Subscript[Ev, k_])@(Subscript[⟨F_,ℰ_⟩, B_]):= (Subscript[Ev, k])@(Subscript[\[LeftBracketingBar]F,ℰ\[RightBracketingBar], B])/.Alternatives@@B->0;
(Subscript[Ev, k_])[B_,⟨ℱ_,ℰ_⟩]:= (Subscript[Ev, k])@(Subscript[⟨Table[(∂_(u,v))ℱ,{u,(SuperStar[B])},{v,(SuperStar[B])}],ℰ⟩, B]);

{(Subscript[Ev, 2])@(Subscript[\[LeftBracketingBar]ℏ(({{0, 1}, {1, 0}})),𝔼[1,x y,ϵSeries[0]]\[RightBracketingBar], {x,y}]),(Subscript[Ev, 3])@(Subscript[⟨ℏ(({{0, 1}, {1, 0}})),𝔼[1,3x y,ϵSeries[0]]⟩, {x,y}])}

Testing Zip1

Zip1[(Subscript[⟨F_,ℰ_⟩, B_])]:=(Subscript[Zip1, B])[⟨(SuperStar[B]).F.(SuperStar[B])/2,ℰ⟩]

{p=3,B={x}, F=ℏ{{f}}; G={{g}}; ℰ=GenericPerturbation[{4},B,c]; 𝒵=(Subscript[⟨F,𝔼[1,B.G.B/2,ℰ]⟩, B])}
lhs=(Subscript[Ev, p])@𝒵
rhs=(Subscript[Ev, p])[B,Zip1@𝒵];
HL[lhs==rhs]

{p=2,B={x,y}, F=ℏ(({{(Subscript[f, 11]), (Subscript[f, 12])}, {(Subscript[f, 12]), (Subscript[f, 22])}})); G=(({{(Subscript[g, 11]), (Subscript[g, 12])}, {(Subscript[g, 12]), (Subscript[g, 22])}})); ℰ=GenericPerturbation[{2},B,c];𝒵=(Subscript[⟨F,𝔼[1,B.G.B/2,ℰ]⟩, B])}
Timing[lhs=(Subscript[Ev, p])@𝒵]
rhs=(Subscript[Ev, p])[B,Zip1@𝒵];
HL[lhs==rhs]

Testing Zip2

Zip2[(Subscript[⟨F_,ℰ_⟩, B_])]:=(Subscript[Zip2, B])[⟨(SuperStar[B]).F.(SuperStar[B])/2,ℰ⟩]

{n=2,p=2,B=Table[(Subscript[z, i]),{i,n}], Y=Table[(Subscript[y, i]),{i,n}],F=ℏ Table[(Subscript[f, {10,1}.Sort[{i,j}]]), {i,n},{j,n}],ℰ=GenericPerturbation[{3},B,c],𝒵=(Subscript[⟨F,𝔼[1,Y.B,ℰ]⟩, B])}

Timing[lhs=(Subscript[Ev, p])@𝒵]
rhs=(Subscript[Ev, p])[B,Zip2@𝒵];
HL[lhs==rhs]

Testing Zip3

Zip3[(Subscript[⟨F_,ℰ_⟩, B_])]:=(Subscript[Zip3, B])[⟨(SuperStar[B]).F.(SuperStar[B])/2,ℰ⟩]

{n=2,p=2,$k=2,B=Table[(Subscript[x, i]),{i,n}],F=ℏ Table[(Subscript[f, {10,1}.Sort[{i,j}]]), {i,n},{j,n}], P=GenericPerturbation[{$k},B,c],𝒵=(Subscript[⟨F,𝔼[1,0,P]⟩, B])}

ZZ=Zip3[𝒵][[3]]
lhs=Normal[Normal[(Subscript[Ev, p])@𝒵]+((O[ϵ])^(k+1))]
rhs=Normal[Series[(E^(Sum[ZZ[[d+1]](ϵ^d),{d,0,Length[ZZ]-1}])),{ℏ,0,p},{ϵ,0,$k}]]
HL@Simplify[lhs==rhs]

{n=2,p=3,$k=3,B=Table[(Subscript[x, i]),{i,n}],F=ℏ Table[(Subscript[f, {10,1}.Sort[{i,j}]]), {i,n},{j,n}], P=GenericPerturbation[{$k},B,c],𝒵=(Subscript[⟨F,𝔼[1,0,P]⟩, B])}

ZZ=Zip3[𝒵][[3]]
lhs=Normal[Normal[(Subscript[Ev, p])@𝒵]+((O[ϵ])^(k+1))]
rhs=Normal[Series[(E^(Sum[ZZ[[d+1]](ϵ^d),{d,0,Length[ZZ]-1}])),{ℏ,0,p},{ϵ,0,$k}]]
HL@Simplify[lhs==rhs]

{n=2,p=4,$k=3,B=Table[(Subscript[x, i]),{i,n}],F=ℏ Table[(Subscript[f, {10,1}.Sort[{i,j}]]), {i,n},{j,n}], P=GenericPerturbation[{$k},B,c],𝒵=(Subscript[⟨F,𝔼[1,0,P]⟩, B])}
ZZ=Zip3[𝒵][[3]]
lhs=Normal[Normal[(Subscript[Ev, p])@𝒵]+((O[ϵ])^(k+1))]
rhs=Normal[Series[(E^(Sum[ZZ[[d+1]](ϵ^d),{d,0,Length[ZZ]-1}])),{ℏ,0,p},{ϵ,0,$k}]]
HL@Simplify[lhs==rhs]

{n=1,p=4,$k=3,B=Table[(Subscript[x, i]),{i,n}],F=ℏ Table[(Subscript[f, {10,1}.Sort[{i,j}]]), {i,n},{j,n}], P=GenericPerturbation[{$k},B,c],𝒵=(Subscript[⟨F,𝔼[1,0,P]⟩, B])}
ZZ=Zip3[𝒵][[3]]
lhs=Normal[Normal[(Subscript[Ev, p])@𝒵]+((O[ϵ])^(k+1))]
rhs=Normal[Series[(E^(Sum[ZZ[[d+1]](ϵ^d),{d,0,Length[ZZ]-1}])),{ℏ,0,p},{ϵ,0,$k}]]
HL@Simplify[lhs==rhs]

{n=1,p=5,$k=4,B=Table[(Subscript[x, i]),{i,n}],F=ℏ Table[(Subscript[f, {10,1}.Sort[{i,j}]]), {i,n},{j,n}], P=GenericPerturbation[{$k},B,c],𝒵=(Subscript[⟨F,𝔼[1,0,P]⟩, B])}
ZZ=Zip3[𝒵][[3]]
lhs=Normal[Normal[(Subscript[Ev, p])@𝒵]+((O[ϵ])^(k+1))]
rhs=Normal[Series[(E^(Sum[ZZ[[d+1]](ϵ^d),{d,0,Length[ZZ]-1}])),{ℏ,0,p},{ϵ,0,$k}]]
HL@Simplify[lhs==rhs]