Skip to content

Instantly share code, notes, and snippets.

@fffej fffej/Minesweeper.hs
Created Oct 21, 2015

Embed
What would you like to do?
module Minesweeper where
import Data.List (delete, maximumBy)
import Data.Char (intToDigit, digitToInt)
import Data.Ord (comparing)
import Test.QuickCheck
-- Tests!
newtype InputFormat = InputFormat [String] deriving (Show)
instance Arbitrary InputFormat where
arbitrary = do
width <- choose (1,20)
height <- choose (1,20)
rows <- vectorOf width (vectorOf height $ elements "*-")
return $ InputFormat rows
shrink (InputFormat xs) = map InputFormat $ shrink xs
prop_shape_stays_constant :: InputFormat -> Bool
prop_shape_stays_constant (InputFormat xs) = length inp == length res
where
inp = concat xs
res = concat $ generateMineField xs
prop_mines_stay_put :: InputFormat -> Bool
prop_mines_stay_put (InputFormat xs) = and $ zipWith zipper inp res
where
inp = concat xs
res = concat $ generateMineField xs
zipper '*' '*' = True
zipper _ '*' = False
zipper '*' _ = False
zipper _ _ = True
prop_numbers_between_0_8 :: InputFormat -> Bool
prop_numbers_between_0_8 (InputFormat xs) =
not $ null res && -- must make sure the list isn't empty
all ((>) 8 . digitToInt) res
where
res = filter (/= '*') $ concat $ generateMineField xs
-- Implementation
type Point = (Integer,Integer)
data MineField = MineField Integer Integer [Point]
generateMineField :: [String] -> [String]
generateMineField = renderMineField . mkMineField . labelCharacters
labelCharacters :: [String] -> [(Point,Char)]
labelCharacters = concatMap (uncurry labelCols) . labelRows
where
labelRows = zip [0..]
labelCols row = zipWith (\col x -> ((row,col), x)) [0..]
mkMineField :: [(Point,Char)] -> MineField
mkMineField xs = MineField width height mines
where
((width,height),_) = maximumBy (comparing fst) xs
mines = map fst $ filter ((== '*') . snd) xs
renderMineField :: MineField -> [String]
renderMineField (MineField w h ms) =
map (\y -> [renderPoint ms (y,x) | x <- [0..h] ]) [0..w]
neighbours :: Point -> [Point] -> Int
neighbours m ms = length $ filter (neighbour m) $ delete m ms
where
neighbour (a,b) (c,d) = abs (a - c) <= 1 && abs (b - d) <= 1
renderPoint :: [Point] -> Point -> Char
renderPoint ms m
| m `elem` ms = '*'
| otherwise = intToDigit (neighbours m ms)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.