63 lines
1.7 KiB
Haskell
63 lines
1.7 KiB
Haskell
|
module Day5 where
|
||
|
|
import System.IO
|
||
|
|
import ParseLib.Abstract
|
||
|
|
import Prelude hiding ((<*), (*>))
|
||
|
|
import Data.Char
|
||
|
|
import Data.List
|
||
|
|
import Data.Maybe
|
||
|
|
|
||
|
|
type Input = Int
|
||
|
|
type Output = Int
|
||
|
|
type Length = Int
|
||
|
|
data Range = Range Output Input Length deriving Show
|
||
|
|
|
||
|
|
type From = String
|
||
|
|
type To = String
|
||
|
|
data Map = Map From To [Range] deriving Show
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
main = do
|
||
|
|
handle <- openFile "app/Day5-input.txt" ReadMode
|
||
|
|
input <- hGetContents handle
|
||
|
|
|
||
|
|
let (seeds, maps) = fst $ head $ parse parseInput input
|
||
|
|
locations = map (applyTill maps "seed" "location") seeds
|
||
|
|
|
||
|
|
putStr "Part 1: "
|
||
|
|
print $ minimum locations
|
||
|
|
|
||
|
|
let seeds' = concatMap range (pairs seeds)
|
||
|
|
locations' = map (applyTill maps "seed" "location") seeds'
|
||
|
|
|
||
|
|
putStr "Part 2: "
|
||
|
|
print $ minimum locations'
|
||
|
|
|
||
|
|
pure ()
|
||
|
|
|
||
|
|
whitespace = greedy (satisfy isSpace)
|
||
|
|
number = whitespace *> natural
|
||
|
|
parseInput = (,) <$> parseHeader <*> greedy parseMap
|
||
|
|
parseHeader = token "seeds: " *> greedy number <* whitespace
|
||
|
|
parseMap = Map <$> identifier <* token "-to-" <*> identifier <* token " map:\n" <*> greedy parseRange <* whitespace
|
||
|
|
parseRange = Range <$> number <*> number <*> number <* whitespace
|
||
|
|
|
||
|
|
apply :: [Map] -> From -> Input -> (To, Output)
|
||
|
|
apply ms f i = (t, applyMap m i)
|
||
|
|
where
|
||
|
|
m@(Map _ t _) = fromJust $ find (\(Map f' _ _) -> f' == f) ms
|
||
|
|
|
||
|
|
applyMap :: Map -> Input -> Output
|
||
|
|
applyMap (Map _ _ []) i' = i'
|
||
|
|
applyMap (Map f t ((Range o i l):rs)) i'
|
||
|
|
| i <= i' && i' <= i+l = o + (i' - i)
|
||
|
|
| otherwise = applyMap (Map f t rs) i'
|
||
|
|
|
||
|
|
applyTill :: [Map] -> From -> To -> Input -> Output
|
||
|
|
applyTill ms f t i | t == t' = o
|
||
|
|
| otherwise = applyTill ms t' t o
|
||
|
|
where (t', o) = apply ms f i
|
||
|
|
|
||
|
|
pairs [] = []
|
||
|
|
pairs (x1:x2:xs) = (x1,x2) : pairs xs
|
||
|
|
|
||
|
|
range (x,y) = [x..x+y-1]
|