Solution for Advent of Code 2020, day 17

aoc2020-17.hs

import Control.Monad (guard)

import Data.List

import qualified Data.Map as Map
import Data.Map (Map)

import Data.Maybe

type Point = [Int]

type PocketDimension = Map Point Bool

readDimension :: Int -> String -> PocketDimension
readDimension d i = Map.fromList $ do
    (y, line) <- zip [0..] $ lines i
    (x, cell) <- zip [0..] line
    pure ([x, y] ++ replicate (d - 2) 0, cell == '#')

input = unlines ["######.#",
                      "##.###.#",
                      "#.###.##",
                      "..#..###",
                      "##.#.#.#",
                      "##...##.",
                      "#.#.##.#",
                      ".###.###"]

cleanup :: PocketDimension -> PocketDimension
cleanup = Map.filter id

points :: PocketDimension -> [Point]
points = Map.keys . cleanup

minPoint :: PocketDimension -> Point
minPoint = map minimum . transpose . points

maxPoint :: PocketDimension -> Point
maxPoint = map maximum . transpose . points

neighbours :: Point -> [Point]
neighbours r = do
    let n t = [t - 1, t, t + 1]
    r' <- traverse n r
    guard $ r /= r'
    pure r'

aliveNeighbours :: PocketDimension -> Point -> Int
aliveNeighbours d p = length $ filter (== Just True) $ map (\p' -> Map.lookup p' d) $ neighbours p

step' :: PocketDimension -> PocketDimension
step' d = Map.fromList $ do
    p0 <- points d
    p <- neighbours p0
    let state = fromMaybe False $ Map.lookup p d
    let alive = aliveNeighbours d p
    let nextState = case (state, alive) of
                                                (True, 2) -> True
                                                (True, 3) -> True
                                                (False, 3) -> True
                                                _ -> False
    pure (p, nextState)

step :: PocketDimension -> PocketDimension
step = cleanup . step'

dimensions = "zw"

restOfDimensions :: [Int] -> [Int] -> [[Int]]
restOfDimensions rmin rmax = traverse (\[min, max] -> [min..max]) $ transpose [rmin, rmax]

showDimension :: PocketDimension -> String
showDimension d = unlines $ map showSlice $ restOfDimensions rmin rmax
    where
        xmin:ymin:rmin = minPoint d
        xmax:ymax:rmax = maxPoint d
        showSlice rest = unlines $ (intercalate ", " $ zipWith (\dc dv -> [dc] ++ "=" ++ show dv) dimensions rest):map showLine [ymin..ymax]
            where
                showLine y = map (showOne . fromMaybe False . (\x -> Map.lookup (x: y: rest) d)) [xmin..xmax]
                showOne True = '#'
                showOne False = '.'

glider = unlines [".#.", "..#", "###"]