Done part 1, brute-forcing part 2

[advent-of-code-23.git] / advent05 / Main.hs

diff --git a/advent05/Main.hs b/advent05/Main.hs
new file mode 100644 (file)
index 0000000..7934a78
--- /dev/null
+++ b/advent05/Main.hs
@@ -0,0 +1,111 @@
+-- Writeup at https://work.njae.me.uk/2023/12/04/advent-of-code-2023-day-04/
+
+import AoC
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text -- hiding (take)
+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
+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 seeds
+      -- 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
+      print $ part2 almanac seeds
+      -- print $ part2 cards
+
+part1 :: Almanac -> [Int] -> Int
+part1 = lowestLocation
+
+part2 almanac seeds = lowestLocation almanac $ expandRanges seeds
+
+lowestLocation almanac seeds = minimum locations
+  where Requirement _ locations = followRequirements almanac $ Requirement "seed" seeds
+
+followRequirements :: Almanac -> Requirement -> Requirement
+followRequirements almanac 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