My solution to Advent of Code 2025 day 9 gave the right answer, but it was massively too slow. It was taking about 20 minutes to give a solution, when the target was a few seconds. Time to do something about it.

Profiling

The first thing was to find out exactly what was taking the time. Profiling the code showed that over 98% of the runtime was spent in the calculation of greenWithin in the validRectangle check.

validRectangle :: Theatre -> Rectangle -> Bool
validRectangle theatre ((V2 x1 y1), (V2 x2 y2)) = isFat && isEmptyWithin && isInside
  where isFat = x1 /= x2 && y1 /= y2
        topLeft = V2 (min x1 x2) (min y1 y2)
        bottomRight = V2 (max x1 x2) (max y1 y2)
        bounds = (topLeft ^+^ DR, bottomRight ^+^ UL)
        greenWithin = M.filterWithKey (\p _ -> inRange bounds p) theatre
        isEmptyWithin = M.null greenWithin
        testPoint = bottomRight ^+^ UL
        isInside = pointInside theatre testPoint

On the face of it, that's a fairly simple check, and the call to inRange should be quick. Each check of the elements of theatre should be fast. But how many checks are being made?

For my input, there are over 120,000 rectangles to check, and the theatre contains almost 590,000 tiles. That's getting on for 10¹¹ checks for the whole lot. That's a lot of checking to do! No wonder it takes so long.

That gives two avenues for optimising. One is to reduce the size of the theatre, the other is to reduce the number of rectangles that are checked. Addressing the theatre size is the easiest, so let's do that first.

Coordinate compression

The idea of coordinate compression is essentially a "sparse" representation of the coordinates. Rather than using the coordinates directly, you first sort the coordinates then build a lookup table going from sorted position to actual coordinate (and one going in reverse).

Going from the sample in the problem specification, the original x coordinates are 2, 7, 9, and 11. Those get compressed down to 0, 1, 2, 3, with the mapping being

I apply the same to the y coordinates, and the theatre and boundary goes from

..............
.......#XXX#..
.......X...X..
..#XXXX#...X..
..X........X..
..#XXXXXX#.X..
.........X.X..
.........#X#..
..............

to this

.#O#
##.O
#O#O
..##

This works for rectangle validity because the tests are all about if a particular tile exists between two others, not how many of them there are. The existence of tiles remains the same in this representation.

The compression is done with mkCompressedTheatre:

type CompressionMap = M.Map Int Int

mkCompressedTheatre :: [Position] -> (Theatre, CompressionMap, CompressionMap)
mkCompressedTheatre redTiles = 
  ( mkTheatre compressedRedTiles
  , xCompression 
  , yCompression
  )
  where 
    rawXs = nub $ sort $ fmap (\(V2 x _) -> x) redTiles
    rawYs = nub $ sort $ fmap (\(V2 _ y) -> y) redTiles
    xCompression = M.fromList $ zip rawXs [0..]
    yCompression = M.fromList $ zip rawYs [0..]
    compressedRedTiles = fmap (\(V2 rawX rawY) -> V2 (xCompression ! rawX) (yCompression ! rawY)) redTiles

This returns the compressed theatre and the mappings to go from original coordinates to the compressed ones. In my case, the compression moves the theatre from 590,000 tiles to only 1630, a factor of 360 smaller.

The definition of allValidRectangles changes to use the compressed theatre.

allValidRectangles :: Theatre -> CompressionMap -> CompressionMap -> [Position] -> [(Position, Position)]
allValidRectangles theatre xCompression yCompression redTiles = rectangles
  where rectangles = [(a, b) | a <- redTiles, b <- redTiles
                             , a < b
                             , validRectangle theatre a b
                             ]
        compress (a, b) = (compressPoint a, compressPoint b)
        compressPoint (V2 rawX rawY) = V2 (xCompression ! rawX) (yCompression ! rawY)

That brings the runtime down from 20 minutes to 2½ seconds, 480 times faster.

The ray-casting part of the validity test may not always be accurate now, but it's still correct for the largest rectangles, which are the ones I'm interested in.

Reusing rectangles

That's an impressive speedup, but there's still the other idea to do. Currently, both parts of the solution generate all the rectangles and process them all to find the largest rectangle (or largest valid rectangle). But if I generate all the rectangles and sort them by size, that saves work for finding the solutions.

Given a list of possible rectangles in order of size, the solution to part 1 is just the first of them, and the solution to part 2 is the first valid one. This allows me to exploit some laziness, in that I don't have to check validity for any rectangle smaller than the largest valid one.

The sorting will take some time, but hopefully that'll be outweighed by the time saved by not testing all the rectangles in part 2.

That changes how I set up and call the solution functions.

main :: IO ()
main = 
  do  dataFileName <- getDataFileName
      text <- TIO.readFile dataFileName
      let redTiles = successfulParse text
      let rectangles = sortBy (compare `on` (Down . rectangleArea)) $ allRectangles redTiles
      print $ part1 rectangles
      print $ part2 redTiles rectangles

part1 :: [Rectangle] -> Int
part1 rectangles = rectangleArea $ head rectangles

part2 :: [Position] -> [Rectangle] -> Int
part2 redTiles rectangles = rectangleArea $ head $ filter (\r -> validRectangle theatre (compress r)) rectangles
  where (theatre, xCompression, yCompression) = mkCompressedTheatre redTiles
        compress (a, b) = (compressPoint a, compressPoint b)
        compressPoint (V2 rawX rawY) = V2 (xCompression ! rawX) (yCompression ! rawY)

This is faster still, taking the runtime down from 2½ seconds to about 1.6 seconds, or about 750 times faster than the original version.

Not bad for a little bit of effort!

Code

You can get the code from Codeberg.