Startup

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\SL2Portfolio2"];
<< KnotTheory`;
<<"../Profile/Profile.m";
<<"Engine-Speedy.m";
<<"Objects.m";
<<"KT.m";
BeginProfile[];
PopupWindow[Button["Show Profile Monitor"],Dynamic[PrintProfile[], UpdateInterval->3, TrackedSymbols->{}]]

$k=2; (*ℏ=γ=1;*)

Utilities and Testing

HL[ℰ_] := Style[ℰ, Background -> Green];

Cyclic Reidemeister 2:

Timing@HL[(((Subscript[(OverBar[R]), 1,5])(Subscript[C, 4])(Subscript[R, 3,2]))//(Subscript[dm, 1,3->1])//(Subscript[dm, 2,4->2])//(Subscript[dm, 2,5->2]))≡(Subscript[dϵ, 1])(Subscript[C, 2])]

aC and bC

Define[(Subscript[aC, i])=(Subscript[(Subscript[𝔼, {}->{i}])[0,0,(E^(-ℏ ϵ (Subscript[a, i])/2))], $k]),
(Subscript[(OverBar[aC]), i])=(Subscript[(Subscript[𝔼, {}->{i}])[0,0,(E^(ℏ ϵ (Subscript[a, i])/2))], $k]),
(Subscript[bC, i])=(Subscript[(Subscript[𝔼, {}->{i}])[0,0,(Subscript[B, i]^(1/2))], $k]),
(Subscript[(OverBar[bC]), i])=(Subscript[(Subscript[𝔼, {}->{i}])[0,0,(Subscript[B, i]^(-1/2))], $k])]

Timing@HL[(((Subscript[(OverBar[R]), 1,5])(Subscript[bC, 4])(Subscript[R, 3,2]))//(Subscript[am, 1,3->1])//(Subscript[bm, 2,4->2])//(Subscript[bm, 2,5->2]))≡(Subscript[dϵ, 1])(Subscript[bC, 2])]

HL[(Subscript[aC, 1])(Subscript[bC, 1])≡(Subscript[C, 1])]