# The Game of Hex in Mathematica

The Game of Hex is a game originally developed by Nash, and it's rules are very simple. You start out with a hexagonal tiling of some size:

There are two players. The game is in turns, and every time it is your turn you fill a hexagon anywhere on the board with your color. The object of the game is to form a connecting path from one of your colored sides to the other.

Here is some more info and here is an online version. I want to make this game in Mathematica, with a computer that just does random moves (I'll add in my own strategies and things later) However, I have absolutely zero experience with games, and so far all my attempts have been futile. I've been able to make a hexagonal tiling and the ability to click it but never got past that (I'll provide that code if you want). I don't need fancy graphics, but just a robust, working program. Can anyone help me out with this?

More specifically,

• how do I make a hexagonal tiling that I can click and
• detect when I have made a connected line?
• Do you have any specific questions? Otherwise this might be a bit broad. Sep 3, 2016 at 12:46
• @Feyre Specifically, how do I make a hexagonal tiling that I can click and detect when I have made a connected line? I apologize if this is too broad, I would provide something to start with and a very specific question but I really don't have any experience with these sort of dynamic objects. Sep 3, 2016 at 12:50
• I think it's a useful question, it's not too complicated and it provides an opportunity for people to show how they would organize this type of code. Sep 3, 2016 at 12:57
• Related: (2512), (66133), (120959) Sep 3, 2016 at 14:03
• I am busy and certainly incompetent. But I need to know if you want a complete answer or simply a way to start Sep 3, 2016 at 14:12

The flow in my program is:

1. I have one global variable, board, which is an 11x11 matrix. Each matrix element corresponds to a hexagon on the board.
2. I pass the board to renderBoard which passes each matrix element along with that element's position to renderHexagonEdge. i.e. step 3-7 is done once for each hexagon.
3. renderHexagonEdge takes the given position and draw the outline of a hexagon at that position. It also passes the the state and position on to eventHandler.
4. eventHandler specifies that when the encapsulated graphics expression is clicked on, boardClicked should be called. boarClicked is a function that updates the global board matrix, by acting on the click and letting the computer choose one hexagon. eventHandler passes its information on to mouseAppearance.
5. mouseAppearance specifies that the cursor should be a link hand when it hovers a hexagon. mouseAppearance passes its information on to mouseover.
6. mouseover specifies that when the cursor hover a hexagon, that hexagon should turn blue. mouseover passes its information on to renderHexagon.
7. renderHexagon draws the hexagon in the specified color.

That I can explain my program this easily is indicative of good design. The main goal of any code design is to avoid complexity, and complexity is usually hard to describe. The guiding principle that got me here was to consciously try to model the entire thing as a chain of stateless functions, because I know that when I do this the end result will be very easy to work with. If I want to add a new feature I can just make a new function and put it into the chain of functions described above. If I want to remove, say, mouseAppearance which changes the cursor to a link hand, I can do this by linking eventHandler directly mouseover. So it's very easy to add or remove new features without having to change almost anything else in the program or even look at the rest of the code.

A small note: The reason why I plot the edges of the hexagons and hexagons separately is because I don't want the edges to be clickable. Since the edges overlap, it will be possible to select two hexagons at once if they are clickable.

hexagon[{i_, j_}] := Polygon@CirclePoints[
{-Sqrt[3] i + 0.5 Sqrt[3] j, -1.5 j},
{1, 90 Degree}, 6
]

renderHexagon[{i_, j_}, color_?ColorQ, edge_: None] := {
color, EdgeForm[edge], hexagon[{i, j}]
}

renderHexagon[0, {i_, j_}] := renderHexagon[{i, j}, LightGray]
renderHexagon[1, {i_, j_}] := renderHexagon[{i, j}, Blue]
renderHexagon[2, {i_, j_}] := renderHexagon[{i, j}, Red]

renderHexagonEdge[state_, {i_, j_}] := {
eventHandler[state, {i, j}],
renderHexagon[{i, j}, Transparent, Black]
}

mouseover[state_, {i_, j_}] := Mouseover[
renderHexagon[state, {i, j}],
renderHexagon[1, {i, j}]
]

mouseAppearance[state_, {i_, j_}] := MouseAppearance[
]

eventHandler[state_, {i_, j_}] := EventHandler[mouseAppearance[state, {i, j}], {
"MouseClicked" :> boardClicked[{i, j}]
}]

boardClicked[{i_, j_}] := If[
board[[i, j]] == 0,
board[[i, j]] = 1; computer[]
]

computer[] := With[{ind = RandomChoice@Position[board, 0]},
board[[First[ind], Last[ind]]] = 2
]

renderBoard[board_] := Deploy@Graphics[
MapIndexed[renderHexagonEdge, board, {2}],
ImageSize -> 500
]


To play:

board = ConstantArray[0, {11, 11}];
Dynamic[renderBoard[board], TrackedSymbols :> {board}]


## Check Winning Condition

To stop the game when either player has won, one might change the definitions to include Anton Antonov's hexCompletePathQ from his answer below.

boardClicked[{i_, j_}] := If[
board[[i, j]] == 0 && player == 1,
board[[i, j]] = 1; player = 2;
computer[]
]

computer[] := With[{ind = RandomChoice@Position[board, 0]},
board[[First[ind], Last[ind]]] = 2;
If[
HexCompletePathQ[11, 11, Position[Reverse@board, 1], "X"] ||
HexCompletePathQ[11, 11, Position[Reverse@board, 2], "Y"],
player = 0,
player = 1
]]

player = 1;
board = ConstantArray[0, {11, 11}];
Dynamic[renderBoard[board], TrackedSymbols :> {board}]


## Online Multiplayer Version

For those that want to play over the Internet against another person, I posted such a version here.

• This is a neat solution! Sep 3, 2016 at 16:51
• @AntonAntonov Thank you :) Sep 3, 2016 at 16:55
• @C.E. I feel like playing with your already clean code. If I find any "improvements" would you prefer that I: (1) Edit them directly into your answer (2) Append a complete version in my style in a separate section of your answer (3) Post my derivative in a separate answer? Sep 4, 2016 at 15:34
• @Mr.Wizard I wouldn't mind either way, but since I reference the first part of the code here it might be best to post your version separately, and probably as a separate answer to avoid confusing people. I find it hard in the abstract, if you don't feel like the improvements you find are big enough to warrant a separate piece of code, then I don't want you to feel like you can't post it. Sep 4, 2016 at 15:54
• Since my answer is just a supplement it seems like a good place to experiment. I applied infix notation to eventHandler in a new formatting that I have not used before in an ongoing effort to find a way to make this syntax readable to a broader audience. Would you please have a look at that and let me know what you think? Sep 5, 2016 at 1:45

Here is an answer that provides modular definitions that allow

• plotting the play-table and players moves with different options, and

• testing for a complete path by a player.

(The function definitions are given in the last section.)

## Plotting

This plots the the Hex 8x8 grid and the paths of the X player and Y player:

HexGrid[8, 8, {{1, "a"}, {1, "b"}, {2, "b"}, {3, "b"}, {3, "c"}}, {{5,
8}, {6, 7}, {6, 6}}]


The full signature is:

HexGrid[
nx_Integer, ny_Integer,
xPlayerPath : {{_Integer, _Integer | _String} ...},
yPlayerPath : {{_Integer, _Integer | _String} ...},
opts : OptionsPattern[] ]


Another example same grid and player moves as above, but with different coloring:

HexGrid[8, 8, {{1, 1}, {1, 2}, {2, 2}, {3, 2}, {3, 3}}, {{5, 8}, {6,
7}, {6, 6}}, "CellColor" -> Lighter[Pink],
"XPlayerColor" -> Yellow, "YPlayerColor" -> Green]


## Complete path check

The complete path check can be done in several ways. Since OP wants to be able to develop the game with strategies etc. I think graph based definitions would be very useful for the development process.

Using the graph representation of the play-table (see below) the plot function HexGrid can recognize and mark with a line complete paths.

Find paths:

hgr = HexGraph[8, 8];
xpath = RandomChoice@FindPath[hgr, {1, 2}, {8, 3}, 12, 900];
ypath = Complement[RandomChoice@FindPath[hgr, {2, 1}, {7, 8}, 13, 60], xpath];


Plot Hex play-table and paths:

HexGrid[8, 8, xpath, ypath, "CompletePathColor" -> Cyan, "CompletePathThickness" -> 0.013]


### More details for the graph representation

This function call makes the Hex game graph:

hgr = HexGraph[8, 8]


Now let us find a path from side to side for X player, visualize it, verify it recognized as a complete path.

cpath = FindShortestPath[hgr, {1, 2}, {8, 3}];
HighlightGraph[hgr, Subgraph[hgr, cpath]]
HexCompletePathQ[hgr, cpath, "X"]
HexCompletePathQ[8, 8, cpath, "X"]


If we remove some nodes from the path the test is not passed:

HexCompletePathQ[hgr, Most[cpath], "X"]
HexCompletePathQ[hgr, Drop[cpath, {4}], "X"]

(* Out[179]= False
Out[180]= False *)


Another example for Y player:

## Definitions

### Plotting functions

hexagonPoints = Table[{Cos[i \[Pi]/3], Sin[i \[Pi]/3]}, {i, 0, 5}];
hexagonPoints = RotateLeft[hexagonPoints.RotationMatrix[-\[Pi]/6]];

Clear[HexagonTranslationVector]
HexagonTranslationVector[hexagonPoints_, pInd1_, pInd2_] :=
Block[{v},
v = Mean[{hexagonPoints[[pInd1]], hexagonPoints[[pInd2]]}] -
Mean[hexagonPoints];
2 v
];

Block[{tv1, tv2, s, h},
{tv1, tv2} = {HexagonTranslationVector[hexagonPoints, 4, 5],
HexagonTranslationVector[hexagonPoints, 5, 6]};
Table[Map[# + (i*tv1 + j*tv2) &, hexagonPoints], {i, 0,
nx - 1}, {j, 0, ny - 1}]
];

Clear[HexGrid]
Options[HexGrid] = {"GridColor" -> Purple,
"CellColor" -> GrayLevel[0.9], "Borders" -> True,
"XPlayerColor" -> Red, "YPlayerColor" -> Blue,
"CompletePathColor" -> White, "CompletePathThickness" -> 0.02};
HexGrid[
nx_Integer, ny_Integer,
xPlayerPath : {{_Integer, _Integer | _String} ...},
yPlayerPath : {{_Integer, _Integer | _String} ...},
opts : OptionsPattern[]] :=
Block[{gridColor, cellColor, bordersQ, xBorderIDs, yBorderIDs,
fullGrid, grid, xPlayerColor, yPlayerColor, cPathColor,
cPathThickness, yRules},
gridColor = OptionValue["GridColor"];
cellColor = OptionValue["CellColor"];
bordersQ = TrueQ[OptionValue["Borders"]];
xPlayerColor = OptionValue["XPlayerColor"];
yPlayerColor = OptionValue["YPlayerColor"];
cPathColor = OptionValue["CompletePathColor"];
cPathThickness = OptionValue["CompletePathThickness"];
xBorderIDs = Range[1, nx];
yBorderIDs = Take[CharacterRange["a", "z"], ny];
fullGrid = SpreadHexagons[hexagonPoints, nx + 2, ny + 2];
grid = fullGrid[[2 ;; nx + 1, 2 ;; ny + 1]];
yRules = Thread[# -> Range[Length[#]]] &@CharacterRange["a", "z"];
Graphics[{
FaceForm[cellColor], EdgeForm[gridColor],
Polygon /@ grid,
If[! bordersQ, Null,
Text, {yBorderIDs,
Take[Mean /@ fullGrid[[1]], {2, nx + 1}]}],
Text, {yBorderIDs,
Take[Mean /@ fullGrid[[-1]], {2, nx + 1}]}],
Text, {xBorderIDs,
Take[Mean /@ Transpose[fullGrid][[1]], {2, nx + 1}]}],
Text, {xBorderIDs,
Take[Mean /@ Transpose[fullGrid][[-1]], {2, nx + 1}]}]}
],
If[Length[xPlayerPath] == 0,
Null, {FaceForm[xPlayerColor],
Polygon[grid[[Sequence @@ #]]] & /@ (xPlayerPath /. yRules)}],
If[Length[yPlayerPath] == 0,
Null, {FaceForm[yPlayerColor],
Polygon[grid[[Sequence @@ #]]] & /@ (yPlayerPath /. yRules)}],
If[! HexCompletePathQ[nx, ny, xPlayerPath /. yRules, "X"],
Null, {Thickness[cPathThickness], cPathColor,
Line[Mean[grid[[Sequence @@ #]]] & /@ (xPlayerPath /.
yRules)]}],
If[! HexCompletePathQ[nx, ny, yPlayerPath /. yRules, "Y"],
Null, {Thickness[cPathThickness], cPathColor,
Line[Mean[grid[[Sequence @@ #]]] & /@ (yPlayerPath /. yRules)]}]
}, AspectRatio -> Automatic]
];


### Complete/winning path check

The variable hexagonPoints is redefined below in order the code of this sub-section to be independent.

hexagonPoints = Table[{Cos[i \[Pi]/3], Sin[i \[Pi]/3]}, {i, 0, 5}];
hexagonPoints = RotateLeft[hexagonPoints.RotationMatrix[-\[Pi]/6]];

Clear[HexGraph]
HexGraph[nx_Integer, ny_Integer] :=
Block[{nodes},
nodes =
1];
VertexReplace[
NearestNeighborGraph[
nodes, {All, Norm[nodes[[1]] - nodes[[2]]] 1.01}],
Rule, {nodes, Flatten[Table[{i, j}, {i, nx}, {j, ny}], 1]}]]
];

Clear[HexCompletePathQ]
HexCompletePathQ[nx_Integer, ny_Integer,
path_: {{_Integer, _Integer} ...}, playerID : ("X" | "Y")] :=
HexCompletePathQ[HexGraph[nx, ny], path, playerID];
HexCompletePathQ[hgr_, path_: {{_Integer, _Integer} ...},
playerID : ("X" | "Y")] :=
Block[{sgr, cs, hvs},
If[Length[path] == 0, Return[False]];
sgr = Subgraph[hgr, path];
cs = ConnectedComponents[sgr];
sgr = Subgraph[hgr,
cs[[Position[Length /@ cs, Max[Length /@ cs]][[1, 1]]]]];
hvs = VertexList[hgr];
If[playerID == "X",
Length[Intersection[VertexList[sgr], Cases[hvs, {1, _}]]] > 0 &&
Length[
Intersection[VertexList[sgr],
Cases[hvs, {Max[hvs[[All, 1]]], _}]]] > 0,
(* playerID == "Y"*)
Length[Intersection[VertexList[sgr], Cases[hvs, {_, 1}]]] > 0 &&
Length[
Intersection[VertexList[sgr],
Cases[hvs, {_, Max[hvs[[All, 2]]]}]]] > 0
]
];

• Maybe add explicitly how you can play, since it's not clickable. Sep 3, 2016 at 15:24
• Let's say we have the board state in the form that you prefer (I represented it as a matrix), how can we determine if either of the players have won using the complete path check? For this we also need to be able to construct the possible paths given the selected hexagons. Sep 3, 2016 at 16:51
• @C.E. Assume the state matrix is with 1's for player X, 2's for player Y, and 0's for empty cells. Then we can just take the locations of the matrix elements corresponding to a given player and give that list to the function HexCompletePathQ. Sep 3, 2016 at 16:57
• ok that's what I hoped I just wasn't sure. Very nice! Sep 3, 2016 at 17:12
• @C.E. Yes it was. I fixed this now. Sep 4, 2016 at 12:40

Mostly working, just don't click the intersections. I seemed to have reversed the colours, but that's easily fixed, just set re and be to be the opposite ones.

Human v Human sofar

Updated to prevent repeat moves

Primer:

p[x_, y_] :=
Rotate[Polygon[CirclePoints[{x, y}, 1/Cos[(7 π)/6], 6]], Pi/2]
list = {{{{0}}}};
list2 = {{{{0}}}};
board = Table[
p[i + 2 j, i 2 Cos[(7 π)/6]], {i, 0, 11}, {j, 0, 11}];
re = {Table[p[i - 2, i 2 Cos[(7 π)/6]], {i, 0, 11}],
Table[p[i + 24, i 2 Cos[(7 π)/6]], {i, 0, 11}]};
be = {Table[p[2 j - 1, - 2 Cos[(7 π)/6]], {j, 0, 12}],
Table[p[2 j + 10, 24 Cos[(7 π)/6]], {j, 0, 12}]};


And here the actual game:

DynamicModule[{pt = {-10, -10}, rb = 1},
ClickPane[
Dynamic@Graphics[{FaceForm[Lighter[Gray]], EdgeForm[Black], board,
FaceForm[Lighter[Red]], re, FaceForm[Red],
If[rb == 1 &&
Position[list[[All, 1, 1]],
p[Round[pt[[1]]], Round[pt[[2]], 2 Cos[(7 π)/6]]][[1,
1]]] == {} &&
Position[list2[[All, 1, 1]],
p[Round[pt[[1]]], Round[pt[[2]], 2 Cos[(7 π)/6]]][[1,
1]]] == {}, rb = 2;
Rest[
AppendTo[list2,
p[Round[pt[[1]]], Round[pt[[2]], 2 Cos[(7 π)/6]]]]],
Rest[list]], FaceForm[Lighter[Blue]], be, FaceForm[Blue],
If[rb == 2 &&
Position[list[[All, 1, 1]],
p[Round[pt[[1]]], Round[pt[[2]], 2 Cos[(7 π)/6]]][[1,
1]]] == {} &&
Position[list2[[All, 1, 1]],
p[Round[pt[[1]]], Round[pt[[2]], 2 Cos[(7 π)/6]]][[1,
1]]] == {}, rb = 1;
Rest[
AppendTo[list,
p[Round[pt[[1]]], Round[pt[[2]], 2 Cos[(7 π)/6]]]]],
Rest[list2]]}, ImageSize -> Large,
PlotRange -> {{-3, 36}, {4, -32}}], (pt = #) &]]


Note that you need to disable Dynamic Updating, and then enable it again to start a new game.

When I first saw this question I immediately thought of a Voronoi diagram because it is so easy to do this:

xy = Join @@ Array[{2 #2 - #, Sqrt[3] #} &, {14, 14}];

VoronoiMesh[xy]


Or perhaps more promisingly with ListDensityPlot:

ListDensityPlot[
{##, RandomInteger[2]} & @@@ xy
, InterpolationOrder -> 0
, Mesh -> All
][[{1}]]


I really wanted this to work however I failed to build anything clean on top of this that did not amount to using one of these as a clever/obfuscated way generate Polygons rather than as a foundation for the interface itself. It is interesting to be able to use Nearest in a ClickPane to align with the hex grid but using that information to update the data to be plotted by ListDensityPlot proves inelegant, as does trimming the edges of the board.

I therefore abandoned this approach and sought any possible improvement to C. E.'s clean answer.

# C. E.'s method

Here therefore is my refactoring of C. E.'s method. My changes include:

• Use pattern aliases to reduce redundancy and enforce consistency in function specifications

• Eliminate a couple of functions that I found too granular

• Merge hexagon and renderHexagon

• shorten CirclePoints usage

• shorten computer[]

Code:

(*pattern aliases*)
p1 = p1 : {i_, j_};
spec = spec : PatternSequence[state_, p1];

(*parameters*)
crules = {0 -> LightGray, 1 -> Blue, 2 -> Red};

(*internal functions*)
hexagon[p1] := Polygon @ CirclePoints[{Sqrt[3] (j - 2 i), -3 j}, {2, 90°}, 6]

hexagon[p1, color_?ColorQ, edge_: None] := {color, EdgeForm[edge], hexagon[p1]}

hexagon[spec] := hexagon[p1, state /. crules]

boardClicked[p1] /; board[[i, j]] == 0 := (board[[i, j]] = 1; computer[];)

computer[] := (board[[##]] = 2) & @@ RandomChoice @ Position[board, 0]

eventHandler[spec] :=
hexagon[spec] ~
Mouseover~ hexagon[1, p1] ~