WOLFRAM NOTEBOOK

Multiway Game Systems

For now, consider “games” where any player can play at any move....

1D tic-tac-toe

Similar to Turing machine; change only one element at a time...
In[]:=
ResourceFunction["MultiwayFunctionSystem"][Function[list,Catenate[Function[a,ReplacePart[list,#a]&/@Flatten[Position[list,0]]]/@{1,2}]],{Table[0,4]},3]
Out[]=
{{{0, 0, 0, 0}},{{0, 0, 0, 1},{0, 0, 0, 2},{0, 0, 1, 0},{0, 0, 2, 0},{0, 1, 0, 0},{0, 2, 0, 0},{1, 0, 0, 0},{2, 0, 0, 0}},{{0, 0, 1, 1},{0, 0, 1, 2},{0, 0, 2, 1},{0, 0, 2, 2},{0, 1, 0, 1},{0, 1, 0, 2},{0, 1, 1, 0},{0, 1, 2, 0},{0, 2, 0, 1},{0, 2, 0, 2},{0, 2, 1, 0},{0, 2, 2, 0},{1, 0, 0, 1},{1, 0, 0, 2},{1, 0, 1, 0},{1, 0, 2, 0},{1, 1, 0, 0},{1, 2, 0, 0},{2, 0, 0, 1},{2, 0, 0, 2},{2, 0, 1, 0},{2, 0, 2, 0},{2, 1, 0, 0},{2, 2, 0, 0}},{{0, 1, 1, 1},{0, 1, 1, 2},{0, 1, 2, 1},{0, 1, 2, 2},{0, 2, 1, 1},{0, 2, 1, 2},{0, 2, 2, 1},{0, 2, 2, 2},{1, 0, 1, 1},{1, 0, 1, 2},{1, 0, 2, 1},{1, 0, 2, 2},{1, 1, 0, 1},{1, 1, 0, 2},{1, 1, 1, 0},{1, 1, 2, 0},{1, 2, 0, 1},{1, 2, 0, 2},{1, 2, 1, 0},{1, 2, 2, 0},{2, 0, 1, 1},{2, 0, 1, 2},{2, 0, 2, 1},{2, 0, 2, 2},{2, 1, 0, 1},{2, 1, 0, 2},{2, 1, 1, 0},{2, 1, 2, 0},{2, 2, 0, 1},{2, 2, 0, 2},{2, 2, 1, 0},{2, 2, 2, 0}}}
In[]:=
ResourceFunction["MultiwayFunctionSystem"][Function[list,Catenate[Function[a,ReplacePart[list,#a]&/@Flatten[Position[list,0]]]/@{1,2}]],{Table[0,3]},5,"StatesGraph"]
Out[]=
In[]:=
ResourceFunction["MultiwayFunctionSystem"][Function[list,Catenate[Function[a,ReplacePart[list,#a]&/@Flatten[Position[list,0]]]/@{1,2}]],{Table[0,4]},5,"StatesGraphStructure"]
Out[]=
In[]:=
Graph3D[%]
Out[]=

2D tic-tac-toe

2×2 case

In[]:=
test=ResourceFunction["MultiwayFunctionSystem"][Function[list,Catenate[Function[a,ReplacePart[list,#a]&/@Position[list,0]]/@{1,2}]],{Table[0,2,2]},2]
Out[]=
{{{{0, 0}, {0, 0}}},{{{0, 0}, {0, 1}},{{0, 0}, {0, 2}},{{0, 0}, {1, 0}},{{0, 0}, {2, 0}},{{0, 1}, {0, 0}},{{0, 2}, {0, 0}},{{1, 0}, {0, 0}},{{2, 0}, {0, 0}}},{{{0, 0}, {1, 1}},{{0, 0}, {1, 2}},{{0, 0}, {2, 1}},{{0, 0}, {2, 2}},{{0, 1}, {0, 1}},{{0, 1}, {0, 2}},{{0, 1}, {1, 0}},{{0, 1}, {2, 0}},{{0, 2}, {0, 1}},{{0, 2}, {0, 2}},{{0, 2}, {1, 0}},{{0, 2}, {2, 0}},{{1, 0}, {0, 1}},{{1, 0}, {0, 2}},{{1, 0}, {1, 0}},{{1, 0}, {2, 0}},{{1, 1}, {0, 0}},{{1, 2}, {0, 0}},{{2, 0}, {0, 1}},{{2, 0}, {0, 2}},{{2, 0}, {1, 0}},{{2, 0}, {2, 0}},{{2, 1}, {0, 0}},{{2, 2}, {0, 0}}}}
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[i_Integer,sz_:40]:=Framed[Framed[PlotBoard[{{i}},sz]]]
In[]:=
Map[PlotBoard,test,{2}]
Out[]=
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
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[]:=
PlotBoard[#]CheckWin[ToExpression[#]]&/@Last[ResourceFunction["MultiwayFunctionSystem"][Function[list,Catenate[Function[a,ReplacePart[list,#a]&/@Position[list,0]]/@{1,2}]],{Table[0,2,2]},2]]
Out[]=
1,
False,
False,
2,
1,
False,
1,
False,
False,
2,
False,
2,
1,
False,
1,
False,
1,
False,
False,
2,
False,
2,
False,
2
In[]:=
TicTacFunction[k_Integer]:=Function[list,Catenate[Function[a,ReplacePart[list,#a]&/@Position[list,0]]/@Range[k]]]
In[]:=
PlotBoard[#]CheckWin[ToExpression[#]]&/@Last[ResourceFunction["MultiwayFunctionSystem"][TicTacFunction[1],{Table[0,2,2]},2]]
Out[]=
1,
1,
1,
1,
1,
1
In[]:=
ResourceFunction["MultiwayFunctionSystem"][If[IntegerQ[#],{#},With[{w=CheckWin[#]},If[w=!=False,{w},TicTacFunction[1][#]]]]&,{Table[0,2,2]},4,"StatesGraph"]
Out[]=

1 color

3 colors

Find shortest game:

Size 3 board

1 color

2 colors

Case with alternating players

[[ need to include step number when determining “play” ]]

More....

Consider “zapping” parts of the board

Consider cyclic boards

Wolfram Cloud

You are using a browser not supported by the Wolfram Cloud

Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.


I understand and wish to continue anyway »

You are using a browser not supported by the Wolfram Cloud. Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.