[PA]
In[]:=
PlotBoard[list_String,sz_:40]:=PlotBoard[ToExpression[list],sz]
In[]:=
PlotBoard[list:{{_Integer..}..},sz_:40]:=ArrayPlot[list,ImageSizesz,ColorRules{0White,1Orange,2Purple},MeshTrue]
In[]:=
PlotBoard[list:{_Integer..},sz_:40]:=ArrayPlot[{list},ImageSizesz,ColorRules{0White,1Orange,2Purple},MeshTrue]
In[]:=
PlotBoard[i_Integer,sz_:40]:=Framed[Framed[PlotBoard[{{i}},sz]]]
In[]:=
CheckWin[list_]:=Catch[Module[{n=First[Dimensions[list]],u},Do[u=Part[list,i,All];If[!AllTrue[u,#0&]&&SameQ@@u,Throw[First[u]]],{i,n}];Do[u=Part[list,All,i];If[!AllTrue[u,#0&]&&SameQ@@u,Throw[First[u]]],{i,n}];u=Table[list[[i,i]],{i,n}];If[!AllTrue[u,#0&]&&SameQ@@u,Throw[First[u]]];u=Table[list[[-i,i]],{i,n}];If[!AllTrue[u,#0&]&&SameQ@@u,Throw[First[u]]];False]]
In[]:=
CheckWin1D[list_]:=False
In[]:=
TicTacFunction[k_Integer]:=Function[list,Catenate[Function[a,ReplacePart[list,#a]&/@Position[list,0]]/@Range[k]]]
In[]:=
TicTacFunction[mlist_List]:=Function[list,Catenate[Function[a,ReplacePart[list,#a]&/@Position[list,0]]/@mlist]]
In[]:=
Graph[ResourceFunction["MultiwayFunctionSystem"][If[IntegerQ[#],{#},With[{w=CheckWin1D[#]},If[w=!=False,{w},TicTacFunction[{1}][#]]]]&,{Table[0,2]},8,"StatesGraphStructure"],GraphLayout"LayeredDigraphEmbedding",AspectRatio1/2]
Out[]=
In[]:=
Graph[%,VertexLabelsAutomatic]
Out[]=
In[]:=
Graph[ResourceFunction["MultiwayFunctionSystem"][If[IntegerQ[#],{#},With[{w=CheckWin1D[#]},If[w=!=False,{w},TicTacFunction[{1}][#]]]]&,{Table[0,3]},8,"StatesGraphStructure"],GraphLayout"LayeredDigraphEmbedding",AspectRatio1/2,VertexLabels->Automatic]
Out[]=
In[]:=
Graph[ResourceFunction["MultiwayFunctionSystem"][If[IntegerQ[#],{#},With[{w=CheckWin1D[#]},If[w=!=False,{w},TicTacFunction[{1}][#]]]]&,{Table[0,4]},8,"StatesGraphStructure"],GraphLayout"LayeredDigraphEmbedding",AspectRatio1/2,VertexLabels->Automatic]
Out[]=
In[]:=
Graph[ResourceFunction["MultiwayFunctionSystem"][If[IntegerQ[#],{#},With[{w=CheckWin1D[#]},If[w=!=False,{w},TicTacFunction[{1,2}][#]]]]&,{Table[0,2]},8,"StatesGraphStructure"],GraphLayout"LayeredDigraphEmbedding",AspectRatio1/2,VertexLabels->Automatic]
Out[]=
In[]:=
Graph[ResourceFunction["MultiwayFunctionSystem"][If[IntegerQ[#],{#},With[{w=CheckWin1D[#]},If[w=!=False,{w},TicTacFunction[{1,2}][#]]]]&,{Table[0,3]},8,"StatesGraphStructure"],GraphLayout"LayeredDigraphEmbedding",AspectRatio1/2,VertexLabels->Automatic]
Out[]=
In[]:=
ResourceFunction["MultiwayFunctionSystem"][If[IntegerQ[#],{#},With[{w=CheckWin[#]},If[w=!=False,{w},TicTacFunction[2][#]]]]&,{Table[0,2,2]},4,"StatesGraph","StateRenderingFunction"(Inset[PlotBoard[#2,30],#1]&)]
In[]:=
NestList[Union[Catenate[TicTacFunction[{1}]/@#]]&,{{0,0,0}},3]
Out[]=
{{{0,0,0}},{{0,0,1},{0,1,0},{1,0,0}},{{0,1,1},{1,0,1},{1,1,0}},{{1,1,1}}}
In[]:=
FoldList[Union[Catenate[TicTacFunction[{#2}]/@#]]&,{{0,0,0}},{1,2,1}]
Out[]=
{{{0,0,0}},{{0,0,1},{0,1,0},{1,0,0}},{{0,1,2},{0,2,1},{1,0,2},{1,2,0},{2,0,1},{2,1,0}},{{1,1,2},{1,2,1},{2,1,1}}}
FoldList[Union[Catenate[TicTacFunction[{#2}]/@#]]&,{{0,0,0}},{1,2,1}]
In[]:=
CheckWin[{{1,2,1},{1,0,0},{1,0,0}}]
Out[]=
1
In[]:=
CheckWin[{{1,2,1},{1,0,0},{2,0,0}}]
Out[]=
False
In[]:=
Length/@FoldList[Select[Union[Catenate[TicTacFunction[{#2}]/@#]],CheckWin[#]===False&]&,{Table[0,3,3]},{1,2,1}]
Out[]=
{1,9,72,252}
In[]:=
Table[Mod[i,2,1],{i,10}]
Out[]=
{1,2,1,2,1,2,1,2,1,2}
In[]:=
Length/@FoldList[Select[Union[Catenate[TicTacFunction[{#2}]/@#]],CheckWin[#]===False&]&,{Table[0,3,3]},Table[Mod[i,2,1],{i,10}]]
Out[]=
{1,9,72,252,756,1140,1372,696,222,16,0}
In[]:=
ListLinePlot[%]
Out[]=
1 player
1 player
3 player
3 player
4 player
4 player
2×2
2×2
4×4
4×4
[More]
Need to merge states on different steps.....
[ Consider path weights ] [ Consider the 1D case ]
[ Consider path weights ] [ Consider the 1D case ]