From 6432099c4508f5aaae5c8b5058ce38221290b424 Mon Sep 17 00:00:00 2001 From: Jack Harley Date: Sun, 31 Jan 2021 19:31:59 +0000 Subject: [PATCH] Autoplay --- src/Autosolver.hs | 54 ++++++++++++++++++++++++++++++++++++++++++++++ src/Main.hs | 41 +++++++++++++++++++++++++++++++---- src/Minesweeper.hs | 47 ++++++++++++++++++++++++++++++---------- 3 files changed, 127 insertions(+), 15 deletions(-) diff --git a/src/Autosolver.hs b/src/Autosolver.hs index 5434309..642be72 100644 --- a/src/Autosolver.hs +++ b/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) \ No newline at end of file diff --git a/src/Main.hs b/src/Main.hs index 6e635b0..6845502 100644 --- a/src/Main.hs +++ b/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.h1 #+ [string "Minesweeper"], - UI.h4 #+ [string "Jack Harley jharley@tcd.ie"], + UI.div #. "row" #+ [ + UI.h1 #+ [string "Minesweeper"], + 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' \ No newline at end of file + 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 \ No newline at end of file diff --git a/src/Minesweeper.hs b/src/Minesweeper.hs index 8a8f206..761a47b 100644 --- a/src/Minesweeper.hs +++ b/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 -falseSquares :: Int -> Grid -> [Square] -falseSquares _ [] = [] -falseSquares r (row:rows) = falseSquares' r 0 row ++ falseSquares (r+1) rows +-- returns a list of all squares on a board currently uncovered +uncoveredSquares :: Board -> [Square] +uncoveredSquares (Board _ _ u _) = booleanSquares 0 True u --- returns a list of all squares in an individual row of a grid with boolean False status -falseSquares' :: Int -> Int -> [Bool] -> [Square] -falseSquares' _ _ [] = [] -falseSquares' r c (col:cols) | not col = (r,c) : falseSquares' r (c+1) cols - | otherwise = falseSquares' r (c+1) cols +-- returns a list of all squares in a grid starting at the given row with the given boolean status +booleanSquares :: Int -> Bool -> Grid -> [Square] +booleanSquares _ _ [] = [] +booleanSquares r status (row:rows) = booleanSquares' r 0 status row ++ booleanSquares (r+1) status rows + +-- 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)