(* ::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\\Beijing-2407"];
Once[<<IType.m];
Subscript[T, 3]=Subscript[T, 1] Subscript[T, 2];


(* ::Input::Initialization:: *)
Subscript[R, 1][1,i_,j_]=CF[
1/2-Subscript[T, 3] Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i]-Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]+Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]+Subscript[T, 1](Subscript[T, 3]-1)Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]+Subscript[T, 2](Subscript[T, 3]-1)Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]-Subscript[T, 2] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]j]+(Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 2\[InvisibleComma]i\[InvisibleComma]i]+(Subscript[T, 3]-1)Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i]-Subscript[T, 1] Subscript[g, 1\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j]-Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]-Subscript[T, 1](Subscript[T, 3]-1)Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]+Subscript[T, 1] Subscript[g, 1\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]j])/(Subscript[T, 1]-1)];


(* ::Input::Initialization:: *)
Subscript[R, 1][-1,i_,j_]=CF[
-1/2-\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(-1\)] 
\*SubscriptBox[\(g\), \(1\[InvisibleComma]j\[InvisibleComma]i\)] 
\*SubscriptBox[\(g\), \(2\[InvisibleComma]i\[InvisibleComma]i\)]\)-(1-\!\(\*SubsuperscriptBox[\(T\), \(1\), \(-1\)]\)-\!\(\*SubsuperscriptBox[\(T\), \(2\), \(-1\)]\))Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i]-Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i]-Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j]+Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]+\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(-1\)] 
\*SubscriptBox[\(g\), \(1\[InvisibleComma]j\[InvisibleComma]i\)] 
\*SubscriptBox[\(g\), \(3\[InvisibleComma]i\[InvisibleComma]i\)]\)-(1-\!\(\*SubsuperscriptBox[\(T\), \(2\), \(-1\)]\))Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]-Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]+(1-\!\(\*SubsuperscriptBox[\(T\), \(3\), \(-1\)]\))Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]-(1-\!\(\*SubsuperscriptBox[\(T\), \(3\), \(-1\)]\))Subscript[g, 2\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]+(2-\!\(\*SubsuperscriptBox[\(T\), \(2\), \(-1\)]\))(1-\!\(\*SubsuperscriptBox[\(T\), \(3\), \(-1\)]\))Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]+(1-\!\(\*SubsuperscriptBox[\(T\), \(3\), \(-1\)]\))Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]+Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]j]+Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]j]+(Subscript[T, 1](1-\!\(\*SubsuperscriptBox[\(T\), \(2\), \(-1\)]\))Subscript[g, 1\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i]-Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 2\[InvisibleComma]i\[InvisibleComma]i]+Subscript[T, 1] Subscript[g, 1\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j]+Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]-\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(-1\)] \((
\*SubscriptBox[\(T\), \(3\)] - 1)\) 
\*SubscriptBox[\(g\), \(1\[InvisibleComma]i\[InvisibleComma]i\)] 
\*SubscriptBox[\(g\), \(3\[InvisibleComma]j\[InvisibleComma]i\)]\)-Subscript[T, 1] Subscript[g, 1\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]j])/(Subscript[T, 1]-1)];


(* ::Input::Initialization:: *)
\[Theta][{1,i0_,j0_},{1,i1_,j1_}]=-Subscript[T, 1](Subscript[T, 3]-1)Subscript[g, 1,j1,i0] Subscript[g, 2,i1,i0] Subscript[g, 3,j0,i1]+(Subscript[T, 3]-1)Subscript[g, 1,j1,j0] Subscript[g, 2,i1,i0] Subscript[g, 3,j0,i1]+Subscript[T, 1](Subscript[T, 3]-1)Subscript[g, 1,j1,i0] Subscript[g, 2,j1,i0] Subscript[g, 3,j0,i1]-(Subscript[T, 3]-1)Subscript[g, 1,j1,j0] Subscript[g, 2,j1,i0] Subscript[g, 3,j0,i1];


(* ::Input::Initialization:: *)
\[Theta][{1,i0_,j0_},{-1,i1_,j1_}]=(Subscript[T, 3]-1)Subscript[g, 1,j1,i0] Subscript[g, 2,i1,i0] Subscript[g, 3,j0,i1]-\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(-1\)] \((
\*SubscriptBox[\(T\), \(3\)] - 1)\) 
\*SubscriptBox[\(g\), \(1, j1, j0\)] 
\*SubscriptBox[\(g\), \(2, i1, i0\)] 
\*SubscriptBox[\(g\), \(3, j0, i1\)]\)-(Subscript[T, 3]-1)Subscript[g, 1,j1,i0] Subscript[g, 2,j1,i0] Subscript[g, 3,j0,i1]+\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(-1\)] \((
\*SubscriptBox[\(T\), \(3\)] - 1)\) 
\*SubscriptBox[\(g\), \(1, j1, j0\)] 
\*SubscriptBox[\(g\), \(2, j1, i0\)] 
\*SubscriptBox[\(g\), \(3, j0, i1\)]\);


