Refactoring
This commit is contained in:
parent
1ff9279f66
commit
b7859f8ea7
|
|
@ -10,8 +10,8 @@ playAutoMove b | fst (nextMove b) == Uncover = uncover 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)
|
||||
nextMove b | not . null $ uncoverStrat b = (Uncover, head $ uncoverStrat b)
|
||||
| not . null $ flagStrat b = (Flag, head $ flagStrat b)
|
||||
| not . null $ uncoverStratFallback b = (Uncover, head $ uncoverStratFallback b)
|
||||
| otherwise = (None, (0,0))
|
||||
|
||||
|
|
@ -21,21 +21,19 @@ nextMove b | not . null $ uncoverStrat1 b = (Uncover, head $ uncoverStrat1 b)
|
|||
-- 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 =
|
||||
uncoverStrat :: Board -> [Square]
|
||||
uncoverStrat b =
|
||||
filter (not. isFlagged b) $
|
||||
filter (isCovered b) $
|
||||
filter (validSquare b) $
|
||||
concatMap adjacentSquares $
|
||||
concatMap (adjacentSquares b) $
|
||||
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: (first covered square)
|
||||
-- filter:
|
||||
-- covered squares
|
||||
-- WHICH are not flagged
|
||||
uncoverStratFallback :: Board -> [Square]
|
||||
|
|
@ -48,20 +46,13 @@ uncoverStratFallback b =
|
|||
-- 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 =
|
||||
flagStrat :: Board -> [Square]
|
||||
flagStrat b =
|
||||
filter (not. isFlagged b) $
|
||||
filter (isCovered b) $
|
||||
filter (validSquare b) $
|
||||
concatMap adjacentSquares $
|
||||
concatMap (adjacentSquares b) $
|
||||
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)
|
||||
uncoveredSquares b
|
||||
|
|
@ -69,12 +69,10 @@ setup w = void $ do
|
|||
#+ [string $ squareAscii b (r,c)]
|
||||
|
||||
on UI.click cell $ \_ -> do
|
||||
--liftIO $ putStrLn $ "Click (" ++ show r ++ "," ++ show c ++ ")"
|
||||
liftIO $ modifyIORef' iob $ \oldB -> uncover oldB (r,c)
|
||||
refresh iob
|
||||
|
||||
on UI.contextmenu cell $ \_ -> do
|
||||
--liftIO $ putStrLn $ "Right Click (" ++ show r ++ "," ++ show c ++ ")"
|
||||
liftIO $ modifyIORef' iob $ \oldB -> flag oldB (r,c)
|
||||
refresh iob
|
||||
|
||||
|
|
|
|||
|
|
@ -50,7 +50,7 @@ seedList' rng p (l:ls) = newBool : seedList' newRng p ls
|
|||
-- returns True with probability p, otherwise False
|
||||
weightedRandomBool :: StdGen -> Float -> (Bool, StdGen)
|
||||
weightedRandomBool rng p = (generatedFloat <= p, newRng)
|
||||
where (generatedFloat, newRng) = randomR (0.0, 1.0) rng
|
||||
where (generatedFloat, newRng) = randomR (0.0, 1.0) rng
|
||||
|
||||
--
|
||||
-- Functions for determing statuses and info on square(s)
|
||||
|
|
@ -60,24 +60,22 @@ weightedRandomBool rng p = (generatedFloat <= p, newRng)
|
|||
-- returns True if the given square has a mine, otherwise False
|
||||
hasMine :: Board -> Square -> Bool
|
||||
hasMine b (r,c) | validSquare b (r,c) = (mines b !! r) !! c
|
||||
| otherwise = False
|
||||
| otherwise = error "square out of board bounds"
|
||||
|
||||
-- returns True if the given square is uncovered, otherwise False
|
||||
isUncovered :: Board -> Square -> Bool
|
||||
isUncovered b (r,c) | validSquare b (r,c) = (uncovered b !! r) !! c
|
||||
| otherwise = True -- We return True when the requested square does not exist as a useful
|
||||
-- hack so that adjacent mine numbers are not shown on the edge of the
|
||||
-- board grid
|
||||
| otherwise = error "square out of board bounds"
|
||||
|
||||
-- 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
|
||||
| otherwise = error "square out of board bounds"
|
||||
|
||||
-- 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
|
||||
| otherwise = False
|
||||
| otherwise = error "square out of board bounds"
|
||||
|
||||
-- returns True if the given square is within the bounds of the board
|
||||
validSquare :: Board -> Square -> Bool
|
||||
|
|
@ -89,23 +87,24 @@ onEdge b (r,c) = r == 0 || c == 0 || r+1 == size b || c+1 == size b
|
|||
|
||||
-- returns the number of mines adjacent to the given square
|
||||
adjacentMines :: Board -> Square -> Int
|
||||
adjacentMines b (r,c) = sum $ map (boolToInt . hasMine b) $ adjacentSquares (r,c)
|
||||
adjacentMines b s = sum $ map (boolToInt . hasMine b) $ adjacentSquares b s
|
||||
|
||||
-- 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)
|
||||
adjacentFlags b s = sum $ map (boolToInt . isFlagged b) $ adjacentSquares b s
|
||||
|
||||
-- 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)
|
||||
adjacentCovereds b s = sum $ map (boolToInt . isCovered b) $ adjacentSquares b s
|
||||
|
||||
-- returns true if the given square is adjacent to a covered square
|
||||
adjacentToCovered :: Board -> Square -> Bool
|
||||
adjacentToCovered b (r,c) = adjacentCovereds b (r,c) > 0
|
||||
adjacentToCovered b s = adjacentCovereds b s > 0
|
||||
|
||||
-- returns a list of all the squares directly adjacent to the given square (using arithmetic)
|
||||
adjacentSquares :: Square -> [Square]
|
||||
adjacentSquares (r,c) = [(r-1,c-1), (r-1,c), (r-1,c+1), (r,c-1), (r,c+1), (r+1,c-1), (r+1,c), (r+1,c+1)]
|
||||
adjacentSquares :: Board -> Square -> [Square]
|
||||
adjacentSquares b s = filter (validSquare b) $ adjacentSquares' s
|
||||
adjacentSquares' (r,c) = [(r-1,c-1), (r-1,c), (r-1,c+1), (r,c-1), (r,c+1), (r+1,c-1), (r+1,c), (r+1,c+1)]
|
||||
|
||||
-- returns 1 for boolean True and 0 for Boolean false
|
||||
boolToInt :: Bool -> Int
|
||||
|
|
@ -118,11 +117,11 @@ gameWon b = all (hasMine b) (coveredSquares b) && not (any (hasMine b) (uncovere
|
|||
|
||||
-- returns a list of all squares on a board currently still covered
|
||||
coveredSquares :: Board -> [Square]
|
||||
coveredSquares (Board _ _ u _) = matchingSquares 0 False u
|
||||
coveredSquares b = matchingSquares 0 False (uncovered b)
|
||||
|
||||
-- returns a list of all squares on a board currently uncovered
|
||||
uncoveredSquares :: Board -> [Square]
|
||||
uncoveredSquares (Board _ _ u _) = matchingSquares 0 True u
|
||||
uncoveredSquares b = matchingSquares 0 True (uncovered b)
|
||||
|
||||
-- returns a list of all squares in a grid starting at the given row with the given boolean status
|
||||
matchingSquares :: Int -> Bool -> Grid -> [Square]
|
||||
|
|
@ -149,67 +148,71 @@ allSquares' (Board s m u f) r c | r < s && c < s = (r,c) : allSquares' (Board s
|
|||
-- returns a string that should be shown in the given square for a UI render of the board
|
||||
-- typically either blank or if bordering on covered squares: the number of adjacent mines
|
||||
squareAscii :: Board -> Square -> String
|
||||
squareAscii b (r,c) | gameWon b = ""
|
||||
| isUncovered b (r,c) && adjacentToCovered b (r,c) = show $ adjacentMines b (r,c)
|
||||
| otherwise = ""
|
||||
squareAscii b s | gameWon b = ""
|
||||
| onEdge b s = ""
|
||||
| isCovered b s = ""
|
||||
| not (adjacentToCovered b s) = ""
|
||||
| otherwise = show $ adjacentMines b s
|
||||
|
||||
-- returns a string indicating the bg colour class for a given square for a UI render of the board
|
||||
-- intended to be a used as a CSS class
|
||||
squareBgColour :: Board -> Square -> String
|
||||
squareBgColour b (r,c) | gameWon b && hasMine b (r,c) = "bg-blue"
|
||||
| gameWon b = "bg-green"
|
||||
| isUncovered b (r,c) && hasMine b (r,c) = "bg-red"
|
||||
| isUncovered b (r,c) = "bg-light"
|
||||
| isFlagged b (r,c) = "bg-yellow"
|
||||
| otherwise = "bg-dark"
|
||||
squareBgColour b s | gameWon b && hasMine b s = "bg-blue"
|
||||
| gameWon b = "bg-green"
|
||||
| isUncovered b s && hasMine b s = "bg-red"
|
||||
| isUncovered b s = "bg-light"
|
||||
| isFlagged b s = "bg-yellow"
|
||||
| otherwise = "bg-dark"
|
||||
|
||||
-- returns a string indicating the text colour class for a given square for a UI render of the board
|
||||
-- intended to be a used as a CSS class
|
||||
squareTextColour :: Board -> Square -> String
|
||||
squareTextColour b (r,c) | hasMine b (r,c) || isFlagged b (r,c) = ""
|
||||
| isUncovered b (r,c) && adjacentToCovered b (r,c) =
|
||||
case adjacentMines b (r,c) of
|
||||
1 -> "text-blue"
|
||||
2 -> "text-green"
|
||||
3 -> "text-red"
|
||||
4 -> "text-purple"
|
||||
5 -> "text-maroon"
|
||||
6 -> "text-turquoise"
|
||||
7 -> "text-black"
|
||||
8 -> "text-gray"
|
||||
_ -> "text-black"
|
||||
| otherwise = "text-black"
|
||||
squareTextColour b s | hasMine b s = ""
|
||||
| isFlagged b s = ""
|
||||
| isUncovered b s && adjacentToCovered b s =
|
||||
case adjacentMines b s of
|
||||
0 -> "text-white"
|
||||
1 -> "text-blue"
|
||||
2 -> "text-green"
|
||||
3 -> "text-red"
|
||||
4 -> "text-purple"
|
||||
5 -> "text-maroon"
|
||||
6 -> "text-turquoise"
|
||||
7 -> "text-black"
|
||||
8 -> "text-gray"
|
||||
| otherwise = ""
|
||||
|
||||
--
|
||||
-- Functions for changing the status of square(s)
|
||||
-- Functions for interacting with the board/making changes
|
||||
--
|
||||
|
||||
-- uncovers a square and recursively uncovers adjacent squares iff the square has zero adjacent mines
|
||||
-- if the uncovered square has a mine, uncovers the entire board (lost)
|
||||
-- uncovers a square, if the uncovered square has a mine: uncovers the entire board (lost)
|
||||
-- otherwise, trigger the recursive uncover in case of 0 adjacent mines
|
||||
uncover :: Board -> Square -> Board
|
||||
uncover b (r,c) | not $ validSquare b (r,c) = b
|
||||
| isUncovered b (r,c) = b
|
||||
| hasMine b (r,c) = Board (size b) (mines b) (createGrid True (size b)) (flagged b)
|
||||
| otherwise = uncoverAdjacentsIfSafe
|
||||
(Board (size b) (mines b) (modSquare (uncovered b) (r,c) True) (flagged b))
|
||||
(r,c)
|
||||
uncover b s | not $ validSquare b s = b
|
||||
| isUncovered b s = b
|
||||
| hasMine b s = Board (size b) (mines b) (createGrid True (size b)) (flagged b)
|
||||
| otherwise = uncoverRecurse
|
||||
(Board (size b) (mines b) (modSquare (uncovered b) s True) (flagged b)) s
|
||||
|
||||
uncoverAdjacentsIfSafe :: Board -> Square -> Board
|
||||
uncoverAdjacentsIfSafe b (r,c) | adjacentMines b (r,c) == 0 = uncoverAll b $ adjacentSquares (r,c)
|
||||
| otherwise = b
|
||||
-- uncovers adjacent squares iff the square has zero adjacent mines
|
||||
uncoverRecurse :: Board -> Square -> Board
|
||||
uncoverRecurse b s | adjacentMines b s == 0 = uncoverAll b $ adjacentSquares b s
|
||||
| otherwise = b
|
||||
|
||||
-- uncovers all squares given in a list
|
||||
uncoverAll :: Board -> [Square] -> Board
|
||||
uncoverAll b [] = b
|
||||
uncoverAll b ((r,c):xs) = uncoverAll newB xs where newB = uncover b (r,c)
|
||||
uncoverAll b (s:ss) = uncoverAll newB ss where newB = uncover b s
|
||||
|
||||
-- toggles a square's flagged status
|
||||
flag :: Board -> Square -> Board
|
||||
flag b (r,c) | not $ validSquare b (r,c) = b
|
||||
| isUncovered b (r,c) = b
|
||||
| isFlagged b (r,c) = Board (size b) (mines b) (uncovered b) (modSquare (flagged b) (r,c) False)
|
||||
| otherwise = Board (size b) (mines b) (uncovered b) (modSquare (flagged b) (r,c) True)
|
||||
flag b s | not $ validSquare b s = b
|
||||
| isUncovered b s = b
|
||||
| isFlagged b s = Board (size b) (mines b) (uncovered b) (modSquare (flagged b) s False)
|
||||
| otherwise = Board (size b) (mines b) (uncovered b) (modSquare (flagged b) s True)
|
||||
|
||||
-- modifies the boolean status value of a given square in a given grid
|
||||
modSquare :: Grid -> Square -> Bool -> Grid
|
||||
modSquare grid (r,c) newStatus = let (rowsA, row : rowsB) = splitAt r grid
|
||||
(cellsA, _ : cellsB) = splitAt c row
|
||||
|
|
|
|||
Loading…
Reference in New Issue