Pensieve Header: The w equations in the β-calculus.

β is to remind of “B picture”, though it is “wheeled”. Also, in faux German, β is ß is SS, for “semi-symmetrized”.

SetDirectory["C:\\drorbn\\AcademicPensieve\\2012-01"];
<< betaCalculus.m

Capping a Strand

{R[1,2], R[1,2] // hη[1], R[1,2] // hη[2]} // βForm

{ρ=W[E^c[1]]+R[1,2], ρ // hη[1], ρ // hη[2], ρ // dη[1], ρ // dη[2]} // βForm

Reversing a Strand

{R[1,2], R[1,2] // dS[1] , R[1,2] // dS[2], RInv[1,2]} // βForm

{(R[1,2]//dS[2])**R[1,2], (R[1,2]//dS[1])**R[1,2], RInv[1,2]**R[1,2]}

{RInv[1,1], R[1,1]**RInv[1,1]}

R3

{t1=R[1,2]**R[1,3]**R[2,3], t2=R[2,3]**R[1,3]**R[1,2], t1==t2} // βForm

“Easy” R4

{t1=R[2,3]**dΔ[2,2,3][R[1,2]], t2=dΔ[2,2,3][R[1,2]]**R[2,3], t1==t2} // βForm

“Hard” R4

{R[1,2]**dd[1][R[1,2]], dd[1][R[1,2]]**R[1,2]} // βForm

Clear[α, β, γ, δ];
(V=W[ω[c[1],c[2]]]+ α[c[1],c[2]] ar[1,1] + β[c[1],c[2]] ar[1,2] + γ[c[1],c[2]] ar[2,1] + δ[c[1],c[2]] ar[2,2]) // βForm

{t1=V**dd[1][R[1,2]], t2=R[1,3]**R[2,3]**V} /. c[s_] :> (Subscript[c, s])// βForm

eqns1=βEquations[t1==t2]

eqns1 /. (ϵ:(α|β|γ|δ))[c[1],c[2]] :> ϵ /. c[s_] :> (Subscript[c, s])

(sol=Solve[eqns1 /. (ϵ:(α|β|γ|δ))[c[1],c[2]] :> ϵ, {α, β, γ, δ}]) /. c[s_] :> (Subscript[c, s])

(γsol=(sol /. {α|β|δ -> 0})[[1,1,2]] // FullSimplify) /. c[s_] :> (Subscript[c, s])

FullSimplify[eqns1 /. {_α|_β|_δ -> 0, _γ -> γsol}]

Θ

(Θ = (R[1,1,1/2] // dΔ[1,1,2])**R[1,1,-1/2]**R[2,2,-1/2])  /. c[s_] :> (Subscript[c, s]) // βForm

(Θ // DeWheel // FullSimplify) /. Log[Exp[x_]] :> x  /. c[s_] :> (Subscript[c, s]) // βForm

{(Θ // dP[1->2, 2->1]) == Θ, (Θ // dS[1] // dS[2]) == Θ}

{
t1=Θ ** (R[1,2] // dd[1]),
t2=(R[1,2] // dd[1])**Θ,
t1==t2 // Simplify
} /. c[s_] :> (Subscript[c, s]) // βForm // ColumnForm

{
t1=Θ ** (R[2,1] // dd[1]),
t2=(R[2,1] // dd[1])**Θ,
t1==t2 // Simplify
} /. c[s_] :> (Subscript[c, s])  // βForm // ColumnForm

{Θ // dη[1], Θ // dη[2]} // βForm

Limit[Θ /. {W[_] -> 0, c[s_] :> ϵ c[s]}, ϵ -> 0]

The Twist Equation

{
(V // dP[2,1])**Θ,
R[1,2]**V
} /. c[s_] :> (Subscript[c, s]) // βForm

(eqns2=βEquations[(V // dP[2,1])**Θ==R[1,2]**V] // FullSimplify) /. c[s_] :> (Subscript[c, s])

Unitarity

(V**(V // dS[1] // dS[2])) // Short

(V**(V // dA[1] // dA[2])) /. c[s_] :> (Subscript[c, s]) // βForm

(eqns3=βEquations[V**(V // dA[1] // dA[2])==W[1]]) /. c[s_] :> (Subscript[c, s])

Non-degeneracy

(eqns4 = Join[
βEquations[(V // dη[1]) == W[1]],
βEquations[(V // dη[2]) == W[1]]
])  /. c[s_] :> (Subscript[c, s])

Cap equation

{Cap=W[κ[c[1]]],
Cap // dd[1],
V**(Cap // dd[1]),
(V**(Cap // dd[1])) // hη[1] // hη[2],
Cap+(Cap // dP[2])
}  /. c[s_] :> (Subscript[c, s]) // βForm

(eqns5=βEquations[((V**(Cap // dd[1])) // hη[1] // hη[2]) == (Cap+(Cap // dP[2]))]) /. c[s_] :> (Subscript[c, s])

120 Degrees Rotational Symmetry

(eqns6=βEquations[V==Rot120[V]]) /. c[s_] :> (Subscript[c, s])

Solving the Equations

Series[f[τ x, τ y], {τ,0,3}] /. Derivative[i___][f][___] :> (Subscript[f, FromDigits[{i}]])

eqns=Join[eqns1, eqns2, eqns3, eqns4, eqns5, eqns6];

n=0;
Simplify[Normal[
Series[
eqns /. c[s_] :> τ c[s],
{τ,0,n}
] /. {(ϵ:(α|β|γ|δ|ω|κ))[___] :> (Subscript[ϵ, 0]), Derivative[k___][(ϵ:(α|β|γ|δ|ω|κ))][___] :> (Subscript[ϵ, FromDigits[{k}]])}
]] /. c[s_] :> (Subscript[c, s])

n=0;
sol=SolveAlways[
Expand[Normal[
Series[
eqns /. c[s_] :> τ c[s],
{τ,0,n}
] /. {(ϵ:(α|β|γ|δ|ω|κ))[___] :> (Subscript[ϵ, 0]), Derivative[k___][(ϵ:(α|β|γ|δ|ω|κ))][___] :> (Subscript[ϵ, FromDigits[{k}]])}
]],
{c[1], c[2], τ}
]

If[Length[sol]==2, {Complement[sol[[1]], sol[[2]]], Complement[sol[[2]], sol[[1]]]}] // ColumnForm

indvars=Union[Cases[Last /@ #, (Subscript[ϵ_, k_]) :> (Subscript[ϵ, k]), Infinity]]& /@  sol

sol0=((#->0)& /@ First[indvars]);
sol0 = Union[sol0, First[sol] /. sol0]

(Normal[
Series[
V /. {W[_] -> 0, c[s_] :> τ c[s]},
{τ,0,n}
] /. {(ϵ:(α|β|γ|δ|ω))[___] :> (Subscript[ϵ, 0]), Derivative[k___][(ϵ:(α|β|γ|δ|ω))][___] :> (Subscript[ϵ, FromDigits[{k}]])}
] /. sol0) /. c[s_] :> (Subscript[c, s])// βForm

(Normal[
Series[
ω[c[1], c[2]] /. {W[_] -> 0, c[s_] :> τ c[s]},
{τ,0,n}
] /. {(ϵ:(α|β|γ|δ|ω))[___] :> (Subscript[ϵ, 0]), Derivative[k___][(ϵ:(α|β|γ|δ|ω))][___] :> (Subscript[ϵ, FromDigits[{k}]])}
] /. sol0) /. c[s_] :> (Subscript[c, s]) // βForm