(* ::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`


GD[g_GD] := g;
GD[L_] := GD@@PD[L] /.
X[i_,j_,k_,l_]:>If[PositiveQ@X[i,j,k,l],Subscript[Ap, l,i],Subscript[Am, j,i]];
Draw[g_GD] := Module[{n=Max@Cases[g,_Integer,\[Infinity]]},Graphics[{
Line[{{0,0}, {n+1,0}}],
List@@g /. Subscript[(ah_), i_,j_] :> {
Arrow[BezierCurve[{{i,0},{i+j,Abs[j-i]}/2,{j,0}}]],
Text[ah /. {Ap->"+", Am->"-"},{i,0.3}]},
Table[Text[i, {i,-0.5}], {i,n}]}]]


Draw /@ GD /@ AllKnots@{3,5}


CF[g_GD]:= Sort[
g /. Thread[Sort@Cases[g,_Integer,\[Infinity]]->Range[2Length[g]]]];
PV[F_GD,g_GD] /; Length[F]>Length[g] := 0;
PV[F_GD,g_GD] /; Length[F]<Length[g] := Sum[
PV[F,y], {y, Subsets[g,{Length[F]}]}];
PV[F_GD,g_GD] /; Length[F]==Length[g] := If[
CF[F]===CF[g /. Ap|Am -> A], (-1)^Count[g, Subscript[Am, __]], 0];
Subscript[V, 2][g_] := Subscript[V, 2][g] = PV[GD[Subscript[A, 3,1],Subscript[A, 2,4]], GD[g]];


Format[Knot[n_,k_]]:= Subscript[n, k];
Table[K->Subscript[V, 2][K], {K, AllKnots@{3,7}}]


PV[F1_+F2_, g_] := PV[F1,g]+PV[F2,g];
PV[c_*F_GD, g_] := c PV[F,g];
Subscript[\[Rho], k_][g_]:=g/.i_Integer:>Mod[i-k,2Length@g,1];
Subscript[F, 3]=\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(k = 0\), \(5\)]\((3 
\*SubscriptBox[\(\[Rho]\), \(k\)]@GD[
\*SubscriptBox[\(A\), \(1, 5\)], 
\*SubscriptBox[\(A\), \(4, 2\)], 
\*SubscriptBox[\(A\), \(6, 3\)]] + 2 
\*SubscriptBox[\(\[Rho]\), \(k\)]@GD[
\*SubscriptBox[\(A\), \(1, 4\)], 
\*SubscriptBox[\(A\), \(5, 2\)], 
\*SubscriptBox[\(A\), \(3, 6\)]])\)\);
Subscript[V, 3][K_] := Subscript[V, 3][K] = PV[Subscript[F, 3], GD@K]/6;


Table[K->Subscript[V, 3][K], {K,AllKnots@{3,7}}]


SetOptions[Histogram3D, 
ImageSize -> 4 72/0.65,
ViewPoint->{0.67099,-2.74409,1.86273},
ChartElements->Graphics3D[Cylinder[]]
];


Subscript[G[\[Lambda]_], a_,b_]:=\!\(
\*SubscriptBox[\(\[PartialD]\), \(
\*SubscriptBox[\(t\), \(a\)], 
\*SubscriptBox[\(h\), \(b\)]\)]\[Lambda]\);
G/:Factor[G[\[Lambda]_]]:=G[Collect[\[Lambda],Subscript[h, _],Collect[#,Subscript[t, _],Factor]&]];
Format@\[Gamma]_G:=Module[{S=Union@Cases[\[Gamma],Subscript[(h|t), a_]:>a,\[Infinity]]},
Table[Subscript[\[Gamma], a,b], {a,S}, {b,S}]// MatrixForm] ;


G/:G[\[Lambda]1_]G[\[Lambda]2_] := G[\[Lambda]1+\[Lambda]2];
Subscript[m, a_,b_->c_][G[\[Lambda]_]] := Module[{\[Alpha],\[Beta],\[Gamma],\[Delta],\[Theta],\[Epsilon],\[Phi],\[Psi],\[CapitalXi],\[Mu]},
({
 {\[Alpha], \[Beta], \[Theta]},
 {\[Gamma], \[Delta], \[Epsilon]},
 {\[Phi], \[Psi], \[CapitalXi]}
})=({
 {\!\(
  \*SubscriptBox[\(\[PartialD]\), \(
   \*SubscriptBox[\(t\), \(a\)], 
   \*SubscriptBox[\(h\), \(a\)]\)]\[Lambda]\), \!\(
  \*SubscriptBox[\(\[PartialD]\), \(
   \*SubscriptBox[\(t\), \(a\)], 
   \*SubscriptBox[\(h\), \(b\)]\)]\[Lambda]\), \!\(
  \*SubscriptBox[\(\[PartialD]\), 
   SubscriptBox[\(t\), \(a\)]]\[Lambda]\)},
 {\!\(
  \*SubscriptBox[\(\[PartialD]\), \(
   \*SubscriptBox[\(t\), \(b\)], 
   \*SubscriptBox[\(h\), \(a\)]\)]\[Lambda]\), \!\(
  \*SubscriptBox[\(\[PartialD]\), \(
   \*SubscriptBox[\(t\), \(b\)], 
   \*SubscriptBox[\(h\), \(b\)]\)]\[Lambda]\), \!\(
  \*SubscriptBox[\(\[PartialD]\), 
   SubscriptBox[\(t\), \(b\)]]\[Lambda]\)},
 {\!\(
  \*SubscriptBox[\(\[PartialD]\), 
   SubscriptBox[\(h\), \(a\)]]\[Lambda]\), \!\(
  \*SubscriptBox[\(\[PartialD]\), 
   SubscriptBox[\(h\), \(b\)]]\[Lambda]\), \[Lambda]}
})/.Subscript[(t|h), a|b]->0; \[Mu]=1-\[Beta];
G[Tr[({
 {Subscript[t, c]},
 {1}
})\[Transpose].\!\(\*
TagBox[
RowBox[{"(", "", GridBox[{
{
RowBox[{"\[Gamma]", "+", 
RowBox[{"\[Alpha]", " ", 
RowBox[{"\[Delta]", "/", "\[Mu]"}]}]}], 
RowBox[{"\[Epsilon]", "+", 
RowBox[{"\[Delta]", " ", 
RowBox[{"\[Theta]", "/", "\[Mu]"}]}]}]},
{
RowBox[{"\[Phi]", "+", 
RowBox[{"\[Alpha]", " ", 
RowBox[{"\[Psi]", "/", "\[Mu]"}]}]}], 
RowBox[{"\[CapitalXi]", "+", 
RowBox[{"\[Psi]", " ", 
RowBox[{"\[Theta]", "/", "\[Mu]"}]}]}]}
},
GridBoxAlignment->{"Columns" -> {{Center}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, "RowsIndexed" -> {}, "Items" -> {}, "ItemsIndexed" -> {}},
GridBoxSpacings->{"Columns" -> {Offset[0.27999999999999997`], {Offset[0.7]}, Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> {Offset[0.2], {Offset[0.4]}, Offset[0.2]}, "RowsIndexed" -> {}, "Items" -> {}, "ItemsIndexed" -> {}}], "", ")"}],
Function[BoxForm`e$, MatrixForm[BoxForm`e$]]]\).({
 {Subscript[h, c]},
 {1}
})]] /. Subscript[T, a|b]->Subscript[T, c] // Factor];
Subscript[Rp, a_,b_] := G[Tr[({
 {Subscript[t, a]},
 {Subscript[t, b]}
})\[Transpose].({
 {1, 1-Subscript[T, a]},
 {0, Subscript[T, a]}
}).({
 {Subscript[h, a]},
 {Subscript[h, b]}
})]];
Subscript[Rm, a_,b_] := Subscript[Rp, a,b] /. Subscript[T, a]->1/Subscript[T, a];


