jack
/
Minesweeper
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Autoplay

This commit is contained in:
Jack Harley 2021-01-31 19:31:59 +00:00
parent 31e5ceb0a9
commit 6432099c45
3 changed files with 127 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
src/Autosolver.hs
View File

@ -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)

41
src/Main.hs
View File

@ -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'
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

47
src/Minesweeper.hs
View File

@ -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)