{,2^}
L, R, F
LR = RL = F^2 = 1
(LF)^(2n)=1
FLRF=1
Arbitrary word
LLLLLLLRRRRRRRRFLLLLLRRRRRR
L^n1 F L^n2 F XXXXXX
(L|R)^n F (L|R)^m F ....
FRFLFRF = R
RFLF=FRFL
True NDTM generators are L, R, FL, FR
{p,{a,b,c}}
In[]:=
gR[{p_,{a_,b_,c_}}]:={p+1,{a,b,c}}
In[]:=
gL[{p_,{a_,b_,c_}}]:={p-1,{a,b,c}}
In[]:=
gF[{p_,{a_,b_,c_}}]:={p,MapAt[1-#&,{a,b,c},p]}
{2,{0,0,0}}
In[]:=
(gF/*gR/*gF/*gL/*gF/*gR/*gL)[{2,{0,0,0}}]
Out[]=
{2,{0,0,1}}
In[]:=
(gR/*gF/*gL/*gF)[{2,{0,0,0}}]
Out[]=
{2,{0,1,1}}
In[]:=
(gF/*gR/*gF/*gL)[{2,{0,0,0}}]
Out[]=
{2,{0,1,1}}
In[]:=
RightComposition@@@Tuples[{gF,gR,gL},4]
Out[]=
In[]:=
BinaryTuringGroup[tapeLength_]:=Module[{vert,two},vert=Tuples[{Range[tapeLength],Range[0,2^tapeLength-1]}];two=Reverse[2^Range[0,tapeLength-1]];PermutationGroup[{PermutationCycles[Flatten[Position[vert,{Mod[#[[1]]+1,tapeLength,1],#[[2]]}]&/@vert]],PermutationCycles[Flatten[Position[vert,{Mod[#[[1]]-1,tapeLength,1],#[[2]]}]&/@vert]],PermutationCycles[Flatten[Position[vert,{Mod[#[[1]]+1,tapeLength,1],BitXor[#[[2]],two[[#[[1]]]]]}]&/@vert]],PermutationCycles[Flatten[Position[vert,{Mod[#[[1]]-1,tapeLength,1],BitXor[#[[2]],two[[#[[1]]]]]}]&/@vert]]}]];
In[]:=
BinaryTuringGroup[4]
Out[]=