(* ::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:: *)
SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\Oaxaca-2210"];
Once[<<KnotTheory`; <<Rot.m];


(* ::Input::Initialization:: *)
Subscript[R, 1][s_,i_,j_]:=s(Subscript[g, j\[InvisibleComma]i](Subscript[g, SuperPlus[j],j]+Subscript[g, j,SuperPlus[j]]-Subscript[g, i\[InvisibleComma]j])-Subscript[g, i\[InvisibleComma]i](Subscript[g, j,SuperPlus[j]]-1)-1/2);
\[Rho][K_]:=\[Rho][K]=Module[{Cs,\[CurlyPhi],n,A,s,i,j,k,\[CapitalDelta],G,\[Rho]1},
{Cs,\[CurlyPhi]}=Rot[K]; n=Length[Cs];
A=IdentityMatrix[2n+1];
Cases[Cs,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=({
 {-T^s, T^s-1},
 {0, -1}
}))];
\[CapitalDelta]=T^((-Total[\[CurlyPhi]]-Total[Cs[[All,1]]])/2) Det[A];
G=Inverse[A];
\[Rho]1=\!\(
\*SubsuperscriptBox[\(\[Sum]\), \(k = 1\), \(n\)]\(
\*SubscriptBox[\(R\), \(1\)] @@ Cs[[k]]\)\) - \!\(
\*SubsuperscriptBox[\(\[Sum]\), \(k = 1\), \(2  n\)]\(\[CurlyPhi][[k]] \((
\*SubscriptBox[\(g\), \(k\[InvisibleComma]k\)] - 1/2)\)\)\);
Factor@{\[CapitalDelta],\[CapitalDelta]^2 \[Rho]1/.SuperPlus[\[Alpha]_]:>\[Alpha]+1/.Subscript[g, \[Alpha]_,\[Beta]_]:>G[[\[Alpha],\[Beta]]]}];


(* ::Input::Initialization:: *)
Subscript[\[Delta], i_,j_]:=If[i===j,1,0];
Subscript[gRules, s_,i_,j_]:={Subscript[g, i\[InvisibleComma]\[Beta]_]:>Subscript[\[Delta], i\[InvisibleComma]\[Beta]]+T^s Subscript[g, SuperPlus[i],\[Beta]]+(1-T^s)Subscript[g, SuperPlus[j],\[Beta]],Subscript[g, j\[InvisibleComma]\[Beta]_]:>Subscript[\[Delta], j\[InvisibleComma]\[Beta]]+Subscript[g, SuperPlus[j],\[Beta]],
Subscript[g, \[Alpha]_,i]:>T^-s (Subscript[g, \[Alpha],SuperPlus[i]]-Subscript[\[Delta], \[Alpha],SuperPlus[i]]),Subscript[g, \[Alpha]_\[InvisibleComma]j]:>Subscript[g, \[Alpha],SuperPlus[j]]-(1-T^s)Subscript[g, \[Alpha]\[InvisibleComma]i]-Subscript[\[Delta], \[Alpha],SuperPlus[j]]}
SuperPlus[(SuperPlus[\[Alpha]_])]:=\!\(\*SuperscriptBox[\(\[Alpha]\), \("\<++\>"\)]\);(* this is for cosmetic reasons only *)


(* ::Input::Initialization:: *)
CF[\[ScriptCapitalE]_]:=Module[{vs=Union[{\[Epsilon]},Cases[\[ScriptCapitalE],Subscript[(g|p|x), __],\[Infinity]]]},Total[
CoefficientRules[Expand@\[ScriptCapitalE],vs]/.(ps_->c_):>Factor[c](Times@@(vs^ps))
]]


(* ::Input::Initialization:: *)
g2px[\[ScriptCapitalE]_]:=Module[{\[Lambda]},Expand[\[ScriptCapitalE]/.Subscript[g, \[Alpha]_,\[Beta]_]:>\[Lambda] Subscript[p, \[Alpha]] Subscript[x, \[Beta]]]/.\[Lambda]^k_.:>1/k!]


(* ::Input::Initialization:: *)
{SuperStar[p],SuperStar[x],SuperStar[\[Pi]],SuperStar[\[Xi]]}={\[Pi],\[Xi],p,x};  SuperStar[(Subscript[u_, i_])]:=Subscript[(SuperStar[u]), i];


(* ::Input::Initialization:: *)
\!\(\*SubscriptBox[\(Zip\), \({}\)]\)[\[ScriptCapitalE]_]:=\[ScriptCapitalE];
\!\(\*SubscriptBox[\(Zip\), \({\[Zeta]_, \[Zeta]s___}\)]\)[\[ScriptCapitalE]_] := (Collect[\[ScriptCapitalE]//\!\(\*SubscriptBox[\(Zip\), \({\[Zeta]s}\)]\),\[Zeta]] /. f_. \[Zeta]^d_.:>(D[f,{SuperStar[\[Zeta]],d}]))/.SuperStar[\[Zeta]]->0


(* ::Input::Initialization:: *)
px2g[\[ScriptCapitalE]_]:=Module[{ps,xs,Q},
ps=Union[Cases[\[ScriptCapitalE],Subscript[p, \[Alpha]_],\[Infinity]]];
xs=Union[Cases[\[ScriptCapitalE],Subscript[x, \[Alpha]_],\[Infinity]]];
Q=Sum[SuperStar[p0] SuperStar[x0] Subscript[g, p0[[2]],x0[[2]]],{p0,ps},{x0,xs}];
Subscript[Zip, ps\[Union]xs][\[ScriptCapitalE] E^Q]//Expand
]


(* ::Input::Initialization:: *)
Module[{i,j,k},
AllMonomials[{},0]={1};
AllMonomials[{},d_Integer] /; d>0 := {};
AllMonomials[{v_,vs___},d_Integer] := Join@@Table[v^(d-k) AllMonomials[{vs},k],{k,0,d}];
AllMonomials[vs_List, {d_}] := Join@@Table[AllMonomials[vs,k],{k,0,d}];
Basis[js_List,m_]:=Flatten@Outer[Times,AllMonomials[Table[Subscript[p, j],{j,js}],m],AllMonomials[Table[Subscript[x, j],{j,js}],m]];
Basis[js_List,{m_}]:=Flatten@Table[Basis[js,k],{k,0,m}];
GenericCombination[bas_,c_]:=bas . Table[Subscript[c, j],{j,Length@bas}];
GenericCombination[bas_,Subscript[c_, k_]]:=bas . Table[Subscript[c, k,j],{j,Length@bas}];
]


(* ::Input::Initialization:: *)
Module[{k,x1,x2,p1,p2},
Subscript[r, d_][1,i_,j_]:=Expand@Together@Sum[\[Epsilon]^k GenericCombination[Basis[{i,j},{k+1}],Subscript[ca, k]],{k,d}];
Subscript[r, d_][-1,i_,j_]:=Expand@Together@Sum[\[Epsilon]^k GenericCombination[Basis[{i,j},{k+1}],Subscript[cb, k]],{k,d}];
Subscript[\[Gamma], d_][0,j_]:=0;
Subscript[\[Gamma], d_][1,j_]:=Expand@Together@Sum[\[Epsilon]^k GenericCombination[Basis[{j},{k+1}],Subscript[cc, k]],{k,d}];
Subscript[\[Gamma], d_][-1,j_]:=Expand@Together@Sum[\[Epsilon]^k GenericCombination[Basis[{j},{k+1}],Subscript[cd, k]],{k,d}];
{SuperStar[x1],SuperStar[x2],SuperStar[p1],SuperStar[p2]}={p1,p2,x1,x2};
Subscript[r, d_][s_,\[CurlyPhi]i_,\[CurlyPhi]j_,i_,j_]:=Normal[Log[O[\[Epsilon]]^(d+1)+\!\(\*SubscriptBox[\(Zip\), \({x1, x2}\)]\)[Exp[O[\[Epsilon]]^(d+1)+
(Subscript[\[Gamma], d][\[CurlyPhi]i,i]/.Subscript[x, i]->Subscript[x, i]+x1)+(Subscript[\[Gamma], d][\[CurlyPhi]j,j]/.Subscript[x, j]->Subscript[x, j]+x2)+(Subscript[r, d][s,i,j]/.{Subscript[p, i]->Subscript[p, i]-p1,Subscript[p, j]->Subscript[p, j]-p2})
]]]]
];



