Day 3 was conceptually quite simple, but some of the concepts required were complex to implement.
First off, some concepts. A Position is a pair of row and column. An Engine is an Array of characters. A Region is a group of Positions.
type Position = V2 Int -- r, c
type Engine = Array Position Char
type Region = [Position]Building the engine from the input file is a matter of finding the size then filling the array.
mkEngine :: String -> Engine
mkEngine text = grid
where rows = lines text
r = length rows - 1
c = (length $ head rows) - 1
grid = listArray ((V2 0 0), (V2 r c)) $ concat rowsFinding numbers
The first hard-to-implement concept is that of finding all the numbers in the engine. As numbers are only horizontal, I can worry about just finding the numbers in each row, then combine the results.
The overall method of finding numbers in a row is a fold over the characters in that row. As I walk along the row, I keep track of
- All the numbers I've found so far
- The number I'm currently building
(Recording numbers as the Region they occupy, as I need that for working out what touches what later.)
I can keep that in a record
data NumberSeek =
NumberSeek { positions :: Region
, foundNumbers :: [Region]
} deriving (Show)That means, when I come across a new character in a row, there are four alternatives, depending on whether I'm currently building a number and whether the current character is a digit:
- I'm building a number and this character is a digit → add the position to the current number, keep building
- I'm building a number and this character is not a digit → add the built number to the list of found ones, stop building
- I'm not building a number and this character is a digit → add the position to the current number, keep building
- I'm not building a number and this character is not a digit → skip ahead.
Those cases translate into the four cases in buildNumber, plus a bit of housekeeping needed for the case where a number ends with the last character in a row.
findNumbersInRow :: Engine -> Int -> NumberSeek
findNumbersInRow engine r
| not $ null positions =
NumberSeek [] ((reverse $ positions):foundNumbers)
| otherwise = finalSeek
where finalSeek@NumberSeek{..} =
foldl' (buildNumber engine)
(NumberSeek [] [])
$ range $ rowBounds engine r
buildNumber :: Engine -> NumberSeek -> Position -> NumberSeek
buildNumber engine NumberSeek{..} p
| (not $ null positions) && isDigit c = NumberSeek (p:positions) foundNumbers
| (not $ null positions) && not (isDigit c) = NumberSeek [] ((reverse positions):foundNumbers)
| (null positions) && isDigit c = NumberSeek [p] foundNumbers
| otherwise = NumberSeek [] foundNumbers
where c = engine ! p
rowBounds :: Engine -> Int -> (V2 Int, V2 Int)
rowBounds engine r = (V2 r c1, V2 r c2)
where (V2 _ c1, V2 _ c2) = bounds engineWith that, I can find all the numbers in the engine by appling findNumbersInRow to every row and combining the results with concatMap.
findNumbers :: Engine -> [Region]
findNumbers engine = numbers
where ((V2 r1 _), (V2 r2 _)) = bounds engine
rows = [r1..r2]
numbers = concatMap (foundNumbers . (findNumbersInRow engine)) rows
The final thing with numbers is to convert the positions of the digits into an actual number.
readNumber :: Engine -> Region -> Int
readNumber engine ps = read $ map (engine !) psTouching
The next concept is that of touching. The puzzle is all about numbers touching symbols, so I need to implement that.
The neighbours of a point are all the points surrounding that point.
A region touches a point if any neighbours of that point are in the region.
Region a touches region b if any point in a touches b.
neighbours :: Position -> Region
neighbours p = [p ^+^ V2 dr dc | dr <- [-1..1], dc <- [-1..1]
, (dr, dc) /= (0, 0) ]
touchPoint :: Region -> Position -> Bool
touchPoint region point = not $ null $ intersect region $ neighbours point
touchRegion :: Region -> Region -> Bool
touchRegion region1 region2 = any (touchPoint region2) region1Solving the puzzle
Now I can solve the puzzle! Preprocessing is to find all the part numbers in the engine. Those are the numbers that touch a symbol.
The set of all symbols is itself a Region (albeit non-contiguous).
isEngineSymbol :: Char -> Bool
isEngineSymbol c = (not $ isDigit c) && (c /= '.')
findSymbols :: Engine -> Region
findSymbols engine = filter (isEngineSymbol . (engine !)) $ indices engineI can find all the numbers, find the symbols, then find which numbers touch the symbols.
main :: IO ()
main =
do dataFileName <- getDataFileName
text <- readFile dataFileName
let engine = mkEngine text
let allNums = findNumbers engine
let symbols = findSymbols engine
let partNums = filter (touchRegion symbols) allNums
print $ part1 engine partNums
print $ part2 engine partNumsPart 1
For part 1, I conver the part numbers (as Regions) into numbers and add them up.
part1 :: Engine -> [Region] -> Int
part1 engine partNums = sum partNumValues
where partNumValues = map (readNumber engine) partNumsPart 2
This is a bit more involved. First, I find all the stars. Then, for each star, I find the part numbers that touch that star; that gives a list of numbers at each star. If there are exactly two numbers at the star, those numbers are the components of that gear. Having found all the gears, I do the arithmetic to find the sum of the gear ratios.
part1 :: Engine -> [Region] -> Int
part2 engine partNums = sum $ fmap product gearRatios
where stars = findStars engine
touchingStars = fmap (possibleGears partNums) stars
gears = filter ((==) 2 . length) touchingStars
gearRatios = fmap (fmap (readNumber engine)) gears
findStars :: Engine -> Region
findStars engine = filter ((==) '*' . (engine !)) $ indices engine
possibleGears :: [Region] -> Position -> [Region]
possibleGears nums star = filter (flip touchPoint star) nums Code
You can get the code from my locally-hosted Git repo, or from Gitlab.