(* ::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:: *)
(*Can be simplified a bit more*)
Logos[\[Alpha]_,\[Beta]_,\[Delta]_,\[Mu]_ ,a_,c_,w_]:=
-(1/(4\[Mu]^4))(1+t)(4a c w \[Delta]^2 \[Mu]^2+\[Delta] (1+\[Mu])(w^2 \[Alpha]^2+ a^2 \[Beta]^2 )+
 a^2 w^2 \[Delta]^3 (1+3 \[Mu])+(1-t)(2(\[Alpha] \[Beta]+\[Delta] \[Mu])^2-\[Alpha]^2 \[Beta]^2)+
2(\[Alpha] \[Beta]+2\[Delta] \[Mu]+ a w \[Delta]^2 (1+2 \[Mu])+2c  \[Delta] \[Mu]^2)(w \[Alpha] +a \[Beta] )+
 4(c \[Mu]^2+a w \[Delta] (1+\[Mu]) )(\[Alpha] \[Beta]+\[Delta] \[Mu])  )



(* ::Input::Initialization:: *)
(*R-matrix*)
Rp[i_,j_]:={1,b Subscript[c, j],Subscript[a, i] Subscript[w, j],Subscript[a, i] Subscript[c, i] Subscript[w, j]+Subscript[c, i] Subscript[c, j]+(Subscript[a, i]^2 Subscript[w, j]^2)/4}
Rm[i_,j_]:={1,-b Subscript[c, j],-t ^-1 Subscript[a, i] Subscript[w, j],-Subscript[c, i ] Subscript[c, j]+t^-1 Subscript[a, i] Subscript[c, j] Subscript[w, j]-(t^-2 Subscript[a, i]^2 Subscript[w, j]^2)/4}


(* ::Input::Initialization:: *)
(*Cuaps*)
nr[i_]:={t^(1/2),0,0,-Subscript[c, i]}
nl[i_]:={1,0,0,0}
ur[i_]:={t^(-1/2),0,0,Subscript[c, i]}
ul[i_]:={1,0,0,0}


(* ::Input::Initialization:: *)
Subscript[DP, x_->Subscript[D, \[Alpha]_],y_->Subscript[D, \[Beta]_]][P_][f_] := Total[CoefficientRules[P, {x,y}] /. ({m_,n_}->c_) :> c D[f,{\[Alpha],m},{\[Beta],n}]]


(* ::Input::Initialization:: *)
(*Stitching operation*)
NO[Subscript[w, i_],Subscript[a, j_],k_][Z_]:=Block[
{\[Alpha],\[Beta],\[Delta],C,L,Q,P,QRest,\[Mu],q },
C=Z[[1]]; (*The (inverse of the) constant in front, aka \[Omega]*)
L=Z[[2]]; (*The linear term of the exponential, unscaled*)
Q=Z[[3]]; (*The quadratic term, unscaled.*)
P=Z[[4]]; 
q= \[Mu]^-1 ((1-t)\[Alpha] \[Beta] +\[Alpha] Subscript[w, i]+\[Beta] Subscript[a, j]+\[Delta] Subscript[a, j] Subscript[w, i]);
P=Subscript[DP, Subscript[w, i]->Subscript[D, \[Alpha]],Subscript[a, j]->Subscript[D, \[Beta]]][P][Exp[q]]Exp[-q]; (*First deal with P formally*)
(*Then set the variables*)
\[Alpha] = D[Q,Subscript[w, i]]/.Subscript[a, j ]->0;
\[Beta] = D[Q,Subscript[a, j]]/.Subscript[w, i ]->0;
\[Delta] = D[Q,Subscript[a, j],Subscript[w, i]];
QRest=Q/.{Subscript[a, j ]->0,Subscript[w, i ]->0};
\[Mu]  = 1-(1-t)\[Delta];

C=\[Mu] C;
Q=QRest+\[Mu]^-1 ((1-t)\[Alpha] \[Beta] +\[Alpha] Subscript[w, i]+\[Beta] Subscript[a, j]+\[Delta] Subscript[a, j] Subscript[w, i]);
P=P+Logos[\[Alpha],\[Beta],\[Delta],\[Mu] ,Subscript[a, j],Subscript[c, k],Subscript[w, i]];
{C,L,Q,P}/.{b->Log[t]}
]

