# Minesweeper: How to Dynamic a lot of graphics with high-speed?

Recently I've implemented Minesweeper in Mathematica.

Clear["Global*"]
path = "https://i.stack.imgur.com//" <> # &;
filenames1 = {"P22Go.jpg", "Zh27M.jpg", "vKZZr.jpg", "2CYDF.png"};
{TL, BR, clock, mine} = Import /@ path /@ filenames1;
{topleft, bottomright} = ImageData /@ {TL, BR};
filenames2 = {"VngIV.jpg", "WeIqo.jpg", "fvub6.jpg", "rb5P7.jpg",
"fl5W2.jpg", "NowyY.jpg", "5Pp3F.jpg", "9pNCj.jpg", "vMIXr.jpg"};
numberpictures[n_] :=
numberpictures[n] = Import[path@filenames2[[n + 1]]];

backgroundcolor = RGBColor[0.698, 0.757, 0.831];
spacecolor = RGBColor[0.839, 0.890, 0.953];
numbercolor =
RGBColor @@@ {{0.247, 0.314, 0.737}, {0.122, 0.408, 0.004}, {0.682, 0.008, 0.020},
{0.027, 0.004, 0.502}, {0.49, 0, 0}, {0, 0.49, 0.495}, {0, 0, 0}, {0, 0, 0}};

back[i_, j_] := back[i, j] =
With[{ii = Rescale[i, {1, 16}], jj = Rescale[j, {1, 30}]},
Image[(1 - (ii + jj)/2) topleft + (ii + jj)/2 bottomright]];
block[{i_, j_, type1_, type2_}] := block[i, j, type1, type2] =
Switch[type1,
0, back[i, j],
1, Switch[type2,
0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8, numberpictures[type2],
9, ImageCompose[back[i, j], mine]
]
];

