Pensieve header: The ${\mathfrak g}_1$ Invariant.

The (Subscript[𝔤, 1]) Invariant

Reminder

Make sure that you have Mathematica and that you play with these programs!

The main (Subscript[𝔤, k]) lemma

In (𝔤^ϵ)=⟨h,e,l,f⟩/([e,l]=-e, [f,l]=f, [e,f]=h-2ϵ l, [h,*]=0) and at (ϵ^(k+1))=0, we have
1. 𝕆((e^(γ l+β e))|le)=𝕆((e^(γ l+(e^γ)β e))|e l),
2. 𝕆((e^(γ l+β f))|f l)=𝕆((e^(γ l+(e^γ)β f))|l f),
3. 𝕆((e^(β e+α f+δ e f))|f e)=𝕆(((νe)^(ν(-α β h+β e+α f+δ e f)))(Subscript[Λ, k])(ϵ,e,l,f,α,β,δ)|e f), with ν=(((1+h δ))^(-1)) and where for any fixed k, (Subscript[Λ, k])(ϵ,e,l,f,α,β,δ) is a fixed polynomial of degree at most 4k in e,(Sqrt[l]),f,α,β, with scalar coefficients.

Comment. Even better, log((Subscript[Λ, k])) is of degree at most 2k+2 in said variables.

The Main (Subscript[𝔤, k]) Theorem

Raw Version. The (Subscript[𝔤, k]) invariant of any S-component tangle T can be written in the form Z(T)=𝕆(ω (e^(L+Q+P))|(∏_(i∈S))(Subscript[e, i])(Subscript[l, i])(Subscript[f, i])), where ω is a scalar (meaning, a rational function in the variables (Subscript[h, i]) and their exponentials (Subscript[t, i])=(e^(Subscript[h, i]))), where L=∑(Subscript[a, ij])(Subscript[h, i])(Subscript[l, j]) is a balanced quadratic in the variables (Subscript[h, i]) and (Subscript[l, j]) with integer coefficients (Subscript[a, ij]), where Q=∑(Subscript[b, ij])(Subscript[e, i])(Subscript[f, j]) is a balanced quadratic in the variables (Subscript[e, i]) and (Subscript[f, j]) with scalar coefficients (Subscript[b, ij]), and where P is a polynomial in {ϵ, (Subscript[e, i]), (Subscript[l, i]), (Subscript[f, i])} (with scalar coefficients) whose (ϵ^d)-term is of degree at most 2d+2 in {(Subscript[e, i]),(Sqrt[(Subscript[l, i])]), (Subscript[f, i])}. Furthermore, after setting (Subscript[h, i])=h and (Subscript[t, i])=t for all i, the invariant Z(T) is poly-time computable.

Partial Proof. Indeed,
0. (R^±)=?, (n^±)=?.
1. 𝕆(𝒫(l,e)(e^(γ l+β e))|l e)=𝕆(𝒫((∂_γ),(∂_β))(e^(γ l+(e^γ)β e))|e l),
2. 𝕆(𝒫(l,f)(e^(γ l+β f))|f l)=𝕆(𝒫((∂_γ),(∂_β))(e^(γ l+(e^γ)β f))|l f),
3. 𝕆(𝒫(e,f)(e^(β e+α f+δ e f))|f e)=𝕆(ν 𝒫((∂_β),(∂_α))(e^(ν(-α β h+β e+α f+δ e f)))(Subscript[Λ, k])(ϵ,e,l,f,α,β,δ)|e f), with ν=(((1+hδ))^(-1)), and (Subscript[Λ, k])(ϵ,e,l,f,α,β,δ) as above.

Implementation at k=1

𝔼1n[ω,L,Q,P] stands for ω (e^(L+Q))(1+ϵ P).

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

(Subscript[Λ, k_])[h_,e_,l_,f_,α_,β_,δ_] :=(Subscript[Λ, k])[h,e,l,f,α,β,δ]=Module[{λ},
λ=Normal@Series[(E^((f α+e β)/(1-α β ϵ))) (((1-α β ϵ))^(-2 l+(h/ϵ))), {ϵ,0,k}]/.(E^(_))->1;
Collect[(Subscript[DP, α->(Subscript[D, f]),β->(Subscript[D, e])])[λ][(E^((f α+e β+e f δ)/(1+h δ)))]/.(E^(_))->1,ϵ,Simplify]];

ϵ /: (ϵ^(p_)) /; p>1 :=0;

