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

app/Day5.hs

@@ -1,5 +1,8 @@
 module Main where
 
+import Control.Arrow ((***))
+import Data.Ix (inRange)
+import Data.List (foldl', sort)
 import System.Environment (getArgs)
 
 main :: IO ()
@@ -12,21 +15,36 @@ part1 :: String -> Int
 part1 = length . uncurry (filter . isFresh) . parse
   where
     isFresh :: [(Int, Int)] -> Int -> Bool
-    isFresh fresh ing = any (contained ing) fresh
+    isFresh fresh ing = any (`inRange` ing) fresh
-
-    contained :: Int -> (Int, Int) -> Bool
-    contained a (x, y) = x <= a && a <= y
 
+-- 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 = (\(ranges, ingredients) -> ((map parseRange ranges), map read (drop 1 ingredients))) . span (/= "") . lines
+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 = error "Not implemented"
+part2 = sum . map ((+ 1) . uncurry (flip (-))) . fst . parse
 
 testInput :: String
 testInput =