ini := Module[{mat1, mat2, modify},
modify[mat_, {i_, j_}] :=
If[mat[[i, j]] != 9,
ReplacePart[mat, {i, j} ->
Count[mat[[Max[1, i - 1] ;; Min[16, i + 1],
Max[1, j - 1] ;; Min[30, j + 1]]], 9, 2]], mat];
mat1 = Table[{i, j, 0}, {i, 16}, {j, 30}];
mat2 = Partition[RandomSample[
Flatten@{9 & /@ Range[99], 0 & /@ Range[16*30 - 99]}], 30];
mat2 = Map[List, Fold[modify[#1, #2] &, mat2,
Flatten[Array[{#1, #2} &, {16, 30}], 1]], {2}];
Join[mat1, mat2, 3]];
CreateDialog[
DynamicModule[{board = ini},
Dynamic@Column@{Spacer[30],
GraphicsGrid[Map[block, board, {2}], ImageSize -> 1200,
Spacings -> {0, 0}, Frame -> All,
FrameStyle -> Directive[Black, Thick]],
Row[{Spacer[60], clock, Spacer[700], mine, Spacer[30]}]},
Initialization :> (
getpos[] :=
With[{pos = MousePosition["Graphics"]},
If[pos === None,
None, {-1, 1}*Quotient[Reverse@pos, 360] + {0, 1}]];
click[board_, "Left"] :=
With[{coor = getpos[]},
If[coor === None, board,
ReplacePart[board, Flatten[{coor, 3}] -> 1]]];
SetOptions[EvaluationNotebook[],
NotebookEventActions -> {{"MouseUp",
1} :> (board = click[board, "Left"]), {"MouseUp",
2} :> {"Right ", Print@getpos[]}}])],
Background -> backgroundcolor, WindowTitle -> "Minesweeper By apple",
WindowMargins -> {{0, Automatic}, {Automatic, 0}}]


There are 16*30 = 480 blocks in the final interface. If I write that Dynamic[...(*480 blocks*)], when I click any cell, it will redraw all the interface (480 blocks or more) and will respond after 2 seconds. I don't know how to just dynamic small part of the final interface. How to make it response with high-speed?

Update 1

Since it is not a good idea to put Dynamic over the whole application, I rewrote my code in ugly way:

DynamicModule[{board = ini},
GraphicsGrid[
{{Dynamic@block@var[1, 1], Dynamic@block@var[1, 2], Dynamic@block@var[1, 3],and so on},
{Dynamic@block@var[2, 1], Dynamic@block@var[2, 2], Dynamic@block@var[2, 3],and so on},
and so on}}}],
Initialization :> (
getpos[] := some code;
click["Left"] := somecode;
SetOptions[EvaluationNotebook[], NotebookEventActions -> somecode])]


var[1, 1] maybe equal to {1,1,0,3}, {1,1} means this block is in row 1, column 1, 0 means this block was not clicked yet, 3 means there are 3 mines around this block.

Now click will be：

click["Left"]:= With[{coor=getpos[]},board[Sequence@@coor][[3]]=1]


But this is not allowed.

Block[{x}, x[1] = {0, 0, 0}; x[1][[2]] = 11; x[1]]


Set::setps: "x[1] in the part assignment is not a symbol."

We only can do something like this:

Block[{x1}, x1 = {0, 0, 0}; x1[[2]] = 11; x1]


{0, 11, 0}

Then I rewrote my code again..

vars = Table[ToExpression["boardR" <> ToString[i] <> "C" <> ToString[j]], {i, 16}, {j, 30}];
Evaluate@vars = ini;

DynamicModule[{},
GraphicsGrid[
{{Dynamic@block@boardR1C1, Dynamic@block@boardR1C2, Dynamic@block@boardR1C3,and so on},
{Dynamic@block@boardR2C1, Dynamic@block@boardR2C2, Dynamic@block@boardR2C3,and so on},
and so on}}}],
Initialization :> (
getpos[] := some code;
click["Left"] := somecode;
SetOptions[EvaluationNotebook[], NotebookEventActions -> somecode])]


now click will be more complex:

click["Left"]:=With[{coor=getpos[]},Set[(ToExpression[
"boardR" <> ToString[coor[[1]]] <> "C" <> ToString[coor[[2]]]])[[3]], 1]]


But this will also cause other problems, since:

a=3;
Set[ToExpression["a"],2]


Set::write: Tag ToExpression in ToExpression[a] is Protected.

So currently all the efforts I did have failed.

Update 2

1:

x[1] = {1, 2, 3};
Module[{temp},
temp = x[1];
temp[[2]] = 4;
x[1] = temp;
]
x[1]


{1, 4, 3}

2:

a=3;
ToExpression["a"<>"=2"]
a


2

Now maybe I can finish my code.

Update 3

This game is not finished (now 2014.11.24). There are a lot of features not included.

NotebookPut@
ImportString[
Uncompress@FromCharacterCode@Drop[#, -Last@#] &@
Flatten@ImageData[
Import["https://i.stack.imgur.com/3wGyI.png"], "Byte"],
"NB"]

• I don't think Mathematica is really meant for this kind of applications... Nov 20, 2014 at 10:29
• Don't have more time, but meanwhile: (# = 3) &@ToExpression["a", InputForm, Unevaluated]
– Kuba
Nov 20, 2014 at 14:05
• Or ToExpression["a=" <> ToString[3]] Nov 20, 2014 at 14:09
• Use another language for games :) Nov 20, 2014 at 15:49
• "People who say it cannot be done should not interrupt those who are doing it." - George Bernard Shaw. ;) Nov 20, 2014 at 21:36

The issue with such multicontroller dynamic interfaces is that one usually wants to store the state of all controllers in one variable for convenience (e.g. store status of position {i, j} as state[{i, j}] := "flagged" or state = <|{1, 1} -> 2, {1, 2} -> "flagged", ...|>). On one hand, this makes assignments easy during updating, but on the other hand, any change to state triggers an interface update of all cells as they all track the single variable state. And in this case, it involves the visual updating of 480 cells. Using Graphic-s or Image-s makes updating even slower.

Unfortunately, there is no mechanism (yet) to dynamically track parts of expressions without updating the whole expression (parts of a symbol, without updating the whole symbol), something like:

(* hypothetic construct, won't work *)
Dynamic[display[state[{1, 2}]], TrackedSymbols :> {state[{1, 2}]}


One possible solution is to introduce 480 independent symbols as variables, one for each cell, but this requires metaprogramming methods to generate and set the symbols.

Here is a proof-of-principle for this approach that uses the excellent method of programmatic symbol assignment from Kuba & John Fultz. I've replaced the imported graphics with domestic frame-and-style ones, as those are much faster printed. One can make code even faster by fine-tuning recursive reveal to only visit every relevant cell once. Now it is quite redundant, but the fact is that this extra traversal is marginal compared to the time needed for visual updating of the interface. A large part of the code is to detect simultaneous L-R clicks.

Note: m1 and m2 is invisibly displayed so that they are correctly tracked.

ClearAll[toString, set, reveal, neighbors, reset, end, lr];

{m, n, k} = {9, 9, 10}; (* Beginner *)
{m, n, k} = {16, 16, 40};(* Intermediate *)
{m, n, k} = {16, 30, 99};(* Expert *)
seed = 1;

pos = Flatten[Table[{i, j}, {i, m}, {j, n}], 1];
st = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, "N", "F"};
bg = {"N" | "F" -> [email protected], _ -> [email protected]};
fg = {
1 -> RGBColor[0.247, 0.314, 0.737],
2 -> RGBColor[0.122, 0.408, 0.004],
3 -> RGBColor[0.682, 0.008, 0.02],
4 -> RGBColor[0.027, 0.004, 0.502],
5 -> RGBColor[0.49, 0, 0],
6 -> RGBColor[0, 0.49, 0.495],
"F" -> RGBColor[1, 0, 0], _ -> GrayLevel[0]};
lbl = {9 -> "\[MathematicaIcon]", 0 -> "", "F" -> "\[SpadeSuit]", x_Integer :> x, _ -> ""};
pics = AssociationMap[
Framed[Style[# /. lbl, Bold, # /. fg], Background -> (# /. bg),
ImageSize -> {20, 20}, Alignment -> {Center, Baseline},
FrameMargins -> 0, ImageMargins -> 0, FrameStyle -> None] &, st];

(* Convert position to symbol name *)
toString[{i_, j_}] := StringJoin["s", ToString@i, "x", ToString@j];
(* Assign val to symbol of name str *)
set[str_, val_] := ToExpression@MakeBoxes[RawBoxes@str = val];
(* Reveal cell at position p and update symbol s (string) *)
reveal[p_, s_] := Module[{c}, If[ToExpression@s === "N", c = counts@p;
If[c == 9, end@False, set[s, c];
If[c == 0, reveal[#, toString@#] & /@ neighbors@p]]]];
(* Return 3x3 submatrix centered at position {i, j} *)
neighbors[{i_, j_}] := Flatten[Outer[List, Range[Max[1, i - 1], Min[m, i + 1]],
Range[Max[1, j - 1], Min[n, j + 1]]], 1];
(* Reset game *)
reset[s_: Automatic] := Module[{mines},
{msg, f, m1, m2} = {"", 0, 0, 0};
seed = If[s === Automatic, RandomInteger@999999, s];
SeedRandom@seed;
counts = AssociationMap[If[mines@# > 0, 9, Total@Lookup[mines, neighbors@#]] &, pos];
str = toString /@ pos; (* generate a symbol name for each cell *)
ClearAll /@ str; (* clear these symbols in case they exist *)
set[#, "N"] & /@ str; (* set all symbols to "N" (not clicked) *)
];
(* Terminate game *)
end[win_] := (MapThread[set[#1, counts@#2] &, {str, pos}];
msg = Style[If[win, "\[HappySmiley]", "\[SadSmiley]"], 16]);
(* Event for simultaneous L-R click *)
lr[p_, s_] := (If[ToExpression@s =!= "N" && ToExpression@s =!= "F",
m1 = m2 = 0; Module[{c = counts@p, nb = neighbors@p, v},
v = ToExpression@*toString /@ nb;
If[c === 0 || Count[v, "F"] === c,
reveal[#, toString@#] & /@ Pick[nb, v, "N"]]]]);

reset@seed;
Deploy@Grid[{
{Button["New", reset[]], Button["Reset", reset@seed],
InputField[Dynamic[seed, (seed = #; reset@#) &], Number,
FieldSize -> 5]},
{Dynamic@(k - f), Dynamic@msg, Invisible@Dynamic@{m1, m2}},
EventHandler[Dynamic@pics@ToExpression@#2, {
{"MouseClicked", 1} :> (m1 = SessionTime[];
If[0 < m1 - m2 < .2, lr[#1, #2], reveal[#1, #2]];
If[(Count[ToExpression /@ str, "N"] + f) === k,
end@True]),
{"MouseClicked", 2} :> (m2 = SessionTime[];
If[0 < m2 - m1 < .2, lr[#1, #2];,
Switch[ToExpression@#2, "N", f++; set[#2, "F"], "F", f--;
set[#2, "N"], _, Null]])
}] &, {pos, str}], n], Spacings -> {.1, .1},
Background -> Black], SpanFromLeft}
}, Spacings -> {.1, .1}, Alignment -> Left]

• Finally, +1 :) Thanks for not abandoning us :)
– Kuba
Oct 29, 2018 at 14:21
• For future readers, here are few topic related to the core problem: 174792, 128344, 64312
– Kuba
Oct 29, 2018 at 14:29
• I just edited tags to add performance-tuning, and I deleted symbols. Only after did I realize you had just added the latter. If you feel strongly that it should be there could you explain why? Oh, and +1 of course! :-) Oct 29, 2018 at 15:27
• @Kuba thank you for the warm welcome :) I never intended to abandon SE, but I had other obligations (work, familiy, and a baby) and I gained a considerable amount of extra time giving up certain hobbies. You all know how a simple checking of Mathematica.SE could lead to a week long research and optimization and bug-hunting-fest. I got out before my superiors (boss, wife, baby, you name it) recognized a performance drop in my output. Oct 29, 2018 at 15:52
• @Mr.Wizard You are right, [symbols]` is not really fitting here. I've only included it because of the algorithmic generation of unique symbols, but that is not the main point here, and there are better posts for that. I'm fine with your edit, thank you. Oct 29, 2018 at 15:54