CF[𝔼1n[ω_,L_,Q_,P_]] := 𝔼1n[Together[ω], Together[L], Together[Q],Together[P]];
𝔼1n /: 𝔼1n[ω1_,L1_,Q1_,P1_]𝔼1n[ω2_,L2_,Q2_,P2_] := CF@𝔼1n[ω1 ω2,L1+L2,Q1+Q2,P1+P2];
𝔼1n[ω1_,L1_,Q1_,P1_] ≡ 𝔼1n[ω2_,L2_,Q2_,P2_] := Simplify[ω1==ω2∧L1==L2∧Q1==Q2∧P1==P2];

0. R=𝕆(exp(hl+(((e^h)-1)/h)ef+P)|e⊗lf):

𝔼1n[(Subscript[X, i_,j_]^(+))]:=𝔼1n[1, (Subscript[h, i])(Subscript[l, j]),(Subscript[h, i]^(-1))((E^(Subscript[h, i]))-1)(Subscript[e, i])(Subscript[f, j]),(SuperPlus[P])];
𝔼1n[(Subscript[X, i_,j_]^(-))]:=𝔼1n[1, -(Subscript[h, i])(Subscript[l, j]),(Subscript[h, i]^(-1))((E^(-(Subscript[h, i])))-1)(Subscript[e, i])(Subscript[f, j]),(SuperMinus[P])];
𝔼1n[p_Times] := 𝔼1n /@ p;

𝔼1n[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))]

1. 𝕆(𝒫(l,e)(e^(γ l+β e))|l e)=𝕆(𝒫((∂_γ),(∂_β))(e^(γ l+(e^γ)β e))|e l),
2. 𝕆(𝒫(l,f)(e^(γ l+β f))|f l)=𝕆(𝒫((∂_γ),(∂_β))(e^(γ l+(e^γ)β f))|l f).

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

3. 𝕆((e^(βe+αf+δef))|fe)=𝕆(((νe)^(ν(-αβh+βe+αf+δef)))|ef), with ν=(((1+hδ))^(-1)):

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

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

Meta-associativity

ζ=𝔼1n[ω,(∑_(i=1)^4)(∑_(j=1)^4)(Subscript[a, i,j])(Subscript[h, i])(Subscript[l, j]), (∑_(i=1)^4)(∑_(j=1)^4)(Subscript[b, i,j])(Subscript[e, i])(Subscript[f, j]),0]

