From: Neil Smith Date: Tue, 5 Dec 2023 20:05:14 +0000 (+0000) Subject: Tidied. X-Git-Url: https://git.njae.me.uk/?a=commitdiff_plain;h=f8648c0ce55739dcadf19bbcdd56d5e48cd4f2e6;p=advent-of-code-23.git Tidied. --- diff --git a/advent-of-code23.cabal b/advent-of-code23.cabal index a4cedff..7874bd6 100644 --- a/advent-of-code23.cabal +++ b/advent-of-code23.cabal @@ -125,4 +125,8 @@ executable advent05 import: common-extensions, build-directives main-is: advent05/Main.hs build-depends: text, attoparsec, containers, split - \ No newline at end of file + +executable advent05d + import: common-extensions, build-directives + main-is: advent05/MainDirect.hs + build-depends: text, attoparsec, containers, split diff --git a/advent05/Main.hs b/advent05/Main.hs index 7f0aefa..002b8f5 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,52 @@ 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" vals) = 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 + newVals = 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 [] 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 (Iv rl rh) _):rs) (v@(Iv xl xh):vs) + | rh < xl = useRules rs (v:vs) + | xh < rl = 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 @@ -120,10 +92,10 @@ 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) diff --git a/advent05/MainDirect.hs b/advent05/MainDirect.hs new file mode 100644 index 0000000..ca59a51 --- /dev/null +++ b/advent05/MainDirect.hs @@ -0,0 +1,102 @@ +-- 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 qualified Data.Map.Strict as M +import Data.Map.Strict ((!)) +import Data.Maybe +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) + + +main :: IO () +main = + do dataFileName <- getDataFileName + text <- TIO.readFile dataFileName + let (seeds, almanac) = successfulParse text + print $ part1 almanac seeds + print $ part2 almanac seeds + +part1, part2 :: Almanac -> [Int] -> Int +part1 = lowestLocation + +part2 almanac seeds = lowestLocation almanac $ expandRanges seeds + +lowestLocation :: Almanac -> [Int] -> Int +lowestLocation almanac seeds = minimum locations + where Requirement _ locations = followRequirements almanac $ Requirement "seed" seeds + +followRequirements :: Almanac -> Requirement -> Requirement +followRequirements _ req@(Requirement "location" vals) = req +followRequirements almanac (Requirement name vals) = + followRequirements almanac newReq + where aMap = almanac ! name + newReq = useAMap aMap vals + + +useRule :: Int -> Rule -> Maybe Int +useRule x (Rule dest src rl) + | 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 + +useAMap :: AMap -> [Int] -> Requirement +useAMap (AMap d rs) xs = Requirement d $ fmap (useRules rs) xs + + +expandRanges :: [Int] -> [Int] +expandRanges seeds = concatMap expandRange ranges + where ranges = chunksOf 2 seeds + expandRange [s, l] = [s..(s + l - 1)] + + +-- Parse the input file + +problemP :: Parser ([Int], Almanac) +seedsP :: Parser [Int] +almanacP :: Parser Almanac +aMapP :: Parser (String, AMap) +aMapHeaderP :: Parser (String, String) +rulesP :: Parser [Rule] +ruleP :: Parser Rule +numbersP :: Parser [Int] +nameP :: Parser String +blankLineP :: Parser () + +problemP = (,) <$> (seedsP <* blankLineP) <*> almanacP + +seedsP = "seeds: " *> numbersP + +almanacP = M.fromList <$> (aMapP `sepBy` blankLineP) + +aMapP = aMapify <$> aMapHeaderP <*> rulesP +aMapHeaderP = (,) <$> (nameP <* "-to-") <*> (nameP <* " map:" <* endOfLine) + +rulesP = ruleP `sepBy` endOfLine +ruleP = Rule <$> (decimal <* space) <*> (decimal <* space) <*> decimal + +numbersP = decimal `sepBy` skipSpace +nameP = many1 letter + +blankLineP = endOfLine *> endOfLine + +aMapify :: (String, String) -> [Rule] -> (String, AMap) +aMapify (s, d) rs = (s, AMap d rs) + +successfulParse :: Text -> ([Int], Almanac) +successfulParse input = + case parseOnly problemP input of + Left _err -> ([], M.empty) -- TIO.putStr $ T.pack $ parseErrorPretty err + Right matches -> matches diff --git a/advent05/advent-of-code-23.code-workspace b/advent05/advent-of-code-23.code-workspace new file mode 100644 index 0000000..e4e7c68 --- /dev/null +++ b/advent05/advent-of-code-23.code-workspace @@ -0,0 +1,7 @@ +{ + "folders": [ + { + "path": "../.." + } + ] +} \ No newline at end of file