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
Day 17 brings us back into the realm of cellular automata, with two key differences from the last automaton question (Day 11). The first difference lies in the update rules, which is easily handled as it each cell cares only about its nearest neighbors. The second difference lies in the lack of boundedness of the simulation domain. However, noting that the question only asks us to simulate 6 steps, and combining that with the fact that each cell is only updated by its nearest neighbors, we can effectively bound our simulation domain to 6 steps in each direction in each dimension.
First, we need to do some work to set up this simulation domain with the initial state:
import D17input
-- input :: [String]
-- dim :: Int -- the total linear dimension of the simulation domain
-- pdim :: Int -- length of the padding required
-- idim :: Int -- inner dimension of the provided input
import Data.List as List
import Data.Maybe as Maybe
import Data.Vector as Vector
type Grid = Vector (Vector (Vector Char))
type Coords = (Int, Int, Int)
emptyPlane :: Vector (Vector Char)
emptyPlane = Vector.replicate dim (Vector.replicate dim '.')
plane :: [String] -> Vector (Vector Char)
plane strings =
let hPadding = List.replicate pdim '.'
hPadded = List.map (\s -> hPadding List.++ s List.++ hPadding) strings
emptyRow = List.replicate dim '.'
vPadding = List.replicate pdim emptyRow
listGrid = vPadding List.++ hPadded List.++ vPadding
in fromList $ List.map fromList listGrid
grid :: [String] -> Grid
grid strings =
let padding = Vector.replicate pdim emptyPlane
in padding Vector.++ (Vector.singleton (plane strings)) Vector.++ padding
The plane function creates an initial 2D Vector from the input, padded to the size of the simulation domain. The grid function uses this to create the entire 3D Vector.
Once we have the simulation domain set up, we need to modify our functions from Day 11 to handle the new automaton rules and the extra dimension (i.e., the extra layer of Vector). The concepts are identical to Day 11, though, so I will refer the interested reader to the Day 11 post for a more detailed explanation.
getOffsets :: Coords -> [Coords]
getOffsets (i,j,k) = [(x, y, z) | x <- [i-1, i, i+1],
y <- [j-1, j, j+1],
z <- [k-1, k, k+1],
x /= i || y /= j || z /= k]
(!!!?) :: Grid -> Coords -> Maybe Char
(!!!?) g (i,j,k) = do
xp <- g !? i
yr <- xp !? j
z <- yr !? k
return z
countNeighbors :: Grid -> Coords -> Int
countNeighbors g pos =
let neighbors = Maybe.catMaybes $ List.map (g!!!?) $ getOffsets pos
in List.sum $ List.map (\c -> if c == '#' then 1 else 0) neighbors
nextChar :: Grid -> Coords -> Char
nextChar g pos
| curr == '.' && numNeighbors == 3 = '#'
| curr == '#' && (numNeighbors > 3 || numNeighbors < 2) = '.'
| otherwise = curr
where curr = Maybe.fromJust (g !!!? pos)
numNeighbors = countNeighbors g pos
updateGrid :: Grid -> Grid
updateGrid g = fromList $ List.map convertPlane [0..(Vector.length g)-1]
where
convertPlane :: Int -> Vector (Vector Char)
convertPlane i =
let num = Vector.length (g ! i)
ijs = List.zip (repeat i) [0..num-1]
in fromList $ List.map (convertRow) ijs
convertRow :: (Int,Int) -> Vector Char
convertRow (i,j) =
let num = Vector.length ((g ! i) ! j)
ijks = List.zipWith (\(a,b) c -> (a,b,c)) (repeat (i,j)) [0..num-1]
in fromList $ List.map (nextChar g) ijks
countOccupied :: Grid -> Int
countOccupied g = Vector.sum $ Vector.map sumPlane g
where
sumPlane plane = Vector.sum $ Vector.map sumRow plane
sumRow row = Vector.sum $ Vector.map (\c -> if c == '#' then 1 else 0) row
solve :: Int
solve = countOccupied $ List.head $ List.drop 6 $ iterate updateGrid (grid input)
main :: IO ()
main = print $ solve
Part 2
Part 2 asks us to extend this to four dimensions. This is a little awkward to implement, but is otherwise a fairly straightforward extension of what we did for part 1. Four dimensions is still small enough that we can hand-code the handling of each dimension separately. Thankfully, the simulation domain is quite small (a 13x13x20x20 grid is sufficient), so the binary still executes in under 5 seconds.
Not much more to say than that - here's the solution in its entirety:
import D17input
-- input :: [String]
-- dim :: Int -- the total linear dimension of the simulation domain
-- pdim :: Int -- length of the padding required
-- idim :: Int -- inner dimension of the provided input
import Data.List as List
import Data.Maybe as Maybe
import Data.Vector as Vector
type Grid = Vector (Vector (Vector (Vector Char)))
type Space = Vector (Vector (Vector Char))
type Plane = Vector (Vector Char)
type Line = Vector Char
type Coords = (Int, Int, Int, Int)
emptyPlane :: Plane
emptyPlane = Vector.replicate dim (Vector.replicate dim '.')
emptySpace :: Space
emptySpace = Vector.replicate dim emptyPlane
plane :: [String] -> Plane
plane strings =
let hPadding = List.replicate pdim '.'
hPadded = List.map (\s -> hPadding List.++ s List.++ hPadding) strings
emptyLine = List.replicate dim '.'
vPadding = List.replicate pdim emptyLine
listGrid = vPadding List.++ hPadded List.++ vPadding
in fromList $ List.map fromList listGrid
grid :: [String] -> Grid
grid strings =
let spacePadding = Vector.replicate pdim emptyPlane
paddedSpace = spacePadding Vector.++ (Vector.singleton (plane strings)) Vector.++ spacePadding
padding = Vector.replicate pdim emptySpace
in padding Vector.++ (Vector.singleton paddedSpace) Vector.++ padding
getOffsets :: Coords -> [Coords]
getOffsets (i,j,k,l) = [(w, x, y, z) | w <- [i-1, i, i+1],
x <- [j-1, j, j+1],
y <- [k-1, k, k+1],
z <- [l-1, l, l+1],
w /= i || x /= j || y /= k || z /= l]
(!!!?) :: Grid -> Coords -> Maybe Char
(!!!?) g (i,j,k,l) = do
ws <- g !? i
xp <- ws !? j
yr <- xp !? k
z <- yr !? l
return z
countNeighbors :: Grid -> Coords -> Int
countNeighbors g pos =
let neighbors = Maybe.catMaybes $ List.map (g!!!?) $ getOffsets pos
in List.sum $ List.map (\c -> if c == '#' then 1 else 0) neighbors
nextChar :: Grid -> Coords -> Char
nextChar g pos
| curr == '.' && numNeighbors == 3 = '#'
| curr == '#' && (numNeighbors > 3 || numNeighbors < 2) = '.'
| otherwise = curr
where curr = Maybe.fromJust (g !!!? pos)
numNeighbors = countNeighbors g pos
updateGrid :: Grid -> Grid
updateGrid g = fromList $ List.map convertSpace [0..(Vector.length g)-1]
where
convertSpace :: Int -> Space
convertSpace i =
let num = Vector.length (g ! i)
ijs = List.zip (repeat i) [0..num-1]
in fromList $ List.map convertPlane ijs
convertPlane :: (Int,Int) -> Plane
convertPlane (i,j) =
let num = Vector.length ((g ! i) ! j)
ijks = List.zipWith (\(a,b) c -> (a,b,c)) (repeat (i,j)) [0..num-1]
in fromList $ List.map convertLine ijks
convertLine :: (Int,Int,Int) -> Line
convertLine (i,j,k) =
let num = Vector.length (((g ! i) ! j) ! k)
ijkls = List.zipWith (\(a,b,c) d -> (a,b,c,d)) (repeat (i,j,k)) [0..num-1]
in fromList $ List.map (nextChar g) ijkls
countOccupied :: Grid -> Int
countOccupied g = Vector.sum $ Vector.map sumSpace g
where
sumSpace space = Vector.sum $ Vector.map sumPlane space
sumPlane plane = Vector.sum $ Vector.map sumLine plane
sumLine line = Vector.sum $ Vector.map (\c -> if c == '#' then 1 else 0) line
solve :: Int
solve = countOccupied $ List.head $ List.drop 6 $ iterate updateGrid (grid input)
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