Created
November 13, 2019 06:02
-
-
Save Elvecent/cf1b40845c4057b4cd27399384c8fb1d to your computer and use it in GitHub Desktop.
Minesweeper
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Main where | |
-- from "monoidal-containers" package | |
import qualified Data.IntMap.Monoidal.Strict as M | |
-- The thing with this IntMap is that whenever | |
-- its elements form a semigroup, the IntMaps | |
-- containing those elements themselves form | |
-- a monoid that works "pointwise" | |
-- Just type synonyms | |
type Height = Int | |
type Width = Int | |
data Cell = Bomb | Number Int | |
deriving Eq | |
data Board = Board | |
{ height :: Height | |
, width :: Width | |
, cells :: M.MonoidalIntMap Cell | |
} | |
instance Show Cell where | |
show Bomb = "b" | |
show (Number a) = show a | |
instance Show Board where | |
show board@Board{height = h, width = w} = | |
concatMap showRow [0..h-1] | |
where | |
showRow y = show row <> "\n" | |
where row = map (\x -> cellAt board x y) [0..w-1] | |
-- Hopefully you've heard of semigroups? | |
instance Semigroup Cell where | |
Bomb <> _ = Bomb | |
_ <> Bomb = Bomb | |
Number a <> Number b = Number $ a + b | |
instance Semigroup Board where | |
boardA <> boardB = if hA /= hB || wA /= wB | |
then error "Cannot concatenate boards with different dimensions" | |
else Board hA wA $ cA <> cB | |
where | |
hA = height boardA | |
hB = height boardB | |
wA = width boardA | |
wB = width boardB | |
cA = cells boardA | |
cB = cells boardB | |
-- Now we can take two boards and (<>) them together | |
-- try: sampleBoard <> sampleBoard | |
-- An example board with two bombs | |
sampleBoard :: Board | |
sampleBoard = Board 3 3 $ | |
M.fromList $ [0..8] `zip` | |
[ Number 0, Number 0, Number 0 | |
, Number 0, Bomb , Number 0 | |
, Number 0, Number 0, Bomb | |
] | |
-- A board filled with zeroes | |
nullBoard :: Height -> Width -> Board | |
nullBoard h w = Board h w $ | |
M.fromList $ [0..h*w-1] `zip` | |
repeat (Number 0) | |
-- Coords origin on a board is its left upper corner | |
-- 0---------> x | |
-- | | |
-- | | |
-- | | |
-- | | |
-- v | |
-- y | |
-- Transform coords into IntMap index | |
flattenCoords :: Board -> Int -> Int -> Int | |
flattenCoords Board{width = w} x y = | |
x + (y * w) | |
-- Transform IntMap index into coords | |
unFlattenCoords :: Board -> Int -> (Int, Int) | |
unFlattenCoords Board{height = h} i = | |
(i `mod` h, i `div` h) | |
-- Pick a cell in a given board at given coords | |
cellAt :: Board -> Int -> Int -> Cell | |
cellAt board x y = | |
cells board M.! (flattenCoords board x y) | |
-- At given coords in a given board, apply a function | |
-- that transforms a cell at that coords | |
modifyCellAt :: Board -> Int -> Int -> (Cell -> Cell) -> Board | |
modifyCellAt board x y f = | |
board { cells = M.adjust f i (cells board) } | |
where i = flattenCoords board x y | |
-- Get adjacent squares around given coords | |
adjacent :: Int -> Int -> [(Int, Int)] | |
adjacent x y = [(x + a, y + b) | a <- [-1..1], b <- [-1..1]] | |
-- Create a board with given height and width that | |
-- consists of zeroes everywhere except around given | |
-- coords, where it's filled with a given cell | |
-- Example: | |
-- surroundedBy 3 3 Bomb 0 0 | |
-- [b,b,0] | |
-- [b,b,0] | |
-- [0,0,0] | |
surroundedBy :: Height -> Width -> Cell -> Int -> Int -> Board | |
surroundedBy h w c x y = foldl go (nullBoard h w) adj | |
where | |
adj = filter | |
(\(x,y) -> x >= 0 && y >= 0 && x < w && y < h) $ | |
adjacent x y | |
go :: Board -> (Int, Int) -> Board | |
go board (x,y) = modifyCellAt board x y (const c) | |
-- Return all bombs' coords in a board | |
getBombs :: Board -> [(Int,Int)] | |
getBombs board = | |
map (unFlattenCoords board) . | |
map fst . | |
filter (\(i,c) -> c == Bomb) $ cellsList | |
where | |
cellsList = M.toList $ cells board | |
-- Speaks for itself | |
markBombs :: Board -> Board | |
markBombs unMarkedBoard = | |
foldl (<>) unMarkedBoard . | |
map surround . | |
getBombs $ unMarkedBoard | |
where | |
surround = uncurry $ | |
surroundedBy h w (Number 1) | |
h = height unMarkedBoard | |
w = width unMarkedBoard | |
main = do | |
putStrLn "Unmarked board:" | |
print sampleBoard | |
putStrLn "Marked board:" | |
print $ markBombs sampleBoard |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment