56 lines
1.7 KiB
Haskell
56 lines
1.7 KiB
Haskell
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
|