Autoplay

src/Autosolver.hs

@@ -2,6 +2,60 @@ module Autosolver where
 
 import Minesweeper
 
+data MoveType = Uncover | Flag | None deriving (Eq, Show)
+
 probabilityOfMine :: Board -> Square -> Float 
 probabilityOfMine _ _ = 1.0
 
+autoplay :: Board -> Board
+autoplay b | fst (nextMove b) == Uncover = uncover b $ snd (nextMove b)
+           | fst (nextMove b) == Flag = flag b $ snd (nextMove b)
+           | otherwise = b
+
+nextMove :: Board -> (MoveType, Square)
+nextMove b | not . null $ uncoverStrat1 b = (Uncover, head $ uncoverStrat1 b)
+           | not . null $ flagStrat1 b = (Flag, head $ flagStrat1 b)
+           | otherwise = (None, (0,0))
+
+-- filter:
+-- uncovered squares
+-- WITH at least one adjacent mine
+-- WHERE the number of adjacent mines == number of adjacent flags
+-- WHERE number of adjacent covered squares > number of adjacent flags
+-- FIND adjacent squares
+-- WHICH are valid
+-- WHICH are covered
+-- WHICH are not flagged
+uncoverStrat1 :: Board -> [Square]
+uncoverStrat1 b = 
+    filter (not. isFlagged b) $
+    filter (isCovered b) $
+    filter (validSquare b) $
+    concatMap adjacentSquares $
+    filter (\s -> adjacentCovereds b s > adjacentFlags b s) $
+    filter (\s -> adjacentFlags b s == adjacentMines b s) $
+    filter (\s -> adjacentMines b s > 0) $ 
+    uncoveredSquares b
+
+-- filter:
+-- uncovered squares
+-- WITH at least one adjacent mine
+-- WHERE the number of adjacent mines == number of adjacent covered squares
+-- FIND adjacent squares
+-- WHICH are valid
+-- WHICH are covered
+-- WHICH are not already flagged
+flagStrat1 :: Board -> [Square]
+flagStrat1 b =
+    filter (not. isFlagged b) $
+    filter (isCovered b) $
+    filter (validSquare b) $
+    concatMap adjacentSquares $
+    filter (\s -> adjacentMines b s == adjacentCovereds b s) $
+    filter (\s -> adjacentMines b s > 0) $ 
+    uncoveredSquares b
+
+
+-- if number of adjacent mines == number of adjacent flags, it's safe to uncover all adjacent non-flagged squares
+adjacentMinesAccountedFor :: Board -> Square -> Bool 
+adjacentMinesAccountedFor b (r,c) = adjacentMines b (r,c) == adjacentFlags b (r,c)

src/Main.hs

@@ -10,6 +10,7 @@ import qualified Graphics.UI.Threepenny as UI
 import Graphics.UI.Threepenny.Core
 
 import Minesweeper
+import Autosolver
 
 main :: IO ()
 main = startGUI defaultConfig {jsStatic = Just "view"} setup
@@ -27,8 +28,11 @@ setup w = void $ do
 
     getBody w #+ [
         UI.div #. "container" #+ [
+            UI.div #. "row" #+ [
                 UI.h1 #+ [string "Minesweeper"],
-            UI.h4 #+ [string "Jack Harley jharley@tcd.ie"],
+                UI.br,
+                UI.p #+ [string "Jack Harley jharley@tcd.ie"]
+            ],
             UI.div #. "row" #+ [
                 UI.div # set UI.id_ "gameCont" #+ [mkElement "table" # set UI.id_ "table" #+ rows iob b 0],
                 UI.div # set UI.id_ "infoCont" #+ [
@@ -38,6 +42,15 @@ setup w = void $ do
                     UI.p #+ [string "At any time, you can refresh the page to start a new game."],
                     UI.p #+ [string "Good luck!"]
                 ] 
+            ],
+            UI.div #. "row" #+ [
+                UI.div #. "card" #+ [
+                    UI.div #. "card-header" #+ [string "Autoplayer"],
+                    UI.div #. "card-body" #+ [
+                        UI.p #+ [string "Not sure what to do? Click the Autoplay button below to let the computer make a move for you!"],
+                        UI.p #+ [autoPlayButton iob]
+                    ]
+                ]
             ]
         ],
 
@@ -67,15 +80,35 @@ setup w = void $ do
 
             return cell
 
+        -- auto play move button
+        autoPlayButton iob = do
+            button <- UI.button #. "btn btn-primary" #+ [string "Autoplay"]
+
+            on UI.click button $ \_ -> do
+                liftIO $ modifyIORef' iob $ \b -> autoplay b
+                refresh iob
+
+            return button
+
         -- refresh the board on screen (rerender)
         refresh iob = do
             b <- liftIO $ readIORef iob
                 
             table <- getElementById w "table"
-            let table' = fromJust table
                 
             cont <- getElementById w "gameCont"
             let cont' = return $ fromJust cont
             cont' #+ [mkElement "table" # set UI.id_ "table" #+ rows iob b 0]
 
