Pensieve header: Playing with fibered knots.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\Theta"];
<< Theta.m

Loading the fibered-knots data obtained from https://knotinfo.org/:

FiberedKnots=Cases[
Import["C:\\drorbn\\AcademicPensieve\\Projects\\Theta\\FiberedInfoFromKnotInfo.org.csv"],
{K_,"Y"}:>Knot@K,
∞]

MemberQ[Knot[12,NonAlternating,57],FiberedKnots]

Θ@Knot[12,NonAlternating,57]

PolyPlot@Θ@Knot[12,NonAlternating,57]

Length@FiberedKnots

Length@AllKnots[{3,13}]

K=Last[FiberedKnots]

Θ[K]

d=Exponent[Θ[K][[1]],T]

Factor[((Coefficient[Θ[K][[2]],(Subscript[T, 2]^(2d))]/.(Subscript[T, 1])->T)/(Θ[K][[1]](T^d)))]

Monitor[
Union@Table[
g=Exponent[Θ[K][[1]],T]; q=Coefficient[Θ[K][[1]],(T^g)],
{K,FiberedKnots⋂AllKnots[{3,13}]}
],{K,q}]

Monitor[
Table[
d=Exponent[Θ[K][[1]],T]; q=Factor[((Coefficient[Θ[K][[2]],(Subscript[T, 2]^(2d))]/.(Subscript[T, 1])->T)/(Θ[K][[1]](T^d)))],
{K,FiberedKnots⋂AllKnots[{3,13}]}
],{K,q}]

Monitor[
Total@Table[
d=Exponent[Θ[K][[1]],T]; q=Factor[((Coefficient[Θ[K][[2]],(Subscript[T, 2]^(2d))]/.(Subscript[T, 1])->T)/(Θ[K][[1]](T^d)))];
2q==KnotSignature@K,
{K,FiberedKnots⋂AllKnots[{3,13}]}
],{K,q}]

Length[Complement[AllKnots[{3,13}],FiberedKnots]]

Length@Select[Complement[AllKnots[{3,13}],FiberedKnots],(
d=Exponent[Θ[#][[1]],T];
!NumberQ[Factor[((Coefficient[Θ[#][[2]],(Subscript[T, 2]),2d]/.(Subscript[T, 1])->T)/(Θ[#][[1]](T^d)))]]
)&]

Select[Complement[AllKnots[{3,13}],FiberedKnots],(
d=Exponent[Θ[#][[1]],T];
NumberQ[Factor[((Coefficient[Θ[#][[2]],(Subscript[T, 2]),2d]/.(Subscript[T, 1])->T)/(Θ[#][[1]](T^d)))]]
)&]

PolyPlot[Θ[#], ImageSize->Tiny]& /@ Select[Complement[AllKnots[{3,13}],FiberedKnots],(
d=Exponent[Θ[#][[1]],T];
NumberQ[Factor[((Coefficient[Θ[#][[2]],(Subscript[T, 2]),2d]/.(Subscript[T, 1])->T)/(Θ[#][[1]](T^d)))]]
)&]

Monitor[
Last@Reap@Table[
g=Exponent[Θ[K][[1]],T];
If[Abs[Coefficient[Θ[K][[1]],T,g]]==1,
 q=Factor[((Coefficient[Θ[K][[2]],(Subscript[T, 2]),2g]/.(Subscript[T, 1])->T)/(Θ[K][[1]](T^g)))];
If[Not@NumberQ[q],Sow@Echo@K]
],
{K,Complement[AllKnots[{3,13}],FiberedKnots]}
],{K,q}]

Θ[Knot["K12n242"]]

Public domain P(-2,3,7) image from https://en.wikipedia.org/wiki/(%E2%88%922,3,7)_pretzel_knot

ThetaK12n242=ImageCompose[PolyPlot[Θ[Knot["K12n242"]], ImageSize->480],
ImageResize[,240],{Right,Bottom},{Right,Bottom}]

Export["figs/ThetaK12n242.pdf",ThetaK12n242]

ThetaK7a7=ImageCompose[PolyPlot[Θ[Knot[7,7]], ImageSize->480],
ImageResize[,240],{Right,Bottom},{Right,Bottom}]

Export["figs/ThetaK7a7.pdf",ThetaK7a7]

{Δ0,θ0}=Θ[Knot["K12n242"]];

PolyPlot2[(Δ0/.T->(Subscript[T, 1]))(Δ0/.T->(Subscript[T, 2]))(Δ0/.T->(Subscript[T, 3]))]

PolyPlot2[θ0-5(Δ0/.T->(Subscript[T, 1]))(Δ0/.T->(Subscript[T, 2]))(Δ0/.T->(Subscript[T, 3]))]