81 lines
2.3 KiB
Haskell
81 lines
2.3 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module Main where
|
|
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.IO as TIO
|
|
|
|
import Data.Attoparsec.Text
|
|
|
|
type Seeds = [Int]
|
|
type Range = (Int, Int)
|
|
type Mapping = (Range, Int)
|
|
|
|
type Input = (Seeds, [[Mapping]])
|
|
|
|
main :: IO ()
|
|
main = do
|
|
input <- TIO.getContents >>= parseInput
|
|
putStrLn ("Part 1: " <> show (part1 input))
|
|
putStrLn ("Part 2: " <> show (part2 input))
|
|
|
|
parseInput :: T.Text -> IO Input
|
|
parseInput s = case parseOnly inputParser s of
|
|
Right i -> pure i
|
|
Left e -> error e
|
|
|
|
inputParser :: Parser Input
|
|
inputParser = do
|
|
seeds <- "seeds: " *> sepBy1 decimal " " <* endOfLine <* endOfLine -- seeds: 1 2 3\n
|
|
mappings <- many1 mappingSection <* endOfInput
|
|
return (seeds, mappings)
|
|
|
|
mappingSection :: Parser [Mapping]
|
|
mappingSection = do
|
|
_ <- takeTill isEndOfLine <* endOfLine -- foo-to-bar map:\n
|
|
mappings <- many1 mappingList
|
|
_ <- choice [endOfLine, endOfInput] -- either a blank line or EOF
|
|
return mappings
|
|
|
|
mappingList :: Parser Mapping
|
|
mappingList = do
|
|
dst <- decimal <* space
|
|
src <- decimal <* space
|
|
size <- decimal <* endOfLine
|
|
return ((src, src + size), dst - src)
|
|
|
|
part1 :: Input -> Int
|
|
part1 (seeds, mappings) = solution [(x, x+1) | x <- seeds] mappings
|
|
|
|
part2 :: Input -> Int
|
|
part2 (seeds, mappings) = solution (toRange $ toPairs seeds) mappings
|
|
|
|
solution :: [Range] -> [[Mapping]] -> Int
|
|
solution ranges mappings = fst $ head $ filter (\(_, v) -> any (`inRange` v) ranges) $ [ (x, mapValues reversed x) | x <- [0..] ]
|
|
where reversed = reverseMappings mappings
|
|
|
|
mapValues :: [[Mapping]] -> Int -> Int
|
|
mapValues ms x = foldl (flip mapValue) x ms
|
|
|
|
toPairs :: Ord a => [a] -> [(a, a)]
|
|
toPairs [] = []
|
|
toPairs [_] = error "Expected the list to have even number of elements"
|
|
toPairs (a:b:xs) = (a, b) : toPairs xs
|
|
|
|
toRange :: Num a => [(a, a)] -> [(a, a)]
|
|
toRange xs = [(a, a + b - 1) | (a, b) <- xs]
|
|
|
|
inRange :: Range -> Int -> Bool
|
|
inRange (start, end) x = x >= start && x < end
|
|
|
|
mapValue :: [Mapping] -> Int -> Int
|
|
mapValue [] x = x
|
|
mapValue ((range, diff):ms) x
|
|
| inRange range x = x + diff
|
|
| otherwise = mapValue ms x
|
|
|
|
reverseMappings :: [[Mapping]] -> [[Mapping]]
|
|
reverseMappings ms = reverse $ [map negateDiff m | m <- ms]
|
|
|
|
negateDiff :: (Range, Int) -> (Range, Int)
|
|
negateDiff ((start, end), diff) = ((start + diff, end + diff), -diff)
|