Skip to main content

programming - Detecting patterns of black and white stones on a 2D board


I'm writing a program to play a game of Pente, and I'm struggling with the following question:



What's the best way to detect patterns on a two-dimensional board?



For example, in Pente a pair of neighboring stones of the same color can be captured when they are flanked from both sides by an opponent; how can we find all the stones that can be captured with the next move for the following board?


sample board



Below I show one possible straightforward solution, but with a defect: it's hard to extend it for other interesting patterns, i.e. three stones of the same color in a row surrounded by empty spaces, or four stones of the same color in a row which are flanked from one side but open from another, etc.



I'm wondering whether there is a way to define a DSL for detecting 2-dimensional structures like that on a board - sort of a 2D pattern matching.



P.S. I would also appreciate any advice on how to simplify the code below and make it more idiomatic - for example, I don't really like the way how sortStones is defined.


Straightforward solution


Here is one way to solve this problem (see below for graphics primitives to generate and display random boards):



  • Enumerate all subsets of 3 stones from the board above

  • Select those that form an AABE or ABBE pattern, where E denotes an unoccupied space



Lets store the board as a list of black and white stones,


a = {black[2, 1], black[4, 3], black[2, 5], black[4, 2], black[5, 3], 
black[1, 2], black[1, 3], black[5, 4], black[1, 5], white[3, 1],
white[4, 1], white[4, 4], white[3, 5], white[3, 4], white[5, 1],
white[5, 2], white[3, 3], white[1, 1]}

First, we define isTriple which checks whether three stones sorted by their x and y coordinates are in the same row next to each other and follow an ABB or AAB pattern:


isTriple[{a_, b_, c_}] := And[
(* A A B or A B B *)

Head[a] != Head[c] /. {black -> 1, white -> 0},
(* x and y coordinates are equally spaced *)
a[[1]] - b[[1]] == b[[1]] - c[[1]],
a[[2]] - b[[2]] == b[[2]] - c[[2]],
(* and are next to each other *)
Abs[a[[1]] - b[[1]]] <= 1,
Abs[a[[2]] - b[[2]]] <= 1]

Next, we determine the coordinates and the color of the stone that will kill the pair:


killerStone[{a_, b_, c_}] := 

If[Head[a] == Head[b] /. {black -> 1, white -> 0},
Head[c][2 a[[1]] - b[[1]], 2 a[[2]] - b[[2]]],
Head[a][2 c[[1]] - b[[1]], 2 c[[2]] - b[[2]]]]

Finally, we only select those triples where killer stone's space is not already occupied:


sortStones[l_] := 
Sort[l, OrderedQ[{#1, #2} /. {black -> List, white -> List}] &]

triplesToKill[board_] := Module[
{triples = Select[sortStones /@ Subsets[board, {3}], isTriple]},

Select[triples,
Block[
{ks = killerStone[#]},
FreeQ[board, _[ks[[1]], ks[[2]]]]] &]]

displayBoard[a, #] & /@ triplesToKill[a] //
Partition[#, 3, 3, {1, 1}, {}] & // GraphicsGrid

straightforward solution


Graphics primitives



randomPoints[n_] := RandomSample[Block[{nn = Ceiling[Sqrt[n]]},
Flatten[Table[{i, j}, {i, 1, nn}, {j, 1, nn}], 1]], n];
(* n is number of moves = 2 * number of points *)
randomBoard[n_] := Module[
{points = randomPoints[2 n]},
Join[
Take[points, n] /. {x_, y_} -> black[x, y],
Take[points, -n] /. {x_, y_} -> white[x, y]
]]


grid[minX_, minY_, maxX_, maxY_] :=
Line[Join[
Table[{{minX - 1.5, y}, {maxX + 1.5, y}}, {y, minY - 1.5, maxY + 1.5,
1}],
Table[{{x, minY - 1.5}, {x, maxY + 1.5}}, {x, minX - 1.5, maxX + 1.5,
1}]]];

displayBoard[board_] := Module[
{minX = Min[First /@ board], maxX = Max[First /@ board],
minY = Min[#[[2]] & /@ board], maxY = Max[#[[2]] & /@ board], n},

Graphics[{
grid[minX, minY, maxX, maxY],
board /. {
black[n__] -> {Black, Disk[{n}, .4]},
white[n__] -> {Thick, Circle[{n}, .4], White, Disk[{n}, .4]}
}}, ImageSize -> Small, Frame -> True]];

displayBoard[board_, points_] := Show[
displayBoard[board],
Graphics[

Map[{Red, Disk[{#[[1]], #[[2]]}, .2]} &, points]]]

Answer



One function comes to mind that already implements matching of multidimensonal rules: CellularAutomaton. Allow me to represent your board data like this:


board = SparseArray[
a /. h_[x_, y_] :> ({-y - 1, x + 1} -> h) /. {black -> ●, white -> ○}, {7, 7}, " "];

For my example I shall show a generic 3x3 rule operation, but this can easily be extended. I know of no built-in way to handle the reflections and translations of your rules, so I will assist with:


variants[x_, y_] := 
Union @@ Outer[
#@{y, x, y} ~Reverse~ #2 &,

{Identity, Transpose},
{{}, 1, 2, {1, 2}},
1
]

expand[h_[x : {_, _, _}, v_]] := variants[x, {_, _, _}] :> v // Thread

I now build the rules. The final rule merely keeps any element that is not at the center of a match unchanged.


rules = Join @@ expand /@ {
{○, ○, ●} -> "Q",

{○, ●, ●} -> "R",
{_, z_, _} :> z
};

Finally I apply them to my board. This shows the original, and after a single transformation:


MatrixForm /@ CellularAutomaton[rules, board, 1]

enter image description here


You can see that any appearance of the patterns in any orthogonal orientation (but not a diagonal) is "marked" by a Q or R at the center accordingly.


This is certainly not a complete implementation of what you requested but I hope that it gives you a reasonable place to start. Another would be ListCorrelate and a kernel large enough to encompass your patters, filled perhaps with unique powers of two, thereby yielding a unique value for each possible "filling" of the overlay.



Comments