Pensieve header: Testing invariance under changes of the order of operations by permuting tangles.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\ICERM-2305"];
<< Signatures.m

Random Permutations

RandomPermutation[K_PD]^:=K[[PermutationList[RandomPermutation@Length@K,Length@K]]]

Some Tangles

T1=PD[(Subscript[(OverBar[X]), -6,2,7,-1]),(Subscript[(OverBar[X]), -2,8,3,-7]),(Subscript[(OverBar[X]), -8,4,9,-3]),(Subscript[X, -11,6,12,-5]),(Subscript[X, -4,11,5,-10])];
T2=PD[(Subscript[X, -6,2,7,-1]),(Subscript[X, -2,8,3,-7]),(Subscript[X, -8,4,9,-3]),(Subscript[(OverBar[X]), -12,6,13,-5]),(Subscript[(OverBar[X]), -4,12,5,-11]),(Subscript[(OverBar[X]), -10,15,11,-14]),(Subscript[(OverBar[X]), -15,10,16,-9])];

Column@{TL[T1],Kas[T1]}

Column@{TL[T2],Kas[T2]}

Total[TL[T1]==TL[#]&/@Permutations[T1]]

Total[TL[T2]==TL[#]&/@Permutations[T2]]

Total[Kas[T1]==Kas[#]&/@Permutations[T1]]

Total[Kas[T2]==Kas[#]&/@Permutations[T2]]

Some Braids

B1=PD[(Subscript[X, -5,2,6,-1]),(Subscript[(OverBar[X]), -8,3,9,-2]),(Subscript[X, -11,4,12,-3]),(Subscript[X, -12,10,13,-9]),(Subscript[(OverBar[X]), -13,7,14,-6])];
B2=PD[(Subscript[X, -5,2,6,-1]),(Subscript[(OverBar[X]), -9,3,10,-2]),(Subscript[X, -10,7,11,-6]),(Subscript[(OverBar[X]), -12,4,13,-3]),(Subscript[X, -13,8,14,-7])];

Total[TL[B1]==TL[#]&/@Permutations[B1]]

Total[TL[B2]==TL[#]&/@Permutations[B2]]

Total[Kas[B1]==Kas[#]&/@Permutations[B1]]

Total[Kas[B2]==Kas[#]&/@Permutations[B2]]

Column@{TL[B1],Kas[B1]}

Column@{TL[B2],Kas[B2]}