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
Strap yourselves in - Day 11 is... quite the ride. AoC seems to really like 2D grid problems, so it was only a matter of time before one popped up this year. All things considered, this was a lot of fun, although I'm going to need to figure out a better way to do 2D grid manipulation, because I'm not a huge fan of how my solutions turned out.
Both part 1 and part 2 ask us to implement a cellular automaton with some simple rules. The first thing we want to do is set up our Grid structure and write a few functions that help us work with it.
import D11input
-- input :: [String]
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import Data.Vector as Vector
type Grid = Vector (Vector Char)
grid :: [String] -> Grid
grid strings = fromList (List.map fromList strings)
getOffsets :: (Int, Int) -> [(Int, Int)]
getOffsets (i,j) = [(i-1,j-1), (i,j-1), (i+1,j-1),
(i-1,j), (i+1,j),
(i-1,j+1), (i,j+1), (i+1,j+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
We use a Vector of Vector of Char to represent our grid. Vector is chosen over a list because we are foreseeing a need to often be indexing into both dimensions in random access fashion. Using a list of lists would incur an O(mn) cost just to query an element of the grid, while using vector of vectors brings this down to O(1).
getOffsets is a simple function that returns all of the cells surrounding a given cell (i,j). We can always return all 8 index pairs here, even if it would go off grid for a given (i,j), because our lookup function (!!?) returns a Maybe Char. (!!?) returns the element in the ith row and jth column, returning Nothing if either of those does not exist.
Then, countNeighbors puts these tools together. Given a grid and coordinates, it computes a list (called neighbors) of all Chars in the surrounding cells. It then counts the number of filled seats (i.e., '#' Chars). Armed with this, we can implement the automaton:
nextChar :: Grid -> (Int,Int) -> Char
nextChar g pos
| curr == '.' = '.'
| curr == 'L' && numNeighbors == 0 = '#'
| curr == '#' && numNeighbors >= 4 = 'L'
| otherwise = curr
where curr = Maybe.fromJust (g !!? pos)
numNeighbors = countNeighbors g pos
updateGrid :: Grid -> Grid
updateGrid g = Vector.map convertRow $ fromList [0..(Vector.length g)-1]
where
convertRow i =
let numCols = Vector.length (g ! i)
indices = Vector.zip (Vector.replicate numCols i) $ fromList [0..numCols-1]
in Vector.map (nextChar g) indices
First, we define a nextChar function, which returns the next value of a given cell of the grid. The rule is a fairly straightforward transcription of the rules outlined in the problems. Floor spots ('.') never change. Empty seats ('L') fill up if there are no filled seats in their surroundings. Filled seats ('#') empty if there are 4 or more filled seats in their surroundings. In all other cases, the cell is unchanged.
This is then used in updateGrid, which structured as a double map. convertRow is an auxiliary function that converts all values in a row, implemented as a map of nextChar over the indices of the row. convertRow itself is then mapped over all rows in order to achieve an update of the entire grid.
Finally, we can solve the actual problem:
steadyState :: Grid -> Grid
steadyState g
| g == u = u
| otherwise = steadyState u
where u = updateGrid g
countOccupied :: Grid -> Int
countOccupied g = Vector.sum $ Vector.map sumRow g
where
sumRow row = Vector.sum $ Vector.map (\c -> if c == '#' then 1 else 0) row
solve :: Int
solve = countOccupied $ steadyState (grid input)
main :: IO ()
main = print $ solve
From the question, what we are seeking is the state of the grid when it no longer changes. Once we have our updateGrid function, this can be elegantly found with a neat recursive function, called steadyState above. First, we apply one step of updateGrid. If it does not change, we are done. Otherwise, we look for the steady state of the next grid. Assuming the grid has a steady state, this is guaranteed to reach it. (Of course, if the grid has no steady state, we will recurse forever, but the problem statement here implies that a steady state exists.)
Finally, we have a countOccupied function that gives the numerical value demanded by the problem: the number of occupied seats in the steady state. This is accomplished by another double map, similar to updateGrid above.
Part 2
Phew. Thankfully, part 2 is very similar, so we can reuse much of what we developed above. All we need to do is change the way the occupied "neighbor" seats are counted, and adjust the threshold from 4 to 5.
However, the new way of counting neighbors is tricky. Instead of being able to return a fixed list (as in getOffsets above), we will do some preprocessing on the initial grid to precompute the list of "neighbors" (really, this now means "seat in view" but I continued to use the term neighbor in the code, and will throughout the rest of this post as well).
getNeighborInDirectionAux :: Grid -> (Int, Int) -> (Int, Int) -> Maybe (Int, Int)
getNeighborInDirectionAux g pos@(i,j) dir@(di,dj) =
case g !!? pos of
Nothing -> Nothing
Just '.' -> getNeighborInDirectionAux g (i+di,j+dj) dir
Just _ -> Just pos
getNeighborInDirection :: Grid -> (Int, Int) -> (Int, Int) -> Maybe (Int, Int)
getNeighborInDirection g pos@(i,j) dir@(di,dj) =
getNeighborInDirectionAux g (i+di,j+dj) dir
getNeighborsInView :: Grid -> (Int, Int) -> [(Int, Int)]
getNeighborsInView g pos =
let dirs = [(-1,-1), (-1,0), (-1,1), (0,-1), (0,1), (1,-1), (1,0), (1,1)]
in Maybe.catMaybes $ List.map (getNeighborInDirection g pos) dirs
neighborMap :: Map.Map (Int, Int) [(Int, Int)]
neighborMap =
let numRows = List.length input
numCols = List.length $ List.head input
positions = [(i,j) | i <- [0..numRows-1], j <- [0..numCols-1]]
neighbors = List.map (getNeighborsInView (grid input)) positions
in Map.fromList $ List.zip positions neighbors
We first start with a helper function getNeighborInDirection. Directions are represented as pairs of offsets to row and column (which can be thought of a 2D displacement vector). We are looking for the first non-'.' character in the given direction, and continue to make recursive calls until one is found, or the edge of the grid is reached (which happens when our lookup function (!!?) returns Nothing).
We then use this to write getNeighborsInView, which gets a list of all neighbors in all directions, if they exist. This is done by mapping our getNeighborInDirection function we just wrote over a list of all 8 directions.
Finally, we build our neighborMap from the input. This amounts to creating a list of all indices in the input, and then using our getNeighborsInView to get the list of neighbors for each position. Zipping the indices with this list of neighbors gives us a list of key-value pairs that we can use to construct our map. It's worth re-emphasizing here that this is a costly step, but we only need to perform this computation of neighborMap once, while subsequent accesses to neighborMap simply access the already constructed map.
getNeighborOffsets :: (Int, Int) -> [(Int, Int)]
getNeighborOffsets pos = Maybe.fromJust $ Map.lookup pos neighborMap
countNeighbors :: Grid -> (Int, Int) -> Int
countNeighbors g (i,j) =
let neighbors = Maybe.catMaybes $ List.map (g!!?) $ getNeighborOffsets (i,j)
in List.sum $ List.map (\c -> if c == '#' then 1 else 0) neighbors
To finish up the problem, we modify our countNeighbors function to align with this new definition of neighbor. This function is almost identical to its part 1 version, except that it calls getNeighborOffsets to get the offsets to check rather than getOffsets. getNeighborOffsets simply performs a lookup into our precomputed neighborMap. With that, we use the same updateGrid, steadyState, and countOccupied functions from part 1 as is to give the answer.
(For the sake of completeness, I'll note that the nextChar function was also changed slightly (4 -> 5) for my part 2 solution, although I did not highlight it here in the code segments.)
And that's that! One final note - the solution to both parts takes a while (6-7 seconds on my i7-4790), so I have no doubt that there is a lot of room for improvement here. This is one Day where I'll definitely be looking up other Haskell solutions to get some ideas.
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