Day 17 was a lot of fiddly detail, so I decided to use a new-to-me Haskell feature, pattern synonyms, to help out. They made the fiddly bits slightly less fiddly.
Data structures
This follows a similar pattern to other grid-based puzzles. Each type of thing in the map is an Element
and the grid is an Array
of Element
s. The head of a beam of light is characterised by both its position and direction. The set of energised cells needs to know both the location and direction of the beam, as beams can cross each other without interference.
data Element =
Empty | SlashMirror | BackslashMirror |
HorizontalSplitter | VerticalSplitter
deriving (Show, Eq, Enum)
type Position = V2 Int -- r, c
type Grid = Array Position Element
data BeamHead = BeamHead { beamPos :: Position, beamDirection :: Position }
deriving (Show, Eq, Ord)
type Energised = S.Set BeamHead
This is where the pattern synonyms came in. There's lot of fiddling around with directions, and changes of direction, and representing all that with different values of row and column changes, and it's all prone to silly mistakes. I can reduce the scope for mistakes with patterns for the four directions.
pattern U, D, L, R :: Position
pattern U = V2 (-1) 0
pattern D = V2 1 0
pattern L = V2 0 (-1)
pattern R = V2 0 1
These patterns are bidirectional, so they can be used in pattern matching and as the parameters of functions. Essentially, every time the compiler sees a D
, it replaces it with V2 1 0
. These patterns get used throughout the code that propagates a beam.
Reading a grid is walking over the data and converting the characters to Element
s.
mkGrid :: String -> Grid
mkGrid text = grid
where rows = lines text
r = length rows - 1
c = (length $ head rows) - 1
grid = listArray ((V2 0 0), (V2 r c)) $ fmap readElement $ concat rows
readElement :: Char -> Element
readElement '/' = SlashMirror
readElement '\\' = BackslashMirror
readElement '|' = VerticalSplitter
readElement '-' = HorizontalSplitter
readElement _ = Empty
Propagation
There can be several beams travelling through the grid. Mirrors change direction, splitters may add an extra beam. Beams are removed when they move outside the bounds of the grid or a beam starts following an prior beam (indicating a loop). propagate
handles a list of beams, and propagateElem
handles one beam interacting with one Element
.
propagate
maintains a list of active beams. It takes the first beam, works out where it could go, and ensures those new locations are in bounds. If the first beam moves into a loop, it's just discarded. It returns the set of energised locations.
propagate :: Grid -> Energised -> [BeamHead] -> Energised
propagate _ energised [] = energised
propagate grid energised (bh:bhs)
| S.member bh energised = propagate grid energised bhs
| otherwise = propagate grid energised' (bhs ++ nexts')
where this = grid ! (beamPos bh)
nexts = propagateElem this bh
nexts' = filter ((inRange (bounds grid)) . beamPos) nexts
energised' = S.insert bh energised
propagateElem
handles all the element logic, and this is where the pattern synonyms come in. They didn't stop me making silly mistakes, but they made those mistakes much easier to spot and correct!
propagateElem :: Element -> BeamHead -> [BeamHead]
propagateElem Empty (BeamHead pos dir) = [BeamHead (pos ^+^ dir) dir]
propagateElem SlashMirror (BeamHead pos L) = [BeamHead (pos ^+^ D) D]
propagateElem SlashMirror (BeamHead pos R) = [BeamHead (pos ^+^ U) U]
propagateElem SlashMirror (BeamHead pos U) = [BeamHead (pos ^+^ R) R]
propagateElem SlashMirror (BeamHead pos D) = [BeamHead (pos ^+^ L) L]
propagateElem BackslashMirror (BeamHead pos L) = [BeamHead (pos ^+^ U) U]
propagateElem BackslashMirror (BeamHead pos R) = [BeamHead (pos ^+^ D) D]
propagateElem BackslashMirror (BeamHead pos U) = [BeamHead (pos ^+^ L) L]
propagateElem BackslashMirror (BeamHead pos D) = [BeamHead (pos ^+^ R) R]
propagateElem HorizontalSplitter (BeamHead pos L) = [BeamHead (pos ^+^ L) L]
propagateElem HorizontalSplitter (BeamHead pos R) = [BeamHead (pos ^+^ R) R]
propagateElem HorizontalSplitter (BeamHead pos _) =
[BeamHead (pos ^+^ L) L, BeamHead (pos ^+^ R) R]
propagateElem VerticalSplitter (BeamHead pos U) = [BeamHead (pos ^+^ U) U]
propagateElem VerticalSplitter (BeamHead pos D) = [BeamHead (pos ^+^ D) D]
propagateElem VerticalSplitter (BeamHead pos _) =
[BeamHead (pos ^+^ U) U, BeamHead (pos ^+^ D) D]
This might be shorter if I used arithmetic on some of the cases, but it would certainly be less readable.
Solutions
Given that I can propagate a beam around a grid, I can count the number of energised cells.
countEnergised :: Grid -> BeamHead -> Int
countEnergised grid bh = S.size $ S.map beamPos $ propagate grid S.empty [bh]
For part 2, I need to find the possible start positions.
getEdges :: Grid -> [BeamHead]
getEdges grid = [BeamHead (V2 0 c) D | c <- [0..maxC]] ++
[BeamHead (V2 r 0) R | r <- [0..maxR]] ++
[BeamHead (V2 r maxC) L | r <- [0..maxR]] ++
[BeamHead (V2 maxR c) U | c <- [0..maxC]]
where (V2 maxR maxC) = snd $ bounds grid
That allows the problems to be solved.
part1, part2 :: Grid -> Int
part1 grid = countEnergised grid (BeamHead (V2 0 0) R)
part2 grid = maximum $ fmap (countEnergised grid) $ getEdges grid
Code
You can get the code from my locally-hosted Git repo, or from Gitlab.