diff --git a/src/Day2505.hs b/src/Day2505.hs new file mode 100644 index 0000000..fce2a00 --- /dev/null +++ b/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