17

Obviously, even if I ask a lot of question I am, obviously, still a dummy!!!!

I want to program the fiver game. It's a very simple game played solitary on a $5 \times 5$ the rule is elementary : if you click with the mouse on a cell it changes color along with its von-Neuman neighbours --- north, south, east and west. The solution is far from trivial and can be obtain by integer programming. You win if you manage to change all the cells to the alternative color.

So according to my analysis

Initialization

$\forall (i,j) \in \{1, 5\}^2$ color c[i,j] = LightBlue

This I can do

cell[i_, j_] := Graphics[{LightBlue, EdgeForm[Directive[Thick, Blue]], 
     Scale[Rectangle[{i, j}], .5]}]
GraphicsGrid[Table[cell[i, j], {i, 1, 5}, {j, 1, 5}], 
     Background -> LightYellow, Spacings -> Scaled[-.03]]

enter image description here

Here I have a two problems secondary problems :

1) The Spacings seems to have nearly no effects --- I want the minimum spacing

2) If I click with the mouse on a square, I can displace it which, in this case, must be forbiden.

Then follows the analysis of the cases ---~I hope not to have make a mistake.

A) If I click on $cell[i,j]$ for ${i,j} \in \{2, 3, 4\}^2$ then the cells $cell[i-1, j]$, $cell[i, j]$, $cell[i+1, j]$, $cell[i, j+1]$ and $cell[i, j-1]$ must have a change in color --- say from LightBlue to LightRed or from LightRed to LightBlue.

B) If I click on $cell[i,j]$ for $\{i,j\} \in \{1\}\times\{2,3,4\}$ then cells $cell[1, j-1]$, $cell[1, j]$, $cell[1, j+1]$ and $cell[2, j]$ must have a change in color.

C) If I click on $cell[i,j]$ for $\{i,j\} \in \{5\}\times\{2,3,4\}$ then cells $cell[5, j-1]$, $cell[5, j]$, $cell[5, j+1]$ and $cell[4, j]$ must have a change in color.

D) If I click on $cell[i,j]$ for $\{i,j\} \in \{2,3,4\}\times \{1\}$ then cells $cell[i-1, 1]$, $cell[i, 1]$, $cell[i+1, 1]$ and $cell[i, 2]$ must have a change in color.

E) If I click on $cell[i,j]$ for $\{i,j\} \in \{2,3,4\}\times \{5\}$ then cells $cell[i-1, 5]$, $cell[i, 5]$, $cell[i+1, 5]$ and $cell[i, 4]$ must have a change in color.

F) If I click on $cell[1,1]$ then $cell[1,1]$, $cell[2,1]$ and $cell[1,2]$ must have a change in color.

G) If I click on $cell[1,5]$ then $cell[1,5]$, $cell[1,4]$ and $cell[2,5]$ must have a change in color.

H) If I click on $cell[5,5]$ then $cell[5,5]$, $cell[4,5]$ and $cell[5,4]$ must have a change in color.

I) If I click on $cell[5,1]$ then $cell[5,1]$, $cell[4,1]$ and $cell[5,2]$ must have a change in color.

If I understand correctly the Mma commands, I need EventHandler and DynamicModule. Unfortunatelly, I have made some trials which gives nothing because, I think, I do not know how to program the fact that any click inside a square must trigger the change.

I do not ask the work be done for me completelly but I need some help. Thanks

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
cyrille.piatecki
  • 4,582
  • 13
  • 26
  • Spacings have effect, but Graphics in each cell introduces ImageMargins, PlotRangePadding etc etc. So a better way is to just have one Graphics and a grid of rectangles inside. – Kuba Jul 18 '16 at 07:17
  • 1
    Very Nice. Be reassured it's not home work. I am a university professor in economics. I always have been dependent of other to program and now I have decided to try to do it by myself. For some elements it's esy to do it for other less. I take note and try to present to my collegues the advantage to use mathematica even over R and other free softwares. This I cannot do with yourcollective help. So I will never thank you enough. For instance, I will never had though to a flip function . As it is finally your work dear Kuba, it will be nice to wrap it in a demonstration project. – cyrille.piatecki Jul 18 '16 at 07:57
  • For large "boards" the method I used will get very slow; for a faster approach in such cases see (66133). – Mr.Wizard Oct 29 '18 at 15:23

