SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\SL2Portfolio2"];
<< KnotTheory`;
<<"../Profile/Profile.m";
<<"Engine-Speedy.m";
<<"Objects.m";
<<"KT.m";
BeginProfile[];

$k=0;ℏ=1;γ=1;

(Subscript[tr, k_]):=(Subscript[𝔼, {k}->{}])[ (Subscript[β, k])(Subscript[b, k]),(( (Subscript[𝒜, k]) (1-(Subscript[B, k])))/(-1+ (Subscript[𝒜, k])))(Subscript[ξ, k])(Subscript[η, k])/ℏ,1];
Simplify[((Subscript[dm, i,j->k])//(Subscript[tr, k]))≡((Subscript[dm, j,i->k])//(Subscript[tr, k]))]

(Subscript[Xp, a_,b_]):= Xp[a,b]; (Subscript[Xm, a_,b_]):=Xm[a,b];

SXForm[L_] := SXForm[
Skeleton[L],
Times@@PD[L] /. X[i_,j_,k_,l_] :> If[PositiveQ[X[i,j,k,l]],Xp[l,i], Xm[j,i]]
];

SXForm[Link[6,Alternating,1]]

Z[L_Link] := Module[{s, z},
{s, z} = List @@ SXForm[L];
z=z/.{Xp[i_,j_]:>(Subscript[R, i,j]), Xm[i_,j_]:>(Subscript[(OverBar[R]), i,j])};
Do[z = z // (Subscript[dm, s[[c,1]],s[[c,k]] ->s[[c,1]]]), {c, Length[s]},{k, 2, Length[s[[c]]]}];
z
];

z=Z[Link[9,Alternating,1]]

z[[0,2,2]]

trZ[L_Link]:=Module[{z,z1,comps},
z=Echo@Z[L];
comps=z[[0,2,2]];
z1=z//(Times@@(Rest[comps]/.i_Integer:>(Subscript[tr, i])));
Echo@z1;
(z1[[3]]//Normal)/.Thread[((Subscript[B, #])&/@comps)-> ((Subscript[B, #])&/@Range@Length@comps)]
]

L=Link[7,Alternating,2];
trZ[L]

MultivariableAlexander[L][B]/.B[i_]:>(Subscript[B, i])

Simplify[trZ[L]*(MultivariableAlexander[L][B]/.B[i_]:>(Subscript[B, i]))]