Pensieve header: Running through the Bedlewo and the Kashaev Programs.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\CMS-2112"]

Once[<< KnotTheory`]

MatrixSignature[A_]:=Total[Sign[Select[Eigenvalues[A],Abs[#]>(10^(-12))&]]];
Writhe[K_]:=Sum[If[PositiveQ[x],1,-1], {x,List@@PD@K}];

<< BedAndKas.m;

\begin{frame}
\parbox{0.54\linewidth}{
Lets run our code line by line\ldots

nb2tex$PDFWidth*=0.6

PD[(Subscript[8, 2])]=PD[X[10,1,11,2], X[2,11,3,12],X[12,3,13,4],X[4,13,5,14],X[14,5,15,6],X[8,16,9,15],X[16,8,1,7],X[6,9,7,10]];

{lhs=Jones[(Subscript[8, 2])][q], rhs=Jones[Knot[8,2]][q],lhs==rhs}

K=(Subscript[8, 2]);

}\hfill\parbox{0.45\linewidth}{\[\scalebox{0.95}{\input{K82.pdf_t}}\]}
\end{frame}\begin{frame}
\parbox{0.54\linewidth}{

XingsByArmpits=List@@PD[K]/.x:X[i_,j_,k_,l_]:>If[PositiveQ[x],(SubPlus[X])[-i,j,k,-l],(SubMinus[X])[-j,k,l,-i]]

}\hfill\parbox{0.45\linewidth}{\[\scalebox{0.95}{\input{K82Labeled.pdf_t}}\]}
\end{frame}\begin{frame}
\parbox{0.54\linewidth}{

bends=Times@@XingsByArmpits/._[X][a_,b_,c_,d_]:>(Subscript[p, a,-d])(Subscript[p, b,-a])(Subscript[p, c,-b])(Subscript[p, d,-c])

faces=bends//.(Subscript[p, x__,y_])(Subscript[p, y_,z__]):>(Subscript[p, x,y,z])

}\hfill\parbox{0.45\linewidth}{\[\scalebox{0.95}{\input{K82Labeled.pdf_t}}\]}
\end{frame}\begin{frame}

nb2tex$PDFWidth/=0.6

A=Table[0,Length@faces,Length@faces];
A//MatrixForm

\end{frame}\begin{frame}

Do[is=Position[faces,#][[1,1]]& /@ List@@x;
A[[is,is]]+=If[Head[x]===(SubPlus[X]),
(({{v, u, 1, u}, {u, 1, u, 1}, {1, u, v, u}, {u, 1, u, 1}})),-(({{v, u, 1, u}, {u, 1, u, 1}, {1, u, v, u}, {u, 1, u, 1}}))],
{x,XingsByArmpits}];

\end{frame}\begin{frame}

x=XingsByArmpits[[1]]

faces

is=Position[faces,#][[1,1]]& /@ List@@x

\end{frame}\begin{frame}
\parbox{0.5\linewidth}{

A[[is,is]]+=If[Head[x]===(SubPlus[X]),
(({{v, u, 1, u}, {u, 1, u, 1}, {1, u, v, u}, {u, 1, u, 1}})),-(({{v, u, 1, u}, {u, 1, u, 1}, {1, u, v, u}, {u, 1, u, 1}}))];
A//MatrixForm

}\hfill\parbox{1.5in}{Recall, $is=\{8,10,2,9\}$}
\end{frame}\begin{frame}

Do[is=Position[faces,#][[1,1]]& /@ List@@x;
A[[is,is]]+=If[Head[x]===(SubPlus[X]),
(({{v, u, 1, u}, {u, 1, u, 1}, {1, u, v, u}, {u, 1, u, 1}})),-(({{v, u, 1, u}, {u, 1, u, 1}, {1, u, v, u}, {u, 1, u, 1}}))],
{x,Rest@XingsByArmpits}]

\end{frame}\begin{frame}

A//MatrixForm

\end{frame}\begin{frame}

Plot[ω=(E^(I t)); u=Re[(ω^(1/2))]; v=Re[ω];
(MatrixSignature[A]-Writhe[K])/2,
{t,0,2π}]

\end{frame}\begin{frame}

Plot[Bed[Knot[8,2],(E^(I t))],{t,0,2π}]

\end{frame}