2 Answers2

25

In this case I don't know how to post something helpful without providing full code so I'll just do that and hope this wasn't homework. My emphasis is on clarity (hopefully) rather than brevity or peak efficiency.

flip = # /. {LightRed -> LightBlue, LightBlue -> LightRed} &;

flipNeighbors[i_, j_] :=
 (color[##] = flip @ color[##];) & @@@ 
   {{i, j}, {i + 1, j}, {i - 1, j}, {i, j + 1}, {i, j - 1}}

ClearAll[color]
color[_, _] = LightBlue;

Grid[
  Array[
    Button[
      Spacer[{50, 50}]
      , flipNeighbors[##]
      , Background -> Dynamic @ color[##]
    ] &
    , {5, 5}
  ]
  , Spacings -> {-0.03, -0.01}
]

enter image description here

Notes

  • Negative Spacings values are used to snug up the buttons.
  • ClearAll[color]; color[_, _] = LightBlue; should be evaluated to reset the board.
  • DynamicModule should be used, with localization for flip, flipNeighbors, and color, if you want the game to appear correctly when you first open a Notebook containing it.
  • Appearance -> None may be used as a Option for Button if you do not like the "3D" border.
  • I made the value of the Button Background Dynamic, rather than the entire Grid, for improved performance.

The full monty

This is a fun little game so I wrote code for my own reuse. I might as well share it. :-)

The output may be copied and used independently, with controls to reset the board and change the colors when your eyes get tired.

DynamicModule[{flip, v, c, square, gui},
 flip[i_, j_] :=
  (v[##] *= -1;) & @@@
   {{i, j}, {i + 1, j}, {i - 1, j}, {i, j + 1}, {i, j - 1}};

 _v = 1;
 {c[1], c[-1], c[0]} = {LightBlue, LightRed, Gray};

 square =
  Button[
    Spacer[{51, 51}], flip @ ##
    , Background -> Dynamic @ c @ v @ ##
    , Appearance -> None
  ] &;

 gui =
  Labeled[ #
    , {Button["Reset", ClearAll[v]; _v = 1],
        ColorSetter@*Dynamic@*c /@ {1, -1, 0} // Column}
    , {Bottom, Right}
  ] &;

 Grid[
     Array[square, {5, 5}]
     , Frame -> c[0]
     , Background -> c[0]
     , Spacings -> {{5, {1}, 5}, {5, {1}, 5}}/10
 ] // gui // Deploy
]

enter image description here

Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371
  • 3
    This is amazing for a variety of reasons: On the one hand, it's just amazing. On the other it's basically a coding tutorial. And finally, it's your only answer that I am aware of that you don't use infix ~#~ (+1 wholeheartedly) – gpap Jul 18 '16 at 15:38
  • @gpap I am glad you like it. :-) Incidentally I don't think I really use infix that extensively, either in my answers here or in my own coding, I just use it where it is easier for me to read, which usually means where there would otherwise be a [[[stack[of[brackets]]]]] which I simply hate. – Mr.Wizard Jul 18 '16 at 16:05
  • @Mr.Wizard I am fascinated by how elegant the code is. I am trying o understand the code. Could you please explain how ColorSetter@*Dynamic@*c this code works especially @* – no-one Jul 20 '16 at 00:03
  • Useful code, three cheers – thils Jul 20 '16 at 02:05
  • @Mr.Wizard I too am having difficulty picking apart this spectacular piece of coding! As I understand it, _v = 1; v@# *= -1 evaluates alternately to $\pm \ 1$, but I get lost somewhere after it is applied to all elements of i and j inside flip, (without Button, it seems to evaluate to Null Null Null Null Null). – martin Jul 20 '16 at 08:00
  • (continued)... I would like to alter the start-state of the evaluation to look something like your first image, where ramdom cells are shaded pink, as opposed to all blue. I tried applying different v values to the array, but wasn't succesful. Should I ask a separate stand-alone question? – martin Jul 20 '16 at 08:01
  • 1
    @vikramreddy @* is shorthand for Composition that was added in version 10. ColorSetter@*Dynamic@*cbehaves typically the same as (ColorSetter@Dynamic@c@# &) but is a little cleaner to write. – Mr.Wizard Jul 20 '16 at 08:06
  • 2
    @martin _v = 1 is a short way to make any use of v[arg1, . . .] that is not otherwise defined evaluate to 1. This lets me do e.g. v[3, 5] *= -1 without having to first set an explicit value for v[3, 5]. The output of flip (a bunch of Null as noted) is irrelivant; I only want to change the DownValues of v, which are later used in Background -> Dynamic @ c @ v @ ## to define the colors of the squares. If you want to flip the color of random squares you can set v[i, j] = -1 for random values of i and j that are within the grid, but it may make the board unsolvable. – Mr.Wizard Jul 20 '16 at 08:16
  • @Mr.Wizard got it - thanks :) – martin Jul 20 '16 at 08:37
  • 1
    @martin Glad I could help. Don't hesitate to ask if you have more questions. – Mr.Wizard Jul 20 '16 at 08:38
  • @Mr.Wizard I got it . Thanks. I tried to look up @* in the documentation but the documentation doesn't say anything. Then when i searched for composition I found it. – no-one Jul 20 '16 at 21:49
  • @vikram The search sometimes fails like that. Next time you might start with (18393) – Mr.Wizard Jul 20 '16 at 21:51
  • Dear Mister Wizard, as i am not the autor of your code --- a nice totaulogy --- I wonder if you can put a cdf in the Wolfram repository. – cyrille.piatecki Aug 19 '18 at 10:46
  • @cyrille.piatecki I am not really interested in doing that. If however you wish to, and you follow the existing (Stack Exchange) license requirement of attribution, including a link to this Answer in the Demonstration, you have my blessing to create and upload one yourself. – Mr.Wizard Aug 20 '18 at 03:40
9

Here is a version that uses only the Front End, which can be verified using LinkSnooper. This is mostly a useless optimisation/exploration.

width = 3;
height = 3;
n = width*height;
heldStates = 
  Join @@ (ToExpression["state" <> ToString[#], InputForm, Hold] & /@ 
     Range[n]);
groupedEdges =
  Flatten[#, 1] &@
   Table[Block[
     {sqs = {0}, index = xii + width (yjj - 1)}
     ,
     If[xii != width, AppendTo[sqs, 1]];
     If[xii != 1, AppendTo[sqs, -1]];
     If[yjj != height, AppendTo[sqs, width]];
     If[yjj != 1, AppendTo[sqs, -width]];
     index + # & /@ sqs]
    ,
    {yjj, 1, height},
    {xii, 1, width}
    ];
heldConnectedStates = heldStates[[#]] & /@ groupedEdges;
dynModVars =
  List @@@ 
   Hold@Evaluate[
     Set @@@ Thread[{heldStates, Hold @@ ConstantArray[False, n]}, 
       Hold]];

Heres the graphical stuff

interactiveRectangleMaker =
  Function[{sA, boxDirective, action},
   {DynamicBox[If[sA, RGBColor[1, 0, 1], RGBColor[0, 1, 0]]], 
    EventHandler[boxDirective, {"MouseDown" :> action}]}, HoldAll];
actionsHeld =
  Join @@ (CompoundExpression @@@ Hold[Evaluate[
         Join @@ 
          Function[Null, Hold[FEPrivate`Set[#, SameQ[#, False]]], 
            HoldAll] /@ #
         ]] & /@ heldConnectedStates);
doubleRange = Transpose@Outer[List, Range[width], Range[height]];
rectBoxes = Flatten@Map[RectangleBox, doubleRange, {2}];
argsHeld = 
  Thread[{heldStates, Hold @@ rectBoxes, actionsHeld }, Hold];

This makes the DynamicModule

DynamicModule @@
 {Unevaluated @@ dynModVars,
  Graphics[
   List @@ interactiveRectangleMaker @@@ argsHeld
   ,
   GridLines -> {Range[2, width], Range[2, height]}
   ]}
Jacob Akkerboom
  • 12,215
  • 45
  • 79