Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
192
Task/Minesweeper-game/Haskell/minesweeper-game-1.hs
Normal file
192
Task/Minesweeper-game/Haskell/minesweeper-game-1.hs
Normal file
|
|
@ -0,0 +1,192 @@
|
|||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module MineSweeper
|
||||
( Board
|
||||
, Cell(..)
|
||||
, CellState(..)
|
||||
, Pos
|
||||
-- lenses / prisms
|
||||
, pos
|
||||
, coveredLens
|
||||
, coveredFlaggedLens
|
||||
, coveredMinedLens
|
||||
, xCoordLens
|
||||
, yCoordLens
|
||||
-- Functions
|
||||
, emptyBoard
|
||||
, groupedByRows
|
||||
, displayCell
|
||||
, isLoss
|
||||
, isWin
|
||||
, exposeMines
|
||||
, openCell
|
||||
, flagCell
|
||||
, mineBoard
|
||||
, totalRows
|
||||
, totalCols )
|
||||
where
|
||||
|
||||
import Control.Lens ((%~), (&), (.~), (^.), (^?), Lens', Traversal', _1, _2,
|
||||
anyOf, filtered, folded, lengthOf, makeLenses, makePrisms,
|
||||
preview, to, view)
|
||||
import Data.List (find, groupBy, nub, delete, sortBy)
|
||||
import Data.Maybe (isJust)
|
||||
import System.Random (getStdGen, getStdRandom, randomR, randomRs)
|
||||
|
||||
type Pos = (Int, Int)
|
||||
type Board = [Cell]
|
||||
|
||||
data CellState = Covered { _mined :: Bool, _flagged :: Bool }
|
||||
| UnCovered { _mined :: Bool }
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Cell = Cell
|
||||
{ _pos :: Pos
|
||||
, _state :: CellState
|
||||
, _cellId :: Int
|
||||
, _adjacentMines :: Int }
|
||||
deriving (Show, Eq)
|
||||
|
||||
makePrisms ''CellState
|
||||
makeLenses ''CellState
|
||||
makeLenses ''Cell
|
||||
|
||||
-- Re-useable lens.
|
||||
coveredLens :: Traversal' Cell (Bool, Bool) --'
|
||||
coveredLens = state . _Covered
|
||||
|
||||
coveredMinedLens, coveredFlaggedLens, unCoveredLens :: Traversal' Cell Bool --'
|
||||
coveredMinedLens = coveredLens . _1
|
||||
coveredFlaggedLens = coveredLens . _2
|
||||
unCoveredLens = state . _UnCovered
|
||||
|
||||
xCoordLens, yCoordLens :: Lens' Cell Int --'
|
||||
xCoordLens = pos . _1
|
||||
yCoordLens = pos . _2
|
||||
|
||||
-- Adjust row and column size to your preference.
|
||||
totalRows, totalCols :: Int
|
||||
totalRows = 4
|
||||
totalCols = 6
|
||||
|
||||
emptyBoard :: Board
|
||||
emptyBoard = (\(n, p) -> Cell { _pos = p
|
||||
, _state = Covered False False
|
||||
, _adjacentMines = 0
|
||||
, _cellId = n }) <$> zip [1..] positions
|
||||
where
|
||||
positions = (,) <$> [1..totalCols] <*> [1..totalRows]
|
||||
|
||||
updateCell :: Cell -> Board -> Board
|
||||
updateCell cell = fmap (\c -> if cell ^. cellId == c ^. cellId then cell else c)
|
||||
|
||||
updateBoard :: Board -> [Cell] -> Board
|
||||
updateBoard = foldr updateCell
|
||||
|
||||
okToOpen :: [Cell] -> [Cell]
|
||||
okToOpen = filter (\c -> c ^? coveredLens == Just (False, False))
|
||||
|
||||
openUnMined :: Cell -> Cell
|
||||
openUnMined = state .~ UnCovered False
|
||||
|
||||
openCell :: Pos -> Board -> Board
|
||||
openCell p b = f $ find (\c -> c ^. pos == p) b
|
||||
where
|
||||
f (Just c)
|
||||
| c ^? coveredFlaggedLens == Just True = b
|
||||
| c ^? coveredMinedLens == Just True = updateCell
|
||||
(c & state .~ UnCovered True)
|
||||
b
|
||||
| isCovered c = if c ^. adjacentMines == 0 && not (isFirstMove b)
|
||||
then updateCell (openUnMined c) $ expandEmptyCells b c
|
||||
else updateCell (openUnMined c) b
|
||||
| otherwise = b
|
||||
f Nothing = b
|
||||
isCovered = isJust . preview coveredLens
|
||||
|
||||
expandEmptyCells :: Board -> Cell -> Board
|
||||
expandEmptyCells board cell
|
||||
| null openedCells = board
|
||||
| otherwise = foldr (flip expandEmptyCells) updatedBoard (zeroAdjacent openedCells)
|
||||
where
|
||||
findMore _ [] = []
|
||||
findMore exclude (c : xs)
|
||||
| c `elem` exclude = findMore exclude xs
|
||||
| c ^. adjacentMines == 0 = c : adjacent c <>
|
||||
findMore (c : exclude <> adjacent c) xs
|
||||
| otherwise = c : findMore (c : exclude) xs
|
||||
adjacent = okToOpen . flip adjacentCells board
|
||||
openedCells = openUnMined <$> nub (findMore [cell] (adjacent cell))
|
||||
zeroAdjacent = filter (view (adjacentMines . to (== 0)))
|
||||
updatedBoard = updateBoard board openedCells
|
||||
|
||||
flagCell :: Pos -> Board -> Board
|
||||
flagCell p board = case find ((== p) . view pos) board of
|
||||
Just c -> updateCell (c & state . flagged %~ not) board
|
||||
Nothing -> board
|
||||
|
||||
adjacentCells :: Cell -> Board -> [Cell]
|
||||
adjacentCells Cell {_pos = c@(x1, y1)} = filter (\c -> c ^. pos `elem` positions)
|
||||
where
|
||||
f n = [pred n, n, succ n]
|
||||
positions = delete c $ [(x, y) | x <- f x1, x > 0, y <- f y1, y > 0]
|
||||
|
||||
isLoss, isWin, allUnMinedOpen, allMinesFlagged, isFirstMove :: Board -> Bool
|
||||
isLoss = anyOf (traverse . unCoveredLens) (== True)
|
||||
isWin b = allUnMinedOpen b || allMinesFlagged b
|
||||
|
||||
allUnMinedOpen = (== 0) . lengthOf (traverse . coveredMinedLens . filtered (== False))
|
||||
allMinesFlagged b = minedCount b == flaggedMineCount b
|
||||
where
|
||||
minedCount = lengthOf (traverse . coveredMinedLens . filtered (== True))
|
||||
flaggedMineCount = lengthOf (traverse . coveredLens . filtered (== (True, True)))
|
||||
|
||||
isFirstMove = (== totalCols * totalRows) . lengthOf (folded . coveredFlaggedLens . filtered (== False))
|
||||
|
||||
groupedByRows :: Board -> [Board]
|
||||
groupedByRows = groupBy (\c1 c2 -> yAxis c1 == yAxis c2)
|
||||
. sortBy (\c1 c2 -> yAxis c1 `compare` yAxis c2)
|
||||
where
|
||||
yAxis = view yCoordLens
|
||||
|
||||
displayCell :: Cell -> String
|
||||
displayCell c
|
||||
| c ^? unCoveredLens == Just True = "X"
|
||||
| c ^? coveredFlaggedLens == Just True = "?"
|
||||
| c ^? (unCoveredLens . to not) == Just True =
|
||||
if c ^. adjacentMines > 0 then show $ c ^. adjacentMines else "▢"
|
||||
| otherwise = "."
|
||||
|
||||
exposeMines :: Board -> Board
|
||||
exposeMines = fmap (\c -> c & state . filtered (\s -> s ^? _Covered . _1 == Just True) .~ UnCovered True)
|
||||
|
||||
updateMineCount :: Board -> Board
|
||||
updateMineCount b = go b
|
||||
where
|
||||
go [] = []
|
||||
go (x : xs) = (x & adjacentMines .~ totalAdjacentMines b) : go xs
|
||||
where
|
||||
totalAdjacentMines =
|
||||
foldr (\c acc -> if c ^. (state . mined) then succ acc else acc) 0 . adjacentCells x
|
||||
|
||||
-- IO
|
||||
mineBoard :: Pos -> Board -> IO Board
|
||||
mineBoard p board = do
|
||||
totalMines <- randomMinedCount
|
||||
minedBoard totalMines >>= \mb -> pure $ updateMineCount mb
|
||||
where
|
||||
mines n = take n <$> randomCellIds
|
||||
minedBoard n = (\m ->
|
||||
fmap (\c -> if c ^. cellId `elem` m then c & state . mined .~ True else c)
|
||||
board) . filter (\c -> openedCell ^. cellId /= c)
|
||||
<$> mines n
|
||||
openedCell = head $ filter (\c -> c ^. pos == p) board
|
||||
|
||||
randomCellIds :: IO [Int]
|
||||
randomCellIds = randomRs (1, totalCols * totalRows) <$> getStdGen
|
||||
|
||||
randomMinedCount :: IO Int
|
||||
randomMinedCount = getStdRandom $ randomR (minMinedCells, maxMinedCells)
|
||||
where
|
||||
maxMinedCells = floor $ realToFrac (totalCols * totalRows) * 0.2
|
||||
minMinedCells = floor $ realToFrac (totalCols * totalRows) * 0.1
|
||||
80
Task/Minesweeper-game/Haskell/minesweeper-game-2.hs
Normal file
80
Task/Minesweeper-game/Haskell/minesweeper-game-2.hs
Normal file
|
|
@ -0,0 +1,80 @@
|
|||
module Main
|
||||
|
||||
where
|
||||
|
||||
import MineSweeper (Board, Cell (..), Pos, coveredLens, coveredMinedLens,
|
||||
coveredFlaggedLens, xCoordLens, yCoordLens, pos, emptyBoard,
|
||||
groupedByRows, displayCell, isLoss, isWin, exposeMines,
|
||||
openCell, flagCell, mineBoard, totalRows, totalCols)
|
||||
import Text.Printf (printf)
|
||||
import Text.Read (readMaybe)
|
||||
import System.IO (hSetBuffering, stdout, BufferMode(..))
|
||||
import Control.Monad (join, guard)
|
||||
import Control.Lens (lengthOf, filtered, view, preview)
|
||||
|
||||
data Command = Open Pos | Flag Pos | Invalid
|
||||
|
||||
parseInput :: String -> Command
|
||||
parseInput s | length input /= 3 = Invalid
|
||||
| otherwise = maybe Invalid command parsedPos
|
||||
where
|
||||
input = words s
|
||||
parsedPos = do
|
||||
x <- readMaybe (input !! 1)
|
||||
y <- readMaybe (input !! 2)
|
||||
guard (x <= totalCols && y <= totalRows)
|
||||
pure (x, y)
|
||||
command p = case head input of
|
||||
"o" -> Open p
|
||||
"f" -> Flag p
|
||||
_ -> Invalid
|
||||
|
||||
cheat :: Board -> String
|
||||
cheat = show . fmap (view pos) . filter ((== Just True) . preview coveredMinedLens)
|
||||
|
||||
totalMines, totalFlagged, totalCovered :: Board -> Int
|
||||
totalMines = lengthOf (traverse . coveredMinedLens . filtered (==True))
|
||||
totalFlagged = lengthOf (traverse . coveredFlaggedLens . filtered (==True))
|
||||
totalCovered = lengthOf (traverse . coveredLens)
|
||||
|
||||
-- IO
|
||||
drawBoard :: Board -> IO ()
|
||||
drawBoard b = do
|
||||
-- printf "Cheat: %s\n" $ cheat b
|
||||
printf " Mines: %d Covered: %d Flagged: %d\n\n"
|
||||
(totalMines b) (totalCovered b) (totalFlagged b)
|
||||
printf "%3s" ""
|
||||
mapM_ (printf "%3d") $ view xCoordLens <$> head rows
|
||||
printf "\n"
|
||||
mapM_ (\row -> do
|
||||
printf "%3d" $ yCoord row
|
||||
mapM_ (printf "%3s" . displayCell) row
|
||||
printf "\n" ) rows
|
||||
where
|
||||
rows = groupedByRows b
|
||||
yCoord = view yCoordLens . head
|
||||
|
||||
gameLoop :: Board -> IO ()
|
||||
gameLoop b
|
||||
| isLoss b = drawBoard (exposeMines b) >> printf "\nYou Lose.\n"
|
||||
| isWin b = drawBoard b >> printf "\nYou Win.\n"
|
||||
| otherwise = do
|
||||
drawBoard b
|
||||
putStr "\nPick a cell: "
|
||||
c <- getLine
|
||||
case parseInput c of
|
||||
Open p -> gameLoop $ openCell p b
|
||||
Flag p -> gameLoop $ flagCell p b
|
||||
Invalid -> gameLoop b
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
hSetBuffering stdout NoBuffering
|
||||
drawBoard emptyBoard
|
||||
putStr "\nPick a cell: "
|
||||
c <- getLine
|
||||
case parseInput c of
|
||||
Open p -> join $ startGame p emptyBoard
|
||||
_ -> main
|
||||
where
|
||||
startGame p b = gameLoop . openCell p <$> mineBoard p b
|
||||
Loading…
Add table
Add a link
Reference in a new issue