day 5

05/solution.hs

@@ -0,0 +1,56 @@
+import Debug.Trace
+import Data.Maybe
+import Data.List
+
+(***) :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
+(f *** g) (x, y) = (f x, g y)
+
+(&&&) :: (a -> b) -> (a -> c) -> a -> (b, c)
+(f &&& g) x = (f x, g x)
+
+infixr 3 ***
+infixr 3 &&&
+
+traceOut :: Show a => a -> a
+traceOut x = traceShow x x
+
+addFirst :: [[a]] -> a -> [[a]]
+addFirst [] x = [[x]]
+addFirst (y:ys) x = (x : y) : ys
+
+split :: Eq a => [a] -> [a] -> [[a]]
+split _ [] = []
+split delims (x:xs)
+  | x `elem` delims = [] : split delims xs
+  | otherwise       = addFirst (split delims xs) x
+
+parseFile :: String -> ([(Int, Int)], [Int])
+parseFile = (map (read *** read . drop 1) . map (break (=='-')) *** map read . drop 1) . break (=="") . split ['\n']
+
+elemRange :: (Int, Int) -> Int -> Bool
+elemRange (x, y) z = x <= z && z <= y
+
+solve1 :: ([(Int, Int)], [Int]) -> Int
+solve1 (xs, ys) = length $ filter id $ map (\y -> foldl (||) False $ map (`elemRange` y) xs) ys
+
+joinRanges :: [(Int, Int)] -> Maybe (Int, Int)
+joinRanges [] = Nothing
+joinRanges xs = Just $ (foldl1 min . map fst &&& foldl1 max . map snd) xs
+
+rangesIntersect :: (Int, Int) -> (Int, Int) -> Bool
+rangesIntersect (p, q) (r, s) = (p <= r && r <= q) || (p <= s && s <= q) || (r <= p && p <= s)
+
+mergeRanges :: [(Int, Int)] -> (Int, Int) -> [(Int, Int)]
+mergeRanges xs y = (fromJust $ joinRanges $ y : merge) : noMerge
+    where (merge, noMerge) = partition (rangesIntersect y) xs    
+
+solve2 :: ([(Int, Int)], [Int]) -> Int
+solve2 = sum . map (\(a, b) -> b-a+1) . foldl mergeRanges [] . fst
+
+main = do 
+    fileinp <- readFile "input.txt"
+    let input = parseFile fileinp
+    let solved1 = solve1 input
+    let solved2 = solve2 input
+    print solved1
+    print solved2