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