Pensieve header: Calculations appearing in the WKO4 paper.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\WKO4"];

Section 1 - Introduction

<< FreeLie.m;
<< AwCalculus.m;
$SeriesShowDegree=4;

Section 2.2 - Some Preliminaries on Lie Algebras and Cyclic Words

(Subscript[x, 1])=LW[1]; (Subscript[x, 2])=LW[2];
{α,β,γ} = LS /@ {(Subscript[x, 1])+b[(Subscript[x, 1]),(Subscript[x, 2])], (Subscript[x, 2])-b[(Subscript[x, 1]),b[(Subscript[x, 1]),(Subscript[x, 2])]], (Subscript[x, 1])+(Subscript[x, 2])-2b[(Subscript[x, 1]),(Subscript[x, 2])]}

{b[α,β], b[α,b[β,γ]]+b[β,b[γ,α]]+b[γ,b[α,β]]}

bch=BCH[LW@x,LW@y]

Timing@{Length@(bch@16), (bch@16)[[1090;;1092]] // TopBracketForm}

{(Subscript[ω, 1]),(Subscript[ω, 2])} = CWS /@ {CW["1"]-3CW["211"],  CW["2"]+CW["22"]}

DegreeScale[h] /@ {(Subscript[ω, 1]),(Subscript[ω, 2])}

{λ=⟨1->α, 2 -> β⟩, γ // (Subscript[D, λ])}

λ1=λ; λ2=⟨1->β, 2 -> γ⟩; tb[λ1,λ2]

lhs=(Subscript[D, tb[λ1,λ2]])[(Subscript[ω, 1])]; rhs=b[(Subscript[D, λ1]),(Subscript[D, λ2])][(Subscript[ω, 1])];
{lhs@{8}, (lhs≡rhs)@{8}}

lhs=(∂_t)(Subscript[Γ, t])[λ]; rhs=λ // (E^(-t (Subscript[D, λ]))) // adSeries[(ad/((E^ad)-1)), (Subscript[Γ, t])[λ]];
{(Subscript[Γ, 0])[λ], lhs, (lhs≡rhs)@{6}}

{γ // (E^(-t (Subscript[D, λ]))), γ // CC[(Subscript[Γ, t])[λ]]}

lhs=(∂_t)(Subscript[Λ, t])[λ]; rhs=λ // (E^(Subscript[D, (Subscript[Λ, t])[λ]])) // adSeries[(ad/((E^ad)-1)), (Subscript[Λ, t])[λ], tb];
{(Subscript[Λ, 0])[λ], lhs, (lhs≡rhs)@{6}}

{γ // CC[t λ], γ // (E^(-(Subscript[D, (Subscript[Λ, t])[λ]])))}

{α // (Subscript[CC, 1])[-γ], α // (Subscript[CC, 1])[-γ] // (Subscript[RC, 1])[γ], α // (Subscript[CC, 1])[-γ] // (Subscript[CC, 1])[γ]}

With[{γ=LW@u+b[b[LW@v,LW@u],LW@u]}, (Subscript[div, u])[γ]] // TopBracketForm

(Subscript[J, 1])[γ]

{div[λ]@{5}, j[λ]@{5}}

lhs=j[(Subscript[BCH, tb])[λ1, λ2]]; rhs=j[λ1] + (E^(Subscript[D, λ1]))[j[λ2]];
{lhs, (lhs≡rhs)@{8}}

lhs=j[(Subscript[BCH, b])[λ1, λ2]]; rhs=j[λ1] + (E^(Subscript[D, λ1]))[j[λ2]];
{lhs, (lhs≡rhs)}

ϵ /: (ϵ^2)=0;
{j[ϵ λ], j[ϵ λ]≡ϵ div[λ]}

Section 2.3 - The [AT]-inspired presentation (Subscript[E, l]) of (Subscript[(A^w), exp])

(Subscript[x, 1])=LW[1]; (Subscript[x, 2])=LW[2];
{(Subscript[ζ, a])=El[⟨1->LS[(Subscript[x, 1])+b[(Subscript[x, 1]),(Subscript[x, 2])]], 2->LS[(Subscript[x, 2])-b[(Subscript[x, 1]),b[(Subscript[x, 1]),(Subscript[x, 2])]]]⟩, CWS[CW["1"]-3CW["121"]]],
(Subscript[ζ, b])=El[⟨1->LS[(Subscript[x, 2])-b[(Subscript[x, 1]),(Subscript[x, 2])]], 2->LS[(Subscript[x, 1])+(Subscript[x, 2])+b[(Subscript[x, 2]),b[(Subscript[x, 1]),(Subscript[x, 2])]]]⟩, CWS[CW["2"]-2CW["12"]]],
(Subscript[ζ, c])=El[⟨1->LS[(Subscript[x, 1])-b[b[(Subscript[x, 1]),(Subscript[x, 2])],b[(Subscript[x, 1]),(Subscript[x, 2])]]], 2->LS[(Subscript[x, 2])+3b[(Subscript[x, 1]),b[(Subscript[x, 1]),(Subscript[x, 2])]]]⟩, CWS[CW["1"]-2CW["12"]+CW["121"]]]}

lhs=(Subscript[ζ, a])**((Subscript[ζ, b])**(Subscript[ζ, c])); rhs=((Subscript[ζ, a])**(Subscript[ζ, b]))**(Subscript[ζ, c]);
{lhs@{3}, (lhs≡rhs)@{8}}

{(Subscript[ζ, a]) // dη[1], (Subscript[ζ, a]) // dη[2]}

{(Subscript[ζ, d])=El[λ, CWS[0]], (Subscript[ζ, d]) // dA}

((Subscript[ζ, d]) ≡ ((Subscript[ζ, d])//dA//dA))@{8}

lhs=((Subscript[ζ, a])**(Subscript[ζ, b]))//dA; rhs=((Subscript[ζ, b])//dA)**((Subscript[ζ, a])//dA);
{lhs@{3}, (lhs≡rhs)@{8}}

(Subscript[ζ, d]) // dS

{(Subscript[ζ, a]), (Subscript[ζ, a])//dΔ[2,2,3]}

lhs=((Subscript[ζ, a])**(Subscript[ζ, b]))//dΔ[2,2,3]; rhs=((Subscript[ζ, a])//dΔ[2,2,3])**((Subscript[ζ, b])//dΔ[2,2,3]);
{lhs@{3}, (lhs≡rhs)@{8}}

Section 2.4 - The factored presentation (Subscript[E, f]) of (Subscript[(A^w), exp]) and its stronger precursor (Subscript[E, s])

u=LW@u; v=LW@v;
(Subscript[ξ, a])=Es[⟨1->LS[u+b[u,v]], 2->LS[v-b[u,b[u,v]]], 3->LS[u-b[b[u,v],b[u,v]]]⟩, CWS[CW["u"]-3CW["uvu"]]]

SeedRandom[0]; (Subscript[ξ, b])=Es[⟨Table[i->RandomLieSeries[{1,2,3,4}], {i,4}]⟩, RandomCWSeries[{1,2,3,4}]];
(Subscript[ξ, b])@{2}

lhs=(Subscript[ξ, a]) // hm[1,2,4] // tha[u,4]; rhs=(Subscript[ξ, a]) // tha[u,1] // tha[u,2] // hm[1,2,4];
{lhs, (lhs≡rhs)@{8}}

lhs=(Subscript[ξ, b]) // dm[1,2,1] // dm[1,3,1]; rhs=(Subscript[ξ, b]) // dm[2,3,2] // dm[1,2,1];
{lhs@{3}, (lhs≡rhs)@{5}}

Section 3.1 - Tangle Invariants

(Subscript[Z, t:(l|s)])[K1_**K2_] := (Subscript[Z, t])[K1]**(Subscript[Z, t])[K2]

(SuperPlus[R])[a_,b_] // (Subscript[Z, l]) := El[⟨a->LS[0], b->LS[LW@a]⟩, CWS[0]];
(SuperMinus[R])[a_,b_] // (Subscript[Z, l]) := El[⟨a->LS[0], b->-LS[LW@a]⟩, CWS[0]]

lhs=(SuperPlus[R])[1,2]**(SuperPlus[R])[1,3]**(SuperPlus[R])[2,3] // (Subscript[Z, l]); rhs=(SuperPlus[R])[2,3]**(SuperPlus[R])[1,3]**(SuperPlus[R])[1,2] // (Subscript[Z, l]);
{lhs@{3}, (lhs≡rhs)@{5}}