In[]:=
NeighboringConfigurations[{{s0_Integer,pos0_Integer},tape0_List},{s_Integer,k_Integer},offs_:{-1,1}]:=Flatten[Table[{{s1,Mod[pos0+pos1,Length[tape0],1]},tape1},{s1,s},{pos1,offs},{tape1,Table[ReplacePart[tape0,pos0i],{i,0,k-1}]}],2]
In[]:=
TMNCGraph[tlen_Integer,{s_Integer,k_Integer},offs_:{-1,1}]:=Graph[Flatten[Table[{{s0,pos0},tape0}#&/@NeighboringConfigurations[{{s0,pos0},tape0},{s,k},offs],{s0,s},{pos0,tlen},{tape0,Tuples[Range[0,k-1],tlen]}]]]
In[]:=
TMNCGraphX[tlen_Integer,{s_Integer,k_Integer},offs_:{-1,1}]:=Graph[Flatten[Table[{{s0,pos0},tape0}#&/@NeighboringConfigurations[{{s0,pos0},tape0},{s,k},offs],{s0,s},{pos0,tlen},{tape0,Tuples[Range[0,k-1],tlen]}]],VertexShapeFunction(Inset[RulePlot[TuringMachine[2506(*needsasampleofruletype*)],{{1,#2[[1,2]]},#2[[2]]},0,MeshAll,FrameFalse,ImageSize30],#1]&)]
Limit at the end:
In[]:=
NeighboringConfigurationsC[{{s0_Integer,pos0_Integer},tape0_List},{s_Integer,k_Integer},offs_:{-1,1}]:=Flatten[Table[If[1≤pos0+pos1≤Length[tape0],{{s1,pos0+pos1},tape1},Nothing],{s1,s},{pos1,offs},{tape1,Table[ReplacePart[tape0,pos0i],{i,0,k-1}]}],2]
In[]:=
TMNCGraphC[tlen_Integer,{s_Integer,k_Integer},offs_:{-1,1}]:=Graph[Flatten[Table[{{s0,pos0},tape0}#&/@NeighboringConfigurationsC[{{s0,pos0},tape0},{s,k},offs],{s0,s},{pos0,tlen},{tape0,Tuples[Range[0,k-1],tlen]}]]]
In[]:=
TMNCGraphCX[tlen_Integer,{s_Integer,k_Integer},offs_:{-1,1}]:=Graph[Flatten[Table[{{s0,pos0},tape0}#&/@NeighboringConfigurationsC[{{s0,pos0},tape0},{s,k},offs],{s0,s},{pos0,tlen},{tape0,Tuples[Range[0,k-1],tlen]}]],VertexShapeFunction(Inset[RulePlot[TuringMachine[2506(*needsasampleofruletype*)],{{1,#2[[1,2]]},#2[[2]]},0,MeshAll,FrameFalse,ImageSize30],#1]&)]
In[]:=
TMNCGraphCX[1,{1,2},{-1,0,1}]
Out[]=
In[]:=
TMNCGraphCX[3,{2,2},{-1,0,1}]
Out[]=
In[]:=
TMNCGraphCX[3,{2,2},{-1,1}]
Out[]=
In[]:=
Graph3D[%]
Out[]=
In[]:=
First[Values[With[{t=5},ResourceFunction["GraphNeighborhoodVolumes"][TMNCGraphC[2t+1,{2,2},{-1,1}],{{{1,t+1},Table[0,2t+1]}}]]]]
Out[]=
{1,9,36,100,248,576,1024,1744,2528,3776,5248,7616,10368,14848,19712,26880,32768,38912,41984,44032,45056}
In[]:=
First[Values[With[{t=5},ResourceFunction["GraphNeighborhoodVolumes"][TMNCGraph[2t+1,{2,2},{-1,1}],{{{1,t+1},Table[0,2t+1]}}]]]]
Out[]=
{1,9,36,100,248,576,1272,2720,5624,11328,22176,36440,44112,45016,45056}
In[]:=
gg4=With[{t=4},TMNCGraph[2t+1,{2,2},{-1,1}]];
In[]:=
NeighborhoodGraph[gg4,With[{t=4},{{1,t+1},Table[0,2t+1]}],1,VertexCoordinatesNone]
Out[]=
In[]:=
NeighborhoodGraph[gg4,With[{t=4},{{1,t+1},Table[0,2t+1]}],2,VertexCoordinatesNone]
Out[]=
In[]:=
First[Values[With[{t=5},ResourceFunction["GraphNeighborhoodVolumes"][TMNCGraphC[2t+1,{1,2},{-1,1}],{{{1,t+1},Table[0,2t+1]}}]]]]
Out[]=
{1,5,18,50,124,288,512,872,1264,1888,2624,3808,5184,7424,9856,13440,16384,19456,20992,22016,22528}
In[]:=
First[Values[With[{t=5},ResourceFunction["GraphNeighborhoodVolumes"][UndirectedGraph[TMNCGraphC[2t+1,{1,2},{-1,1}]],{{{1,t+1},Table[0,2t+1]}}]]]]
Out[]=
{1,7,26,74,180,412,646,1032,1472,2208,3040,4448,6016,8576,11136,14976,17408,19456,20992,22016,22528}