結び目のジョーンズ多項式の計算プログラム

ジョーンズ多項式を求める．（ここではあえてFor 文，If 文を多用した．）
(* Computing the Jones Polynomials of oriented links *)
Link ; L ; A ; t ;BoltmanWeight ; Writhe ; JonesPoly ; Jones ; LQ1; LQ2; LQ ;

Marking[L_Link,k_,l_]:=IntegerDigits[k,2,Length[L]][[l]];

StateEdges[L_Link,k_]:=
Flatten[Table[
Switch[Marking[L,k,i],
0,{Sort[{L[[i]][[1]],L[[i]][[2]]}], Sort[{L[[i]][[3]],L[[i]][[4]]}]},
1,{Sort[{L[[i]][[1]],L[[i]][[4]]}], Sort[{L[[i]][[2]],L[[i]][[3]]}]},
_,{0}],{i,Length[L]}],1];

Chains[bb_]:=
Block[{b,c,d},
For[b=bb; k=1,k <= Length[bb],k++,
For[d={};i=1,i <= Length[b],i++,
For[c={};
j=i+1, j <= Length[b],j++,
If[
Length[ Intersection[ b[[i]], b[[j]] ] ] > 0,
c=Union[ c,b[[i]],b[[j]] ]
]
];
If[
Length[c]>0,
d=AppendTo[d,Sort[c] ],
d=AppendTo[ d,Sort[b[[i]]]]
]
];
b=Union[Sort[d]]
]; b
];

StateDepth[L_Link,k_] := Length[Chains[StateEdges[L,k]]];

BoltmanWeight[L_Link,k_]:=(-A^2-A^{-2})^{StateDepth[L,k] -1}*
A^{Count[IntegerDigits[k,2,Length[L]],0]-
Count[IntegerDigits[k,2,Length[L]],1]};

KauffmanBracket[L_Link]:=
Expand[Sum[BoltmanWeight[L,k],{k,1,2^Length[L]}]];

Writhe[L_Link]:=
Block[{s},
For[s=0;i=1,i <= Length[L],i++,
If[L[[i]][[2]]-L[[i]][[4]] == 1||L[[i]][[4]]-L[[i]][[2]]>1,
s=s+1];
If[L[[i]][[2]]-L[[i]][[4]] == -1||L[[i]][[4]]-L[[i]][[2]]<-1,
s=s-1]];s
];

JonesPoly[L_Link]:=
Flatten[Expand[(-A^3)^{-Writhe[L]}*KauffmanBracket[L]]];
Jones[L_Link]:=
Flatten[Expand[JonesPoly[L]/.A\[Rule]Sqrt[t]^{-1/2}]];

(* Examples *)
trefoil=Link[X[1,5,2,4],X[5,3,6,2],X[3,1,4,6]];

計算実験

　（１） StateEdges[trefoil,3]

右手系クローバー結び目の射影図式 trefoil の，３番目のステート（ステート３）において，
各頂点での切り方の情報（A marker ，B marker のいずれか）のリストを見る．

　（２） Chains[StateEdges[trefoil,3]]

切り方の情報を元に辺を繋げていく．つまり，ステート３の各連結成分を，
その成分を構成する辺のリストとして表す．
そうしたリストをすべて集めてリストにして出力する．関数 Chains の説明

　（３） StateDepth[trefoil,3]

ステート３の連結成分の個数の値を返す．

　（４） BoltmanWeight[trefoil,3]

ステート３のボルツマンウエイトの積（d の |S|-1 乗× Wc(S) の積）を出力する．

　（５） Table[Chains[StateEdges[trefoil,i]],{i,2^3}]

射影図式 trefoil のすべてのステートについて（２）の情報を調べ，リストで返す．

　（６） Table[StateDepth[trefoil,i] ,{i,2^3}]

射影図式 trefoil のすべてのステートについて（３）の情報を調べ，リストで返す．

　（７） KauffmanBracket[trefoil]

射影図式 trefoil のブラケット多項式を出力する．

　（８） Writhe[trefoil]

射影図式 trefoil の交点符号和を出力する．

　（９） JonesPoly[trefoil]

右手系クローバー結び目のジョーンズ多項式を A の多項式として出力する．

（１０） Jones[trefoil]

右手系クローバー結び目のジョーンズ多項式を t^{1/2} の多項式として出力する．

（１１） Timing[Jones[trefoil]]

計算（１０）とその計算時間を表示させる．

（１２）絡み目の場合：
Hopfplus=Link[X[5,1,6,4],X[1,7,2,6],X[2,7,3,8],X[3,5,4,8]];

Jones[Hopfplus]

絡み数＋１のホップ絡み目のジョーンズ多項式を出力する．