(* ::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"];


(* ::Input::Initialization:: *)
Once[<<KnotTheory`; <<Rot.m];


(* ::Input::Initialization:: *)
<< "../../Projects/Profile/Profile.m"


(* ::Input::Initialization:: *)
V@Subscript[\[Gamma], 1,\[CurlyPhi]_][k_]:=\[CurlyPhi] (1/2-Subscript[\!\(\*OverscriptBox[\(p\), \(_\)]\), k] Subscript[\!\(\*OverscriptBox[\(x\), \(_\)]\), k]); V@Subscript[\[Gamma], 2,\[CurlyPhi]_][k_]:=-(\[CurlyPhi]^2/2) Subscript[\!\(\*OverscriptBox[\(p\), \(_\)]\), k] Subscript[\!\(\*OverscriptBox[\(x\), \(_\)]\), k]; V@Subscript[\[Gamma], 3,\[CurlyPhi]_][k_]:=-(1/6) \[CurlyPhi]^3 Subscript[\!\(\*OverscriptBox[\(p\), \(_\)]\), k] Subscript[\!\(\*OverscriptBox[\(x\), \(_\)]\), k];


(* ::Input::Initialization:: *)
V@Subscript[r, 1,s_][i_,j_]:=1/2 s (-1+(Subscript[p, i]-Subscript[p, j]) Subscript[x, i] (2+Subscript[p, j] ((-1+T^s) Subscript[x, i]-2 Subscript[x, j])))


(* ::Input::Initialization:: *)
V@Subscript[r, 2,1][i_,j_]:=1/12 (Subscript[p, i]-Subscript[p, j]) Subscript[x, i] (-6+Subscript[p, j] (Subscript[x, i] (3-9 T-2 (-1+T) (-2 Subscript[p, i]+(3+T) Subscript[p, j]) Subscript[x, i])+6 (3+(-Subscript[p, i]+(1+T) Subscript[p, j]) Subscript[x, i]) Subscript[x, j]-6 Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(j\), \(2\)]\)))


(* ::Input::Initialization:: *)
V@Subscript[r, 2,-1][i_,j_]:=-(((Subscript[p, i]-Subscript[p, j]) Subscript[x, i] (6 T^2+Subscript[p, j] (2 (-1+T) (2 T Subscript[p, i]-(1+3 T) Subscript[p, j]) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\)+6 T^2 Subscript[x, j] (-3+Subscript[p, j] Subscript[x, j])-3 T Subscript[x, i] (-3+T+2 (-T Subscript[p, i]+(1+T) Subscript[p, j]) Subscript[x, j]))))/(12 T^2))


(* ::Input::Initialization:: *)
V@Subscript[r, 3,1][i_,j_]:=1/24 Subscript[x, i] (\!\(
\*SubsuperscriptBox[\(p\), \(i\), \(3\)]\ 
\*SubscriptBox[\(p\), \(j\)]\ 
\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\ \((3\ \((\(-1\) + T)\)\ 
\*SubscriptBox[\(x\), \(i\)] - 4\ 
\*SubscriptBox[\(x\), \(j\)])\)\)+\!\(
\*SubsuperscriptBox[\(p\), \(i\), \(2\)]\ 
\*SubscriptBox[\(p\), \(j\)]\ 
\*SubscriptBox[\(x\), \(i\)]\ \((\(-3\)\ \((\(-4\) + T + 3\ 
\*SuperscriptBox[\(T\), \(2\)])\)\ 
\*SubscriptBox[\(p\), \(j\)]\ 
\*SubsuperscriptBox[\(x\), \(i\), \(2\)] + 12\ 
\*SubscriptBox[\(x\), \(j\)]\ \((3 - 2\ 
\*SubscriptBox[\(p\), \(j\)]\ 
\*SubscriptBox[\(x\), \(j\)])\) + 4\ 
\*SubscriptBox[\(x\), \(i\)]\ \((5 - 6\ T + 7\ T\ 
\*SubscriptBox[\(p\), \(j\)]\ 
\*SubscriptBox[\(x\), \(j\)])\))\)\)+Subscript[p, i] (4+Subscript[p, j] (Subscript[x, i] (2 (5+7 T)+Subscript[p, j] Subscript[x, i] (-64+68 T+8 T^2+(-1+T) (13+T (22+T)) Subscript[p, j] Subscript[x, i]))-4 (7+Subscript[p, j] Subscript[x, i] (27+6 T+(-6+T (17+T)) Subscript[p, j] Subscript[x, i])) Subscript[x, j]+6 Subscript[p, j] (4+(10+T) Subscript[p, j] Subscript[x, i]) \!\(\*SubsuperscriptBox[\(x\), \(j\), \(2\)]\)-4 \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(j\), \(3\)]\)))+Subscript[p, j] (-4+Subscript[p, j] (Subscript[x, i] (-2 (5+7 T)+Subscript[p, j] Subscript[x, i] (44-4 T (11+2 T)-(-1+T) (4+T (13+T)) Subscript[p, j] Subscript[x, i]))+4 (7+Subscript[p, j] Subscript[x, i] (6 (3+T)+(-5+T (10+T)) Subscript[p, j] Subscript[x, i])) Subscript[x, j]-6 Subscript[p, j] (4+(6+T) Subscript[p, j] Subscript[x, i]) \!\(\*SubsuperscriptBox[\(x\), \(j\), \(2\)]\)+4 \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(j\), \(3\)]\))))


(* ::Input::Initialization:: *)
V@Subscript[r, 3,-1][i_,j_]:=-(1/(24 T^3)) Subscript[x, i] (T^2 \!\(\*SubsuperscriptBox[\(p\), \(i\), \(3\)]\) Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) (-3 (-1+T) Subscript[x, i]-4 T Subscript[x, j])+T \!\(\*SubsuperscriptBox[\(p\), \(i\), \(2\)]\) Subscript[p, j] Subscript[x, i] (3 (-1+T) (3+4 T) Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\)+12 T^2 Subscript[x, j] (3-2 Subscript[p, j] Subscript[x, j])+4 T Subscript[x, i] (-6+5 T+7 Subscript[p, j] Subscript[x, j]))+Subscript[p, j] (-4 T^3+Subscript[p, j] ((-1+T) (1+T (13+4 T)) \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(3\)]\)+4 T Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) (-2+11 (-1+T) T+(1-5 (-2+T) T) Subscript[p, j] Subscript[x, j])+4 T^3 Subscript[x, j] (7+Subscript[p, j] Subscript[x, j] (-6+Subscript[p, j] Subscript[x, j]))+2 T^2 Subscript[x, i] (-7-5 T-3 Subscript[p, j] Subscript[x, j] (-4 (1+3 T)+(1+6 T) Subscript[p, j] Subscript[x, j]))))+Subscript[p, i] (4 T^3+Subscript[p, j] (-((-1+T) (1+T (22+13 T)) \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(3\)]\))+4 T Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) (2+(17-16 T) T+(-1+T (-17+6 T)) Subscript[p, j] Subscript[x, j])-4 T^3 Subscript[x, j] (7+Subscript[p, j] Subscript[x, j] (-6+Subscript[p, j] Subscript[x, j]))+2 T^2 Subscript[x, i] (7+5 T+3 Subscript[p, j] Subscript[x, j] (-2 (2+9 T)+(1+10 T) Subscript[p, j] Subscript[x, j])))));


(* ::Input::Initialization:: *)
{SuperStar[p],SuperStar[x],SuperStar[\!\(\*OverscriptBox[\(p\), \(_\)]\)],SuperStar[\!\(\*OverscriptBox[\(x\), \(_\)]\)]}={\[Pi],\[Xi],\!\(\*OverscriptBox[\(\[Pi]\), \(_\)]\),\!\(\*OverscriptBox[\(\[Xi]\), \(_\)]\)};  SuperStar[(Subscript[z_, i__])]:=Subscript[(SuperStar[z]), i];


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


(* ::Input::Initialization:: *)
gPair[fs_,w_]:=gPair[fs,w]=Subscript[PP, gPair][
Print["Running gPair[",fs,",",w,"]..."];
Collect[Subscript[Zip, Join@@Table[{Subscript[p, \[Alpha]],Subscript[\!\(\*OverscriptBox[\(p\), \(_\)]\), \[Alpha]],Subscript[x, \[Alpha]],Subscript[\!\(\*OverscriptBox[\(x\), \(_\)]\), \[Alpha]]},{\[Alpha],w}]][(Times@@(V/@fs))Exp[Sum[Subscript[g, \[Alpha],\[Beta]](Subscript[\[Pi], \[Alpha]]+Subscript[\!\(\*OverscriptBox[\(\[Pi]\), \(_\)]\), \[Alpha]])(Subscript[\[Xi], \[Beta]]+Subscript[\!\(\*OverscriptBox[\(\[Xi]\), \(_\)]\), \[Beta]]),{\[Alpha],w},{\[Beta],w}]-Sum[Subscript[\!\(\*OverscriptBox[\(\[Xi]\), \(_\)]\), \[Alpha]] Subscript[\[Pi], \[Alpha]],{\[Alpha],w}]]],
Subscript[g, __],Factor]
]


(* ::Input::Initialization:: *)
Subscript[\[Rho], d_][K_]:=Subscript[PP, \[Rho]d]@Module[{Cs,\[CurlyPhi],n,A,s,i,j,k,\[CapitalDelta],G,d1,\[Rho]d1,\[Rho]d2,\[Rho]d3},
\!\(\*SubscriptBox[\(PP\), \("\<Green\>"\)]\)[
{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]=Factor[T^((-Total[\[CurlyPhi]]-Total[Cs[[All,1]]])/2) Det[A]];
G=Factor@Inverse[A];
];
\[Rho]d1=Subscript[PP, Mold]@Exp[Total[Cases[Cs,{s_,i_,j_}:>Sum[\[Epsilon]^d1 Subscript[r, d1,s][i,j],{d1,d}]]]+ Sum[\[Epsilon]^d1 Subscript[\[Gamma], d1,\[CurlyPhi][[k]]][k], {k,2n},{d1,d}]];
\[Rho]d2=Subscript[PP, ExpandedMold][
Expand[F[{},{}]*Normal@Series[\[Rho]d1,{\[Epsilon],0,d}]]//.F[fs_,{es___}]*(f:Subscript[(r|\[Gamma]), ps__][is__])^p_.:>F[Join[fs,Table[f,p]],DeleteDuplicates@{es,is}]
];
\[Rho]d3=Subscript[PP, PandS]@Expand[
\[Rho]d2/.F[fs_,es_]:>Expand[gPair[
Replace[fs,Thread[es->Range@Length@es],{2}],
Length@es
]/.Subscript[g, \[Alpha]_,\[Beta]_]:>G[[es[[\[Alpha]]],es[[\[Beta]]]]]]
];
Subscript[PP, Factor]@Collect[Expand@{\[CapitalDelta],\[Rho]d3/.\[Epsilon]^p_.->p! \[CapitalDelta]^(2p) \[Epsilon]^p}/.{T^p_./;p>0:>((2+z^2-z Sqrt[4+z^2])/2)^p,T^p_./;p<0:> ((2+z^2+z Sqrt[4+z^2])/2)^-p},\[Epsilon],Expand]
];



