Pensieve header: Mathematica notebook for Talks: Beijing-2407.

Ancestors in Projects/HigherRank.

nb2tex$TeXFileName = "IType1.tex";

SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\Beijing-2407"];

Preliminaries

This is IType.nb of \web{ap}.

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

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

\vskip 1mm\rule{\linewidth}{1pt}\vspace{-2mm}

Integration

Using Picard Iteration!

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

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

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

\parpic[r]{\parbox{0.75in}{
  \includegraphics[width=0.75in]{../../Projects/Gallery/Fourier.jpg}
  \footnotesize Joseph Fourier
}}
\picskip{2}

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

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

\needspace{12mm}

∫ℱ 𝔼[-I ξ x] \[DifferentialD]{ξ}

So we’ve tested and nearly proven the Fourier inversion formula!

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])}

\parpic[r]{\parbox{0.65in}{
  \includegraphics[width=0.65in]{../../Projects/Gallery/Fubini.jpg}
  \scriptsize Guido Fubini
}}
\picskip{2}

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

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

\vskip 1mm
From \surl{oeis.org/A226260}:
\vskip 1mm
\includegraphics[width=\linewidth]{../Groningen-240530/OEIS.png}

\vskip -3mm\rule{\linewidth}{1pt}\vspace{-2mm}

The Right-Handed Trefoil

K=Mirror@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_]:=Join@@Table[{(Subscript[p, i]),(Subscript[x, i])},{i,Features[K][[1]]}]

nb2tex$PDFWidth*=1.25;

\needspace{5cm}

{vs[K],ℒ[K]}

nb2tex$PDFWidth/=1.25;

\needspace{10mm}

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

∫(ℒ[K]/.(Subscript[x, i_]):>I (Subscript[x, i]))\[DifferentialD](vs@K)

\vskip 1mm\rule{\linewidth}{1pt}\vspace{2mm}
%\newcolumn

Invariance Under Reidemeister 3

\def\ip{{i^+}} \def\jp{{j^+}} \def\kp{{k^+}}
\def\ipp{{i^{+\!+}}} \def\jpp{{j^{+\!+}}} \def\kpp{{k^{+\!+}}}
\import{../Groningen-240530}{figs/R3.pdf_t}

lhs=∫(ℒ/@((Subscript[X, i,j])[1](Subscript[X, i+1,k])[1](Subscript[X, j+1,k+1])[1]))\[DifferentialD]{(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+1]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[p, k+1]),(Subscript[x, j+1]),(Subscript[x, k+1])};
lhs===rhs

\vskip 1mm\rule{\linewidth}{1pt}\vspace{2mm}

Invariance Under Reidemeister 3, Take 2

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

\newcolumn

Invariance Under Reidemeister 3, Take 3

nb2tex$PDFWidth*=1.25;

lhs=∫(𝔼[I (Subscript[π, i])(Subscript[p, i])+I (Subscript[π, j])(Subscript[p, j])+I (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=∫(𝔼[I (Subscript[π, i])(Subscript[p, i])+I (Subscript[π, j])(Subscript[p, j])+I (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

\needspace{20mm}

lhs

nb2tex$PDFWidth/=1.25;

Invariance under the other Reidemeister moves is proven in a similar way. See IType.nb at \web{ap}.

Invariance Under Reidemeister 3, Take 4 (just for fun)

lhs=∫(𝔼[I (Subscript[π, i])(Subscript[p, i])+I (Subscript[π, j])(Subscript[p, j])+I (Subscript[π, k])(Subscript[p, k])+I (Subscript[π, i+2])(Subscript[p, i+2])+I (Subscript[π, j+2])(Subscript[p, j+2])+I (Subscript[π, k+2])(Subscript[p, k+2])+I (Subscript[ξ, i+2])(Subscript[x, i+2])+I (Subscript[ξ, j+2])(Subscript[x, j+2])+I (Subscript[ξ, k+2])(Subscript[x, k+2])]ℒ/@((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]),(Subscript[p, i+2]),(Subscript[p, j+2]),(Subscript[p, k+2]),(Subscript[x, i+2]),(Subscript[x, j+2]),(Subscript[x, k+2])};
rhs=∫(𝔼[I (Subscript[π, i])(Subscript[p, i])+I (Subscript[π, j])(Subscript[p, j])+I (Subscript[π, k])(Subscript[p, k])+I (Subscript[π, i+2])(Subscript[p, i+2])+I (Subscript[π, j+2])(Subscript[p, j+2])+I (Subscript[π, k+2])(Subscript[p, k+2])+I (Subscript[ξ, i+2])(Subscript[x, i+2])+I (Subscript[ξ, j+2])(Subscript[x, j+2])+I (Subscript[ξ, k+2])(Subscript[x, k+2])]ℒ/@((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]),(Subscript[p, i+2]),(Subscript[p, j+2]),(Subscript[p, k+2]),(Subscript[x, i+2]),(Subscript[x, j+2]),(Subscript[x, k+2])};
lhs==rhs

lhs

Invariance Under Reidemeister 2b

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

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

Invariance Under R2c

lhs=∫𝔼[I (Subscript[π, i])(Subscript[p, i])+I (Subscript[π, j])(Subscript[p, j])]ℒ/@((Subscript[X, i+1,j])[1](Subscript[X, i,j+2])[-1](Subscript[C, j+1])[1])\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[x, j+2]),(Subscript[p, j+2])}
rhs=∫𝔼[I (Subscript[π, i])(Subscript[p, i])+I (Subscript[π, j])(Subscript[p, 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[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[x, j+2]),(Subscript[p, j+2])};
lhs==rhs

Invariance Under R1l

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

Invariance Under R1r

lhs=∫𝔼[I (Subscript[π, i])(Subscript[p, i])]ℒ/@((Subscript[X, i,i+2])[1](Subscript[C, i+1])[-1])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i]),(Subscript[x, i+1]),(Subscript[p, i+1]),(Subscript[x, i+2]),(Subscript[p, i+2])}
rhs=∫𝔼[I (Subscript[π, i])(Subscript[p, i])]ℒ/@((Subscript[C, i])[0](Subscript[C, i+1])[0](Subscript[C, i+2])[0])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i]),(Subscript[x, i+1]),(Subscript[p, i+1]),(Subscript[x, i+2]),(Subscript[p, i+2])};
lhs==rhs

Invariance Under Sw

lhs=∫𝔼[I (Subscript[π, i])(Subscript[p, i])+I (Subscript[π, j])(Subscript[p, 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[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[x, i+2]),(Subscript[p, i+2]),(Subscript[x, j+2]),(Subscript[p, j+2])}
rhs=∫𝔼[I (Subscript[π, i])(Subscript[p, i])+I (Subscript[π, j])(Subscript[p, 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[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[x, i+2]),(Subscript[p, i+2]),(Subscript[x, j+2]),(Subscript[p, j+2])};
lhs==rhs