Pensieve header:  May 14, 2026 experiments: R3 fails without the wisdom projection - probably meaning that not every to-$\epsilon$ solution extends to a to-$\epsilon^2$ solution.

Initialization

SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\Bonn-2505"];
Once[<<KnotTheory`; <<Rot.m];

CF[ω_.ℰ_𝔼]:=CF[ω]CF/@ℰ;
CF[ℰ_List]:=CF/@ℰ;
CF[ℰ_] := Module[{vs,ps,c},
vs=Cases[ℰ,(Subscript[(x|p|ξ|π|g), __]),∞]⋃{ϵ};
Total[CoefficientRules[Expand[ℰ], vs] /. (ps_->c_) :> Factor[c](Times@@(vs^ps))] ];

𝔼/:𝔼[A_]𝔼[B_]:=𝔼[A+B];

$π=Identity; (* The Wisdom Projection *)

Unprotect[Integrate];
∫ω_.𝔼[L_]\[DifferentialD](vs_List):=Module[{n,L0,Q,Δ,G,Z0,Z,λ,DZ,DDZ,FZ,a,b},
n=Length@vs; L0=L/.ϵ->0;
Q=Table[(-(∂_(vs[[a]],vs[[b]]))L0)/.Thread[vs->0]/.(Subscript[(p|x), __])->0,{a,n},{b,n}];
If[(Δ=Det[Q])==0,Return@"Degenerate Q!"];
Z=Z0=CF@$π[L+vs.Q.vs/2]; G=Inverse[Q];
FixedPoint[(DZ=Table[(∂_v)Z,{v,vs}];
DDZ=Table[(∂_u)DZ,{u,vs}];
FZ=Sum[G[[a,b]](DDZ[[a,b]]+DZ[[a]]DZ[[b]]),{a,n},{b,n}]/2;
Z=CF[Z0+(∫_0^λ)$π[FZ] \[DifferentialD]λ])&,Z];
PowerExpand@Factor[ω (Δ^(-1/2))]𝔼[CF[Z/.λ->1/.Thread[vs->0]]]];
Protect[Integrate];

(Subscript[T, 3])=(Subscript[T, 1])(Subscript[T, 2]);  (SuperPlus[i_]):=i+1;
$π=(CF@Normal[#+((O[ϵ])^2)]/. {(Subscript[π, is__]):>(B^(-1))(Subscript[π, is]),(Subscript[x, is__]):>(B^(-1))(Subscript[x, is]),(Subscript[p, is__]):>B (Subscript[p, is])}/.ϵ (B^(b_))/;b<0->0/.B->1)&;

(Subscript[vs, i_]):=Sequence[(Subscript[p, 1,i]),(Subscript[p, 2,i]),(Subscript[p, 3,i]),(Subscript[x, 1,i]),(Subscript[x, 2,i]),(Subscript[x, 3,i])];
ℱ[is__]:=𝔼[Sum[(Subscript[π, ν,i])(Subscript[p, ν,i]),{i,{is}}, {ν,3}]];
ℒ[K_]:=CF[ℒ/@Features[K][[2]]];
vs[K_] := Union@@Table[{(Subscript[vs, i])},{i,Features[K][[1]]}]

The Lagrangian

\needspace{30mm}
{\bf\red The Lagrangian.}

nb2tex$PDFWidth *= 1.25;

ℒ[(Subscript[X, i_,j_])[s_]]:=(Subscript[T, 3]^s)𝔼[CF@Plus[
(∑_(ν=1)^3)((Subscript[x, ν,i])((Subscript[p, ν,(SuperPlus[i])])-(Subscript[p, ν,i]))+(Subscript[x, ν,j])((Subscript[p, ν,(SuperPlus[j])])-(Subscript[p, ν,j]))+((Subscript[T, ν]^s)-1)(Subscript[x, ν,i])((Subscript[p, ν,(SuperPlus[i])])-(Subscript[p, ν,(SuperPlus[j])]))),
((Subscript[T, 1]^s)-1)(Subscript[p, 3,j])(Subscript[x, 1,i])((Subscript[T, 2]^s)(Subscript[x, 2,i])-(Subscript[x, 2,j])),
ϵ s((Subscript[T, 3]^s)-1)(Subscript[p, 1,j])((Subscript[p, 2,i])-(Subscript[p, 2,j]))(Subscript[x, 3,i])/((Subscript[T, 2]^s)-1),
ϵ s(1/2+(Subscript[T, 2]^s)(Subscript[p, 1,i])(Subscript[p, 2,j])(Subscript[x, 1,i])(Subscript[x, 2,i])-(Subscript[p, 1,i])(Subscript[p, 2,j])(Subscript[x, 1,i])(Subscript[x, 2,j])-(Subscript[p, 3,i])(Subscript[x, 3,i])-((Subscript[T, 2]^s)-1)(Subscript[p, 2,j])(Subscript[p, 3,i])(Subscript[x, 2,i])(Subscript[x, 3,i])+((Subscript[T, 3]^s)-1)(Subscript[p, 2,j])(Subscript[p, 3,j])(Subscript[x, 2,i])(Subscript[x, 3,i])+2 (Subscript[p, 2,j])(Subscript[p, 3,i])(Subscript[x, 2,j])(Subscript[x, 3,i])+(Subscript[p, 1,i])(Subscript[p, 3,j])(Subscript[x, 1,i])(Subscript[x, 3,j])-(Subscript[p, 2,i])(Subscript[p, 3,j])(Subscript[x, 2,i])(Subscript[x, 3,j])-(Subscript[T, 2]^s)(Subscript[p, 2,j])(Subscript[p, 3,j])(Subscript[x, 2,i])(Subscript[x, 3,j])+(((Subscript[T, 1]^s)-1)(Subscript[p, 1,j])(Subscript[x, 1,i])((Subscript[T, 2]^(2s))(Subscript[p, 2,j])(Subscript[x, 2,i])-(Subscript[T, 2]^s)(Subscript[p, 2,j])(Subscript[x, 2,j])-((Subscript[T, 2]^s)+1)((Subscript[T, 3]^s)-1)(Subscript[p, 3,j])(Subscript[x, 3,i])+(Subscript[T, 2]^s)(Subscript[p, 3,j])(Subscript[x, 3,j]))+((Subscript[T, 3]^s)-1)(Subscript[p, 3,j])(Subscript[x, 3,i])(1-(Subscript[T, 2]^s)(Subscript[p, 1,i])(Subscript[x, 1,i])+(Subscript[p, 2,i])(Subscript[x, 2,j])+((Subscript[T, 2]^s)-2)(Subscript[p, 2,j])(Subscript[x, 2,j])))/((Subscript[T, 2]^s)-1))]]

ℒ[(Subscript[C, i_])[φ_]]:=(Subscript[T, 3]^φ)𝔼[(∑_(ν=1)^3)(Subscript[x, ν,i])((Subscript[p, ν,(SuperPlus[i])])-(Subscript[p, ν,i]))+ϵ φ((Subscript[p, 3,i])(Subscript[x, 3,i])-1/2)]

nb2tex$PDFWidth /= 1.25;

Reidemeister 3

{\bf\red Reidemeister 3.}

Short[lhs=∫ℱ[i,j,k]ℒ/@((Subscript[X, i,j])[1](Subscript[X, (SuperPlus[i]),k])[1](Subscript[X, (SuperPlus[j]),(SuperPlus[k])])[1])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, j]),(Subscript[vs, k]),(Subscript[vs, (SuperPlus[i])]),(Subscript[vs, (SuperPlus[j])]),(Subscript[vs, (SuperPlus[k])])}]

rhs=∫ℱ[i,j,k]ℒ/@((Subscript[X, j,k])[1](Subscript[X, i,(SuperPlus[k])])[1](Subscript[X, (SuperPlus[i]),(SuperPlus[j])])[1])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, j]),(Subscript[vs, k]),(Subscript[vs, (SuperPlus[i])]),(Subscript[vs, (SuperPlus[j])]),(Subscript[vs, (SuperPlus[k])])};lhs==rhs

$π=(CF@Normal[#+((O[ϵ])^2)])&;

Short[lhs=∫ℱ[i,j,k]ℒ/@((Subscript[X, i,j])[1](Subscript[X, (SuperPlus[i]),k])[1](Subscript[X, (SuperPlus[j]),(SuperPlus[k])])[1])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, j]),(Subscript[vs, k]),(Subscript[vs, (SuperPlus[i])]),(Subscript[vs, (SuperPlus[j])]),(Subscript[vs, (SuperPlus[k])])}]

rhs=∫ℱ[i,j,k]ℒ/@((Subscript[X, j,k])[1](Subscript[X, i,(SuperPlus[k])])[1](Subscript[X, (SuperPlus[i]),(SuperPlus[j])])[1])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, j]),(Subscript[vs, k]),(Subscript[vs, (SuperPlus[i])]),(Subscript[vs, (SuperPlus[j])]),(Subscript[vs, (SuperPlus[k])])};lhs==rhs

diff=CF[lhs[[3,1]]-rhs[[3,1]]]/. {(Subscript[π, is__]):>B (Subscript[π, is]),(Subscript[x, is__]):>B (Subscript[x, is]),(Subscript[p, is__]):>(B^(-1)) (Subscript[p, is])}

{diff/.ϵ->0, diff/.B->0}

The Trefoil

\needspace{25mm}
\parpic[r]{\includegraphics[width=0.6in]{../Beijing-2407/Trefoil.jpg}}
{\bf\red The Trefoil.}

K=Knot[3,1]; ∫ℒ[K]\[DifferentialD] vs[K]

Invariance Under Reidemeister 2b

Territory: (Subscript[(x|p), (SuperPlus[(i|j)])]), (Subscript[x, i|j]).

lhs=∫ℱ[i,j]ℒ/@((Subscript[X, i,j])[1](Subscript[X, i+1,j+1])[-1])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, j]),(Subscript[vs, (SuperPlus[i])]),(Subscript[vs, (SuperPlus[j])])}
rhs=∫ℱ[i,j]ℒ/@((Subscript[C, i])[0](Subscript[C, i+1])[0](Subscript[C, j])[0](Subscript[C, j+1])[0])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, j]),(Subscript[vs, (SuperPlus[i])]),(Subscript[vs, (SuperPlus[j])])};
lhs==rhs

Invariance Under R2c

lhs=∫ℱ[i,j]ℒ/@((Subscript[X, i+1,j])[1](Subscript[X, i,j+2])[-1](Subscript[C, j+1])[1])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, j]),(Subscript[vs, (SuperPlus[i])]),(Subscript[vs, (SuperPlus[j])]),(Subscript[vs, j+2])}
rhs=∫ℱ[i,j]ℒ/@((Subscript[C, i])[0](Subscript[C, i+1])[0](Subscript[C, j])[0](Subscript[C, j+1])[1](Subscript[C, j+2])[0])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, j]),(Subscript[vs, (SuperPlus[i])]),(Subscript[vs, (SuperPlus[j])]),(Subscript[vs, j+2])};
lhs==rhs

Invariance Under R1l

lhs=∫ℱ[i]ℒ/@((Subscript[X, i+2,i])[1](Subscript[C, i+1])[1])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, (SuperPlus[i])]),(Subscript[vs, i+2])}
rhs=∫ℱ[i]ℒ/@((Subscript[C, i])[0](Subscript[C, i+1])[0](Subscript[C, i+2])[0])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, (SuperPlus[i])]),(Subscript[vs, i+2])};
lhs==rhs

Invariance Under R1r

lhs=∫ℱ[i]ℒ/@((Subscript[X, i,i+2])[1](Subscript[C, i+1])[-1])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, (SuperPlus[i])]),(Subscript[vs, i+2])}
rhs=∫ℱ[i]ℒ/@((Subscript[C, i])[0](Subscript[C, i+1])[0](Subscript[C, i+2])[0])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, (SuperPlus[i])]),(Subscript[vs, i+2])};
lhs==rhs

Invariance Under Sw

lhs=∫ℱ[i,j]ℒ/@((Subscript[X, i+1,j+1])[1](Subscript[C, i])[-1](Subscript[C, j])[-1](Subscript[C, i+2])[1](Subscript[C, j+2])[1])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, j]),(Subscript[vs, (SuperPlus[i])]),(Subscript[vs, (SuperPlus[j])]),(Subscript[vs, i+2]),(Subscript[vs, j+2])}
rhs=∫ℱ[i,j]ℒ/@((Subscript[X, i+1,j+1])[1](Subscript[C, i])[0](Subscript[C, j])[0](Subscript[C, i+2])[0](Subscript[C, j+2])[0])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, j]),(Subscript[vs, (SuperPlus[i])]),(Subscript[vs, (SuperPlus[j])]),(Subscript[vs, i+2]),(Subscript[vs, j+2])};
lhs==rhs