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
63 lines
1.8 KiB
Haskell
63 lines
1.8 KiB
Haskell
module Main where
|
|
|
|
import Control.Arrow ((***))
|
|
import Data.Ix (inRange)
|
|
import Data.List (foldl', sort)
|
|
import System.Environment (getArgs)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
input <- readFile . head =<< getArgs
|
|
putStrLn $ unwords ["Part 1:", show $ part1 input]
|
|
putStrLn $ unwords ["Part 2:", show $ part2 input]
|
|
|
|
part1 :: String -> Int
|
|
part1 = length . uncurry (filter . isFresh) . parse
|
|
where
|
|
isFresh :: [(Int, Int)] -> Int -> Bool
|
|
isFresh fresh ing = any (`inRange` ing) fresh
|
|
|
|
-- 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 = (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 = sum . map ((+ 1) . uncurry (flip (-))) . fst . parse
|
|
|
|
testInput :: String
|
|
testInput =
|
|
unlines
|
|
[ "3-5",
|
|
"10-14",
|
|
"16-20",
|
|
"12-18",
|
|
"",
|
|
"1",
|
|
"5",
|
|
"8",
|
|
"11",
|
|
"17",
|
|
"32"
|
|
]
|