Pensieve header: Mathematica notebook for Talks: Groningen-240530.

Ancestors in Projects/HigherRank.

nb2tex$TeXFileName = "IType1.tex";

SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\Groningen-240530"];

Pensieve header: Implementing $\rho_1$, and also $\rho_d$.

Preliminaries

This is IType.nb of http://drorbn.net/g24/ap.

Once[<<KnotTheory`; <<Rot.m];

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

Integration

Using Picard Iteration!

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

$π=Identity; (* hacks in pink *)

Unprotect[Integrate];
∫ω_.𝔼[L_]\[DifferentialD](vs_List):=Module[{n,L0,Q,Δ,G,Z,e,λ,DZ,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=CF@$π[L+vs.Q.vs/2]; G=Inverse[Q];
(Subscript[DZ, a_]):=(∂_(vs[[a]]))Z; (Subscript[DZ, a_,b_]):=(∂_(vs[[b]]))(Subscript[DZ, a]);
While[e=CF@$π[
((∂_λ)Z)-(1/2)(∑_(a=1)^n)(∑_(b=1)^n)G[[a,b]]((Subscript[DZ, a,b])+(Subscript[DZ, a])(Subscript[DZ, b]))];
0=!=e,Z-=(∫_0^λ)e \[DifferentialD]λ
];
PowerExpand@Factor[ω (Δ^(-1/2))]𝔼[CF[Z/.λ->1/.Thread[vs->0]]]
];
Protect[Integrate];

∫𝔼[I μ (x^2)/2+I ξ x]\[DifferentialD]{x}

L=-(1/2){(Subscript[x, 1]),(Subscript[x, 2])}.(({{a, b}, {b, c}})).{(Subscript[x, 1]),(Subscript[x, 2])}+{(Subscript[ξ, 1]),(Subscript[ξ, 2])}.{(Subscript[x, 1]),(Subscript[x, 2])};
Z12=∫𝔼[L]\[DifferentialD]{(Subscript[x, 1]),(Subscript[x, 2])}

{Z1=∫𝔼[L]\[DifferentialD]{(Subscript[x, 1])}, Z12==∫Z1 \[DifferentialD]{(Subscript[x, 2])}}

$π=Normal[#+((O[ϵ])^13)]&; ∫𝔼[-(x^2)/2+ϵ (x^3)/6]\[DifferentialD]{x}

From \surl{oeis.org/A226260}:
\newline\includegraphics[width=\linewidth]{OEIS.png}

K=Knot[3,1]; Features[K]

ℒ[(Subscript[X, i_,j_])[s_]]:=(T^(s/2))𝔼[
(Subscript[x, i])((Subscript[p, i+1])-(Subscript[p, i]))+(Subscript[x, j])((Subscript[p, j+1])-(Subscript[p, j]))+ ((T^s)-1)(Subscript[x, i])((Subscript[p, i+1])-(Subscript[p, j+1]))
+((ϵ s)/2)((Subscript[x, i])((Subscript[p, i])-(Subscript[p, j]))(((T^s)-1)(Subscript[x, i])(Subscript[p, j])+2(1-(Subscript[x, j])(Subscript[p, j])))-1)];
ℒ[(Subscript[C, i_])[φ_]]:=(T^(φ/2))𝔼[(Subscript[x, i])((Subscript[p, i+1])-(Subscript[p, i]))+ϵ φ(1/2-(Subscript[x, i])(Subscript[p, i]))];
ℒ[K_]:=CF[ℒ/@Features[K][[2]]];
vs[K_] := Union@@Table[{(Subscript[p, i]),(Subscript[x, i])},{i,Features[K][[1]]}];

\needspace{5cm}

{vs[K],ℒ[K]}

$π=Normal[#+((O[ϵ])^2)]&;∫ℒ[K]\[DifferentialD](vs@K)

Invariance Under Reidemeister 3b

lhs=∫(ℒ/@((Subscript[X, i,j])[1](Subscript[X, i+1,k])[1](Subscript[X, j+1,k+1])[1]))\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[x, k]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[p, k+1]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[x, k+1])}
rhs=∫(ℒ/@((Subscript[X, j,k])[1](Subscript[X, i,k+1])[1](Subscript[X, i+1,j+1])[1]))\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[x, k]),(Subscript[x, i+1]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[p, k+1]),(Subscript[x, j+1]),(Subscript[x, k+1])};
lhs==rhs

lhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])+(Subscript[π, k])(Subscript[p, k])]ℒ/@((Subscript[X, i,j])[1](Subscript[X, i+1,k])[1](Subscript[X, j+1,k+1])[1]))\[DifferentialD]{(Subscript[p, i]),(Subscript[p, j]),(Subscript[p, k]),(Subscript[x, i]),(Subscript[x, j]),(Subscript[x, k]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[p, k+1]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[x, k+1])}
rhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])+(Subscript[π, k])(Subscript[p, k])]ℒ/@((Subscript[X, j,k])[1](Subscript[X, i,k+1])[1](Subscript[X, i+1,j+1])[1]))\[DifferentialD]{(Subscript[p, i]),(Subscript[p, j]),(Subscript[p, k]),(Subscript[x, i]),(Subscript[x, j]),(Subscript[x, k]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[p, k+1]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[x, k+1])};
lhs==rhs