--- 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
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
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)
--- /dev/null
+-- 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
projects / advent-of-code-23.git / commitdiff