Pensieve header: Implementing the HOMFLYPT Arc Algebra.

ν[(Subscript[a, i_,j_]),(Subscript[a, k_,l_])]:=HeavisideTheta[i-k]-HeavisideTheta[i-l]-HeavisideTheta[j-k]+HeavisideTheta[j-l];

(Subscript[PT, k_])[w[lft___,(Subscript[a, i_,j_]),(Subscript[a, k_,l_]),rgt___]]:=Module[
{ν=ν[(Subscript[a, i,j]),(Subscript[a, k,l])]},
(Subscript[PT, k])[(a^(2ν)) w[lft,(Subscript[a, k,l]),(Subscript[a, i,j]),rgt]+ν (a^ν) w[lft,(Subscript[a, k,j]),(Subscript[a, i,l]),rgt]]
];
(Subscript[PT, k_])[w[(Subscript[a, k_,l_]),rest___]]:=w[(Subscript[a, k,l]),rest];
(Subscript[PT, k_])[ℰ_]/;(Head[ℰ]=!=w):=Expand[ℰ/.ω_w:>(Subscript[PT, k])[ω]]

(Subscript[PT, 2])[w[(Subscript[a, 4,1]),(Subscript[a, 3,6]),(Subscript[a, 2,5])]]

(Subscript[PT, 4])[w[(Subscript[a, 4,1]),(Subscript[a, 3,6]),(Subscript[a, 2,5])]]

(Subscript[PT, 4])@(Subscript[PT, 2])[w[(Subscript[a, 4,1]),(Subscript[a, 3,6]),(Subscript[a, 2,5])]]

(Subscript[PT, 2])@(Subscript[PT, 4])@(Subscript[PT, 2])[w[(Subscript[a, 4,1]),(Subscript[a, 3,6]),(Subscript[a, 2,5])]]

(Subscript[PT, 4])@(Subscript[PT, 3])@(Subscript[PT, 2])@(Subscript[PT, 2])@(Subscript[PT, 4])@(Subscript[PT, 2])[w[(Subscript[a, 4,1]),(Subscript[a, 3,6]),(Subscript[a, 2,5])]]

(Subscript[PT, 2])@(Subscript[PT, 3])@(Subscript[PT, 4])@w[(Subscript[a, 4,1]),(Subscript[a, 3,6]),(Subscript[a, 2,5])]

(Subscript[PT, 3])@(Subscript[PT, 2])@(Subscript[PT, 4])@w[(Subscript[a, 4,1]),(Subscript[a, 3,6]),(Subscript[a, 2,5])]

(Subscript[PT, 4])@(Subscript[PT, 3])@(Subscript[PT, 2])@w[(Subscript[a, 2,1]),(Subscript[a, 3,5]),(Subscript[a, 4,6])]

CF[ℰ_]:=Expand@Module[{},
ℰ//.w[lft___,(Subscript[a, i_,j_]),(Subscript[a, k_,l_]),rgt___]/;i>k:>(n=ν[(Subscript[a, i,j]),(Subscript[a, k,l])];
(a^(2n)) w[lft,(Subscript[a, k,l]),(Subscript[a, i,j]),rgt]+n (a^n) w[lft,(Subscript[a, k,j]),(Subscript[a, i,l]),rgt]
)
]

CF[(a^3) w[(Subscript[a, 2,1]),(Subscript[a, 4,5]),(Subscript[a, 3,6])]+(a^2) w[(Subscript[a, 2,1]),(Subscript[a, 4,6]),(Subscript[a, 3,5])]+(a^4) w[(Subscript[a, 2,5]),(Subscript[a, 4,1]),(Subscript[a, 3,6])]+(a^3) w[(Subscript[a, 2,6]),(Subscript[a, 4,1]),(Subscript[a, 3,5])]]

BestCyclicMatch[a_List,b_List]:=Module[{i,j,k,la=Length@a,lb=Length@b,m},
m=Join@@Table[
k=0;While[a[[Mod[i+k,la,1]]]===b[[Mod[j+k,lb,1]]],++k];
{k,i,j},
{i,la},{j,lb}
];
MaximalBy[m,First][[1]]
]

BestCyclicMatch[{9,2,5,4,6,7},Range[10]]

BestCyclicMatch[{11,23},Range[10]]