Day 15 - Beacons and Scanners
Unfortunately this solution took me quite a while to complete (I spent a while on an infeasible solution), so I don't have as much time for details on the writeup.
Subscribe to Monday Morning Haskell!
Problem Overview
Solution Approach and Insights
My initial approach would effectively count every square that would be excluded, but this isn't feasible because the grid size is "millions by millions" for the large input.
If you actually consider the question being asked in the first part, then things become a bit easier. You can count the number of excluded spaces on single row by using arithmetic to gather a series of exclusion intervals. You can then sort and merge these, which allows you to count the number of excluded items very quickly.
Then in the second part, it is not prohibitive to go through this process for each of the 4 million rows until you find an interval list that has a gap.
Relevant Utilities
Manhattan distance:
type Coord2 = (Int, Int)
manhattanDistance :: Coord2 -> Coord2 -> Int
manhattanDistance (x1, y1) (x2, y2) = abs (x2 - x1) + abs (y2 - y1)Get neighbors in each direction:
getNeighbors4Unbounded :: Coord2 -> [Coord2]
getNeighbors4Unbounded (x, y) =
[ (x + 1, y)
, (x, y + 1)
, (x - 1, y)
, (x, y - 1)
]Parsing the Input
Here's a sample input:
Sensor at x=2, y=18: closest beacon is at x=-2, y=15
Sensor at x=9, y=16: closest beacon is at x=10, y=16
Sensor at x=13, y=2: closest beacon is at x=15, y=3
Sensor at x=12, y=14: closest beacon is at x=10, y=16
Sensor at x=10, y=20: closest beacon is at x=10, y=16
Sensor at x=14, y=17: closest beacon is at x=10, y=16
Sensor at x=8, y=7: closest beacon is at x=2, y=10
Sensor at x=2, y=0: closest beacon is at x=2, y=10
Sensor at x=0, y=11: closest beacon is at x=2, y=10
Sensor at x=20, y=14: closest beacon is at x=25, y=17
Sensor at x=17, y=20: closest beacon is at x=21, y=22
Sensor at x=16, y=7: closest beacon is at x=15, y=3
Sensor at x=14, y=3: closest beacon is at x=15, y=3
Sensor at x=20, y=1: closest beacon is at x=15, y=3Simple line-by-line stuff, combining keywords and numbers.
type InputType = [LineType]
type LineType = (Coord2, Coord2)
parseInput :: (MonadLogger m) => ParsecT Void Text m InputType
parseInput =
sepEndBy1 parseLine eol
parseLine :: (MonadLogger m) => ParsecT Void Text m LineType
parseLine = do
string "Sensor at x="
i <- parseSignedInteger
string ", y="
j <- parseSignedInteger
string ": closest beacon is at x="
k <- parseSignedInteger
string ", y="
l <- parseSignedInteger
return ((i, j), (k, l))Part 1
To exclude coordinates on a particular row, determine if the distance from the sensor to that row is less than the manhattan distance to its nearest beacon. Whatever distance is leftover can be applied in both directions from the x coordinate (a column in this problem), giving an interval.
excludedCoords :: (MonadLogger m) => Int -> (Coord2, Coord2) -> m (Maybe Interval)
excludedCoords rowNum (sensor@(sx, sy), beacon) = do
let dist = manhattanDistance sensor beacon
let distToRow = abs (sy - rowNum)
let leftoverDist = dist - distToRow
if leftoverDist < 0
then return Nothing
else return $ Just (sx - leftoverDist, sx + leftoverDist)Intervals should be sorted and merged together, giving a disjoint set of intervals covering the whole row.
mergeIntervals :: (MonadLogger m) => [Interval] -> m [Interval]
mergeIntervals [] = return []
mergeIntervals intervals = do
let sorted = sort intervals
mergeTail [] (head sorted) (tail sorted)
where
mergeTail :: (MonadLogger m) => [Interval] -> Interval -> [Interval] -> m [Interval]
mergeTail accum current [] = return $ reverse (current : accum)
mergeTail accum current@(cStart, cEnd) (first@(fStart, fEnd) : rest) = if fStart > cEnd
then mergeTail (current : accum) first rest
else mergeTail accum (cStart, max cEnd fEnd) restNow let's count the total size of the intervals. In part 1, we have to be careful to exclude the locations of beacons themselves. This makes the operation quite a bit more difficult, introducing an extra layer of complexity to the recursion.
countIntervalsExcludingBeacons :: (MonadLogger m) => [Interval] -> [Int] -> m Int
countIntervalsExcludingBeacons intervals beaconXs = countTail 0 intervals (sort beaconXs)
where
countTail :: (MonadLogger m) => Int -> [Interval] -> [Int] -> m Int
countTail accum [] _ = return accum
countTail accum ((next1, next2) : rest) [] = countTail (accum + (next2 - next1 + 1)) rest []
countTail accum ints@((next1, next2) : restInts) beacons@(nextBeaconX : restBeacons)
| nextBeaconX < next1 = countTail accum ints restBeacons
| nextBeaconX > next2 = countTail (accum + (next2 - next1)) restInts restBeacons
| otherwise = countTail (accum - 1) ints restBeaconsNow combine all these together to get a final count of the excluded cells in this row. Note we need an extra parameter to these functions (the size) because the small input and large input use different row numbers on which to evaluate the excluded locations (10 vs. 2000000).
type EasySolutionType = Int
processInputEasy :: (MonadLogger m) => InputType -> Int -> m EasySolutionType
processInputEasy inputs size = do
resultingIntervals <- mapM (excludedCoords size) inputs
mergedIntervals <- mergeIntervals (catMaybes resultingIntervals)
let beacons = nub $ filter (\c@(_, y) -> y == size) (snd <$> inputs)
countIntervalsExcludingBeacons mergedIntervals (fst <$> beacons)
solveEasy :: FilePath -> Int -> IO (Maybe Int)
solveEasy fp size = runStdoutLoggingT $ do
input <- parseFile parseInput fp
Just <$> processInputEasy input sizePart 2
In part 2, we need one extra helping function. This finds a "hole" in a series of intervals, as long as that hold comes before the "max" column.
findHole :: (MonadLogger m) => [Interval] -> Int -> m (Maybe Int)
findHole [] _ = return Nothing
findHole [(start, end)] maxCol
| start > 0 = return (Just (start - 1))
| end < maxCol = return (Just (end + 1))
| otherwise = return Nothing
findHole ((start1, end1) : (start2, end2) : rest) maxCol = if end1 + 1 < start2 && (end1 + 1) >= 0 && (end1 + 1) <= maxCol
then return (Just (end1 + 1))
else findHole ((start2, end2) : rest) maxColThe rest of the solution for part 2 involves combining our old code for a evaluating a single row, just done recursively over all the rows until we find one that has a hole.
processInputHard :: (MonadLogger m) => InputType -> Int -> m HardSolutionType
processInputHard inputs maxDimen = evaluateRow 0
where
evaluateRow :: (MonadLogger m) => Int -> m (Maybe Coord2)
evaluateRow row = if row > maxDimen then return Nothing
else do
resultingIntervals <- mapM (excludedCoords row) inputs
mergedIntervals <- mergeIntervals (catMaybes resultingIntervals)
result <- findHole mergedIntervals maxDimen
case result of
Nothing -> evaluateRow (row + 1)
Just col -> return $ Just (col, row)Notice again we have an extra input, this time for the maxDimen, which is 20 for the small input and 4 million for the large part.
solveHard :: FilePath -> Int -> IO (Maybe Integer)
solveHard fp size = runStdoutLoggingT $ do
input <- parseFile parseInput fp
result <- processInputHard input size
findHardSolution result