Advent of Code 2020 in Haskell - Day 24



Jump to:

D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13 | D14 | D15 | D16 | D17 | D18 | D19 | D20 | D21 | D22 | D23 | D24 | D25


Part 1

I was more excited to see Day 24's problem than perhaps I should have been, because I spent a lot of time during my research looking into hexagonal lattice crystal structures. Anyways...

We're traversing another grid in part 1, but this time it's made of hexagonal cells, so that each grid has six neighbors. At first glance, this seems tricky to handle, but redefinition of the axes reveals that the hexagonal discrete grid can be viewed as skewed rectangular grid.

Thus, we can treat this as a problem on the usual x-y Cartesian grid. Stepping east or west moves in the +x or -x directions, and stepping northeast or southwest moves in the +y or -y directions. Stepping northwest or southeast actually moves one step in an x direction and one step in a y direction.

    
import D24input
-- input :: [String]
import qualified Data.List as List
import qualified Data.Map.Strict as Map

data Dir = E | SE | SW | W | NW | NE deriving Show

getSteps :: Dir -> (Int, Int)
getSteps E = (1, 0)
getSteps SE = (1, -1)
getSteps SW = (0, -1)
getSteps W = (-1, 0)
getSteps NW = (-1, 1)
getSteps NE = (0, 1)

getFinalOffset :: [Dir] -> (Int, Int)
getFinalOffset dirs = 
    List.foldr (\(a,b) (c,d) -> (a+c, b+d)) (0,0) $ List.map getSteps dirs

parse :: String -> [Dir]
parse [] = []
parse (c:cs)
    | c == 'e' = E : parse cs
    | c == 'w' = W : parse cs
    | c == 's' = if head cs == 'e'
                    then SE : parse (tail cs)
                    else SW : parse (tail cs)
    | c == 'n' = if head cs == 'e'
                    then NE : parse (tail cs)
                    else NW : parse (tail cs)
    
flippedCounts :: [String] -> Map.Map (Int, Int) Int
flippedCounts = List.foldr performFlip Map.empty 
    where performFlip s m = 
            let offset = getFinalOffset $ parse s
                in Map.insertWith (+) offset 1 m

solve :: Int
solve = let counts = flippedCounts input
            flipped = Map.filter (\x -> x `mod` 2 /= 0) counts
            in Map.size flipped

main :: IO ()
main = print $ solve        
    

We create our Dir enum representing the six directions in which we can step, as well as a getSteps function that maps each direction into the step we would need to take on the x-y Cartesian grid. The getFinalOffset uses getSteps to sum each step up and get the total offset from the reference tile of a sequence of directions. The parse function creates this list of Dirs from each input string by a straightforward recursive parse (we are aided here by the guarantee that each input is a well-formed string of directions).

flippedCounts then takes the input strings and accumulates each into a map from (x,y) position to the number of times it is flipped. We use insertWith again, "inserting" 1 each time we reach a final tile, and rely on insertWith to add it to the count instead if the tile has been flipped before.

To finish off part 1, the solve function filters this map for all tiles that were flipped an odd number of times (and thus will be black) and returns the size. All other tiles were either not visited by the input (and therefore remain white), or were flipped an even number of times (and thus were flipped back to white).

Part 2

Part 2 asks us to perform another cellular automaton simulation. Thankfully, with our reinterpretation of the hexagonal grid as a rectangular one, we can reuse most of the code from Day 11 to get our answer.

We simply need to convert our flippedCounts into a Vector of Vector of Char so that it can be fed into our Day 11 logic. We also update the automaton so that each cell only has six neighbors, and also update the tile change rules to those specified in the problem. The resulting code is quite long, but it is largely copied and pasted from Part 1 or Day 11. Here's the entire solution:

    
import D24input
-- nSteps :: Int
-- input :: [String]
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Maybe as Maybe
import Data.Vector ((!?), (!))
import qualified Data.Vector as Vector

data Dir = E | SE | SW | W | NW | NE deriving Show

