Day 5

src/Day2505.hs

@@ -0,0 +1,59 @@
+module Main where
+
+import Data.List (find)
+import Data.Maybe (fromJust, isNothing, isJust)
+
+type Range = (Int, Int)
+
+takeDropWhile :: (a -> Bool) -> [a] -> ([a], [a])
+takeDropWhile f xs = (takeWhile f xs, drop 1 $ dropWhile f xs)
+
+remove :: Eq a => a -> [a] -> [a]
+remove d []     = []
+remove d (x:xs) | d == x    =            xs
+                | otherwise = x:remove d xs
+
+part1 :: String -> Int
+part1 str = length $ filter id $ map isIdValid availableIds
+  where
+  input = lines str
+
+  (ranges, ids) = takeDropWhile (/="") input
+
+  freshRanges :: [Range]
+  freshRanges = map ((\(a,b)-> (read a, read b)) . takeDropWhile (/='-')) ranges
+
+  availableIds :: [Int]
+  availableIds = map read ids
+
+  isIdValid :: Int -> Bool
+  isIdValid n = any (\(lo,hi) -> n >= lo && n <= hi) freshRanges
+
+part2 :: String -> Int
+part2 str = sum $ map (\(lo, hi) -> hi - lo + 1) $ mergeRanges freshRanges
+  where
+  input = lines str
+
+  freshRanges :: [Range]
+  freshRanges = map ((\(a,b) -> (read a, read b)) . takeDropWhile (/='-')) $ takeWhile (/="") input
+
+  merge :: Range -> Range -> Range
+  merge a@(loA, hiA) b@(loB, hiB) = (min loA loB, max hiA hiB)
+
+  mergeRanges :: [Range] -> [Range]
+  mergeRanges [] = []
+  mergeRanges (x:xs) | isJust findRes = mergeRanges (remove item ((merge item x):xs))
+                     | otherwise      = x : mergeRanges xs
+    where
+    findRes = find (not . isDisjoint x) xs
+    item = fromJust findRes
+
+  isDisjoint :: Range -> Range -> Bool
+  (loA, hiA) `isDisjoint` (loB, hiB) = loB > hiA || loA > hiB
+
+main :: IO ()
+main = do
+  str <- getContents
+
+  print $ part1 str
+  print $ part2 str -- 248440777865316 < part2