Pensieve header: Solving the KV equations ($k=0).

Follows code in Projects/SL2Portfolio/SL2PortfolioProgram.nb.

Startup

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\SL2Portfolio2"];
Once[<< KnotTheory`];
Once[<<"../Profile/Profile.m";];
<<"Engine-Speedy.m";
<<"Objects.m";
$k=0;
$QZipFail=True;
HL[ℰ_] := Style[ℰ, Background -> Green];

(Subscript[R, i,j])

(Subscript[V0, i_,j_]):=(Subscript[𝔼, {}->{i,j}])[(ℏ/2) (Subscript[a, j]) (Subscript[b, i]),ℏ F[(Subscript[B, i]),(Subscript[B, j])] (Subscript[y, i])(Subscript[x, j])+ℏ G[(Subscript[B, i]),(Subscript[B, j])](Subscript[x, i]) (Subscript[y, j]),ω[(Subscript[B, i]),(Subscript[B, j])]];
(Subscript[V0, i,j])

R4l=((Subscript[V0, -1,-2])((Subscript[R, 1,3])//(Subscript[cΔ, 1->1,2])))//(Subscript[cm, -1,1->1])//(Subscript[cm, -2,2->2])

R4r=((Subscript[R, -2,-3])(Subscript[R, -1,3]) // (Subscript[cm, -3,3->3]))(Subscript[V0, 1,2])//(Subscript[cm, -1,1->1])//(Subscript[cm, -2,2->2])

Simplify[R4l≡R4r]

Simplify[(((Sqrt[(Subscript[B, 1])])-(Subscript[B, 1]))/(-γ  (Subscript[b, 1])))]

(Subscript[V0, i_,j_]):=(Subscript[𝔼, {}->{i,j}])[(ℏ/2) (Subscript[a, j]) (Subscript[b, i]),((-(Sqrt[(Subscript[B, i])])+(Subscript[B, i]))/(γ (Subscript[b, i])))(Subscript[x, i]) (Subscript[y, j]),ω[(Subscript[B, i]),(Subscript[B, j])]];
(Subscript[V0, 3,4])

R4l=((Subscript[V0, -1,-2])((Subscript[R, 1,3])//(Subscript[cΔ, 1->1,2])))//(Subscript[cm, -1,1->1])//(Subscript[cm, -2,2->2])

R4r=((Subscript[R, -2,-3])(Subscript[R, -1,3]) // (Subscript[cm, -3,3->3]))(Subscript[V0, 1,2])//(Subscript[cm, -1,1->1])//(Subscript[cm, -2,2->2])

HL@Simplify[R4l≡R4r]

(Subscript[(OverBar[V0]), i_,j_]):=(Subscript[𝔼, {}->{i,j}])[-(ℏ/2) (Subscript[a, j]) (Subscript[b, i]),ℏ F[(Subscript[B, i]),(Subscript[B, j])](Subscript[x, j]) (Subscript[y, i])+ℏ G[(Subscript[B, i]),(Subscript[B, j])](Subscript[x, i]) (Subscript[y, j]),(OverBar[ω])[(Subscript[B, i]),(Subscript[B, j])]];
(Subscript[(OverBar[V0]), i,j])

Simplify/@((Subscript[(OverBar[V0]), -1,-2])(Subscript[V0, 1,2])// (Subscript[cm, -1,1->1])//(Subscript[cm, -2,2->2]))

Solve[(-1+γ ℏ G[(Subscript[B, 1]),(Subscript[B, 2])] (Subscript[b, 1])+(Sqrt[(Subscript[B, 1])]))==0,G[(Subscript[B, 1]),(Subscript[B, 2])]]

(Subscript[(OverBar[V0]), i_,j_]):=(Subscript[𝔼, {}->{i,j}])[-(ℏ/2) (Subscript[a, j]) (Subscript[b, i]),((1-(Sqrt[(Subscript[B, i])]))/(γ (Subscript[b, i])))(Subscript[x, i]) (Subscript[y, j]),((ω[(Subscript[B, i]),(Subscript[B, j])])^(-1))];
(Subscript[(OverBar[V0]), i,j])

(Subscript[(OverBar[V0]), -1,-2])(Subscript[V0, 1,2])// (Subscript[cm, -1,1->1])//(Subscript[cm, -2,2->2])

(Subscript[Φ0, i_,j_,k_]):=Module[{s1,s2,s3},
((((Subscript[(OverBar[V0]), i,k])//(Subscript[cΔ, i->i,j]))(Subscript[(OverBar[V0]), s1,s2])//(Subscript[cm, i,s1->i])//(Subscript[cm, j,s2->j]))(Subscript[V0, s2,s3])//(Subscript[cm, j,s2->j])//(Subscript[cm, k,s3->k]))((Subscript[V0, s1,s2])//(Subscript[cΔ, s2->s2,s3]))//(Subscript[cm, i,s1->i])//(Subscript[cm, j,s2->j])//(Subscript[cm, k,s3->k])
];
(Subscript[Φ0, i,j,k])

lhs=((Subscript[Φ0, 1,2,3])((Subscript[Φ0, -1,-2,4])//(Subscript[cΔ, -2->-2,-3]))//(Subscript[cm, 1,-1->1])//(Subscript[cm, 2,-2->2])//(Subscript[cm, 3,-3->3]))(Subscript[Φ0, -2,-3,-4])//(Subscript[cm, 2,-2->2])//(Subscript[cm, 3,-3->3])//(Subscript[cm, 4,-4->4])

rhs=((Subscript[Φ0, 1,3,4])//(Subscript[cΔ, 1->1,2]))((Subscript[Φ0, -1,-2,-3])//(Subscript[cΔ, -3->-3,-4]))//(Subscript[cm, 1,-1->1])//(Subscript[cm, 2,-2->2])//(Subscript[cm, 3,-3->3])//(Subscript[cm, 4,-4->4])

Simplify[lhs≡rhs]

(Subscript[cΔ, 1->1,2])