Pensieve header: Finding a $V$ satisfying R4, Twist, and Unitarity, with Huan Vo.

SetDirectory["C:\\drorbn\\AcademicPensieve\\2016-11"];

CF[expr_] := (expr /. (E^(x_)):>(E^(Simplify[x /. (Subscript[b, i_]):>2Log[(Subscript[t, i])]])))// Together // ExpandNumerator // ExpandDenominator;
𝔼 /: CF[𝔼[ω_,Q_]] := 𝔼[CF[ω], CF[Q]];
𝔼 /: 𝔼[ω1_, Q1_]𝔼[ω2_, Q2_] := CF@𝔼[ω1 ω2, Q1+Q2];
𝔼[ω1_,Q1_] ≡ 𝔼[ω2_, Q2_] := CF[ω1==ω2∧Q1==Q2];

(Subscript[N, (Subscript[u, i_])(Subscript[c, j_])->k_])[𝔼[ω_, Q_]] := CF[
𝔼[ω,(E^(-γ))β (Subscript[u, k])+γ (Subscript[c, k])+(Q/.(Subscript[c, j])|(Subscript[u, i])->0)]/.{γ->(∂_(Subscript[c, j]))Q,β->(∂_(Subscript[u, i]))Q}];
(Subscript[N, (Subscript[w, i_])(Subscript[c, j_])->k_])[𝔼[ω_, Q_]] := CF[
𝔼[ω, (E^γ)α (Subscript[w, k])+γ (Subscript[c, k])+(Q/.(Subscript[c, j])|(Subscript[w, i])->0)]/.{γ->(∂_(Subscript[c, j]))Q,α->(∂_(Subscript[w, i]))Q}];
(Subscript[N, (Subscript[w, i_])(Subscript[u, j_])->k_])[𝔼[ω_,Q_]] := CF[
𝔼[ν ω , -(Subscript[b, k])ν α β+ν β (Subscript[u, k])+ν δ (Subscript[u, k])(Subscript[w, k])+ν α (Subscript[w, k]) +(Q/.(Subscript[w, i])|(Subscript[u, j])->0)] /. ν-> (((1+(Subscript[b, k]) δ))^(-1)) /. {α->(∂_(Subscript[w, i]))Q/.(Subscript[u, j])->0, β->(∂_(Subscript[u, j]))Q/.(Subscript[w, i])->0, δ->(∂_((Subscript[w, i]),(Subscript[u, j])))Q}];