-            delete table'
+            when (isJust table) $ delete (fromJust table)
+
+            -- For some reason, ocassionally threepenny will fail to render the table after a change.
+            -- Despite extensive debugging I cannot determine why, I believe there may be some type of
+            -- bug in threepenny causing this, the underlying data structures all appear fine and
+            -- simply forcing a second refresh always fixes it.
+            -- Therefore: to workaround, we'll check if the render failed and if so, render again
+
+            newTable <- getElementById w "table"
+            when (isNothing newTable) $ do
+                liftIO $ putStrLn "Render failed, triggering repeat"
+                refresh iob

src/Minesweeper.hs

@@ -69,6 +69,11 @@ isUncovered b (r,c) | validSquare b (r,c) = (uncovered b !! r) !! c
                                        -- hack so that adjacent mine numbers are not shown on the edge of the
                                        -- board grid
 
+-- returns True if the given square is covered, otherwise False
+isCovered :: Board -> Square -> Bool
+isCovered b (r,c) | validSquare b (r,c) = not $ (uncovered b !! r) !! c
+                  | otherwise = False
+
 -- returns True if the given square is flagged, otherwise False
 isFlagged :: Board -> Square -> Bool
 isFlagged b (r,c) | validSquare b (r,c) = (flagged b !! r) !! c
@@ -86,6 +91,14 @@ onEdge b (r,c) = r == 0 || c == 0 || r+1 == size b || c+1 == size b
 adjacentMines :: Board -> Square -> Int
 adjacentMines b (r,c) = sum $ map (boolToInt . hasMine b) $ adjacentSquares (r,c)
 
+-- returns the number of flagged squares adjacent to the given square
+adjacentFlags :: Board -> Square -> Int
+adjacentFlags b (r,c) = sum $ map (boolToInt . isFlagged b) $ adjacentSquares (r,c)
+
+-- returns the number of covered squares adjacent to the given square
+adjacentCovereds :: Board -> Square -> Int
+adjacentCovereds b (r,c) = sum $ map (boolToInt . isCovered b) $ adjacentSquares (r,c)
+
 -- returns true if the given square is adjacent to a covered square
 adjacentToCovered :: Board -> Square -> Bool
 adjacentToCovered b (r,c) = not $ all (isUncovered b) $ adjacentSquares (r,c)
@@ -105,18 +118,29 @@ gameWon b = all (hasMine b) (coveredSquares b)
 
 -- returns a list of all squares on a board currently still covered
 coveredSquares :: Board -> [Square]
-coveredSquares (Board _ _ u _) = falseSquares 0 u
+coveredSquares (Board _ _ u _) = booleanSquares 0 False u
 
--- returns a list of all squares in a grid with boolean False status
+-- returns a list of all squares on a board currently uncovered
-falseSquares :: Int -> Grid -> [Square]
+uncoveredSquares :: Board -> [Square]
-falseSquares _ [] = []
+uncoveredSquares (Board _ _ u _) = booleanSquares 0 True u
-falseSquares r (row:rows) = falseSquares' r 0 row ++ falseSquares (r+1) rows
 
--- returns a list of all squares in an individual row of a grid with boolean False status
+-- returns a list of all squares in a grid starting at the given row with the given boolean status
-falseSquares' :: Int -> Int -> [Bool] -> [Square]
+booleanSquares :: Int -> Bool -> Grid -> [Square]
-falseSquares' _ _ [] = []
+booleanSquares _ _ [] = []
-falseSquares' r c (col:cols) | not col = (r,c) : falseSquares' r (c+1) cols
+booleanSquares r status (row:rows) = booleanSquares' r 0 status row ++ booleanSquares (r+1) status rows
-                             | otherwise = falseSquares' r (c+1) cols
+
+-- returns a list of all squares in an individual row of a grid with the given boolean status
+booleanSquares' :: Int -> Int -> Bool -> [Bool] -> [Square]
+booleanSquares' _ _ _ [] = []
+booleanSquares' r c status (col:cols) | col == status = (r,c) : booleanSquares' r (c+1) status cols
+                                      | otherwise = booleanSquares' r (c+1) status cols
+
+-- returns a list of all squares on a board
+allSquares :: Board -> [Square]
+allSquares b = allSquares' b 0 0
+allSquares' (Board s m u f) r c | r < s && c < s = (r,c) : allSquares' (Board s m u f) r (c+1)
+                                | r < s = allSquares' (Board s m u f) (r+1) 0
+                                | otherwise = []
 
 --
 -- Functions for rendering a board to a UI
@@ -153,7 +177,8 @@ squareTextColour b (r,c) | hasMine b (r,c) || isFlagged b (r,c) = ""
                               6 -> "text-turquoise"
                               7 -> "text-black"
                               8 -> "text-gray"
-                         | otherwise = ""
+                              _ -> "text-black"
+                         | otherwise = "text-black"
 
 --
 -- Functions for changing the status of square(s)