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

Question

Recently I've implemented Minesweeper in Mathematica.

Clear["Global`*"]
path = "https://i.sstatic.net//" <> # &;
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.sstatic.net/3wGyI.png"], "Byte"], 
  "NB"]

Answer 1

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;
   mines = AssociationThread[pos -> RandomSample@PadRight[Table[1, {k}], m n]];
   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}},
   {Deploy@Grid[Partition[MapThread[
        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]