2017/21.hs

import Data.List (transpose)
import Data.List.Split (splitOn, chunksOf)
import Data.HashMap (Map, insert, empty, (!))

type Rules = Map String String
squareRoot = floor . sqrt . fromIntegral

validTwos = [
        [0..3],
        [0, 2, 1, 3],
        [1, 0, 3, 2],
        [1, 3, 0, 2],
        [2, 0, 3, 1],
        [2, 3, 0, 1],
        [3, 1, 2, 0],
        [3,2..0]
    ]

validThrees = [
        [0..8],
        [0, 3, 6, 1, 4, 7, 2, 5, 8],
        [2, 1, 0, 5, 4, 3, 8, 7, 6],
        [2, 5, 8, 1, 4, 7, 0, 3, 6],
        [6, 3, 0, 7, 4, 1, 8, 5, 2],
        [6, 7, 8, 3, 4, 5, 0, 1, 2],
        [8, 5, 2, 7, 4, 1, 6, 3, 0],
        [8,7..0]
    ]

valids :: String -> [String]
valids str = map (map (str !!)) $ case length str of
    4 -> validTwos
    9 -> validThrees

chunk :: String -> [[String]]
chunk str =
    let size     = squareRoot $ length str
        multiple = if even size then 2 else 3
        makeRow  = map concat . transpose . map (chunksOf multiple) . chunksOf size
    in  map makeRow $ chunksOf (size * multiple) str

dechunk :: [[String]] -> String
dechunk rows =
    let multiple  = squareRoot . length . head . head $ rows
        unmakeRow = concat . concat . transpose . map (chunksOf multiple)
    in  concat $ map unmakeRow rows

enhance :: Rules -> String -> String
enhance rules = dechunk . map (map (rules !)) . chunk

parseLine :: String -> Rules -> Rules
parseLine line =
    let input : output : [] = splitOn " => " $ filter (/= '/') line
    in  flip (foldr (\key currRules -> insert key output currRules)) $ valids input

main :: IO ()
main = do
    rules <- foldr parseLine empty . lines <$> readFile "21.txt"
    let iterations = map (length . filter (=='#')) $ iterate (enhance rules) ".#...####"
    print $ iterations !! 5
    print $ iterations !! 18