From: Neil Smith Date: Tue, 5 Dec 2023 12:32:41 +0000 (+0000) Subject: Done part 2, needs tidying X-Git-Url: https://git.njae.me.uk/?a=commitdiff_plain;h=af726c71a3805ece4256d469fb0abe607289024d;p=advent-of-code-23.git Done part 2, needs tidying --- diff --git a/advent05/Main.hs b/advent05/Main.hs index 7934a78..7f0aefa 100644 --- a/advent05/Main.hs +++ b/advent05/Main.hs @@ -5,7 +5,7 @@ import Data.Text (Text) import qualified Data.Text.IO as TIO import Data.Attoparsec.Text -- hiding (take) import Control.Applicative --- import Data.List +import Data.List import qualified Data.Map.Strict as M import Data.Map.Strict ((!)) import Data.Maybe @@ -13,8 +13,10 @@ import Data.List.Split (chunksOf) type Almanac = M.Map String AMap data AMap = AMap String [Rule] deriving (Eq, Show) -data Rule = Rule Int Int Int deriving (Eq, Show) -data Requirement = Requirement String [Int] deriving (Eq, Show) +data Rule = Rule Interval Int deriving (Eq, Ord, Show) +data Requirement = Requirement String [Interval] deriving (Eq, Show) + +data Interval = Iv Int Int deriving (Eq, Ord, Show) -- inclusive, closed at both ends main :: IO () @@ -22,23 +24,36 @@ 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 - -- print $ expandRanges 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 :: Almanac -> [Int] -> Int +-- part1 = lowestLocation + +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 -part2 almanac seeds = lowestLocation almanac $ expandRanges seeds -lowestLocation almanac seeds = minimum locations +lowestLocation almanac seeds = l where Requirement _ locations = followRequirements almanac $ Requirement "seed" seeds + (Iv l h) = head locations followRequirements :: Almanac -> Requirement -> Requirement followRequirements almanac req@(Requirement "location" vals) = req @@ -49,25 +64,70 @@ followRequirements almanac (Requirement name vals) = -useRule :: Int -> Rule -> Maybe Int -useRule x (Rule dest src rl) - | x >= src && x < (src + rl) = Just (x + dest - src) - | otherwise = Nothing +-- 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) + 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 + + +useRules :: [Rule] -> [Interval] -> [Interval] +useRules [] ivs = ivs +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 + + +legalInterval :: Interval -> Bool +legalInterval (Iv l h) = l <= h -useRules :: [Rule] -> Int -> Int -useRules rs x - | null ruleResults = x - | otherwise = head ruleResults - where ruleResults = catMaybes $ fmap (useRule x) rs +legalRule (Rule iv _) = legalInterval iv -useAMap :: AMap -> [Int] -> Requirement -useAMap (AMap d rs) xs = Requirement d $ fmap (useRules rs) xs +useAMap :: AMap -> [Interval] -> Requirement +useAMap (AMap d rs) xs = Requirement d $ tidyIntervals $ useRules rs xs -expandRanges :: [Int] -> [Int] -expandRanges seeds = concatMap expandRange ranges +singletonRanges :: [Int] -> [Interval] +singletonRanges = fmap (\x -> Iv x x) + +expandRanges :: [Int] -> [Interval] +expandRanges seeds = fmap expandRange ranges where ranges = chunksOf 2 seeds - expandRange [s, l] = [s..(s + l - 1)] + expandRange [s, l] = Iv s (s + l - 1) + + +tidyIntervals :: [Interval] -> [Interval] +tidyIntervals ivs0 = tidyIntervalsS $ sort ivs0 + +tidyIntervalsS :: [Interval] -> [Interval] +tidyIntervalsS [] = [] +tidyIntervalsS [x] = [x] +tidyIntervalsS (x:y:xs) + | x `allBelow` y = x : tidyIntervalsS (y:xs) + | otherwise = tidyIntervalsS $ (x `merge` y) : xs + +allBelow :: Interval -> Interval -> Bool +allBelow (Iv x1 x2) (Iv y1 y2) = (x2 + 1) < y1 + +merge :: Interval -> Interval -> Interval +merge (Iv x1 x2) (Iv y1 y2) = Iv (min x1 y1) (max x2 y2) + -- Parse the input file @@ -94,7 +154,7 @@ aMapP = aMapify <$> aMapHeaderP <*> rulesP aMapHeaderP = (,) <$> (nameP <* "-to-") <*> (nameP <* " map:" <* endOfLine) rulesP = ruleP `sepBy` endOfLine -ruleP = Rule <$> (decimal <* space) <*> (decimal <* space) <*> decimal +ruleP = ruleify <$> (decimal <* space) <*> (decimal <* space) <*> decimal numbersP = decimal `sepBy` skipSpace nameP = many1 letter @@ -102,7 +162,10 @@ nameP = many1 letter blankLineP = endOfLine *> endOfLine aMapify :: (String, String) -> [Rule] -> (String, AMap) -aMapify (s, d) rs = (s, AMap d rs) +aMapify (s, d) rs = (s, AMap d (sort rs)) + +ruleify :: Int -> Int -> Int -> Rule +ruleify d s l = Rule (Iv s (s + l - 1)) (d - s) successfulParse :: Text -> ([Int], Almanac) successfulParse input =