Tidying
[advent-of-code-23.git] / advent05 / MainDirect.hs
1 -- Writeup at https://work.njae.me.uk/2023/12/05/advent-of-code-2023-day-05/
2
3 import AoC
4 import Data.Text (Text)
5 import qualified Data.Text.IO as TIO
6 import Data.Attoparsec.Text -- hiding (take)
7 -- import Control.Applicative
8 import qualified Data.Map.Strict as M
9 import Data.Map.Strict ((!))
10 import Data.Maybe
11 import Data.List.Split (chunksOf)
12
13 type Almanac = M.Map String AMap
14 data AMap = AMap String [Rule] deriving (Eq, Show)
15 data Rule = Rule Int Int Int deriving (Eq, Show)
16 data Requirement = Requirement String [Int] deriving (Eq, Show)
17
18
19 main :: IO ()
20 main =
21 do dataFileName <- getDataFileName
22 text <- TIO.readFile dataFileName
23 let (seeds, almanac) = successfulParse text
24 print $ part1 almanac seeds
25 print $ part2 almanac seeds
26
27 part1, part2 :: Almanac -> [Int] -> Int
28 part1 = lowestLocation
29
30 part2 almanac seeds = lowestLocation almanac $ expandRanges seeds
31
32 lowestLocation :: Almanac -> [Int] -> Int
33 lowestLocation almanac seeds = minimum locations
34 where Requirement _ locations = followRequirements almanac $ Requirement "seed" seeds
35
36 followRequirements :: Almanac -> Requirement -> Requirement
37 followRequirements _ req@(Requirement "location" vals) = req
38 followRequirements almanac (Requirement name vals) =
39 followRequirements almanac newReq
40 where aMap = almanac ! name
41 newReq = useAMap aMap vals
42
43
44 useRule :: Int -> Rule -> Maybe Int
45 useRule x (Rule dest src rl)
46 | x >= src && x < (src + rl) = Just (x + dest - src)
47 | otherwise = Nothing
48
49 useRules :: [Rule] -> Int -> Int
50 useRules rs x
51 | null ruleResults = x
52 | otherwise = head ruleResults
53 where ruleResults = catMaybes $ fmap (useRule x) rs
54
55 useAMap :: AMap -> [Int] -> Requirement
56 useAMap (AMap d rs) xs = Requirement d $ fmap (useRules rs) xs
57
58
59 expandRanges :: [Int] -> [Int]
60 expandRanges seeds = concatMap expandRange ranges
61 where ranges = chunksOf 2 seeds
62 expandRange [s, l] = [s..(s + l - 1)]
63
64
65 -- Parse the input file
66
67 problemP :: Parser ([Int], Almanac)
68 seedsP :: Parser [Int]
69 almanacP :: Parser Almanac
70 aMapP :: Parser (String, AMap)
71 aMapHeaderP :: Parser (String, String)
72 rulesP :: Parser [Rule]
73 ruleP :: Parser Rule
74 numbersP :: Parser [Int]
75 nameP :: Parser String
76 blankLineP :: Parser ()
77
78 problemP = (,) <$> (seedsP <* blankLineP) <*> almanacP
79
80 seedsP = "seeds: " *> numbersP
81
82 almanacP = M.fromList <$> (aMapP `sepBy` blankLineP)
83
84 aMapP = aMapify <$> aMapHeaderP <*> rulesP
85 aMapHeaderP = (,) <$> (nameP <* "-to-") <*> (nameP <* " map:" <* endOfLine)
86
87 rulesP = ruleP `sepBy` endOfLine
88 ruleP = Rule <$> (decimal <* space) <*> (decimal <* space) <*> decimal
89
90 numbersP = decimal `sepBy` skipSpace
91 nameP = many1 letter
92
93 blankLineP = endOfLine *> endOfLine
94
95 aMapify :: (String, String) -> [Rule] -> (String, AMap)
96 aMapify (s, d) rs = (s, AMap d rs)
97
98 successfulParse :: Text -> ([Int], Almanac)
99 successfulParse input =
100 case parseOnly problemP input of
101 Left _err -> ([], M.empty) -- TIO.putStr $ T.pack $ parseErrorPretty err
102 Right matches -> matches