(* ::Input::Initialization:: *)
\[Theta][{-1,i0_,j0_},{1,i1_,j1_}]=CF[
\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(-1\)] 
\*SubsuperscriptBox[\(T\), \(2\), \(-1\)] \((
\*SubscriptBox[\(T\), \(3\)] - 1)\) \((
\*SubscriptBox[\(g\), \(1, j1, i0\)] 
\*SubscriptBox[\(g\), \(2, i1, i0\)] 
\*SubscriptBox[\(g\), \(3, j0, i1\)] - 
\*SubscriptBox[\(T\), \(1\)] 
\*SubscriptBox[\(g\), \(1, j1, j0\)] 
\*SubscriptBox[\(g\), \(2, i1, i0\)] 
\*SubscriptBox[\(g\), \(3, j0, i1\)] - 
\*SubscriptBox[\(g\), \(1, j1, i0\)] 
\*SubscriptBox[\(g\), \(2, j1, i0\)] 
\*SubscriptBox[\(g\), \(3, j0, i1\)] + 
\*SubscriptBox[\(T\), \(1\)] 
\*SubscriptBox[\(g\), \(1, j1, j0\)] 
\*SubscriptBox[\(g\), \(2, j1, i0\)] 
\*SubscriptBox[\(g\), \(3, j0, i1\)])\)\)];


(* ::Input::Initialization:: *)
\[Theta][{-1,i0_,j0_},{-1,i1_,j1_}]=CF[
(1-\!\(\*SubsuperscriptBox[\(T\), \(3\), \(-1\)]\)) (-\!\(\*SubsuperscriptBox[\(T\), \(1\), \(-1\)]\) Subscript[g, 1,j1,i0] Subscript[g, 2,i1,i0] Subscript[g, 3,j0,i1]+Subscript[g, 1,j1,j0] Subscript[g, 2,i1,i0] Subscript[g, 3,j0,i1]+\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(-1\)] 
\*SubscriptBox[\(g\), \(1, j1, i0\)]\ 
\*SubscriptBox[\(g\), \(2, j1, i0\)]\ 
\*SubscriptBox[\(g\), \(3, j0, i1\)]\)-Subscript[g, 1,j1,j0] Subscript[g, 2,j1,i0] Subscript[g, 3,j0,i1])];


(* ::Input::Initialization:: *)
Subscript[\[CapitalGamma], 1][\[CurlyPhi]_,k_]=-\[CurlyPhi]/2+\[CurlyPhi] Subscript[g, 3,k,k];


(* ::Input::Initialization:: *)
\[Theta][K_]:=Module[{Cs,\[CurlyPhi],n,A,s,i,j,k,\[CapitalDelta],G,\[Nu],\[Alpha],\[Beta],gEval,c,z},
{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]; gEval[\[ScriptCapitalE]_]:=Factor[\[ScriptCapitalE]/.Subscript[g, \[Nu]_,\[Alpha]_,\[Beta]_]:>(G[[\[Alpha],\[Beta]]]/.T->Subscript[T, \[Nu]])];
z=gEval[\!\(
\*SubsuperscriptBox[\(\[Sum]\), \(k1 = 1\), \(n\)]\(
\*SubsuperscriptBox[\(\[Sum]\), \(k2 = 1\), \(n\)]\[Theta][Cs[\([\)\(k1\)\(]\)], Cs[\([\)\(k2\)\(]\)]]\)\)];
z+=gEval[\!\(
\*SubsuperscriptBox[\(\[Sum]\), \(k = 1\), \(n\)]\(
\*SubscriptBox[\(R\), \(1\)] @@ Cs[[k]]\)\)];
z+=gEval[\!\(
\*SubsuperscriptBox[\(\[Sum]\), \(k = 1\), \(2  n\)]\(
\(\*SubscriptBox[\(\[CapitalGamma]\), \(1\)]\)[\[CurlyPhi][\([\)\(k\)\(]\)], k]\)\)];
{\[CapitalDelta],(\[CapitalDelta]/.T->Subscript[T, 1])(\[CapitalDelta]/.T->Subscript[T, 2])(\[CapitalDelta]/.T->Subscript[T, 3])z}//Factor ];


(* ::Input::Initialization:: *)
PolyPlot[0]=Graphics[{}];
PolyPlot[p_]:=Module[{crs,m1,m2,maxc,minc,s,hex},
crs=CoefficientRules[\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(m1 = \(-Exponent[p, 
\*SubscriptBox[\(T\), \(1\)], Min]\)\)] 
\*SubsuperscriptBox[\(T\), \(2\), \(m2 = \(-Exponent[p, 
\*SubscriptBox[\(T\), \(2\)], Min]\)\)] p\),{Subscript[T, 1],Subscript[T, 2]}];
maxc=N@Log@Max@Abs[Last/@crs];
minc=N@Log@Min@Select[Abs[Last/@crs],#>0&];
If[minc==maxc,s[_]=0,s[c_]:=s[c]=(maxc-Log@c)/(maxc-minc)];
hex=Table[{Cos[\[Alpha]],Sin[\[Alpha]]}/Cos[2\[Pi]/12]/2, {\[Alpha],2\[Pi]/12,2\[Pi],2\[Pi]/6}];
Graphics[crs/.({x1_,x2_}->c_):>{
If[c==0,White,Lighter[If[c>0,Red,Blue], 0.88s[Abs@c]]],
Polygon[(({
 {1, -1/2},
 {0, Sqrt[3]/2}
}) . {x1+m1,x2+m2}+#)&/@hex] }] ]



