1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
import Text.Parsec.String (Parser)
import Text.Parsec
import System.Environment
import Control.Monad
import Debug.Trace
import qualified Data.Map as M
num :: Parser Int
num = read <$> many1 digit
seeds :: Parser [Int]
seeds = string "seeds: " *> many1 (read <$> many1 digit <* space) <* newline
almanacTitle = (,) <$> many1 (noneOf "-") <* string "-to-" <*> many1 (noneOf " ") <* string " map:"
mapLine = (,,) <$> num <* space <*> num <* space <*> num
almanacMap :: Parser ([(Int,Int,Int)])
almanacMap = almanacTitle *> newline *> sepEndBy mapLine newline
almanac = (,) <$> seeds <*> sepEndBy1 almanacMap newline
buildRange :: (Int,Int,Int) -> M.Map Int Int
buildRange (dst,src,len) = M.fromList $ zip [src..src+len-1] [dst..dst+len-1]
sectionMap :: [(Int,Int,Int)] -> M.Map Int Int
sectionMap xs = M.unionsWith (const id) $ (M.fromList $ zip [0..99] [0..99]):map buildRange xs
locations :: ([Int], [[(Int,Int,Int)]]) -> [Int]
locations (seeds,sections) = do
let maps = map sectionMap sections
seed <- seeds
let location = foldr (M.!) seed (reverse maps)
return location
solution = minimum . locations
main = (>>=) <$> readFile <*> ((print . solution . either (error.show) id) .) . parse almanac =<< head <$> getArgs
|
