17
$\begingroup$

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

$\endgroup$
3
  • $\begingroup$ 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. $\endgroup$
    – Kuba
    Jul 18, 2016 at 7:17
  • 1
    $\begingroup$ 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. $\endgroup$ Jul 18, 2016 at 7:57
  • $\begingroup$ For large "boards" the method I used will get very slow; for a faster approach in such cases see (66133). $\endgroup$
    – Mr.Wizard
    Oct 29, 2018 at 15:23

2 Answers 2

25
$\begingroup$

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

$\endgroup$
14
  • 3
    $\begingroup$ 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) $\endgroup$
    – gpap
    Jul 18, 2016 at 15:38
  • $\begingroup$ @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. $\endgroup$
    – Mr.Wizard
    Jul 18, 2016 at 16:05
  • 1
    $\begingroup$ @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. $\endgroup$
    – Mr.Wizard
    Jul 20, 2016 at 8:06
  • 2
    $\begingroup$ @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. $\endgroup$
    – Mr.Wizard
    Jul 20, 2016 at 8:16
  • 1
    $\begingroup$ @martin Glad I could help. Don't hesitate to ask if you have more questions. $\endgroup$
    – Mr.Wizard
    Jul 20, 2016 at 8:38
9
$\begingroup$

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]}
   ]}
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.