getSteps :: Dir -> (Int, Int)
getSteps E = (1, 0)
getSteps SE = (1, -1)
getSteps SW = (0, -1)
getSteps W = (-1, 0)
getSteps NW = (-1, 1)
getSteps NE = (0, 1)

parse :: String -> [Dir]
parse [] = []
parse (c:cs)
    | c == 'e' = E : parse cs
    | c == 'w' = W : parse cs
    | c == 's' = if head cs == 'e'
                    then SE : parse (tail cs)
                    else SW : parse (tail cs)
    | c == 'n' = if head cs == 'e'
                    then NE : parse (tail cs)
                    else NW : parse (tail cs)
    
getFinalOffset :: [Dir] -> (Int, Int)
getFinalOffset dirs = 
    List.foldr (\(a,b) (c,d) -> (a+c, b+d)) (0,0) $ List.map getSteps dirs

flippedCounts :: [String] -> Map.Map (Int, Int) Int
flippedCounts = List.foldr performFlip Map.empty 
    where performFlip s m = 
            let offset = getFinalOffset $ parse s
                in Map.insertWith (+) offset 1 m

type Grid = Vector.Vector (Vector.Vector Char)

createGrid :: Int -> Int -> Map.Map (Int, Int) Int -> Grid
createGrid h w flipped = 
    let half_h = div h 2
        half_w = div w 2
        strings = [[if Map.member (j - half_w, i - half_h) flipped 
                    then '#' 
                    else 'L' | j <- [0..w-1]] 
                                | i <- [h-1,h-2..0]]
        in Vector.fromList (List.map Vector.fromList strings)

grid :: Map.Map (Int, Int) Int -> Grid
grid counts = 
    let flipped = Map.filter (\x -> x `mod` 2 /= 0) counts
        xs = List.map fst $ Map.keys flipped
        ys = List.map snd $ Map.keys flipped
        (minx, maxx) = (minimum xs, maximum xs)
        (miny, maxy) = (minimum ys, maximum ys)
        h = maxy - miny + 2 * nSteps
        w = maxx - minx + 2 * nSteps
        initial = Vector.replicate h (Vector.replicate w 'L')
        in createGrid h w flipped

getOffsets :: (Int, Int) -> [(Int, Int)]
getOffsets (x,y) = [(x-1,y-1), (x,y-1),
                    (x-1,y), (x+1,y),
                    (x,y+1), (x+1,y+1)]

(!!?) :: Grid -> (Int,Int) -> Maybe Char
(!!?) g (i,j) = do
    row <- g !? i
    c <- row !? j
    return c

countNeighbors :: Grid -> (Int, Int) -> Int
countNeighbors g (i,j) = 
    let neighbors = Maybe.catMaybes $ List.map (g!!?) $ getOffsets (i,j)
        in List.sum $ List.map (\c -> if c == '#' then 1 else 0) neighbors

nextChar :: Grid -> (Int,Int) -> Char
nextChar g pos
    | curr == 'L' && numNeighbors == 2 = '#'
    | curr == '#' && (numNeighbors == 0 || numNeighbors > 2) = 'L'
    | otherwise = curr
        where curr = Maybe.fromJust (g !!? pos)
                numNeighbors = countNeighbors g pos

updateGrid :: Grid -> Grid
updateGrid g = Vector.map convertRow $ Vector.fromList [0..(Vector.length g)-1]
    where
        convertRow i = 
            let numCols = Vector.length (g ! i)
                indices = Vector.zip (Vector.replicate numCols i) $ Vector.fromList [0..numCols-1]
                in Vector.map (nextChar g) indices

getNthState :: Int -> Grid -> Grid
getNthState n start = head $ drop n $ iterate updateGrid start

countHashes :: Grid -> Int
countHashes = Vector.sum . (Vector.map (Vector.length . (Vector.filter (=='#'))))

solve :: Int
solve = let counts = flippedCounts input
            start = grid counts
            end = getNthState nSteps start
            in countHashes end

main :: IO ()
main = print $ solve
    

Jump to:

D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13 | D14 | D15 | D16 | D17 | D18 | D19 | D20 | D21 | D22 | D23 | D24 | D25