Pensieve header: NOE-1 demo for GWU-1612, using elf conventions.

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

Formatting

CF[ℰ_] := Module[{vars=Union@Cases[ℰ,(Subscript[e, _])|(Subscript[l, _])|(Subscript[f, _]),∞]},
If[vars==={}, Factor[ℰ],
Total[CoefficientRules[ℰ, vars]/. (p_->c_):>Factor[c]Times@@((vars^p))] ]];
CF[ℰ_𝔼] :=CF/@ℰ;

The Program and the Trefoil

𝔼[i_,j_,s_] := 𝔼[1,(((-1))^s)(Subscript[l, j]), (((-t))^s)(Subscript[e, i])(Subscript[f, j]), (t^s)(Subscript[e, i])(Subscript[l, (1+s)i-s j])(Subscript[f, j])+(((-1))^s)(Subscript[l, i])(Subscript[l, j])+(((-(t^2)))^s)(Subscript[e, i]^2)(Subscript[f, j]^2)/4];
𝔼[i_,s_] := 𝔼[1,0,0,s (Subscript[l, i])];
𝔼/:𝔼[1,L1_,Q1_,P1_]𝔼[1,L2_,Q2_,P2_]:=𝔼[1,L1+L2, Q1+ Q2,P1+P2];

z1=(𝔼[1,11,0]𝔼[4,2,-1]𝔼[15,5,0]
𝔼[6,8,-1]𝔼[9,16,0]𝔼[12,14,-1]𝔼[3,-1]𝔼[7,+1]𝔼[10,-1]𝔼[13,+1])

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

(Subscript[S, (Subscript[l, j_])(Subscript[(x:e|f), i_])->k_])[𝔼[ω_,L_,Q_,P_]]:=With[{λ=(∂_(Subscript[l, j]))L,α=(∂_(Subscript[x, i]))Q,q=(E^γ)β (Subscript[x, k])+γ (Subscript[l, k])},CF[
𝔼[ω,L/.(Subscript[l, j])->(Subscript[l, k]),(t^λ)α (Subscript[x, k])+(Q/.(Subscript[x, i])->0),(E^(-q))(Subscript[DP, (Subscript[l, j])->(Subscript[D, γ]),(Subscript[x, i])->(Subscript[D, β])])[P][(E^q)]/.{β->α/ω,γ->λ Log[t]}] ]];

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

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

(Subscript[m, i_,j_->k_])[Z_𝔼]:=Module[{x,z},
CF[(Z//(Subscript[S, (Subscript[f, i])(Subscript[e, j])->x])//(Subscript[S, (Subscript[l, i])(Subscript[e, x])->x])//(Subscript[S, (Subscript[f, x])(Subscript[l, j])->x]))/.(Subscript[z_, i|j|x])->(Subscript[z, k])]]

(Do[z1=z1//(Subscript[m, 1,k->1]), {k,2,16}]; z1)

(Subscript[ρ, 1])[𝔼[ω_,_,_,P_]] := CF[((t((P/.(Subscript[e, _])|(Subscript[l, _])|(Subscript[f, _])->0)-t (ω^3)((∂_t)ω)))/((((t-1))^2)(ω^2)))]

(Subscript[ρ, 1])[z1] // Expand

Exporting the above as PDF files

The below is adapted from pensieve://Talks/NCSU-1604/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