aoc2020/day17/day17.hs

41 lines
1.5 KiB
Haskell

{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, DataKinds #-}
module Day17 where
import AoC
import Data.List
import Data.Vector.Sized (Vector)
import qualified Data.Vector.Sized as V
import Data.Map (Map)
import qualified Data.Map as M
import Data.Set (Set)
import qualified Data.Set as S
class Index i where
neighbours :: i -> [i]
addIndex :: i -> i -> i
instance (Num a, Eq a) => Index (Vector n a) where
neighbours i = filter (/= i) . V.mapM (flip map [-1, 0, 1] . (+)) $ i
addIndex = V.zipWith (+)
counts :: Ord a => [a] -> Map a Int
counts = M.fromList . map (\xs -> (head xs, length xs)) . group . sort
neighbourCounts :: (Index i, Ord i) => Set i -> Map i Int
neighbourCounts = counts . concatMap neighbours . S.elems
update :: (Index i, Ord i) => (Int -> Bool) -> (Int -> Bool) -> Set i -> Set i
update create destroy old = M.keysSet $ M.filterWithKey shouldLive $ M.fromSet (flip (M.findWithDefault 0) nCounts) indices
where nCounts = neighbourCounts old
indices = S.union old $ M.keysSet nCounts
shouldLive ix n = if S.notMember ix old then create n else not $ destroy n
run6 :: (Index i, Ord i) => Set i -> Int
run6 = S.size . (!! 6) . iterate (update (==3) (`notElem` [2, 3]))
main = runAoC (toIndices . lines) (run6 . S.fromList . map extendIndex) (run6 . S.fromList . map (extendIndex . extendIndex))
where toIndices input = [V.fromTuple (row, col) :: Vector 2 Int | (row, line) <- zip [0..] input, (col, '#') <- zip [0..] line]
extendIndex = V.cons 0