(Subscript[m, i_,j_->k_])[𝔼[ω_, Q_]] :=CF[Module[{x},
(𝔼[ω, Q] /. {(Subscript[b, i|j])->(Subscript[b, k]), (Subscript[t, i|j])->(Subscript[t, k])} // (Subscript[N, (Subscript[w, i])(Subscript[c, j])->x])//(Subscript[N, (Subscript[u, i])(Subscript[c, x])->x])//(Subscript[N, (Subscript[w, x])(Subscript[u, j])->x])) /. {(Subscript[c, i])->(Subscript[c, k]),(Subscript[w, j])->(Subscript[w, k]),(Subscript[y_, x]):>(Subscript[y, k])}]]

(Subscript[R, i_,j_])[p_]:=𝔼[1, p (Subscript[b, i])(Subscript[c, j])+(Subscript[b, i]^(-1))((E^(p (Subscript[b, i])))-1)(Subscript[u, i])(Subscript[w, j])]//CF;
(Subscript[R, i_,j_]^(+)):=(Subscript[R, i,j])[1]; (Subscript[R, i_,j_]^(-)):=(Subscript[R, i,j])[-1];

(Subscript[R, 1,2]^(+))(Subscript[R, 3,4]^(+))(Subscript[R, 5,6]^(+))//(Subscript[m, 3,5->x])//(Subscript[m, 1,6->y])//(Subscript[m, 2,4->z])

(Subscript[R, 1,2]^(+))(Subscript[R, 3,4]^(+))(Subscript[R, 5,6]^(+))//(Subscript[m, 1,3->x])//(Subscript[m, 2,5->y])//(Subscript[m, 4,6->z])

z1=(Subscript[R, 12,1]^(-))(Subscript[R, 2,7]^(-))(Subscript[R, 8,3]^(-))(Subscript[R, 4,11]^(-))(Subscript[R, 16,5]^(+))(Subscript[R, 6,13]^(+))(Subscript[R, 14,9]^(+))(Subscript[R, 10,15]^(+));
Do[z1=(z1//(Subscript[m, 1,n->1]))/.(Subscript[b, i_])->2Log[(Subscript[t, i])],{n,2,16}];
{CF@z1, KnotData[{8,17}, "AlexanderPolynomial"][t]}

𝔼 /: (((e_𝔼))^(σ[s___List])):=CF[e /. Flatten@Table[{
(Subscript[b, k])->Total[(Subscript[b, #])&/@{s}[[k]]], (Subscript[c, k])->Total[(Subscript[c, #])&/@{s}[[k]]],(Subscript[u, k])->Total[(Subscript[u, #])&/@{s}[[k]]],(Subscript[w, k])->Total[(Subscript[w, #])&/@{s}[[k]]],(Subscript[t, k])->Times@@((Subscript[t, #])&/@{s}[[k]])
},{k,1,Length@{s}}]];
σ[l___,k_Integer,r___]:=σ[l,{k},r];

((((Subscript[R, 1,2]^(+))))^(σ[{1,2},3]))

CF[(Subscript[R, 1,3]^(+))/.{(Subscript[t, 1])->(Subscript[t, 1])(Subscript[t, 2]),(Subscript[x_, 1])->(Subscript[x, 1])+(Subscript[x, 2])}]

𝔼/: e1_𝔼**e2_𝔼 := Module[{λ,ν,e},
λ=(Union@Cases[e1,(Subscript[(b|t|c|u|w), k_]):>k,∞])⋂(Union@Cases[e2,(Subscript[(b|t|c|u|w), k_]):>k,∞]);
ν=Table[Unique[], {Length@λ}];
e=e1(e2/.Flatten@Table[{(Subscript[b, λ[[k]]])->(Subscript[b, ν[[k]]]),(Subscript[t, λ[[k]]])->(Subscript[t, ν[[k]]]),(Subscript[c, λ[[k]]])->(Subscript[c, ν[[k]]]),(Subscript[u, λ[[k]]])->(Subscript[u, ν[[k]]]),(Subscript[w, λ[[k]]])->(Subscript[w, ν[[k]]])}, {k,Length@λ}]);
Do[e=(Subscript[m, λ[[k]],ν[[k]]->λ[[k]]])[e], {k,Length@λ}];
e
]

(Subscript[R, 1,2]^(+))**(Subscript[R, 1,3]^(+))**(Subscript[R, 2,3]^(+))

(Subscript[R, 2,3]^(+))**(Subscript[R, 1,3]^(+))**(Subscript[R, 1,2]^(+))

(Subscript[f, 11])=(Subscript[f, 21])=(Subscript[f, 22])=0; (Subscript[f, 12])=1/2;
V=𝔼[h[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[t, 1]),(Subscript[t, 2])],(Subscript[b, 1]) (Subscript[c, 1]) (Subscript[f, 11])+(Subscript[b, 1]) (Subscript[c, 2]) (Subscript[f, 12])+(Subscript[b, 2]) (Subscript[c, 1]) (Subscript[f, 21])+(Subscript[b, 2]) (Subscript[c, 2]) (Subscript[f, 22])+(Subscript[u, 1]) (Subscript[w, 1]) (Subscript[g, 11])[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[t, 1]),(Subscript[t, 2])]+(Subscript[u, 1]) (Subscript[w, 2]) (Subscript[g, 12])[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[t, 1]),(Subscript[t, 2])]+(Subscript[u, 2]) (Subscript[w, 1]) (Subscript[g, 21])[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[t, 1]),(Subscript[t, 2])]+(Subscript[u, 2]) (Subscript[w, 2]) (Subscript[g, 22])[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[t, 1]),(Subscript[t, 2])]]

Eqn1=Simplify[(V**((((Subscript[R, 1,2]^(+))))^(σ[{1,2},3])))≡((Subscript[R, 2,3]^(+))**(Subscript[R, 1,3]^(+))**V)]

(Subscript[uR, i_,j_]):=((((Subscript[R, 1,2])[1/2]//(Subscript[m, 1,2->1])))^(σ[{i,j}]))**((((Subscript[R, 1,2])[-1/2]//(Subscript[m, 1,2->1])))^(σ[{i}]))**((((Subscript[R, 1,2])[-1/2]//(Subscript[m, 1,2->1])))^(σ[{j}]))

Simplify/@(Subscript[uR, i,j])

Eqn2=(V**(Subscript[uR, 1,2]))≡((Subscript[R, 1,2]^(+))**(V^(σ[2,1])))

A[n_][e_𝔼]:=(e/.{(Subscript[c, n])-> -(Subscript[c, n]),(Subscript[w, n])->-(Subscript[w, n])})//(Subscript[N, (Subscript[u, n])(Subscript[c, n])->n])//(Subscript[N, (Subscript[w, n])(Subscript[c, n])->n])//(Subscript[N, (Subscript[w, n])(Subscript[u, n])->n]);
A[{}][e_𝔼] := e;
A[{n_,r___}][e_𝔼] := e // A[n] // A[{r}];

Eqn3=(V**A[{1,2}][V]≡𝔼[1,0])

(CF /@ {-(1/((-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))) (Subscript[b, 1]) ((Subscript[b, 1])+(Subscript[b, 2]))))(E^(-(Subscript[b, 1]) (Subscript[f, 11])-(Subscript[b, 2]) (Subscript[f, 12]))) (((E^((Subscript[b, 1])+((Subscript[b, 2])/2)))-(E^((Subscript[b, 2])/2))+(E^((Subscript[b, 1]) (Subscript[f, 11])+(Subscript[b, 2]) (Subscript[f, 12])))-(E^((Subscript[b, 1]) (1+(Subscript[f, 11]))+(Subscript[b, 2]) (1+(Subscript[f, 12]))))) (Subscript[b, 1])+((E^((Subscript[b, 1])+((Subscript[b, 2])/2)))-(E^((Subscript[b, 2])/2))-(E^(((Subscript[b, 1])+(Subscript[b, 2])) ((Subscript[f, 11])+(Subscript[f, 12]))))+(E^(((Subscript[b, 1])+(Subscript[b, 2])) (1+(Subscript[f, 11])+(Subscript[f, 12]))))+(E^((Subscript[b, 1]) (Subscript[f, 11])+(Subscript[b, 2]) (Subscript[f, 12])))-(E^((Subscript[b, 1]) (1+(Subscript[f, 11]))+(Subscript[b, 2]) (1+(Subscript[f, 12]))))) (Subscript[b, 2])),
-(((E^(-(Subscript[b, 1]) (Subscript[f, 11])-(Subscript[b, 2]) (Subscript[f, 12]))) (((E^((Subscript[b, 1])+((Subscript[b, 2])/2)))-(E^((Subscript[b, 2])/2))+(E^(((Subscript[b, 1])+(Subscript[b, 2])) ((Subscript[f, 11])+(Subscript[f, 12]))))-(E^(((Subscript[b, 1])+(Subscript[b, 2])) (1+(Subscript[f, 11])+(Subscript[f, 12]))))) (Subscript[b, 1])+(E^((Subscript[b, 2])/2)) (-1+(E^(Subscript[b, 1]))) (Subscript[b, 2])))/((-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))) (Subscript[b, 1]) ((Subscript[b, 1])+(Subscript[b, 2])))),
-(((E^(-(1/2) (Subscript[b, 2]) (1+2 (Subscript[f, 11]))-(Subscript[b, 1]) (Subscript[f, 12]))) ((E^((Subscript[b, 1])+((Subscript[b, 2])/2))) (-1+(E^(Subscript[b, 2]))) (Subscript[b, 1])+(-(E^((Subscript[b, 1])+((Subscript[b, 2])/2)))+(E^((Subscript[b, 1])+((3 (Subscript[b, 2]))/2)))+(E^(((Subscript[b, 1])+(Subscript[b, 2])) ((Subscript[f, 11])+(Subscript[f, 12]))))-(E^(((Subscript[b, 1])+(Subscript[b, 2])) (1+(Subscript[f, 11])+(Subscript[f, 12]))))) (Subscript[b, 2])))/((-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))) (Subscript[b, 2]) ((Subscript[b, 1])+(Subscript[b, 2])))),
((1-(((E^((Subscript[b, 1])-(Subscript[b, 2]) (Subscript[f, 11])-(Subscript[b, 1]) (Subscript[f, 12]))) (-1+(E^(Subscript[b, 2]))) ((Subscript[b, 1])+(Subscript[b, 2])))/((-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))) (Subscript[b, 2])))+(((E^(-(Subscript[b, 2]) ((1/2)+(Subscript[f, 11]))-(Subscript[b, 1]) (Subscript[f, 12]))) (Subscript[b, 1]) ((E^((Subscript[b, 1])+((Subscript[b, 2])/2))) (-1+(E^(Subscript[b, 2]))) (Subscript[b, 1])+(-(E^((Subscript[b, 1])+((Subscript[b, 2])/2)))+(E^((Subscript[b, 1])+((3 (Subscript[b, 2]))/2)))+(E^(((Subscript[b, 1])+(Subscript[b, 2])) ((Subscript[f, 11])+(Subscript[f, 12]))))-(E^(((Subscript[b, 1])+(Subscript[b, 2])) (1+(Subscript[f, 11])+(Subscript[f, 12]))))) (Subscript[b, 2])))/((-1+(E^((Subscript[b, 1])+(Subscript[b, 2])))) (Subscript[b, 2]) ((Subscript[b, 1])+(Subscript[b, 2])))))/(Subscript[b, 2]))}) /. {(Subscript[b, 1])->b1,(Subscript[b, 2])->b2,(Subscript[t, 1])->t1,(Subscript[t, 2])->t2}

