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

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

NOE-1t

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

Format[ℰ_𝔼] :="𝔼"@@(CF/@ℰ);
Format[𝕆[spec_List, ℰ_𝔼]] := "𝕆"[StringJoin@@((x|->ToString[x,StandardForm])/@spec), ℰ];

Λ[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;

Λ[k] // TeXForm

(Subscript[R, i_,j_]^(+)):=𝔼[1,(Subscript[l, j]),(Subscript[e, i])(Subscript[f, j]),(Subscript[e, i])(Subscript[l, i])(Subscript[f, j])+(Subscript[l, i])(Subscript[l, j])+(Subscript[e, i]^2)(Subscript[f, j]^2)/4];
(Subscript[R, i_,j_]^(-)):=𝔼[1,-(Subscript[l, j]),-(t^(-1))(Subscript[e, i])(Subscript[f, j]),(t^(-1))(Subscript[e, i])(Subscript[l, j])(Subscript[f, j])-(Subscript[l, i])(Subscript[l, j])-(t^(-2))(Subscript[e, i]^2)(Subscript[f, j]^2)/4];
((Subscript[ur, i_]):=𝔼[1,0,0,(Subscript[l, i])]; (Subscript[nr, i_]):=𝔼[1,0,0,-(Subscript[l, i])];)

(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_]𝔼[1,L2_,Q2_,P2_]:=CF@𝔼[1,L1+L2, Q1+ Q2,P1+P2];

(Subscript[N, (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[N, (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]}]
]];

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

z1=𝕆[{(Subscript[e, 1]),(Subscript[l, 1]),(Subscript[f, 1]),(Subscript[e, 2]),(Subscript[l, 2]),(Subscript[f, 2]),(Subscript[e, 3]),(Subscript[l, 3]),(Subscript[f, 3]),(Subscript[e, 4]),(Subscript[l, 4]),(Subscript[f, 4]),(Subscript[e, 5]),(Subscript[l, 5]),(Subscript[f, 5]),(Subscript[e, 6]),(Subscript[l, 6]),(Subscript[f, 6]),(Subscript[e, 7]),(Subscript[l, 7]),(Subscript[f, 7]),(Subscript[e, 8]),(Subscript[l, 8]),(Subscript[f, 8]),(Subscript[e, 9]),(Subscript[l, 9]),(Subscript[f, 9]),(Subscript[e, 10]),(Subscript[l, 10]),(Subscript[f, 10]),(Subscript[e, 11]),(Subscript[l, 11]),(Subscript[f, 11]),(Subscript[e, 12]),(Subscript[l, 12]),(Subscript[f, 12]),(Subscript[e, 13]),(Subscript[l, 13]),(Subscript[f, 13]),(Subscript[e, 14]),(Subscript[l, 14]),(Subscript[f, 14]),(Subscript[e, 15]),(Subscript[l, 15]),(Subscript[f, 15]),(Subscript[e, 16]),(Subscript[l, 16]),(Subscript[f, 16])},(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])]

z2=Last[z1]

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

Earliest computation of the above (from NOE-Demo.nb, on this folder) gives:

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*)