Short[ζ // (Subscript[m, 1,2->1]),5] // Timing

Short[lhs=ζ // (Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]),5] // Timing

Short[rhs=ζ // (Subscript[m, 2,3->2])//(Subscript[m, 1,2->1]),5] // Timing

lhs≡rhs

Profiling

<< "C:\\drorbn\\AcademicPensieve\\Projects\\Profile\\Profile.m"

CF[𝔼1n[ω_,L_,Q_,P_]] := (Subscript[PP, CF])@𝔼1n[Together[ω], Together[L], Together[Q],Together[P]];
(Subscript[NO, (Subscript[(x:f|e), i_])(Subscript[l, j_])])[𝔼1n[ω_,L_,Q_,P_]] := (Subscript[PP, NOxl])@With[{q=(E^γ)β (Subscript[x, i])+γ (Subscript[l, j])},
CF[𝔼1n[ω,L,
(E^γ)β (Subscript[x, i])+(Q/.(Subscript[x, i])->0),
(E^(-q))(Subscript[DP, (Subscript[l, j])->(Subscript[D, γ]),(Subscript[x, i])->(Subscript[D, β])])[P][(E^q)]
]/.{γ->(∂_(Subscript[l, j]))L,β->(∂_(Subscript[x, i]))Q}]];
(Subscript[NO, (Subscript[f, i_])(Subscript[e, j_])->k_])[𝔼1n[ω_,L_,Q_,P_]]:=(Subscript[PP, NOfe])@With[{q=ν(-α β (Subscript[h, k])+β (Subscript[e, k])+α (Subscript[f, k])+δ (Subscript[e, k])(Subscript[f, k]))},
CF[𝔼1n[ν ω,L,
q+(Q/.(Subscript[f, i])|(Subscript[e, j])->0),
(E^(-q))(Subscript[DP, (Subscript[f, i])->(Subscript[D, α]),(Subscript[e, j])->(Subscript[D, β])])[P][(E^q)]+((Subscript[Λ, 1])[(Subscript[h, k]),(Subscript[e, k]),(Subscript[l, k]),(Subscript[f, k]),α,β,δ]-1 /. ϵ->1)
]/.ν->(((1+(Subscript[h, k])δ))^(-1))/.{α->(∂_(Subscript[f, i]))Q/.(Subscript[e, j])->0,β->(∂_(Subscript[e, j]))Q/.(Subscript[f, i])->0,δ->(∂_((Subscript[f, i]),(Subscript[e, j])))Q}]];

BeginProfile[];
Short[ζ // (Subscript[m, 1,2->1])//(Subscript[m, 1,3->1])]
EndProfile[];
PrintProfile[]

Logos Games

(Subscript[Λ, 1])[h,e,l,f,α,β,δ]

With[{ζ=(h/(t-1))},(Subscript[Λ, 1])[h,e,l,f,α,β,δ] /. Thread[{h,e,l,f,α,β,δ}->{h,ζ e,l,f,α,(ζ^(-1))β,(ζ^(-1))δ}]] // Simplify

Pragmatic Simplifications

𝔼1n[ω,L,Q,P] stands for ω (e^(L+Q))(1+ϵ P); 𝔼1p[ω,L,Q,P] stands for ((ω )^(-1))(e^(L+(ω^(-1))Q))(1+ϵ (ω^(-4))P) /. (Subscript[e, i])->(((Subscript[t, i])-1)/(Subscript[h, i]))(Subscript[e, i]), all written in (Subscript[t, i])=(e^(Subscript[h, i])).

𝔼1n[𝔼1p[ω_,L_,Q_,P_]] := CF[PowerExpand/@CF[𝔼1n[(ω^(-1)),L,(ω^(-1))Q,(ω^(-4))P] /. (Subscript[e, i_]):>(((Subscript[t, i])-1)/(Subscript[h, i]))(Subscript[e, i])/. (Subscript[t, i_]):>(E^(Subscript[h, i]))]];
CF[𝔼1p[ω_,L_,Q_,P_]] := 𝔼1p[Together[ω], Together[L], Together[Q],Together[P]];
𝔼1p[𝔼1n[ω_,L_,Q_,P_]] := CF[𝔼1p[(ω^(-1)),L,(ω^(-1)) Q,(ω^(-4))P] /. (Subscript[e, i_]):>((Subscript[h, i])/((Subscript[t, i])-1))(Subscript[e, i])/. (Subscript[h, i_]):>Log[(Subscript[t, i])]];
𝔼1p[ω1_,L1_,Q1_,P1_] ≡ 𝔼1p[ω2_,L2_,Q2_,P2_] := Simplify[ω1==ω2∧L1==L2∧Q1==Q2∧P1==P2];

(Subscript[X, 1,2]^(+))//𝔼1n

(Subscript[X, 1,2]^(+))//𝔼1n //𝔼1p

ζ=ReplacePart[ζ,4->P]

Simplify /@ 𝔼1p[ζ]

ζ≡(𝔼1p[ζ] // 𝔼1n)

Simplify/@𝔼1n[𝔼1p@@ζ]

(𝔼1p@@ζ/. (Subscript[h, i_]):>Log[(Subscript[t, i])])≡(𝔼1n[𝔼1p@@ζ] // 𝔼1p)

𝔼1p[ω,L,(Subscript[e, 1])(Subscript[f, 2])+(Subscript[f, 1])(Subscript[e, 2])+δ (Subscript[e, 1])(Subscript[f, 1]),0] //𝔼1n

Simplify /@ ((𝔼1p[ω,L,(Subscript[e, 1])(Subscript[f, 2])+(Subscript[f, 1])(Subscript[e, 2])+δ (Subscript[e, 1])(Subscript[f, 1]),0] //𝔼1n// (Subscript[NO, (Subscript[f, 1])(Subscript[e, 1])->0])//𝔼1p) /. {(Subscript[t, 0])->(Subscript[t, 1]),(Subscript[h, 0])->(Subscript[h, 1]),(Subscript[l, 0])->(Subscript[l, 1])}/. {(Subscript[e, 2])->α,(Subscript[f, 2])->β})

Simplify /@ ((𝔼1p[ω,L,ω (Subscript[e, 1])β+ω (Subscript[f, 1])α+ω δ (Subscript[e, 1])(Subscript[f, 1]),0] //𝔼1n// (Subscript[NO, (Subscript[f, 1])(Subscript[e, 1])->0])//𝔼1p) /. {(Subscript[t, 0])->(Subscript[t, 1]),(Subscript[h, 0])->(Subscript[h, 1]),(Subscript[l, 0])->(Subscript[l, 1])})

Simplify /@ ((𝔼1p[ω,L,(Subscript[e, 1])β+(Subscript[f, 1])α+δ (Subscript[e, 1])(Subscript[f, 1])*(((((Subscript[t, 1])-1))/(Log[(Subscript[t, 1])]))),0] //𝔼1n// (Subscript[NO, (Subscript[f, 1])(Subscript[e, 1])->0])//𝔼1p) /. {(Subscript[t, 0])->(Subscript[t, 1]),(Subscript[h, 0])->(Subscript[h, 1]),(Subscript[l, 0])->(Subscript[l, 1])})