CF /@ ({Eqn1, Eqn2, Eqn3} /. Thread[{(Subscript[g, 11])[b1_,b2_,t1_,t2_],(Subscript[g, 12])[b1_,b2_,t1_,t2_],(Subscript[g, 21])[b1_,b2_,t1_,t2_],(Subscript[g, 22])[b1_,b2_,t1_,t2_]} :>  {((b2 t1-b1 (t1^2)-b2 (t1^2)+b1 (t1^2) (t2^2)+b2 (t1^2) (t2^2)-b2 (t1^3) (t2^2))/(-(b1^2)-b1 b2+(b1^2) (t1^2) (t2^2)+b1 b2 (t1^2) (t2^2))),((b1+b2-b1 t1-b1 (t1^2)-b2 (t1^2)+b1 (t1^3) (t2^2))/(-(b1^2)-b1 b2+(b1^2) (t1^2) (t2^2)+b1 b2 (t1^2) (t2^2))),((-b2+b1 t1+b2 t1-b1 t1 (t2^2)-b2 t1 (t2^2)+b2 (t1^2) (t2^2))/(-b1 b2-(b2^2)+b1 b2 (t1^2) (t2^2)+(b2^2) (t1^2) (t2^2))),((-b2+b1 t1+b2 t1-b1 t1 (t2^2)-b2 t1 (t2^2)+b2 (t1^2) (t2^2))/(-b1 b2-(b2^2)+b1 b2 (t1^2) (t2^2)+(b2^2) (t1^2) (t2^2)))}])

