(* ::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.                                                         *)
(************************************************************************)



<< KnotTheory`
Get["C:\\drorbn\\AcademicPensieve\\People\\Frohlich\\221117/RVT.m"] (* RVT-conversion program was written in Haskell*)


(* ::Input::Initialization:: *)
Format[gdo_GDO]:=Subsuperscript[\[DoubleStruckCapitalE],Row[{gdo//getCO,",",gdo//getCC}],Row[{gdo//getDO,",",gdo//getDC}]][gdo//getL,gdo//getQ,gdo//getP];
Format[pg_PG]:=\[DoubleStruckCapitalE][pg//getL,pg//getQ,pg//getP];

SubscriptFormat[v_]:=(Format[v[i_]]:=Subscript[v,i]);

SubscriptFormat/@{y,b,t,a,x,\[Eta],\[Beta],\[Alpha],\[Xi],A,B,T};


(* ::Input::Initialization:: *)
\[Gamma]=1;\[HBar]=1;$k=0;


(* ::Input::Initialization:: *)
setValue[value_,obj_,coord_]:=Module[{b=Association@@obj},b[coord]=value;Head[obj]@@Normal@b]


(* ::Input::Initialization:: *)
fromE[e_\[DoubleStruckCapitalE]]:=toPG@@e/.
Subscript[(v:y|b|t|a|x|B|T|\[Eta]|\[Beta]|\[Tau]|\[Alpha]|\[Xi]|A),i_]->v[i]


(* ::Input::Initialization:: *)
toPG[L_,Q_,P_]:=PG["L"->L,"Q"->Q,"P"->P]

\[Delta][i_,j_]:=If[SameQ[i,j],1,0]

getL[pg_PG]:=Lookup[Association@@pg,"L",0]
getQ[pg_PG]:=Lookup[Association@@pg,"Q",0]
getP[pg_PG]:=Lookup[Association@@pg,"P",1]

setL[L_][pg_PG]:=setValue[L,pg,"L"];
setQ[Q_][pg_PG]:=setValue[Q,pg,"Q"];
setP[P_][pg_PG]:=setValue[P,pg,"P"];

applyToL[f_][pg_PG]:=pg//setL[pg//getL//f]
applyToQ[f_][pg_PG]:=pg//setQ[pg//getQ//f]
applyToP[f_][pg_PG]:=pg//setP[pg//getP//f]


(* ::Input::Initialization:: *)
CCF[e_]:=ExpandDenominator@ExpandNumerator@Together[Expand[e]//.E^x_ E^y_:>E^(x+y)/. E^x_:>E^CCF[x]];
CF[sd_SeriesData]:=MapAt[CF,sd,3];
CF[e_]:=Module[{vs=Union[Cases[e,(y|b|t|a|x|\[Eta]|\[Beta]|\[Tau]|\[Alpha]|\[Xi])[_],\[Infinity]],{y,b,t,a,x,\[Eta],\[Beta],\[Tau],\[Alpha],\[Xi]}]},Total[CoefficientRules[Expand[e],vs]/.
(ps_->c_):>CCF[c] (Times@@(vs^ps))]];
CF[e_PG]:=e//applyToL[CF]//applyToQ[CF]//applyToP[CF]


(* ::Input::Initialization:: *)
PG/:Congruent[pg1_PG,pg2_PG]:=And[CF[getL@pg1==getL@pg2],CF[getQ@pg1==getQ@pg2],CF[Normal[getP@pg1-getP@pg2]==0]]

PG/:pg1_PG*pg2_PG:=toPG[getL@pg1+getL@pg2,getQ@pg1+getQ@pg2,getP@pg1*getP@pg2]

setEpsilonDegree[k_Integer][pg_PG]:=setP[Series[Normal@getP@pg,{\[Epsilon],0,k}]][pg]


(* ::Input::Initialization:: *)
ddsl2vars={y,b,t,a,x};
ddsl2varsDual={\[Eta],\[Beta],\[Tau],\[Alpha],\[Xi]};

Evaluate[Dual/@ddsl2vars]=ddsl2varsDual;
Evaluate[Dual/@ddsl2varsDual]=ddsl2vars;
Dual@z=\[Zeta];
Dual@\[Zeta]=z;

Dual[u_[i_]]:=Dual[u][i]

U2l={B[i_]^p_.:>E^(-p \[HBar] \[Gamma] b[i]),B^p_.:>E^(-p \[HBar] \[Gamma] b),T[i_]^p_.:>E^(-p \[HBar] t[i]),T^p_.:>E^(-p \[HBar] t),A[i_]^p_.:>E^(p \[Gamma] \[Alpha][i]),A^p_.:>E^(-p \[Gamma] \[Alpha])};
l2U={E^(c_. b[i_]+d_.):>B[i]^(-c/(\[HBar] \[Gamma]))E^d,E^(c_. b+d_.):>B^(-c/(\[HBar] \[Gamma]))E^d,E^(c_. t[i_]+d_.):>T[i]^(-c/\[HBar])E^d,E^(c_. t+d_.):>T^(-c/\[HBar])E^d,E^(c_. \[Alpha][i_]+d_.):>A[i]^(c/\[Gamma])E^d,E^(c_. \[Alpha]+d_.):>A^(c/\[Gamma])E^d,E^expr_:>E^Expand@expr};


(* ::Input::Initialization:: *)
DD[f_,b]:=D[f,b]-\[HBar] \[Gamma] B D[f,B];
DD[f_,b[i_]]:=D[f,b[i]]-\[HBar] \[Gamma] B[i] D[f,B[i]];

DD[f_,t]:=D[f,t]-\[HBar] T D[f,T];
DD[f_,t[i_]]:=D[f,t[i]]-\[HBar] T[i] D[f,T[i]];

DD[f_,\[Alpha]]:=D[f,\[Alpha]]+\[Gamma] A D[f,A];
DD[f_,\[Alpha][i_]]:=D[f,\[Alpha][i]]+\[Gamma] A[i] D[f,A[i]];

DD[f_,v_]:=D[f,v];
DD[f_,{v_,0}]:=f;
DD[f_,{}]:=f;
DD[f_,{v_,n_Integer}]:=DD[DD[f,v],{v,n-1}];
DD[f_,{l_List,ls___}]:=DD[DD[f,l],{ls}];


(* ::Input::Initialization:: *)
collect[sd_SeriesData,\[Zeta]_]:=MapAt[collect[#,\[Zeta]]&,sd,3];
collect[expr_,\[Zeta]_]:=Collect[expr,\[Zeta]];

Zip[{}][P_]:=P;
Zip[\[Zeta]s_List][Ps_List]:=Zip[\[Zeta]s]/@Ps;
Zip[{\[Zeta]_,\[Zeta]s___}][P_]:=(collect[P//Zip[{\[Zeta]s}],\[Zeta]]/.
f_. \[Zeta]^d_.:>DD[f,{Dual[\[Zeta]],d}])/.
Dual[\[Zeta]]->0/.
((Dual[\[Zeta]]/. {b->B,t->T,\[Alpha]->A})->1)


(* ::Input::Initialization:: *)
QZip[\[Zeta]s_List][pg_PG]:=Module[{Q,P,\[Zeta],z,zs,c,ys,\[Eta]s,qt,zrule,\[Zeta]rule},zs=Dual/@\[Zeta]s;
Q=pg//getQ;
P=pg//getP;
c=CF[Q/.Alternatives@@Union[\[Zeta]s,zs]->0];
ys=CF/@Table[D[Q,\[Zeta]]/.Alternatives@@zs->0,{\[Zeta],\[Zeta]s}];
\[Eta]s=CF/@Table[D[Q,z]/.Alternatives@@\[Zeta]s->0,{z,zs}];
qt=CF/@#&/@(Inverse@Table[\[Delta][z,Dual[\[Zeta]]]-D[Q,z,\[Zeta]],{\[Zeta],\[Zeta]s},{z,zs}]);
zrule=Thread[zs->CF/@(qt . (zs+ys))];
\[Zeta]rule=Thread[\[Zeta]s->\[Zeta]s+\[Eta]s . qt];
CF@setQ[c+\[Eta]s . qt . ys]@setP[Det[qt] Zip[\[Zeta]s][P/. Union[zrule,\[Zeta]rule]]]@pg]


(* ::Input::Initialization:: *)
LZip[\[Zeta]s_List][pg_PG]:=Module[{L,Q,P,\[Zeta],z,zs,Zs,c,ys,\[Eta]s,lt,zrule,Zrule,\[Zeta]rule,Q1,EEQ,EQ,U},zs=Dual/@\[Zeta]s;
{L,Q,P}=Through[{getL,getQ,getP}@pg];
Zs=zs/. {b->B,t->T,\[Alpha]->A};
c=CF[L/.Alternatives@@Union[\[Zeta]s,zs]->0/.Alternatives@@Zs->1];
ys=CF/@Table[D[L,\[Zeta]]/.Alternatives@@zs->0,{\[Zeta],\[Zeta]s}];
\[Eta]s=CF/@Table[D[L,z]/.Alternatives@@\[Zeta]s->0,{z,zs}];
lt=CF/@#&/@Inverse@Table[\[Delta][z,Dual[\[Zeta]]]-D[L,z,\[Zeta]],{\[Zeta],\[Zeta]s},{z,zs}];
zrule=Thread[zs->CF/@(lt . (zs+ys))];
Zrule=Join[zrule,zrule/.
r_Rule:>((U=r[[1]]/. {b->B,t->T,\[Alpha]->A})->(U/. U2l/. r//.l2U))];
\[Zeta]rule=Thread[\[Zeta]s->\[Zeta]s+\[Eta]s . lt];
Q1=Q/. Union[Zrule,\[Zeta]rule];
EEQ[ps___]:=EEQ[ps]=(CF[E^-Q1 DD[E^Q1,Thread[{zs,{ps}}]]/.
{Alternatives@@zs->0,Alternatives@@Zs->1}]);
CF@toPG[c+\[Eta]s . lt . ys,Q1/. {Alternatives@@zs->0,Alternatives@@Zs->1},Det[lt] (Zip[\[Zeta]s][(EQ@@zs) (P/. Union[Zrule,\[Zeta]rule])]/.
Derivative[ps___][EQ][___]:>EEQ[ps]/. _EQ->1)]]


(* ::Input::Initialization:: *)
Pair[{}][L_PG,R_PG]:=L R;
Pair[is_List][L_PG,R_PG]:=Module[{n},Times[L/. ((v:b|B|t|T|a|x|y)[#]->v[n@#]&/@is),R/. ((v:\[Beta]|\[Tau]|\[Alpha]|A|\[Xi]|\[Eta])[#]->v[n@#]&/@is)]//LZip[Join@@Table[Through[{\[Beta],\[Tau],a}[n@i]],{i,is}]]//QZip[Join@@Table[Through[{\[Xi],y}[n@i]],{i,is}]]]


(* ::Input::Initialization:: *)
toGDO[do_List,dc_List,co_List,cc_List,L_,Q_,P_]:=GDO["do"->do,"dc"->dc,"co"->co,"cc"->cc,"PG"->toPG[L,Q,P]]

toGDO[do_List,dc_List,co_List,cc_List,pg_PG]:=GDO["do"->do,"dc"->dc,"co"->co,"cc"->cc,"PG"->pg]

getDO[gdo_GDO]:=Lookup[Association@@gdo,"do",{}]
getDC[gdo_GDO]:=Lookup[Association@@gdo,"dc",{}]
getCO[gdo_GDO]:=Lookup[Association@@gdo,"co",{}]
getCC[gdo_GDO]:=Lookup[Association@@gdo,"cc",{}]

getPG[gdo_GDO]:=Lookup[Association@@gdo,"PG",PG[]]

getL[gdo_GDO]:=gdo//getPG//getL
getQ[gdo_GDO]:=gdo//getPG//getQ
getP[gdo_GDO]:=gdo//getPG//getP

setPG[pg_PG][gdo_GDO]:=setValue[pg,gdo,"PG"]

setL[L_][gdo_GDO]:=setValue[setL[L][gdo//getPG],gdo,"PG"]
setQ[Q_][gdo_GDO]:=setValue[setQ[Q][gdo//getPG],gdo,"PG"]
setP[P_][gdo_GDO]:=setValue[setP[P][gdo//getPG],gdo,"PG"]

setDO[do_][gdo_GDO]:=setValue[do,gdo,"do"]
setDC[dc_][gdo_GDO]:=setValue[dc,gdo,"dc"]
setCO[co_][gdo_GDO]:=setValue[co,gdo,"co"]
setCC[cc_][gdo_GDO]:=setValue[cc,gdo,"cc"]

applyToDO[f_][gdo_GDO]:=gdo//setDO[gdo//getDO//f]
applyToDC[f_][gdo_GDO]:=gdo//setDC[gdo//getDC//f]
applyToCO[f_][gdo_GDO]:=gdo//setCO[gdo//getCO//f]
applyToCC[f_][gdo_GDO]:=gdo//setCC[gdo//getCC//f]

applyToPG[f_][gdo_GDO]:=gdo//setPG[gdo//getPG//f]

applyToL[f_][gdo_GDO]:=gdo//setL[gdo//getL//f]
applyToQ[f_][gdo_GDO]:=gdo//setQ[gdo//getQ//f]
applyToP[f_][gdo_GDO]:=gdo//setP[gdo//getP//f]

CF[e_GDO]:=e//applyToDO[Union]//applyToDC[Union]//applyToCO[Union]//applyToCC[Union]//applyToPG[CF]


(* ::Input::Initialization:: *)
Pair[is_List][gdo1_GDO,gdo2_GDO]:=GDO["do"->Union[gdo1//getDO,Complement[gdo2//getDO,is]],"dc"->Union[gdo1//getDC,gdo2//getDC],"co"->Union[gdo2//getCO,Complement[gdo1//getCO,is]],"cc"->Union[gdo1//getCC,gdo2//getCC],"PG"->Pair[is][gdo1//getPG,gdo2//getPG]]

gdo1_GDO//gdo2_GDO:=Pair[Intersection[gdo1//getCO,gdo2//getDO]][gdo1,gdo2];

GDO/:Congruent[gdo1_GDO,gdo2_GDO]:=And[Sort@*getDO/@Equal[gdo1,gdo2],Sort@*getDC/@Equal[gdo1,gdo2],Sort@*getCO/@Equal[gdo1,gdo2],Sort@*getCC/@Equal[gdo1,gdo2],Congruent[gdo1//getPG,gdo2//getPG]]

GDO/:gdo1_GDO gdo2_GDO:=GDO["do"->Union[gdo1//getDO,gdo2//getDO],"dc"->Union[gdo1//getDC,gdo2//getDC],"co"->Union[gdo1//getCO,gdo2//getCO],"cc"->Union[gdo1//getCC,gdo2//getCC],"PG"->(gdo1//getPG)*(gdo2//getPG)]

setEpsilonDegree[k_Integer][gdo_GDO]:=setP[Series[Normal@getP@gdo,{\[Epsilon],0,k}]][gdo]


(* ::Input::Initialization:: *)
fromE[Subscript[\[DoubleStruckCapitalE],{do_List,dc_List}->{co_List,cc_List}][L_,Q_,P_]]:=toGDO[do,dc,co,cc,fromE[\[DoubleStruckCapitalE][L,Q,P]]]

fromE[Subscript[\[DoubleStruckCapitalE],dom_List->cod_List][L_,Q_,P_]]:=GDO["do"->dom,"co"->cod,"PG"->fromE[\[DoubleStruckCapitalE][L,Q,P]]]


(* ::Input::Initialization:: *)
fromLog[l_]:=CF@Module[{L,l0=Limit[l,\[Epsilon]->0]},L=l0/. (\[Eta]|y|\[Xi]|x)[_]->0;
PG["L"->L,"Q"->l0-L]/.l2U]

c\[CapitalLambda]=(\[Eta][i]+E^(-\[Gamma] \[Alpha][i]-\[Epsilon] \[Beta][i]) \[Eta][j]/(1+\[Gamma] \[Epsilon] \[Eta][j]\[Xi][i]))y[k]+(\[Beta][i]+\[Beta][j]+Log[1+\[Gamma] \[Epsilon] \[Eta][j]\[Xi][i]]/\[Epsilon]) b[k]+(\[Alpha][i]+\[Alpha][j]+Log[1+\[Gamma] \[Epsilon] \[Eta][j]\[Xi][i]]/\[Gamma]) a[k]+(\[Xi][j]+E^(-\[Gamma] \[Alpha][j]-\[Epsilon] \[Beta][j]) \[Xi][i]/(1+\[Gamma] \[Epsilon] \[Eta][j]\[Xi][i]))x[k];

cm[i_,j_,k_]=GDO["do"->{i,j},"co"->{k},"PG"->fromLog[c\[CapitalLambda]]];

c\[Eta][i_]=GDO["co"->{i}];
c\[Sigma][i_,j_]=GDO["do"->{i},"co"->{j},"PG"->fromLog[\[Beta][i] b[j]+\[Alpha][i] a[j]+\[Eta][i] y[j]+\[Xi][i] x[j]]];
c\[Epsilon][i_]=GDO["do"->{i}];
c\[CapitalDelta][i_,j_,k_]=GDO["do"->{i},"co"->{j,k},"PG"->fromLog[\[Beta][i](b[j]+b[k])+\[Alpha][i](a[j]+a[k])+\[Eta][i](y[j]+y[k])+\[Xi][i](x[j]+x[k])]];

sY[i_,j_,k_,l_,m_]=GDO["do"->{i},"co"->{j,k,l,m},"PG"->fromLog[\[Beta][i]b[k]+\[Alpha][i]a[l]+\[Eta][i]y[j]+\[Xi][i]x[m]]];

sS[i_]=GDO["do"->{i},"co"->{i},"PG"->fromLog[-(\[Beta][i] b[i]+\[Alpha][i] a[i]+\[Eta][i] y[i]+\[Xi][i] x[i])]];

cS[i_]=sS[i]//sY[i,1,2,3,4]//cm[4,3,i]//cm[i,2,i]//cm[i,1,i];

cR[i_,j_]=GDO["co"->{i,j},"PG"->toPG[\[HBar] a[j] b[i],(B[i]-1)/(-b[i]) x[j] y[i],1]]

cRi[i_,j_]=GDO["co"->{i,j},"PG"->toPG[-\[HBar] a[j] b[i],(B[i]-1)/(B[i] b[i]) x[j] y[i],1]]

CC[i_]:=GDO["co"->{i},"PG"->PG["P"->B[i]^(1/2)]]
CCi[i_]:=GDO["co"->{i},"PG"->PG["P"->B[i]^(-1/2)]]


(* ::Input::Initialization:: *)
getConstLCoef::usage="getConstLCoef[i][gdo] returns the terms in the L-portion of a GDO expression which are not a function of y[i], b[i], a[i], nor x[i]."
getConstLCoef[i_][gdo_]:=(SeriesCoefficient[#,{b[i],0,0}]&)@*(Coefficient[#,y[i],0]&)@*(Coefficient[#,a[i],0]&)@*(Coefficient[#,x[i],0]&)@*ReplaceAll[U2l]@*getL@gdo

getConstQCoef::usage="getConstQCoef[i][gdo] returns the terms in the Q-portion of a GDO expression which are not a function of y[i], b[i], a[i], nor x[i]."
getConstQCoef[i_][gdo_][bb_]:=ReplaceAll[{b[i]->bb}]@*(Coefficient[#,y[i],0]&)@*(Coefficient[#,a[i],0]&)@*(Coefficient[#,x[i],0]&)@*ReplaceAll[U2l]@*getQ@gdo

getyCoef::usage="getyCoef[i][gdo][b[i]] returns the linear coefficient of y[i] as a function of b[i]."
getyCoef[i_][gdo_][bb_]:=ReplaceAll[{b[i]->bb}]@*ReplaceAll[U2l]@*(Coefficient[#,x[i],0]&)@*(Coefficient[#,y[i],1]&)@*getQ@gdo

getbCoef::usage="getbCoef[i][gdo] returns the linear coefficient of b[i]."
getbCoef[i_][gdo_]:=(SeriesCoefficient[#,{b[i],0,1}]&)@*(Coefficient[#,a[i],0]&)@*(Coefficient[#,x[i],0]&)@*(Coefficient[#,y[i],0]&)@*ReplaceAll[U2l]@*getL@gdo

getPCoef::usage="getPCoef[i][gdo] returns the perturbation P of a GDO as a function of b[i]."
getPCoef[i_][gdo_][bb_]:=ReplaceAll[{b[i]->bb}]@*(Coefficient[#,a[i],0]&)@*(Coefficient[#,x[i],0]&)@*(Coefficient[#,y[i],0]&)@*ReplaceAll[U2l]@*getP@gdo

getaCoef::usage="getaCoef[i][gdo] returns the linear coefficient of a[i]."
getaCoef[i_][gdo_]:=(SeriesCoefficient[#,{b[i],0,0}]&)@*(Coefficient[#,a[i],1]&)@*ReplaceAll[U2l]@*getL@gdo

getxCoef::usage="getxCoef[i][gdo][b[i]] returns the linear coefficient of x[i] as a function of b[i]."
getxCoef[i_][gdo_][bb_]:=ReplaceAll[{b[i]->bb}]@*ReplaceAll[U2l]@*(Coefficient[#,y[i],0]&)@*(Coefficient[#,x[i],1]&)@*getQ@gdo

getabCoef::usage="getabCoef[i][gdo] returns the linear coefficient of a[i]b[i]."
getabCoef[i_][gdo_]:=(SeriesCoefficient[#,{b[i],0,1}]&)@*(Coefficient[#,a[i],1]&)@*ReplaceAll[U2l]@*getL@gdo

getxyCoef::usage="getxyCoef[i][gdo][b[i]] returns the linear coefficient of x[i]y[i] as a function of b[i]."
getxyCoef[i_][gdo_][bb_]:=ReplaceAll[{b[i]->bb}]@*ReplaceAll[U2l]@*(Coefficient[#,x[i],1]&)@*(Coefficient[#,y[i],1]&)@*getQ@gdo


(* ::Input::Initialization:: *)
safeEval[f_][x_]:=Module[{fx,x0},If[(fx=Quiet[f[x]])===Indeterminate,Series[f[x0],{x0,x,0}]//Normal,fx]]

closeComponent[i_][gdo_GDO]:=gdo//setCO[Complement[gdo//getCO,{i}]]//setCC[Union[gdo//getCC,{i}]]

tr::usage="tr[i] computes the trace of a GDO element on component i. Current implementation assumes the Subscript[a, i] Subscript[b, i] term vanishes and $k=0."
tr::nonzeroSigma="tr[`1`]: Component `1` has writhe: `2`, expected: 0."
tr[i_][gdo_GDO]:=Module[{cL=getConstLCoef[i][gdo],cQ=getConstQCoef[i][gdo],\[Beta]P=getPCoef[i][gdo],\[Eta]\[Eta]=getyCoef[i][gdo],\[Beta]\[Beta]=getbCoef[i][gdo],\[Alpha]\[Alpha]=getaCoef[i][gdo],\[Xi]\[Xi]=getxCoef[i][gdo],\[Lambda]=getxyCoef[i][gdo],ta},ta=(1-Exp[-\[Alpha]\[Alpha]]) t[i];
expL=cL+\[Alpha]\[Alpha] a[i]+\[Beta]\[Beta] ta;
expQ=safeEval[cQ[#]+t[i]\[Eta]\[Eta][#]\[Xi]\[Xi][#]/(1-t[i] \[Lambda][#])&][ta];
expP=safeEval[\[Beta]P[#]/(1-t[i] \[Lambda][#])&][ta];
CF[(gdo//closeComponent[i]//setL[expL]//setQ[expQ]//setP[expP])//.l2U]]/;Module[{\[Sigma]=getabCoef[i][gdo]},If[\[Sigma]==0,True,Message[tr::nonzeroSigma,i,ToString[\[Sigma]]];False]]


(* ::Input::Initialization:: *)
CCn[i_][n_Integer]:=Module[{j},If[n==0,GDO["co"->{i}],If[n>0,If[n==1,CC[i],CC[j]//CCn[i][n-1]//cm[i,j,i]],If[n==-1,CCi[i],CCi[j]//CCn[i][n+1]//cm[i,j,i]]]]]

cm[{},j_]:=c\[Eta][j]
cm[{i_},j_]:=c\[Sigma][i,j]
cm[{i_,j_},k_]:=cm[i,j,k]
cm[ii_List,k_]:=Module[{i=First[ii],is=Rest[ii],j,js,l},j=First[is];
js=Rest[is];
cm[i,j,l]//cm[Prepend[js,l],k]]

toGDO[Xp[i_,j_]]:=cR[i,j]
toGDO[Xm[i_,j_]]:=cRi[i,j]
toGDO[{i_,n_}]:=CCn[i][n]
toGDO[xs_Strand]:=cm[List@@xs,First[xs]]
toGDO[xs_Loop]:=Module[{x=First[xs]},cm[List@@xs,x]//tr[x]]

toList[RVT[cs_List,xs_List,rs_List]]:=Flatten[#,1]&@((toGDO/@#&)/@{xs,rs,cs})

getIndices[RVT[cs_List,_List,_List]]:=Sort@Flatten[#,1]&@(List@@@cs)

ZFramed[rvt_RVT]:=Fold[#2[#1]&,GDO["co"->getIndices@rvt],toList@rvt]

combineBySecond[l_List]:=mergeWith[Total,#]&/@GatherBy[l,First];
combineBySecond[lis___]:=combineBySecond[Join[lis]]

mergeWith[f_,l_]:={l[[1,1]],f@(#[[2]]&/@l)}

Reindex[RVT[cs_,xs_,rs_]]:=Module[{sf,cs2,xs2,rs2,repl,repl2},sf=Flatten[List@@#&/@cs];
repl=(Thread[sf->Range[Length[sf]]]);
repl2=repl/. {(a_->b_)->({a,i_}->{b,i})};
cs2=cs/. repl;
xs2=xs/. repl;
rs2=rs/. repl2;
RVT[cs2,xs2,rs2]]

Unwrithe[RVT[cs_List,xs_List,rs_List]]:=Module[{lw},lw=Table[{l,Plus@@xs/.{Xp[i_,j_]:>If[MemberQ[l,i]\[And]MemberQ[l,j],1,0],Xm[i_,j_]:>If[MemberQ[l,i]\[And]MemberQ[l,j],-1,0]}},{l,cs}];
addLoops[l_,n_]:=Join[l,Head[l]@@Table[Subscript[Last[l],i],{i,2 Abs[n]}]];
Xn[n_]:=If[n>=0,Xm,Xp];(*Loops to counteract the writhe.*)addXings[l_,n_]:=If[n==0,{},Table[Xn[n][Subscript[Last[l],2 i-1],Subscript[Last[l],2i]],{i,Abs[n]}]];
addRots[l_,n_]:={First@l,n};
(*Print["lw: ",lw];*)Reindex@RVT[addLoops@@@lw,Join[xs,Flatten[addXings@@@lw]],combineBySecond[rs,addRots@@@lw]]]

Z[L_RVT]:=ZFramed[Unwrithe[L]]


(* ::Input::Initialization:: *)
ptr[L_]:=Module[{ZL=Z[L],cod},cod=getCO@ZL;
Table[(Composition@@Table[tr[j],{j,Complement[cod,{i}]}])[ZL],{i,cod}]]


(* ::Input::Initialization:: *)
getGDOIndices[gdo_GDO]:=Sort@Catenate@Through[{getDO,getDC,getCO,getCC}@gdo]

isolateVarIndices[i_->j_]:=(v:y|b|t|a|x|\[Eta]|\[Beta]|\[Alpha]|\[Xi]|A|B|T)[i]->v[j];

ReindexBy[f_][gdo_GDO]:=Module[{replacementRules,varIndexFunc,repFunc,indices=getGDOIndices[gdo]},replacementRules=Thread[indices->(f/@indices)];
repFunc=ReplaceAll[replacementRules];
varIndexFunc=ReplaceAll[Thread[isolateVarIndices[replacementRules]]];
gdo//applyToPG[varIndexFunc]//applyToCO[repFunc]//applyToDO[repFunc]//applyToDC[repFunc]//applyToCC[repFunc]]

fromAssoc[ass_]:=Association[ass][#]&

ReindexToInteger[gdos_List]:=Module[{is=getGDOIndices@gdos[[1]],f},f=fromAssoc@Thread[is->Range[Length[is]]];
ReindexBy[f]/@gdos]

getReindications[gdos_List]:=Module[{gdosInt=ReindexToInteger[gdos],is,fs,ls},is=getGDOIndices[gdosInt[[1]]];
fs=(fromAssoc@*Association@*Thread)/@(is->#&/@Permutations[is]);
ls=CF@ReindexBy[#]/@gdosInt&/@fs;
Sort[Sort/@ls]]

getCanonicalIndex[gdo_]:=First@getReindications@gdo



