Pensieve header: Testing the expansion extension property for $n$-strand pure braid groups.

SetDirectory["C:\\drorbn\\AcademicPensieve\\2015-02"];
<< ../Projects/WKO4/FreeLie.m
Conj[a_,b_] := (-b)**a**b;

SolvePB[n_] := SeriesSolve[
Flatten@Table[
Do[cs[n,i,j][l,k]=0, {k,1,n-1}, {l, k+1,n}]; cs[n,i,j][j,i]=1;
s[n,i,j]=DKS[n,cs[n,i,j]],
{i,1,n-1}, {j, i+1, n}
],
And@@(Flatten@Table[
Which[
l<i || i<k<l<j, Conj[s[n,i,j],s[n,k,l]] ≡ s[n,i,j],
l==i, Conj[s[n,i,j],s[n,k,l]] ≡ Conj[s[n,i,j], -s[n,k,j]],
i==k && k<l<j, Conj[s[n,i,j],s[n,k,l]] ≡  Conj[s[n,i,j], (-s[n,l,j])**(-s[n,i,j])],
k<i<l<j, Conj[s[n,i,j],s[n,k,l]] ≡ Conj[s[n,i,j], Conj[s[n,k,j], -s[n,l,j]]**(-s[n,k,j])],
True, BS@True
],
{i,1,n-1}, {j,i+1,n}, {k,1,n-1}, {l, k+1,n}
])
]

SolvePB[2]

SolvePB[2]; s[2,1,2]

SolvePB[3]

With[{n=3}, Flatten@Table["s"[n,i,j]->s[n,i,j], {i,1,n-1}, {j, i+1, n}]]