VV=V/.Thread[{h[b1_,b2_,t1_,t2_],(Subscript[g, 11])[b1_,b2_,t1_,t2_],(Subscript[g, 12])[b1_,b2_,t1_,t2_],(Subscript[g, 21])[b1_,b2_,t1_,t2_],(Subscript[g, 22])[b1_,b2_,t1_,t2_]} :>  {1,((b2 t1-b1 (t1^2)-b2 (t1^2)+b1 (t1^2) (t2^2)+b2 (t1^2) (t2^2)-b2 (t1^3) (t2^2))/(-(b1^2)-b1 b2+(b1^2) (t1^2) (t2^2)+b1 b2 (t1^2) (t2^2))),((b1+b2-b1 t1-b1 (t1^2)-b2 (t1^2)+b1 (t1^3) (t2^2))/(-(b1^2)-b1 b2+(b1^2) (t1^2) (t2^2)+b1 b2 (t1^2) (t2^2))),((-b2+b1 t1+b2 t1-b1 t1 (t2^2)-b2 t1 (t2^2)+b2 (t1^2) (t2^2))/(-b1 b2-(b2^2)+b1 b2 (t1^2) (t2^2)+(b2^2) (t1^2) (t2^2))),((-b2+b1 t1+b2 t1-b1 t1 (t2^2)-b2 t1 (t2^2)+b2 (t1^2) (t2^2))/(-b1 b2-(b2^2)+b1 b2 (t1^2) (t2^2)+(b2^2) (t1^2) (t2^2)))}]

