From b7859f8ea7ed2e187861c840a2790fd5275b2a36 Mon Sep 17 00:00:00 2001 From: Jack Harley Date: Sun, 31 Jan 2021 20:54:08 +0000 Subject: [PATCH] Refactoring --- src/Autosolver.hs | 29 ++++-------- src/Main.hs | 2 - src/Minesweeper.hs | 111 +++++++++++++++++++++++---------------------- 3 files changed, 67 insertions(+), 75 deletions(-) diff --git a/src/Autosolver.hs b/src/Autosolver.hs index 382fc63..a8303f7 100644 --- a/src/Autosolver.hs +++ b/src/Autosolver.hs @@ -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) \ No newline at end of file + uncoveredSquares b \ No newline at end of file diff --git a/src/Main.hs b/src/Main.hs index e593535..9d9fbcd 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/src/Minesweeper.hs b/src/Minesweeper.hs index b4d3c68..2913797 100644 --- a/src/Minesweeper.hs +++ b/src/Minesweeper.hs @@ -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