1
0
Fork 0
advent-of-code/2020/11/Day11.hs

75 lines
1.6 KiB
Haskell
Raw Normal View History

2022-09-21 09:19:53 -04:00
module Day11 where
import Data.Array
data Cell = Empty | Occupied | Floor
deriving (Eq, Show)
isCell 'L' = True
isCell '#' = True
isCell '.' = True
isCell _ = False
toCell 'L' = Empty
toCell '#' = Occupied
toCell '.' = Floor
instance Read Cell where
readsPrec _ (c:rest) = [(toCell c, rest)]
readList input = [(map toCell cells, rest)]
where (cells, rest) = span isCell input
toChar Empty = 'L'
toChar Occupied = '#'
toChar Floor = '.'
type State = Array (Int, Int) Cell
parse :: String -> State
parse input = listArray ((1, 1), (width, height)) $ concat lists
where
lists :: [[Cell]]
lists = map read $ lines input
width = length $ head lists
height = length lists
render :: State -> String
render state = unlines chunks
where
(_, (width, _)) = bounds state
chars = map toChar $ elems state
chunks = chunk width chars
chunk n [] = []
chunk n xs = curr:(chunk n rest)
where
(curr, rest) = splitAt n xs
n (x, y) = (x, y-1)
s (x, y) = (x, y+1)
w (x, y) = (x-1, y)
e (x, y) = (x+1, y)
ne = n . e
nw = n . w
se = s . e
sw = s . w
directions x = map ($ x) [n, ne, e, se, s, sw, w, nw]
(!?) arr ix =
if inRange (bounds arr) ix
then Just (arr ! ix)
else Nothing
tick :: State -> State
tick curr = array (bounds curr) $ map nextCell $ assocs curr
where
occupiedAdjacent ix =
length $ filter (== (Just Occupied)) $ map ((!?) curr) $ directions ix
nextCell c@(ix, Empty)
| occupiedAdjacent ix == 0 = (ix, Occupied)
nextCell c@(ix, Occupied)
| occupiedAdjacent ix >= 4 = (ix, Empty)
nextCell x = x