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