NO[Subscript[w, k_],Subscript[c, j_]][Z_]:=Block[
{\[Alpha],\[Gamma],C,L,Q,P,QRest,q },
C=Z[[1]]; (*The (inverse of the) constant in front, aka \[Omega]*)
L=Z[[2]]; (*The linear term of the exponential, unscaled*)
Q=Z[[3]]; (*The quadratic term, unscaled.*)
P=Z[[4]]; 
q=E^\[Gamma] \[Alpha] Subscript[w, k]+\[Gamma] Subscript[c, j];
P=Subscript[DP, Subscript[w, k]->Subscript[D, \[Alpha]],Subscript[c, j]->Subscript[D, \[Gamma]]][P][Exp[q]]Exp[-q]; (*First deal with P formally*)
(*Then set the variables*)
\[Alpha] = D[Q,Subscript[w, k]];
\[Gamma] = D[L,Subscript[c, j]];
QRest=Q/.{Subscript[w, k ]->0};

Q=QRest+E^\[Gamma] \[Alpha] Subscript[w, k];
{C,L,Q,P}/.{b->Log[t]}
]

NO[Subscript[c, i_],Subscript[a, k_]][Z_]:=Block[
{\[Beta],\[Gamma],C,L,Q,P,QRest,q },
C=Z[[1]]; (*The (inverse of the) constant in front, aka \[Omega]*)
L=Z[[2]]; (*The linear term of the exponential, unscaled*)
Q=Z[[3]]; (*The quadratic term, unscaled.*)
P=Z[[4]]; 
q=E^\[Gamma] \[Beta] Subscript[a, k]+\[Gamma] Subscript[c, i];
P=Subscript[DP, Subscript[a, k]->Subscript[D, \[Beta]],Subscript[c, i]->Subscript[D, \[Gamma]]][P][Exp[q]]Exp[-q]; (*First deal with P formally*)
(*Then set the variables*)
\[Beta] = D[Q,Subscript[a, k]];
\[Gamma] = D[L,Subscript[c, i]];

QRest=Q/.{Subscript[a, k ]->0};

Q=Q/.{Subscript[a, k]->E^\[Gamma] Subscript[a, k]};
(*Q=QRest+\[ExponentialE]^\[Gamma]\[Beta] Subscript[a, k];*)
{C,L,Q,P}/.{b->Log[t]}
]

m[i_,j_,k_][Z_]:=Block[{x},(Z//NO[Subscript[w, i],Subscript[a, j],x]//NO[Subscript[c, i],Subscript[a, j]]//NO[Subscript[w, i],Subscript[c, j]])/.{Subscript[a, i|j]->Subscript[a, k],Subscript[c, i|j|x]->Subscript[c, k],Subscript[w, i|j]->Subscript[w, k]}//Together]


(* ::Input::Initialization:: *)
(*Disjoint union of two tangles, multiplies the constant terms, adds the exponents*)
DisjUnion[L_]:={Times@@L[[All,1]],Plus@@L[[All,2]],Plus @@L[[All,3]],Plus @@L[[All,4]]}


(* ::Input::Initialization:: *)
(*Kinks*)
Kp[i_]:={Sqrt[t],Log[t] Subscript[c, i],Subscript[a, i] Subscript[w, i],-Subscript[c, i]+
\!\(\*SubsuperscriptBox[\(c\), \(i\), \(2\)]\)+Subscript[a, i] Subscript[c, i] Subscript[w, i]+1/4 
\!\(\*SubsuperscriptBox[\(a\), \(i\), \(2\)]\) 
\!\(\*SubsuperscriptBox[\(w\), \(i\), \(2\)]\)}
Km[i_]:={1/Sqrt[t],-Log[t] Subscript[c, i],-((Subscript[a, i] Subscript[w, i])/t),Subscript[c, i]-
\!\(\*SubsuperscriptBox[\(c\), \(i\), \(2\)]\)+(Subscript[a, i] Subscript[c, i] Subscript[w, i])/t-(\!\(
\*SubsuperscriptBox[\(a\), \(i\), \(2\)]\ 
\*SubsuperscriptBox[\(w\), \(i\), \(2\)]\))/(4 t^2)}