GG[g_GD, k_, F_, BB_] := Module[{n=2Length@g+Length@BB,y,cuts,rr,\[Gamma]0,\[Gamma]},
\[Gamma]0=G[Subscript[t, n+1] Subscript[h, n+1]]Times@@g /. {Ap->Rp, Am->Rm};
\[Gamma]0*=G[Sum[Subscript[\[Beta], a,b] Subscript[t, a] Subscript[h, b],{a,BB},{b,BB}]];
Sum[ \[Gamma]=\[Gamma]0;
cuts=Cases[y,_Integer,\[Infinity]]\[Union]{n+1};
rr=Thread[cuts->Range[Length@cuts]];
Do[If[!MemberQ[cuts, j], \[Gamma]=\[Gamma]//Subscript[m, j,j+1->j+1]],{j,n}];
F[y /. rr, \[Gamma] /. Subscript[(v_), a_]:>Subscript[v, a/.rr]],
(*over*) {y,Subsets[List@@g,k]}]];
GG[g_GD, k_, F_] := GG[g,k,F,{}];


FA[{x_}, \[Gamma]_] := Simplify[
Switch[x, Subscript[Ap, __],1,Subscript[Am, __],-1]*Switch[x,Subscript[_, 1,2],(Subscript[\[Gamma], 2,2] Subscript[\[Gamma], 3,3]-Subscript[\[Gamma], 2,3] Subscript[\[Gamma], 3,2])/(Subscript[\[Gamma], 3,3]+Subscript[\[Gamma], 1,3] Subscript[\[Gamma], 3,2]-Subscript[\[Gamma], 1,2] Subscript[\[Gamma], 3,3]),
Subscript[_, 2,1],(Subscript[\[Gamma], 1,3] Subscript[\[Gamma], 3,2]-Subscript[\[Gamma], 1,2] Subscript[\[Gamma], 3,3])/(Subscript[\[Gamma], 3,2]-Subscript[\[Gamma], 2,3] Subscript[\[Gamma], 3,2]+Subscript[\[Gamma], 2,2] Subscript[\[Gamma], 3,3])]/. Subscript[T, _]->T];
GGA[K_,bb___] := GG[GD@K,{1},FA,bb];


SetDirectory["C:/drorbn/AcademicPensieve/Talks/NCSU-1604/"];

ConditionalExport[fname_String, rest___] := Module[{temp, exists},
temp="ConditionalExportTemporary"<>"."<>FileExtension[fname];
exists=FileExistsQ[fname];
Export[temp, rest];
If[exists && FileByteCount[fname]===FileByteCount[temp],
DeleteFile[temp],
(* else *) Print["Exporting "<>fname<>"..."];
If[exists, DeleteFile[fname]];
RenameFile[temp, fname]
];
fname
]

Button["Export",
SetOptions[$FrontEndSession,PrintingStyleEnvironment->"Working"];
TagProperties[_] := {};
TagProperties["GG441"] = {PageWidth -> 8/0.65};
TagProperties["OneCo441"] = {PageWidth -> 11/0.65};
Options[CellExport] = {
PageWidth -> 4/0.65, CellFilter -> Identity, ExportBaseFilename -> Automatic, ExportFormat -> ".pdf", ExportOptions -> {}, Split -> False
};
CellExport[tag_String, opts___Rule] := CellExport[
NotebookGet[EvaluationNotebook[]],
tag, opts
];
CellExport[nb_Notebook, tag_String] := CellExport[nb, tag, TagProperties[tag]];
CellExport[nb_Notebook, tag_String, OptionsPattern[]] := Module[
{cells, cell, filename, format},
filename = OptionValue[ExportBaseFilename] /. Automatic -> tag;
format=OptionValue[ExportFormat];
cells=OptionValue[CellFilter][Cases[
nb, c_Cell /; FreeQ[List@@c, Cell] && !FreeQ[c, CellTags->tag],
Infinity
]];
If[!OptionValue[Split],
If[Length[cells]>=1,
If[Length[cells]==1,
cells=Append[First[cells], PageWidth ->1.2 72OptionValue[PageWidth]],
cells=Cell[CellGroup[cells], PageWidth -> 72OptionValue[PageWidth]]
];
ConditionalExport[
filename<>format,cells,
ImageResolution -> 300,
OptionValue[ExportOptions]
]
],
k=0;
Table[
++k;
ConditionalExport[
filename<>"-"<>ToString[k]<>format,
Append[cell, PageWidth -> 72OptionValue[PageWidth]],
ImageResolution -> 300,
OptionValue[ExportOptions]
],
{cell, cells}
]
]
];
nb=NotebookGet[EvaluationNotebook[]];
tags=Cases[nb, (CellTags->tag_) :> tag, Infinity ] // Union;
CellExport /@ tags;
Print["Done."]
]