VVi=A[{1,2}][VV]

VV**VVi

VΦ=(VVi^(σ[{1,2},3]))**(VVi^(σ[1,2]))**(VV^(σ[2,3]))**(VV^(σ[1,{2,3}]))

θ[i_][e_𝔼]:=(e/.{(Subscript[b, i]):>-(Subscript[b, i]),(Subscript[c, i]):>-(Subscript[c, i]),(Subscript[u, i]):>(Subscript[w, i]),(Subscript[w, i]):>(Subscript[u, i]),(Subscript[t, i]):>(Subscript[t, i]^(-1))})//CF//(Subscript[N, (Subscript[w, i])(Subscript[u, i])->i]);
θ[][e_𝔼] := e;
θ[n_,r___][e_𝔼] := e // θ[n] // θ[r];

(Subscript[uR, 1,2])//θ[1,2]

(Subscript[uR, 1,2])≡((Subscript[uR, 1,2])//θ[1,2])

(Subscript[R, 1,2]^(+))≡((Subscript[R, 1,2]^(+))//θ[1,2])

(lhs=(Subscript[uR, 1,2])**(Subscript[uR, 2,3]))≡(lhs//θ[1,2,3])

(lhs=(Subscript[uR, 1,2])**(Subscript[uR, 1,3])**(Subscript[uR, 2,3]))≡(lhs//θ[1,2,3])

Simplify[VΦ≡(VΦ//θ[1,2,3])]

The bug: h is not a scalar! It remains a function of the b’s and the t’s, and the action of strand doubling on those is not trivial. So our conclusion that GΦ is independent of h is wrong.

sol={h[___] :> h, (Subscript[g, 12])[b1_,b2_,t1_,t2_]:> ((b2-b1 (t1^2)-b2 (t1^2)+b1 (t1^2) (t2^2)+(b1^2) (Subscript[g, 11])[b1,b2,t1,t2]-(b1^2) (t1^2) (t2^2) (Subscript[g, 11])[b1,b2,t1,t2])/(b1 b2 (-1+(t1^2) (t2^2)))),(Subscript[g, 21])[b1_,b2_,t1_,t2_]:> ((-b2+b1 t1+b2 t1-b1 t1 (t2^2)-b2 t1 (t2^2)+b2 (t1^2) (t2^2)+(b2^2) (Subscript[g, 22])[b1,b2,t1,t2]-(b2^2) (t1^2) (t2^2) (Subscript[g, 22])[b1,b2,t1,t2])/(b1 b2 (-1+(t1^2) (t2^2)))),(Subscript[g, 22])[b1_,b2_,t1_,t2_]:>(1/((b2^2) (b1+b2) (-1+(t1^2)) (-1+(t1^2) (t2^2))))(b2 (b1+b2)-b2 (b1+b2) t1-b2 (b1+b2) (t1^2)+b1 (b1+b2) (t1^3)+b2 (b1+b2) (t1^3)+b2 (b1+b2) t1 (t2^2)-b2 (b1+b2) (t1^2) (t2^2)-2 b1 (b1+b2) (t1^3) (t2^2)-b2 (b1+b2) (t1^3) (t2^2)+b2 (b1+b2) (t1^4) (t2^2)+b1 (b1+b2) (t1^3) (t2^4)-b1 b2 (((-1+(t1^2) (t2^2)))^2) ((h[b1,b2,t1,t2])^2)-(b1^2) (b1+b2) t1 (-1+(t2^2)) (-1+(t1^2) (t2^2)) (Subscript[g, 11])[b1,b2,t1,t2]),
(Subscript[g, 11])[b1_,b2_,t1_,t2_]:>-((-b2 (h^2) t1+b1 (t1^2)+b2 (t1^2)-b1 (t1^2) (t2^2)-b2 (t1^2) (t2^2)+b2 (h^2) (t1^3) (t2^2))/(b1 (b1+b2) (-1+(t1^2) (t2^2))))};

Flatten[
(CoefficientRules[#//. sol, {(Subscript[u, 1]),(Subscript[u, 2]),(Subscript[w, 1]),(Subscript[w, 2])}]/. (p_->c_):> Simplify@c)& /@ Simplify[
({Eqn1, Eqn2, Eqn3} /. And -> Sequence /. a_==b_ :> Simplify[a-b])/{(1/((Subscript[b, 1]) (Subscript[b, 2]) ((Subscript[b, 1])+(Subscript[b, 2]))))(Subscript[w, 3]),1, (1/((Subscript[b, 1]) (Subscript[b, 2]) ((Subscript[b, 1])+(Subscript[b, 2])) (Subscript[t, 1]) (Subscript[t, 2]))),(((1-(Subscript[b, 2]) (Subscript[g, 22])[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[t, 1]),(Subscript[t, 2])]+(Subscript[b, 1]) (-(Subscript[b, 2]) (Subscript[g, 12])[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[t, 1]),(Subscript[t, 2])] (Subscript[g, 21])[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[t, 1]),(Subscript[t, 2])]+(Subscript[g, 11])[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[t, 1]),(Subscript[t, 2])] (-1+(Subscript[b, 2]) (Subscript[g, 22])[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[t, 1]),(Subscript[t, 2])]))))^(-1))} /. {(Subscript[b, 1])->b1,(Subscript[b, 2])->b2,(Subscript[t, 1])->t1,(Subscript[t, 2])->t2}
]
] // Column

Solve[b1 b2 (((-1+(t1^2) (t2^2)))^2) ((h[b1,b2,t1,t2])^2)+(b1+b2) (-b2+b2 t1+b2 (t1^2)-b1 (t1^3)-b2 (t1^3)-b2 t1 (t2^2)+b2 (t1^2) (t2^2)+2 b1 (t1^3) (t2^2)+b2 (t1^3) (t2^2)-b2 (t1^4) (t2^2)-b1 (t1^3) (t2^4)+(b1^2) t1 (-1+(t2^2)) (-1+(t1^2) (t2^2)) (Subscript[g, 11])[b1,b2,t1,t2]+(b2^2) (-1+(t1^2)) (-1+(t1^2) (t2^2)) (Subscript[g, 22])[b1,b2,t1,t2])==0, (Subscript[g, 22])[b1,b2,t1,t2]]

GV=CF[V//.sol ]

GVi=A[{1,2}][GV]

GV**GVi

GΦ=(GVi^(σ[{1,2},3]))**(GVi^(σ[1,2]))**(GV^(σ[2,3]))**(GV^(σ[1,{2,3}]))

err=Simplify[GΦ≡(GΦ//θ[1,2,3])][[1]]

VV≡(GV /. h->1)

GV

VΦ**((VΦ)^(σ[3,2,1]))

((((Subscript[uR, 1,2])))^(σ[{1,2},3]))≡VΦ**(Subscript[uR, 2,3])**(((((VΦ)^(σ[3,2,1]))))^(σ[1,3,2]))**(Subscript[uR, 1,3])**((VΦ)^(σ[3,1,2]))

lhs=VΦ**((VΦ)^(σ[1,{2,3},4]))**((VΦ)^(σ[2,3,4]))

rhs=((VΦ)^(σ[{1,2},3,4]))**((VΦ)^(σ[1,2,{3,4}]))

lhs≡rhs