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