Pensieve header: Demo of NOE-0 and NOE-1t for MIT-1612, using vcw conventions

SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\MIT-1612"];

NOE-0

(Subscript[R, 0,i_,j_]^(+)):=𝔼[(Subscript[b, i])(Subscript[c, j])+(Subscript[b, i]^(-1))((E^(Subscript[b, i]))-1)(Subscript[u, i])(Subscript[w, j])]; (Subscript[R, 0,i_,j_]^(-)):=𝔼[-(Subscript[b, i])(Subscript[c, j])+(Subscript[b, i]^(-1))((E^(-(Subscript[b, i])))-1)(Subscript[u, i])(Subscript[w, j])];

CF[ω_.𝔼[Q_]] := Simplify[ω]𝔼[Simplify[Q]];
𝔼 /: 𝔼[Q1_]𝔼[Q2_] := CF@𝔼[Q1+Q2];
ω1_.𝔼[Q1_] ≡ ω2_.𝔼[Q2_] := Simplify[ω1==ω2∧Q1==Q2];

(Subscript[N, (Subscript[(x:w|u), i_])(Subscript[c, j_])->k_])[ω_.𝔼[Q_]] := CF[
ω 𝔼[(E^γ)α (Subscript[x, k])+γ (Subscript[c, k])+(Q/.(Subscript[c, j])|(Subscript[x, i])->0)]/.{γ->(∂_(Subscript[c, j]))Q,α->(∂_(Subscript[x, i]))Q}];
(Subscript[N, (Subscript[w, i_])(Subscript[u, j_])->k_])[ω_.𝔼[Q_]] := CF[
ν ω 𝔼[-(Subscript[b, k])ν α β+ν β (Subscript[u, k])+ν α (Subscript[w, k])+ν δ (Subscript[u, k])(Subscript[w, k]) +(Q/.(Subscript[w, i])|(Subscript[u, j])->0)] /. ν-> (((1+(Subscript[b, k]) δ))^(-1)) /. {α->(∂_(Subscript[w, i]))Q/.(Subscript[u, j])->0, β->(∂_(Subscript[u, j]))Q/.(Subscript[w, i])->0, δ->(∂_((Subscript[w, i]),(Subscript[u, j])))Q}];

