Pensieve header: Solving the zipper equations; continued pensieve://2015-10/.

Done:

The u-involution ui on Γ-calculus: implement, verify invariance of θ, verify homomorphicity.

To do:

The twist equation.

The associator equations.

The noose equation.

SetDirectory["C:\\drorbn\\AcademicPensieve\\2015-09"];
<< "../Projects/MetaCalculi/MetaCalculi.m"

(Subscript[T, i_]):=(E^(Subscript[b, i]));
bConjugate[expr_]:= expr /. (Subscript[b, i_]) :> -(Subscript[b, i]);
bSimplify[expr_] := Assuming[(Subscript[b, 1])>0∧(Subscript[b, 2])>0∧(Subscript[b, 3])>0∧(Subscript[b, i])>0∧(Subscript[b, j])>0, Simplify[PowerExpand[expr]]];
ΓSimp=bSimplify;

The u-involution ui on Γ-calculus: implement, verify invariance of θ, verify homomorphicity.

ui[Γ[ω_,σ_,λ_]] := Module[{S=dL[Γ[ω,σ,λ]], A},
A=Outer[((∂_((Subscript[t, #1]),(Subscript[h, #2])))λ)&, S, S];
Γ[
bConjugate[Det[A]*ω/Product[(∂_(Subscript[h, i]))σ, {i,S}]],
σ,
((Subscript[h, #])/(Subscript[b, #])& /@ S).Inverse[bConjugate[A]].((Subscript[t, #])(Subscript[b, #])& /@ S)
] // ΓSimp
];

{Xp[1,2]//Γ, Xp[1,2]//Γ//ui}

{t1=Θ[1,2] // Γ, t2=Θ[1,2] // Γ // ui, t1==t2 // bSimplify, (Θ[1,2] // Γ)@A // Eigenvalues}

{n=3; γ0=Γ[ω[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])], (∑_(i=1)^n)(Subscript[h, i])(∏_(j=1)^n)((Subscript[T, j])^(Subscript[σ, 10i+j])), (∑_(i=1)^n)(∑_(j=1)^n)(Subscript[t, i])(Subscript[h, j])(Subscript[α, 10i+j])[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])]] // bSimplify}

{t1=γ0//dm[1,2,1] // ui, t2=γ0 // ui // dm[1,2,1], t1==t2 // Simplify} // ColumnForm

{t1=γ0//dS[1] // ui, t2=γ0 // ui // dS[1], t1==t2 // bSimplify} // ColumnForm

The twist equation.

Υ0=Γ[Vi]//bSimplify

Series[PowerExpand[(Sqrt[(((-1+(E^(Subscript[b, 1]))) (-1+(E^(Subscript[b, 2]))) (-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))) (Subscript[b, 2]))/((Subscript[b, 1]) ((Subscript[b, 1])+(Subscript[b, 2]))))])/. (Subscript[b, i_]):>ℏ (Subscript[b, i])], {ℏ,0,5}]

Series[PowerExpand[(Sqrt[(-1+(E^(Subscript[b, 1]))) (-1+(E^(Subscript[b, 2]))) (-1+(E^((Subscript[b, 1])+(Subscript[b, 2]))))])/. (Subscript[b, i_]):>ℏ (Subscript[b, i])], {ℏ,0,5}]

Υ0**(Υ0//dA[1,2])

θ0=Υ0**(Xp[1,2] // Γ)**(Υ0//dS[1,2]//dσ[1->2,2->1])

Υ0**(Xp[1,2] // Γ)**(Υ0//dS[1,2])

Υ0**(Xp[1,2] // Γ)**(Υ0//dA[1,2])

(1/((Sqrt[(-1+(E^(Subscript[b, 1]))) (-1+(E^(Subscript[b, 2])))]) ((Subscript[b, 1])+(Subscript[b, 2]))))(-(((E^((Subscript[b, 1])/2)) (-(E^((Subscript[b, 1])/2))+(E^(((Subscript[b, 1])/2)+(Subscript[b, 2])))-(Sqrt[(((-1+(E^(Subscript[b, 1]))) (-1+(E^(Subscript[b, 2]))) (-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))) (Subscript[b, 2]))/((Subscript[b, 1]) ((Subscript[b, 1])+(Subscript[b, 2]))))])) (-(Sqrt[(-1+(E^(Subscript[b, 1]))) (-1+(E^(Subscript[b, 2]))) (-1+(E^((Subscript[b, 1])+(Subscript[b, 2]))))]) (Subscript[b, 1])+(E^(((Subscript[b, 1])/2)+(Subscript[b, 2]))) (-1+(E^(Subscript[b, 1]))) (Sqrt[(Subscript[b, 1]) (Subscript[b, 2]) ((Subscript[b, 1])+(Subscript[b, 2]))])))/(((-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))))^(3/2)))+((-1+(E^(Subscript[b, 1]))+(E^((Subscript[b, 1])/2)) (Sqrt[(((-1+(E^(Subscript[b, 1]))) (-1+(E^(Subscript[b, 2]))) (-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))) (Subscript[b, 2]))/((Subscript[b, 1]) ((Subscript[b, 1])+(Subscript[b, 2]))))])) ((E^((Subscript[b, 1])+(Subscript[b, 2]))) (-1+(E^(Subscript[b, 1]))) (-1+(E^(Subscript[b, 2]))) (Subscript[b, 1]^2) (Sqrt[(-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))) (Subscript[b, 2])])+(-1+(E^(Subscript[b, 1]))) (-1+(E^(Subscript[b, 2]))) (Subscript[b, 1]) (Sqrt[(-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))) (Subscript[b, 2])]) (-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))+(E^((Subscript[b, 1])+(Subscript[b, 2]))) (Subscript[b, 2]))+(E^((Subscript[b, 1])/2)) (-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))) (Sqrt[(-1+(E^(Subscript[b, 1]))) (-1+(E^(Subscript[b, 2]))) (Subscript[b, 1]) ((Subscript[b, 1])+(Subscript[b, 2]))]) ((E^(Subscript[b, 2])) (-1+(E^(Subscript[b, 1]))) (Subscript[b, 1])+(-1+(E^(Subscript[b, 2]))) (Subscript[b, 2]))))/((((-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))))^2) ((Sqrt[(-1+(E^(Subscript[b, 1]))) (-1+(E^(Subscript[b, 2]))) (-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))) (Subscript[b, 2])])-(E^(((Subscript[b, 1])/2)+(Subscript[b, 2]))) (Sqrt[(Subscript[b, 1]) ((Subscript[b, 1])+(Subscript[b, 2]))])+(E^(((3 (Subscript[b, 1]))/2)+(Subscript[b, 2]))) (Sqrt[(Subscript[b, 1]) ((Subscript[b, 1])+(Subscript[b, 2]))]))))//FullSimplify

{n=2; Υ=Γ[ω[(Subscript[b, 1]),(Subscript[b, 2])], (∑_(i=1)^n)(Subscript[h, i])(∏_(j=1)^n)((Subscript[T, j])^(Subscript[σ, 10i+j])), (∑_(i=1)^n)(∑_(j=1)^n)(Subscript[t, i])(Subscript[h, j])(Subscript[α, 10i+j])[(Subscript[b, 1]),(Subscript[b, 2])]] // bSimplify}

θ=Υ**(Xp[1,2] // Γ)**(Υ//dS[1,2]//dσ[1->2,2->1])

bSimplify[θ==ui[θ]]

Assuming[(Subscript[α, 12])[-(Subscript[b, 1]),-(Subscript[b, 2])] (Subscript[α, 21])[-(Subscript[b, 1]),-(Subscript[b, 2])]-(Subscript[α, 11])[-(Subscript[b, 1]),-(Subscript[b, 2])] (Subscript[α, 22])[-(Subscript[b, 1]),-(Subscript[b, 2])]≠0, bSimplify[θ==ui[θ]]]