Part I: Minesweeper CDF can be read here .
For the creation of minesweeper classic, ArrayPlot was combined with ClickPane to generate a GUI. For hexagonal minesweeper though, a fundamental approach will be taken were the entire game interface is drawn from scratch.
This collection of guides on the topic of hexagonal grids and applications really helped me to get the ball rolling on this project:
http://www.redblobgames.com/grids/hexagons/
Drawing A Hexagon
We want to define the locations of the hexagon’s vertices for any given (x,y) coordinate representing its central location.
I’ve chosen height (h) as equal to 1 and thus expressed width in terms of height (the opposite may also be applied).
A function to compute the vertex coordinates and generate a hexagon shape is defined
frame = Polygon[{
{#[[1]] + h/Sqrt[3], #[[2]]},
{#[[1]] + h/(2 Sqrt[3]), #[[2]] + h/2},
{#[[1]] - h/(2 Sqrt[3]), #[[2]] + h/2},
{#[[1]] - h/ Sqrt[3], #[[2]]},
{#[[1]] - h/(2 Sqrt[3]), #[[2]] - h/2},
{#[[1]] + h/(2 Sqrt[3]), #[[2]] - h/2}
}] &;
Evaluating yields
I like this approach because its interesting, fun and offers a lot of flexibility.
Functions to set the style of the graphic are defined.
highlight = Graphics[{EdgeForm[{Thick, White}], Hue[0.3, 1, 1, 0.5], #}] &;
mesh = Graphics[{EdgeForm[{Thick, GrayLevel[0.5]}], Hue[0, 0, 0, 0], #}] &;
Now we can modify the appearance of the hexagons for any given situation.
The function mesh creates a translucent graphic with a grey border so can be shown on top of another graphic without obscuring it. highlight was originally used for a game feature to show the NNs for a clicked tile but it was too slow to evaluate to make it in as a permanent feature.
Creating a Hexagonal Tessellation
So these individual hexagons will form the tiles of the minesweeper game hence we need to plot them in a grid arrangement. I used an offset coordinate system for this since I found it to be the most intuitive.
This is very much like a regular array except that every other column has been offset by an amount of h/2. We generate the central locations of the hexagon tiles according to the offset coordinate system.
hexPoints =
Table[Table[{k*(h Sqrt[3])/2 + ((k - 1)*m*(h Sqrt[3])/2), ((m + h)/(
Mod[k, 2] /. (0 -> 2)) + i)}, {i, 0, #*h, h + (m h)}], {k,
1, #, 1}] &;
m is a value defining the margin of space between each tile. Its been set to 0 since introducing further offsets into the coordinate system was becoming troublesome. I kept it in the function though since I may want it some day. The usage of the mesh style function made for a viable alternative.
We can now plot the first column of tiles.
Graphics[(frame[#] & /@ hexPoints[10][[1(*column*)]])]
Repeated via Table, the complete grid of tiles is generated.
Finding Nearest Neighbours
For a hexagonal system, defining the locations of NNs isn’t as straightforward as it was before.
For an offset coordinate system, there are two cases for NN locations and depend on wherever the column is odd (x=1,3,..) or even (x=2,4,..) so this condition is included with the NN function.
(* returns nearest neighbours as funciton of hex coordinate *)
hexNN = Select[#[[1]] <= Dimensions[hexPoints[n]][[1]] &]@
Select[#[[2]] <= Dimensions[hexPoints[n]][[2]] &]@
DeleteCases[{0, _} | {_, 0}]@{
{#[[1]], #[[2]] + 1},
{#[[1]], #[[2]] - 1},
{#[[1]] - 1, #[[2]]},
{#[[1]] + 1, #[[2]]},
{#[[1]] - 1, #[[2]] - (Mod[#[[1]], 2] /. {0 -> 1, 1 -> -1})},
{#[[1]] + 1, #[[2]] - (Mod[#[[1]], 2] /. {0 -> 1, 1 -> -1})}
} &;
It also has the usual checks for taking a tile’s NNs at the array boundary. Below is the NN highlight feature which is still useful for testing.
Mapping Click Locations to Nearest Tile
As before, a function will take the output generated by ClickPane and convert it into an array location which corresponds to the clicked tile.
Its possible to draw a vertical line though our hexagonal array and have it touch tiles from two different columns, likewise with a horizontal case. The tiles ‘overlap’ which is an issue when identifying which row or column the click location refers to. So Nearest has been used to identify the hex plot coordinate closest to the click location and thus determine which row and colum the user has clicked in.
(* Gives hex coordinate from mouse click *)
clickColumn[pt_] := Flatten[
Position[
Partition[#, 1], Nearest[#, pt[[1]]]
]
] &[First /@ hexPoints[n][[All, 1]]];
clickRow[pt_] := Flatten[
Position[
Partition[#, 1], Nearest[#, pt[[2]]]
]
] &[Last /@ hexPoints[n][[
Mod[clickColumn[pt], 2][[1]] /. {0 -> 2}]]];
Combined, they give the complete location
clickID[pt_] := Join[clickColumn[pt], clickRow[pt]];
Creating a Minefield
Same approach as used in classic except that data will be stored as associations. pointIndex associates each tile (defined by a plot coordinate ) with its array location.
pointIndex =
<|Table[
Table[{i, j} -> #[[All, j]][[i]], {i, 1, Dimensions[#][[1]]}],{j, 1, Dimensions[#][[2]]}]|> &;
mineLocations =
AssociationThread[#2 ->
RandomChoice[{#1, 1 - #1} -> {"m", 0}, Length[#2]]] &[#1, Keys[pointIndex[hexPoints[#2]]]] &[minePr, n]
<|{1, 1} -> 0, {2, 1} -> 0, {3, 1} -> 0, {4, 1} -> "m",...,{12, 16} -> 0, {13, 16} -> 0, {14, 16} -> 0, {15, 16} -> 0|>
Then like before
(* location of mines *)
mineTiles = KeySortBy[First]@Select[mineLocations, # == "m" &]
<|{1, 6} -> "m", {2, 7} -> "m", {2, 9} -> "m", {2, 14} -> "m", ..., {14, 2} -> "m", {14, 9} -> "m", {15, 13} ->"m"|>
(* loaction of safe tiles *)
safeTiles = SortBy[First]@Keys[Select[mineLocations, # == 0 &]]
{{1, 1}, {1, 2}, {1, 3}, {1, 4}, {1, 5}, {1, 7}, {1, 8},..., {15, 14}, {15, 15}, {15, 16}}
Again, we calculate the NNs for each safe tile. Evaluating the hex NN function repeatedly takes a moment so instead, all the NN locations are pre-computed (NNlist) and used to lookup values, rather than generate them.
(* take NNs of all safe tiles and return number of neighbouring mines *)
tileTips = AssociationThread[safeTiles ->
Table[Length[
Intersection[NNlist[safeTiles[[i]]], Keys[mineTiles]]], {i, 1,
Length[safeTiles]}]
]
<|{1, 1} -> 0, {1, 2} -> 0, {1, 3} -> 0, {1, 4} -> 0, {1, 5} -> 1, {1, 7} -> 2, ..., {15, 15} -> 0, {15, 16} -> 0|>
With the tile-tips made, we can produce the final data set.
(* association of states for all tiles in hex array *)
IDstate = Merge[{
AssociationThread[
Keys[tileTips] -> (Values[tileTips])
],
AssociationThread[
Keys[mineTiles] -> (Values[mineTiles])
]
}, # &]
<|{1, 1} -> {0}, {1, 2} -> {0}, {1, 3} -> {0}, ..., {14,2} -> {"m"}, {14, 9} -> {"m"}, {15, 13} -> {"m"}|>
Generating the colour scheme uses the same method as before but adjusted for fewer NNs to scale for.
(* tile color replacement rules *)
colRules = Join[
Normal[AssociationThread[
Range[6] -> (Rest[(Hue[1, #, 1] & /@ Rescale[Range[7]])])]],
{"m" -> Hue[1, 1, 0]}, {0 -> White}
]
Since the tiles are plotted individually there needs to be a list containing the colour for each tile.
(* list of colors for hex array *)
colScheme = ArrayReshape[
Flatten[
Values[
KeySortBy[
Merge[{
AssociationThread[
Keys[tileTips] -> (Values[tileTips] /. colRules)
],
AssociationThread[
Keys[mineTiles] -> (Values[mineTiles] /. colRules)
]
}, # &], First]
]
], Dimensions[hexPoints[n]][[1 ;; 2]]]
Now the background can be built.
background = {
(*colorIndicators*)
Table[Graphics[{Thread[{colScheme[[
z]], (frame[#] & /@ hexPoints[n][[z]])}]}],
{z, 1, Length[hexPoints[n]]}],
(*tileTipOverlayNN*)
Graphics[
MapThread[
Inset, {Values[(* 'drop' 0s*)Replace[0 -> ""] /@ tileTips],
Lookup[hexID, Keys[tileTips]]}]]
};
meshOverlay = Table[mesh /@ (frame[#] & /@ hexPoints[n][[z]]),
{z, 1, Length[hexPoints[n]]}];
Show[{background, meshOverlay}]
The background image is masked with a second grid of identical dimension generated and formatted (via maskScheme) using the same method to create the background.
(* mask *)
Table[Graphics[{Thread[{maskScheme[[z]], (frame[#] & /@ hexPoints[n][[z]])}]}],
{z, 1, Length[hexPoints[n]]}]
When a tile is clicked, maskScheme is updated with the corresponding colour value being replaced from gray to transparent.
maskScheme = ReplacePart[maskScheme, clickID[pt] -> Hue[0, 0, 0, 0]]
Now it all fits together
gameEnv := (
ClickPane[
Show[{
background,
(* mask *)
Table[
Graphics[{Thread[{maskScheme[[
z]], (frame[#] & /@ hexPoints[n][[z]])}]}],
{z, 1, Length[hexPoints[n]]}]
(* mesh *)
, meshOverlay
(* highlight NNs *)
(*,highlight/@frame/@Lookup[pointIndex[hexPoints[n]],NNlist[Join[
clickColumn[pt],clickRow[pt]]]]
*)
}],
(pt = #;
If[CurrentValue["ShiftKey"] == False,
(* reveal tiles in case of Shift Key False *)
If[
(* do chainUncover if revealing a blank tile *)
getTileClick[pt] == {""},
chainUncover,
(* else, reveal clicked tile only *)
maskScheme =
ReplacePart[maskScheme, clickID[pt] -> Hue[0, 0, 0, 0]]
],
(* toggle flag/unflag for case of Shift Key True*)
Which[
(* set flag *)
maskScheme[[#[[1]], #[[2]]]] &@clickID[pt] === GrayLevel[0.8],
maskScheme =
ReplacePart[maskScheme, clickID[pt] -> RGBColor[0, 2/3, 0]],
(* unset flag *)
maskScheme[[#[[1]], #[[2]]]] &@clickID[pt] ===
RGBColor[0, 2/3, 0],
maskScheme =
ReplacePart[maskScheme, clickID[pt] -> GrayLevel[0.8]]
]
]
) &]
)
After initializing (functions, variables, etc) , evaluating gameEnv within dynamic will allow the game to be played for testing. We finish by adding the same enhancements and conveniences as done for classic, contain it within Manipulate and finalize by deploying as CDF.
This version has a lot of overhead, created in particular by generating the game grid twice (background and overlay) to update for each click and so there’s a noticeable lag between clicking and updating. Also, in both versions, its possible to loose on the first move so improving how the game grid is generated is worth pursuing.
Pathfinding - Square Grid
I did this for both square and hexagonal versions. The square version works much better due to it’s simplicity however there is an (in hindsight) obvious oversight which I’ll detail soon.
In minesweeper, there were two types of tiles: mined and not mined (which had two sub-types: empty (0 mined NNs) and non-empty. The chain uncover algorithm would look for empty tiles since the NNs of those will never contain mines and as a consequence, would search the grid with a margin of 1 tile between possible mines.
Now we define a new grid which has ‘mines’ (or obstacles in this context) and start & end tiles. It begins empty since the user may choose where to place obstacles.
(* content of array locations: "E" for empty, "O" - obstruction, "A" - arrive, "D" - depart *)
indexState = <|
Table[Flatten[grid, 1][[i]] -> "E", {i, 1,
Length[Flatten[grid, 1]]}]|>;
<|{1, 1} -> "E", {2, 1} -> "E", {3, 1} -> "E", ..., {14, 15} -> "E", {15, 15} -> "E"|>
indexState will be updated by the user via a click interface not dissimilar to that used for minesweeper.
A new class of tiles requires a new set of colour rules
(* color rules for array plot *)
colRules = {"E" -> White, "O" -> Black, "A" -> Red, "D" -> Blue, "S" -> Hue[0.5, 0.5, 0.85], "P" -> Orange}
“S” and “P” represent tiles which have been searched and tiles which form the path and serve to merely illustrate.
The interface uses the same methods as before.
Dynamic[
ClickPane[
Dynamic@
ArrayPlot[ArrayReshape[Values[indexState], {n, n}], Mesh -> All,
ColorRules -> colRules],
(pt = {IntegerPart[#][[1]] + 1, Abs[IntegerPart[#][[2]] - n]};
Which[
(* set departure *)
CurrentValue["ShiftKey"] == True,
If[indexState[pt] == "E" && Cases[Values[indexState], "D"] == {},
indexState[[Flatten[Position[Keys[indexState], pt]]]] = "D",
indexState[[Flatten[Position[Keys[indexState], pt]]]] = "E"
],
(* set arrival *)
CurrentValue["AltKey"] == True,
If[indexState[pt] == "E" && Cases[Values[indexState], "A"] == {},
indexState[[Flatten[Position[Keys[indexState], pt]]]] = "A",
indexState[[Flatten[Position[Keys[indexState], pt]]]] = "E"
],
(* set obstructions *)
True,
If[
indexState[pt] == "O",
indexState[[Flatten[Position[Keys[indexState], pt]]]] = "E",
indexState[[Flatten[Position[Keys[indexState], pt]]]] = "O"
]
]
) &]
]
The default click will place/remove an obstacle on the grid, shift-click and alt-click will toggle placement of start and end points respectively.
In the code, it looks like this
Grid[ArrayReshape[Values[indexState], {n, n}]]
Now we adapt the chain uncover feature from minesweeper.
In[72]:= (* get depart and arrive locations *)
departLocation = Keys[Select[indexState, # == "D" &]][[1]]
arrivalLocation = Keys[Select[indexState, # == "A" &]][[1]]
Out[72]= {2, 14}
Out[73]= {11, 7}
In[71]:= (* for the depart location, find NNs which are Empty *)
stepNew = Select[# == "E" &]@KeyTake[indexState, nn[departLocation]]
Out[71]= <|{1, 14} -> "E", {1, 15} -> "E", {2, 15} -> "E"|>
In[74]:= (* mark locations as Searched *)
Table[indexState[Keys[stepNew][[i]]] = "S", {i, 1,Length[Keys[stepNew]]}]
Out[74]= {"S", "S", "S"}
In[75]:= (* carry over to the next step *)
stepOld = stepNew
Out[75]= <|{1, 14} -> "E", {1, 15} -> "E", {2, 15} -> "E"|>
This begins the search.
The blue tiles are those which have been searched - the set of searched tiles is the list searchSpace; an association between the tiles location and its state:
searchSpace = Select[# == "S" || # == "A" || # == "D" &]@indexState
<|{11, 7} -> "A", {1, 14} -> "S", {2, 14} -> "D", {1, 15} ->"S", {2, 15} -> "S"|>
The output is used for the first iteration which is then looped until the arrival location is part of the search space.
While[
KeyExistsQ[stepNew, arrivalLocation] == False,
Pause[0.1];
(* take the NNs from previous serached locations which are empty.
Compliment with previous serach locations *)
stepNew =
Complement[
Select[# == "E" || # == "A" && # != "D" &]@
KeyTake[indexState, Flatten[nn[#] & /@ Keys[stepOld], 1]],
stepOld]
(* mark locations as Searched *)
Table[
indexState[Keys[stepNew][[i]]] = "S", {i, 1,
Length[Keys[stepNew]]}];
stepOld = stepNew;
];
searchSpace = Select[# == "S" || # == "A" || # == "D" &]@indexState
<|{1, 6} -> "S", {2, 6} -> "S", {4, 6} -> "S", {5, 6} -> "S",...,{8, 15} -> "S", {9, 15} -> "S", {10, 15} -> "S"|>
searchSpace is then used to create a graph. First, we need to define which locations link to which so we use the nearest neighbour function described earlier.
(* for the ith entry in `serachSpace`, find its NNs which are also elements of `searchSpace` *)
(* {i,{Subscript[j, k]}} for k=1,2,.. *)
graphList = Table[
{
Keys[searchSpace][[i]],
Intersection[nn[Keys[searchSpace][[i]]], Keys[searchSpace]]
}, {i, 1, Length[Keys[searchSpace]]}]
Outputs
{
{{1, 6}, {{1, 6}, {1, 7}, {2, 6}, {2, 7}}},
{{2, 6}, {{1, 6}, {1, 7}, {2, 6}, {2, 7}, {3, 7}}},
{{4, 6}, {{3, 7}, {4, 6}, {4, 7}, {5, 6}, {5, 7}}},
...
{{8, 15}, {{7, 14}, {7, 15}, {8, 14}, {8, 15}, {9, 14}, {9, 15}}},
{{9, 15}, {{8, 14}, {8, 15}, {9, 14}, {9, 15}, {10, 14}, {10, 15}}},
{{10, 15}, {{9, 14}, {9, 15}, {10, 14}, {10, 15}}}
}
So location {1,6} has valid NNs at {1,6},{1,7},{2,6},{2,7} and so on. We want to take this and produce something like below which can form a graph.
{1, 6} <-> {1, 7}, {1, 6} <-> {2, 6} ...
We want a graph so that we may take advantage of its ShortestDistance function.
(* join each element of `seachSpace` to each of its NNs with \
undirected edges *)
graph = Flatten[
Table[Table[
graphList[[#, 1]] <-> graphList[[#, 2, i]], {i, 1, Length[graphList[[#, 2]]]}] &[i], {i, 1, Length[graphList]}]];
This yields
{{1, 6} <-> {1, 6}, {1, 6} <-> {1, 7}, {1, 6} <-> {2, 6},...,{10, 15} <-> {10, 14}, {10, 15} <-> {10, 15}}
And thus
It would be nice if we could overlay this on top of the UI - that comes later.
Now we get shortest path between the start and end locations
FindShortestPath[Graph[graph], departLocation, arrivalLocation]
This returns the vertices of the graph which give the shortest path and are also locations in searchSpace.
{{2, 14}, {3, 13}, {4, 12}, {5, 11}, {6, 10}, {7, 10}, {8, 10}, {9, 9}, {10, 8}, {11, 7}}
The shortest path includes the start and end points which we don’t want to include when drawing the path so we delete them from the list
Delete[FindShortestPath[Graph[graph], departLocation, arrivalLocation], {{1}, {-1}}]
{{3, 13}, {4, 12}, {5, 11}, {6, 10}, {7, 10}, {8, 10}, {9, 9}, {10, 8}}
As a finishing touch, we update indexState in increments so it looks like the path is being drawn.
Do[
indexState[Delete[FindShortestPath[Graph[graph], departLocation, arrivalLocation], {{1}, {-1}}][[i]]] = "P";
Pause[0.1],
{i, 1, Length[Delete[FindShortestPath[Graph[graph], departLocation, arrivalLocation], {{1}, {-1}}]]}]
Add some UI features and wrap it in Manipulate…
So there’s an option to disallow diagonal movement. This is fun to play with but also for testing as I noticed it does this:
Pathfinding - Hexagonal Grid
When it comes to choosing between a square of hexagonal grid, there are a number of points to consider
Square:
- Easy to implement
- Natural conversion between visualisation and data structure
- 8 NNs - good for minesweeper
- Requires only 1 NN function
Hexagonal:
- Tricky to implement
- Needs conversion for conventional data structures
- 6 NNs - interesting
- Requires two cases for NN function (at least when using offset
coordinates)
So what’s the main advantage to using a hexagonal grid? Well, it looks cool and is much more of an interesting problem to solve. But there is one major functional advantage.
This means that the graph for the case of a square grid needs to have the edges joining diagonal spaces weighted by a factor of \sqrt{2}. I overlooked this initially and so I believe it goes towards explaining why the ‘shortest’ path doesn’t always follow a straight line (as above).
We wont find this issue when using a hexagonal grid though since NN distances are equal for all neighbouring locations.
The hex pathfinder uses the same procedure as that described for a square grid and borrows a lot of code from hex minesweeper too. It doesn’t have the user defined placement of obstacles but it does the same task overall.
I also took a slightly different approach to drawing the path; instead of highlighting the tiles, the tile plot coordinates are used as points for a BSplineCurve. In a similar approach, the points are also used to draw a representation of the graph.
And as it turns out, the spline curve yields added functionality too.
Traffic Modelling - The Adventure Continues
This was supposed to be about minesweeper, how’d this happen?
After some research, it appears that this is a simple implementation of a navigation mesh and so has given me a possible solution to an idea I had earlier but didn’t know where to start.
That’s enough for now.
