advent of code, puzzle, haskell

Advent of Code 2023 day 03

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 rows

Finding 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

  1. All the numbers I've found so far
  2. 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:

  1. I'm building a number and this character is a digit → add the position to the current number, keep building
  2. I'm building a number and this character is not a digit → add the built number to the list of found ones, stop building
  3. I'm not building a number and this character is a digit → add the position to the current number, keep building
  4. 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 engine

With 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 !) ps

Touching

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) region1

Solving 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 engine

I 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 partNums

Part 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) partNums

Part 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.