(Subscript[m, i_,j_->k_])[Z_]:=Module[{x,z},
CF[(Z//(Subscript[N, (Subscript[w, i])(Subscript[u, j])->x])//(Subscript[N, (Subscript[c, i])(Subscript[u, x])->x])//(Subscript[N, (Subscript[w, x])(Subscript[c, j])->x]))/.(Subscript[z_, i|j|x])->(Subscript[z, k])]]

(Subscript[T, 0])=(Subscript[R, 0,5,1]^(+))(Subscript[R, 0,2,4]^(+))(Subscript[R, 0,3,6]^(-))

(Subscript[T, 0])//(Subscript[m, 1,2->1])//(Subscript[m, 3,4->3])//(Subscript[m, 3,5->3])//(Subscript[m, 3,6->3])

Q0=𝔼[Sum[(Subscript[f, i])(Subscript[c, i]),{i,3}]+Sum[(Subscript[f, i,j])(Subscript[u, i])(Subscript[w, j]),{i,3},{j,3}]]

Q0//(Subscript[N, (Subscript[w, 1])(Subscript[u, 2])->3])

Q0 // (Subscript[m, 1,2->1])

(Q0//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]))≡(Q0//(Subscript[m, 2,3->2])//(Subscript[m, 1,2->1]))

t1=(Subscript[R, 0,1,2]^(+))(Subscript[R, 0,3,4]^(+))(Subscript[R, 0,5,6]^(+))//(Subscript[m, 3,5->x])//(Subscript[m, 1,6->y])//(Subscript[m, 2,4->z])

t1≡((Subscript[R, 0,1,2]^(+))(Subscript[R, 0,3,4]^(+))(Subscript[R, 0,5,6]^(+))//(Subscript[m, 1,3->x])//(Subscript[m, 2,5->y])//(Subscript[m, 4,6->z]))

z1=(Subscript[R, 0,12,1]^(-))(Subscript[R, 0,2,7]^(-))(Subscript[R, 0,8,3]^(-))(Subscript[R, 0,4,11]^(-))(Subscript[R, 0,16,5]^(+))(Subscript[R, 0,6,13]^(+))(Subscript[R, 0,14,9]^(+))(Subscript[R, 0,10,15]^(+));
Do[z1=(z1//(Subscript[m, 1,n->1]))/.(Subscript[b, _])->b,{n,2,16}];
{CF@z1, KnotData[{8,17}, "AlexanderPolynomial"][t]}

NOE-1t

Λ[k_]:= (((Subscript[t, k])-1)(2(((α β+δ μ))^2)-(α^2)(β^2))-4(Subscript[v, k])(Subscript[c, k])(Subscript[w, k])(δ^2)(μ^2)-
δ(1+μ)((Subscript[w, k]^2)(α^2)+(Subscript[v, k]^2)(β^2))-(Subscript[v, k]^2)(Subscript[w, k]^2)(δ^3)(1+3μ)-2(α β+2δ μ+(Subscript[v, k])(Subscript[w, k])(δ^2)(1+2μ)+2(Subscript[c, k])δ (μ^2))((Subscript[w, k])α+(Subscript[v, k])β)-4((Subscript[c, k])(μ^2)+(Subscript[v, k])(Subscript[w, k])δ(1+μ))(α β+δ μ))(1+(Subscript[t, k]))/4;

(Subscript[R, i_,j_]^(+)):=𝔼[1,Log[(Subscript[t, i])](Subscript[c, j]),(Subscript[v, i])(Subscript[w, j]),(Subscript[v, i])(Subscript[c, i])(Subscript[w, j])+(Subscript[c, i])(Subscript[c, j])+(Subscript[v, i]^2)(Subscript[w, j]^2)/4];
(Subscript[R, i_,j_]^(-)):=𝔼[1,-Log[(Subscript[t, i])](Subscript[c, j]),-(Subscript[t, i]^(-1))(Subscript[v, i])(Subscript[w, j]),(Subscript[t, i]^(-1))(Subscript[v, i])(Subscript[c, j])(Subscript[w, j])-(Subscript[c, i])(Subscript[c, j])-(Subscript[t, i]^(-2))(Subscript[v, i]^2)(Subscript[w, j]^2)/4];
((Subscript[ur, i_]):=𝔼[(Subscript[t, i]^(-1/2)),0,0,(Subscript[c, i])(Subscript[t, i]^(-2))]; (Subscript[nr, i_]):=𝔼[(Subscript[t, i]^(1/2)),0,0,-(Subscript[c, i])(Subscript[t, i]^2)];)

(Subscript[DP, x_->(Subscript[D, α_]),y_->(Subscript[D, β_])])[P_][f_]:= (* means P[(∂_α),(∂_β)][f] *)
Total[CoefficientRules[P,{x,y}]/.({m_,n_}->c_):>c D[f,{α,m},{β,n}]]

CF[ℰ_𝔼]:=Expand/@Together/@ℰ;
𝔼/:𝔼[ω1_,L1_,Q1_,P1_]𝔼[ω2_,L2_,Q2_,P2_]:=CF@𝔼[ω1 ω2,L1+L2,ω2 Q1+ω1 Q2,((ω2)^4)P1+((ω1)^4)P2];

(Subscript[N, (Subscript[w, i_])(Subscript[v, j_])->k_])[𝔼[ω_,L_,Q_,P_]]:=With[{q=((1-(Subscript[t, k]))α β+β (Subscript[v, k])+α (Subscript[w, k])+δ (Subscript[v, k])(Subscript[w, k]))/μ},CF[
𝔼[μ ω,L,μ ω q+μ(Q/.(Subscript[w, i])|(Subscript[v, j])->0),(μ^4)(E^(-q))(Subscript[DP, (Subscript[w, i])->(Subscript[D, α]),(Subscript[v, j])->(Subscript[D, β])])[P][(E^q)]+(ω^4)Λ[k]]/.μ->1+((Subscript[t, k])-1)δ/.{α->(ω^(-1))((∂_(Subscript[w, i]))Q/.(Subscript[v, j])->0),β->(ω^(-1))((∂_(Subscript[v, j]))Q/.(Subscript[w, i])->0),δ->(ω^(-1))(∂_((Subscript[w, i]),(Subscript[v, j])))Q}]];

(Subscript[N, (Subscript[c, j_])(Subscript[(x:v|w), i_])->k_])[𝔼[ω_,L_,Q_,P_]]:=With[{q=(E^γ)β (Subscript[x, k])+γ (Subscript[c, k])},CF[
𝔼[ω,γ (Subscript[c, k])+(L/.(Subscript[c, j])->0),ω (E^γ)β (Subscript[x, k])+(Q/.(Subscript[x, i])->0),(E^(-q))(Subscript[DP, (Subscript[c, j])->(Subscript[D, γ]),(Subscript[x, i])->(Subscript[D, β])])[P][(E^q)]]/.{γ->(∂_(Subscript[c, j]))L,β->(ω^(-1))(∂_(Subscript[x, i]))Q}]];

(Subscript[m, i_,j_->k_])[Z_𝔼]:=Module[{x,z},
CF[(Z//(Subscript[N, (Subscript[w, i])(Subscript[v, j])->x])//(Subscript[N, (Subscript[c, i])(Subscript[v, x])->x])//(Subscript[N, (Subscript[w, x])(Subscript[c, j])->x]))/.(Subscript[z_, i|j|x])->(Subscript[z, k])]]

z2=(Subscript[R, 1,11]^(+))(Subscript[R, 4,2]^(-))(Subscript[nr, 3])(Subscript[R, 15,5]^(+))(Subscript[R, 6,8]^(-))(Subscript[ur, 7])(Subscript[R, 9,16]^(+))(Subscript[nr, 10])(Subscript[R, 12,14]^(-))(Subscript[ur, 13]);
(Do[z2=z2//(Subscript[m, 1,k->1]), {k,2,16}]; z2=z2 /. (Subscript[a_, 1]):>a)

Exporting the above as PDF files

The below is adapted from pensieve://2016-04/GaussGassner/GaussGassnerDemo.nb.

ConditionalExport[fname_String, rest___] := Module[{temp, exists},
temp="ConditionalExportTemporary"<>"."<>FileExtension[fname];
exists=FileExistsQ[fname];
Export[temp, rest];
If[exists && FileByteCount[fname]===FileByteCount[temp],
DeleteFile[temp],
(* else *) Print["Exporting "<>fname<>"..."];
If[exists, DeleteFile[fname]];
RenameFile[temp, fname]
];
fname
]

SetOptions[$FrontEndSession,PrintingStyleEnvironment->"Working"];
TagProperties[_] := {};
TagProperties["131"] = {PageWidth ->3.2/0.66};
Options[CellExport] = {
PageWidth -> 4/0.66, CellFilter -> Identity, ExportDirectory -> "Snips", ExportBaseFilename -> Automatic, ExportFormat -> ".pdf", ExportOptions -> {}, Split -> False
};
CellExport[tag_String, opts___Rule] := CellExport[
NotebookGet[EvaluationNotebook[]],
tag, opts
];
CellExport[nb_Notebook, tag_String] := CellExport[nb, tag, TagProperties[tag]];
CellExport[nb_Notebook, tag_String, OptionsPattern[]] := Module[
{cells, cell, filename, format},
filename = FileNameJoin[{
OptionValue[ExportDirectory] /. Automatic -> Directory[],
OptionValue[ExportBaseFilename] /. Automatic -> tag
}];
format=OptionValue[ExportFormat];
cells=OptionValue[CellFilter][Cases[
nb, c_Cell /; FreeQ[List@@c, Cell] && !FreeQ[c, CellTags->tag],
Infinity
]];
If[!OptionValue[Split],
If[Length[cells]≥1,
If[Length[cells]==1,
cells=Join[First[cells], Cell[PageWidth ->1.2 72OptionValue[PageWidth], Background->{White, Opacity[0]}]],
cells=Cell[CellGroup[cells], PageWidth -> 72OptionValue[PageWidth]]
];
ConditionalExport[
filename<>format,cells,
ImageResolution -> 300,
OptionValue[ExportOptions]
]
],
k=0;
Table[
++k;
ConditionalExport[
filename<>"-"<>ToString[k]<>format,
Append[cell, PageWidth -> 72OptionValue[PageWidth]],
ImageResolution -> 300,
OptionValue[ExportOptions]
],
{cell, cells}
]
]
];

ExportCells:=(
nb=NotebookGet[EvaluationNotebook[]];
tags=Cases[nb, (CellTags->tag_String) :> tag, Infinity ] // Union;
Print[tags];
CellExport /@ tags;
Print["Done."]
);

ExportCells