Pensieve header: Optimization base for the NOE1 program, with split Nfe and Nlx and with demoted CF.

Initialization

SetDirectory["C:\\drorbn\\AcademicPensieve\\2017-01"];
<< "NOE-Utilities.m"

NOE-1t

(Subscript[R, i_,j_]^(+)):=𝔼[1,Log[(Subscript[t, i])](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,-Log[(Subscript[t, i])](Subscript[l, j]),-(Subscript[t, i]^(-1))(Subscript[e, i])(Subscript[f, j]),-(Subscript[l, i])(Subscript[l, j])+(Subscript[t, i]^(-1))(Subscript[e, i])(Subscript[l, j])(Subscript[f, j])-(Subscript[t, i]^(-2))(Subscript[e, i]^2)(Subscript[f, j]^2)/4];
((Subscript[ur, i_]):=𝔼[(Subscript[t, i]^(-1/2)),0,0,(Subscript[l, i])(Subscript[t, i]^(-2))]; (Subscript[nr, i_]):=𝔼[(Subscript[t, i]^(1/2)),0,0,-(Subscript[l, i])(Subscript[t, i]^2)];)

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

CF[𝔼[ω_,L_,Q_,P_]]:=(Subscript[PP, CF])@𝔼[Expand@ω, Expand@L, Expand@Q,Expand@P];

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

Λ[k_]:= (((Subscript[t, k])-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+(Subscript[t, k]))/4;

(Subscript[N, (Subscript[f, i_])(Subscript[e, j_])->k_])[𝔼[ω_,L_,Q_,P_]]:=(Subscript[PP, Nfe])@With[{q=((1-(Subscript[t, k]))α β+β (Subscript[e, k])+δ (Subscript[e, k])(Subscript[f, k])+α (Subscript[f, k]))/μ},𝔼[
(Subscript[PP, Nfeω])@Expand@Together[μ ω /.μ->1+((Subscript[t, k])-1)δ/.δ->(ω^(-1))(∂_((Subscript[f, i]),(Subscript[e, j])))Q],
L,
(Subscript[PP, NfeQ])@Expand@Together[μ ω q+μ(Q/.(Subscript[f, i])|(Subscript[e, j])->0) /. μ->1+((Subscript[t, k])-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}],
Plus[
(Subscript[PP, NfeDP])@Expand@Together[(μ^4)((Subscript[DP, (Subscript[f, i])->(Subscript[D, α]),(Subscript[e, j])->(Subscript[D, β])])[P][(E^q)]/.(E^(_))->1)/. μ->1+((Subscript[t, k])-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[PP, NfeΛ])@Expand@Together[(ω^4)Λ[k]/. μ->1+((Subscript[t, k])-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_]]:=(Subscript[PP, Nlx])@With[{q=(E^γ)β (Subscript[x, k])+γ (Subscript[l, k])},𝔼[
ω,
(Subscript[PP, NlxL])@Expand@Together[γ (Subscript[l, k])+(L/.(Subscript[l, j])->0)/.γ->(∂_(Subscript[l, j]))L],
(Subscript[PP, NlxQ])@Expand@Together[ω (E^γ)β (Subscript[x, k])+(Q/.(Subscript[x, i])->0)/.{γ->(∂_(Subscript[l, j]))L,β->(ω^(-1))(∂_(Subscript[x, i]))Q}],
(Subscript[PP, NlxP])@Expand@Together[(E^(-q))(Subscript[DP, (Subscript[l, j])->(Subscript[D, γ]),(Subscript[x, i])->(Subscript[D, β])])[P][(E^q)]/.{γ->(∂_(Subscript[l, j]))L,β->(ω^(-1))(∂_(Subscript[x, i]))Q}]
]];

(Subscript[m, i_,j_->k_])[Z_𝔼]:=(Subscript[PP, m])@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])]]

Testing (Subscript[3, 1])...

BeginProfile[];
Timing[Z[Knot[3,1]]]
EndProfile[];
PrintProfile[]

Testing (Subscript[10, 100])...

BeginProfile[];
Timing[Z[Knot[10,100]]]
EndProfile[];
PrintProfile[]

Testing (Subscript[T, 9,5])...

BeginProfile[];
Timing[Z[TorusKnot[9,5]]]
EndProfile[];
PrintProfile[]