Pensieve header: The WG Algebra with testing.

DeclareGroup[(Subscript[S, k_])]:=Module[{α,β,e,γs},
Clear[G,n,g,ι,m,inv];
G=PermutationCycles/@(Permutations@Range@k);
n=Length[G];
Do[g[α]=e=G[[α]]; ι[e]=α,{α,n} ];
m[]=ι[Cycles[{}]];
Do[m[α,β]=ι[g[α]~PermutationProduct~g[β]],{α,n},{β,n} ];
m[α_]:=α; m[α_,β_,γs__]:=m[m[α,β],γs];
Do[inv[α]=ι[InversePermutation[g[α]]],{α,n}]
]

DeclareGroup[(Subscript[S, 3])];
Table[m[i,j],{i,n},{j,n}]//MatrixForm

Basis[]={1};
Basis[i_,is___]:=Flatten@Table[(Subscript[W, i])[α,β]Basis[is],{α,n},{β,n}]

Basis[1,2]

(Subscript[m, i_,j_->k_])[ℰ_]:=Expand[ℰ]/.(Subscript[W, i])[α_,β_](Subscript[W, j])[γ_,δ_]:>If[m[α,β]==m[β,γ],(Subscript[W, k])[α,m[β,δ]],0];
(Subscript[η, i_])[ℰ_]:=Expand[ℰ Sum[(Subscript[W, i])[α,m[]], {α,n}]];

(Subscript[Δ, i_->j_,k_])[ℰ_]:=Expand[ℰ/.(Subscript[W, i])[α_,β_]:>Sum[(Subscript[W, j])[γ,β](Subscript[W, k])[m[α,inv[γ]],β],{γ,n}]];
(Subscript[ε, i_])[ℰ_]:=Expand[ℰ/.(Subscript[W, i])[α_,β_]:>If[α==m[],1,0]];

(Subscript[S, i_])[ℰ_]:=Expand[ℰ/.(Subscript[W, i])[α_,β_]:>(Subscript[W, i])[m[inv[β],inv[α],β], inv[β]]];

(Subscript[R, i_,j_]):=Sum[(Subscript[W, i])[α,m[]](Subscript[W, j])[β,α], {α,n}, {β,n}];
(Subscript[(OverBar[R]), i_,j_]):=Sum[(Subscript[W, i])[α,m[]](Subscript[W, j])[β,inv@α], {α,n}, {β,n}];

b=Basis[1,2,3]; (b//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]))==(b//(Subscript[m, 2,3->2])//(Subscript[m, 1,2->1]))

b=Basis[1]; (b//(Subscript[η, 2])//(Subscript[m, 1,2->1]))==b==(b//(Subscript[η, 2])//(Subscript[m, 1,2->1]))

b=Basis[1]; (b //(Subscript[Δ, 1->1,2])//(Subscript[Δ, 2->2,3]))==(b//(Subscript[Δ, 1->1,3])//(Subscript[Δ, 1->1,2]))

b=Basis[1]; (b//(Subscript[Δ, 1->1,2])//(Subscript[ε, 2]))==b==(b//(Subscript[Δ, 1->2,1])//(Subscript[ε, 2]))

b=Basis[1,2]; (b//(Subscript[ε, 1])//(Subscript[ε, 2]))==(b//(Subscript[m, 1,2->1])//(Subscript[ε, 1]))

b=Basis[1,3]; (b //(Subscript[Δ, 1->1,2])//(Subscript[Δ, 3->3,4])//(Subscript[m, 1,3->1])//(Subscript[m, 2,4->2]))==(b//(Subscript[m, 1,3->1])//(Subscript[Δ, 1->1,2]))

b=Basis[1]; (b//(Subscript[S, 1])//(Subscript[S, 1]))==b

b=Basis[1]; (b //(Subscript[Δ, 1->1,2])//(Subscript[S, 2])//(Subscript[m, 1,2->1]))==(b//(Subscript[ε, 1])//(Subscript[η, 1]))==(b //(Subscript[Δ, 1->1,2])//(Subscript[S, 1])//(Subscript[m, 1,2->1]))

((Subscript[R, 1,2])(Subscript[(OverBar[R]), 3,4])//(Subscript[m, 1,3->1])//(Subscript[m, 2,4->2]))==(1//(Subscript[η, 1])//(Subscript[η, 2]))==((Subscript[R, 1,2])(Subscript[(OverBar[R]), 3,4])//(Subscript[m, 1,3->1])//(Subscript[m, 4,2->2]))

((Subscript[R, 1,2])(Subscript[R, 4,3])(Subscript[R, 5,6])//(Subscript[m, 1,4->1])//(Subscript[m, 2,5->2])//(Subscript[m, 3,6->3]))==((Subscript[R, 2,3])(Subscript[R, 1,4])(Subscript[R, 5,6])//(Subscript[m, 1,5->1])//(Subscript[m, 2,6->2])//(Subscript[m, 3,4->3]))

{((Subscript[R, 1,3])//(Subscript[Δ, 1->1,2]) )==( (Subscript[R, 2,3])(Subscript[R, 1,4])//(Subscript[m, 3,4->3])), ((Subscript[R, 1,2])//(Subscript[Δ, 2->2,3]) )==( (Subscript[R, 0,2])(Subscript[R, 1,3])//(Subscript[m, 0,1->1]))}

{((Subscript[R, 1,2])//(Subscript[ε, 1]))==(1//(Subscript[η, 2])),((Subscript[R, 1,2])//(Subscript[ε, 2]))==(1//(Subscript[η, 1]))}

((Subscript[R, 1,2])//(Subscript[S, 1]))==(Subscript[(OverBar[R]), 1,2])==((Subscript[R, 1,2])//(Subscript[S, 2]))

Does R1 hold?

{(Subscript[R, 1,2])//(Subscript[m, 1,2->1]),1//(Subscript[η, 1])}

Ks={PD[X[1,4,2,5],X[3,6,4,1],X[5,2,6,3]],
PD[X[4,2,5,1],X[8,6,1,5],X[6,3,7,4],X[2,7,3,8]],
PD[X[1,6,2,7],X[3,8,4,9],X[5,10,6,1],X[7,2,8,3],X[9,4,10,5]],
PD[X[1,4,2,5],X[3,8,4,9],X[5,10,6,1],X[9,6,10,7],X[7,2,8,3]]};

Z[pd_PD]:=Module[{z},
z=Expand[Times@@pd/.x:X[i_,j_,k_,l_]:>If[PositiveQ@x, (Subscript[R, l,i]),(Subscript[(OverBar[R]), j,i])]];
Do[z=z//(Subscript[m, 1,k->1]),{k,2Length@pd}];
z]

Table[K->Echo[Timing[Z[K]]], {K,Ks}]