X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent05%2FMain.hs;h=d8bb80651619e20b6408db47ece5cfb9e999f897;hb=3af07db033456d04a8c0f307b20fc6ca0ffcba9e;hp=7f0aefa23f499336b49afe1bf23f4ef1b095b4a6;hpb=af726c71a3805ece4256d469fb0abe607289024d;p=advent-of-code-23.git diff --git a/advent05/Main.hs b/advent05/Main.hs index 7f0aefa..d8bb806 100644 --- a/advent05/Main.hs +++ b/advent05/Main.hs @@ -1,14 +1,13 @@ --- Writeup at https://work.njae.me.uk/2023/12/04/advent-of-code-2023-day-04/ +-- Writeup at https://work.njae.me.uk/2023/12/05/advent-of-code-2023-day-05/ import AoC import Data.Text (Text) import qualified Data.Text.IO as TIO import Data.Attoparsec.Text -- hiding (take) -import Control.Applicative +-- import Control.Applicative import Data.List import qualified Data.Map.Strict as M import Data.Map.Strict ((!)) -import Data.Maybe import Data.List.Split (chunksOf) type Almanac = M.Map String AMap @@ -24,79 +23,54 @@ main = do dataFileName <- getDataFileName text <- TIO.readFile dataFileName let (seeds, almanac) = successfulParse text - let eSeeds = tidyIntervals $ expandRanges seeds - -- print seeds - -- print eSeeds - -- print almanac - -- print $ useAMap (almanac ! "seed") [97, 98, 99, 100] - -- print $ useAMap (almanac ! "seed") [49, 50, 51, 53, 96, 97, 98] - -- print $ useAMap (almanac ! "seed") [79, 14, 55, 13] print $ part1 almanac seeds - -- let seedRanges = tidyIntervals eSeeds - -- print $ useAMap (almanac ! "seed") seedRanges - -- print $ useAMap (almanac ! "seed") [Iv 0 55] - -- print $ useAMap (almanac ! "seed") [Iv 95 105] - -- print $ part2 almanac [(Iv 82 82)] print $ part2 almanac seeds - -- print $ part2 cards - --- part1 :: Almanac -> [Int] -> Int --- part1 = lowestLocation - + +part1, part2 :: Almanac -> [Int] -> Int part1 almanac seeds = lowestLocation almanac seeds' where seeds' = tidyIntervals $ singletonRanges seeds part2 almanac seeds = lowestLocation almanac seeds' where seeds' = tidyIntervals $ expandRanges seeds --- part2 almanac seeds = followRequirements almanac $ Requirement "seed" seeds - +lowestLocation :: Almanac -> [Interval] -> Int lowestLocation almanac seeds = l where Requirement _ locations = followRequirements almanac $ Requirement "seed" seeds - (Iv l h) = head locations + (Iv l _) = head locations followRequirements :: Almanac -> Requirement -> Requirement -followRequirements almanac req@(Requirement "location" vals) = req +followRequirements _ req@(Requirement "location" _) = req followRequirements almanac (Requirement name vals) = followRequirements almanac newReq where aMap = almanac ! name newReq = useAMap aMap vals - --- useRule :: Interval -> Rule -> [Interval] --- useRule (Iv xl xh) (Rule (Iv rl rh) d) --- | x >= src && x < (src + rl) = Just (x + dest - src) --- | otherwise = Nothing - --- useRules :: [Rule] -> Int -> Int --- useRules rs x --- | null ruleResults = x --- | otherwise = head ruleResults --- where ruleResults = catMaybes $ fmap (useRule x) rs - useRule :: Rule -> Interval -> ([Interval], [Interval], [Rule]) -useRule (Rule (Iv rl rh) d) (Iv xl xh) = (newResults, newIvs, newRules) +useRule (Rule (Iv rl rh) d) (Iv xl xh) = (newResults, newVals, newRules) where newResults = - filter legalInterval [ Iv (min xl rl) (min xh (rl - 1)) -- input below rule - , Iv ((max xl rl) + d) ((min xh rh) + d)] -- input within rule - newIvs = filter legalInterval [Iv (max xl (rh + 1)) (max xh rh)] -- input above rule - newRules = filter legalRule [Rule (Iv (max (xh + 1) rl) (max xh rh)) d] -- rule above input + filter legalInterval + [ Iv xl (rl - 1) -- input below rule + , Iv ((max xl rl) + d) ((min xh rh) + d)] -- input within rule + newVals = filter legalInterval + [Iv (rh + 1) xh] -- input above rule + newRules = filter legalRule + [Rule (Iv (xh + 1) rh) d] -- rule above input useRules :: [Rule] -> [Interval] -> [Interval] -useRules [] ivs = ivs +useRules [] vals = vals useRules _ [] = [] -useRules (r@(Rule (Iv rl rh) d):rs) (iv@(Iv xl xh):ivs) - | rh < xl = useRules rs (iv:ivs) - | xh < rl = iv : useRules (r:rs) ivs - | otherwise = newResults ++ (useRules (newRules ++ rs) (newIvs ++ ivs)) - where (newResults, newIvs, newRules) = useRule r iv - +useRules (r@(Rule rv _):rs) (v:vs) + | rv `allBelow` v = useRules rs (v:vs) + | v `allBelow` rv = v : useRules (r:rs) vs + | otherwise = newResults ++ (useRules (newRules ++ rs) (newVals ++ vs)) + where (newResults, newVals, newRules) = useRule r v legalInterval :: Interval -> Bool legalInterval (Iv l h) = l <= h +legalRule :: Rule -> Bool legalRule (Rule iv _) = legalInterval iv useAMap :: AMap -> [Interval] -> Requirement @@ -113,17 +87,17 @@ expandRanges seeds = fmap expandRange ranges tidyIntervals :: [Interval] -> [Interval] -tidyIntervals ivs0 = tidyIntervalsS $ sort ivs0 +tidyIntervals = tidyIntervalsS . sort tidyIntervalsS :: [Interval] -> [Interval] tidyIntervalsS [] = [] tidyIntervalsS [x] = [x] tidyIntervalsS (x:y:xs) | x `allBelow` y = x : tidyIntervalsS (y:xs) - | otherwise = tidyIntervalsS $ (x `merge` y) : xs + | otherwise = tidyIntervalsS ((x `merge` y) : xs) allBelow :: Interval -> Interval -> Bool -allBelow (Iv x1 x2) (Iv y1 y2) = (x2 + 1) < y1 +allBelow (Iv _ x2) (Iv y1 _) = (x2 + 1) < y1 merge :: Interval -> Interval -> Interval merge (Iv x1 x2) (Iv y1 y2) = Iv (min x1 y1) (max x2 y2)