aoc-25/app/Day5.hs
Jacob Jonsson 7af90f9e9c feat: solve day 5, part 2
Keeping the old solution for the ranges was too ineffective when it
came to enumerating all contained integers, the amount of elements was
too large to either expand the ranges into Sets or similar.

However, it turned out (after some thinking) to be fairly
straight-forward to check if consecutive ranges overlapped, and in
that case merge them. The solution therefore now parses the ranges,
sorts them on the first component and then merges them as far as
possible.

changes: JJ: M app/Day5.hs
2025-12-05 22:55:51 +01:00

63 lines
1.8 KiB
Haskell

module Main where
import Control.Arrow ((***))
import Data.Ix (inRange)
import Data.List (foldl', sort)
import System.Environment (getArgs)
main :: IO ()
main = do
input <- readFile . head =<< getArgs
putStrLn $ unwords ["Part 1:", show $ part1 input]
putStrLn $ unwords ["Part 2:", show $ part2 input]
part1 :: String -> Int
part1 = length . uncurry (filter . isFresh) . parse
where
isFresh :: [(Int, Int)] -> Int -> Bool
isFresh fresh ing = any (`inRange` ing) fresh
-- Splits input on empty line and parses the first half with genRanges
-- and the second half into ints with read.
parse :: String -> ([(Int, Int)], [Int])
parse = (genRanges *** (map read . drop 1)) . span (/= "") . lines
where
genRanges :: [String] -> [(Int, Int)]
genRanges = foldl' (mergeRanges) mempty . sort . map parseRange
-- Parse "X-Y" -> (X, Y)
parseRange :: String -> (Int, Int)
parseRange s = case span (/= '-') s of
(start, '-' : end) -> (read start, read end)
_ -> error $ "parseRange: expected a string on the form \"NUM-NUM\", got \"" <> s <> "\""
-- Generate ranges by combining adjacent ranges if they overlap.
--
-- Ignores ranges that are fully enclosed by previous range.
-- N.B. Assumes ranges are sorted on first component.
mergeRanges :: [(Int, Int)] -> (Int, Int) -> [(Int, Int)]
mergeRanges [] i = [i]
mergeRanges fresh@((a, b) : rest) (x, y)
| inRange (a, b) x && y > b = (a, y) : rest
| x < a && inRange (a, b) y = (x, b) : rest
| inRange (a, b) x && inRange (a, b) y = fresh
| otherwise = (x, y) : fresh
part2 :: String -> Int
part2 = sum . map ((+ 1) . uncurry (flip (-))) . fst . parse
testInput :: String
testInput =
unlines
[ "3-5",
"10-14",
"16-20",
"12-18",
"",
"1",
"5",
"8",
"11",
"17",
"32"
]