advent05/Main.hs

   1 -- Writeup at https://work.njae.me.uk/2023/12/04/advent-of-code-2023-day-04/
   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 Data.List
   9 import qualified Data.Map.Strict as M
  10 import Data.Map.Strict ((!))
  11 import Data.Maybe
  12 import Data.List.Split (chunksOf)
  13
  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)
  18
  19
  20 main :: IO ()
  21 main =
  22   do  dataFileName <- getDataFileName
  23       text <- TIO.readFile dataFileName
  24       let (seeds, almanac) = successfulParse text
  25       -- print seeds
  26       -- print almanac
  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
  34
  35 part1 :: Almanac -> [Int] -> Int
  36 part1 = lowestLocation
  37
  38 part2 almanac seeds = lowestLocation almanac $ expandRanges seeds
  39
  40 lowestLocation almanac seeds = minimum locations
  41   where Requirement _ locations = followRequirements almanac $ Requirement "seed" seeds
  42
  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
  49
  50
  51
  52 useRule :: Int -> Rule -> Maybe Int
  53 useRule x (Rule dest src rl)
  54   | x >= src && x < (src + rl) = Just (x + dest - src)
  55   | otherwise = Nothing
  56
  57 useRules :: [Rule] -> Int -> Int
  58 useRules rs x
  59   | null ruleResults = x
  60   | otherwise = head ruleResults
  61   where ruleResults = catMaybes $ fmap (useRule x) rs
  62
  63 useAMap :: AMap -> [Int] -> Requirement
  64 useAMap (AMap d rs) xs = Requirement d $ fmap (useRules rs) xs
  65
  66
  67 expandRanges :: [Int] -> [Int]
  68 expandRanges seeds = concatMap expandRange ranges
  69   where ranges = chunksOf 2 seeds
  70         expandRange [s, l] = [s..(s + l - 1)]
  71
  72
  73 -- Parse the input file
  74
  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]
  81 ruleP :: Parser Rule
  82 numbersP :: Parser [Int]
  83 nameP :: Parser String
  84 blankLineP :: Parser ()
  85
  86
  87 problemP = (,) <$> (seedsP <* blankLineP) <*> almanacP
  88
  89 seedsP = "seeds: " *> numbersP
  90
  91 almanacP = M.fromList <$> (aMapP `sepBy` blankLineP)
  92
  93 aMapP = aMapify <$> aMapHeaderP <*> rulesP
  94 aMapHeaderP = (,) <$> (nameP <* "-to-") <*> (nameP <* " map:" <* endOfLine)
  95
  96 rulesP = ruleP `sepBy` endOfLine
  97 ruleP = Rule <$> (decimal <* space) <*> (decimal <* space) <*> decimal
  98
  99 numbersP = decimal `sepBy` skipSpace
 100 nameP = many1 letter
 101
 102 blankLineP = endOfLine *> endOfLine
 103
 104 aMapify :: (String, String) -> [Rule] -> (String, AMap)
 105 aMapify (s, d) rs = (s, AMap d rs)
 106
 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