day17: add haskell solution
This commit is contained in:
parent
f6fb838807
commit
956228b487
4 changed files with 51 additions and 1 deletions
|
@ -22,7 +22,7 @@ https://adventofcode.com/2020/
|
|||
|14 | | `**` | |
|
||||
|15 | `**` | | |
|
||||
|16 | | `**` | |
|
||||
|17 | | | |
|
||||
|17 | | `**` | |
|
||||
|18 | | `**` | |
|
||||
|19 | | `**` | |
|
||||
|
||||
|
|
2
data/day17.expected
Normal file
2
data/day17.expected
Normal file
|
@ -0,0 +1,2 @@
|
|||
359
|
||||
2228
|
8
data/day17.input
Normal file
8
data/day17.input
Normal file
|
@ -0,0 +1,8 @@
|
|||
.##..#.#
|
||||
#...##.#
|
||||
##...#.#
|
||||
.##.##..
|
||||
...#.#.#
|
||||
.##.#..#
|
||||
...#..##
|
||||
###..##.
|
40
day17/day17.hs
Normal file
40
day17/day17.hs
Normal file
|
@ -0,0 +1,40 @@
|
|||
{-# 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
|
Loading…
Reference in a new issue