diff options
author | Julien Dessaux | 2023-12-05 16:57:54 +0100 |
---|---|---|
committer | Julien Dessaux | 2023-12-05 17:11:56 +0100 |
commit | fd1fbb916f1ff33142e6fdadfe7a9800ebe240d1 (patch) | |
tree | 0c282e8bd131179b170cd18f636ee9cc32600054 /2023/05-If_You_Give_A_Seed_A_Fertilizer/second.hs | |
parent | 2023-04 in haskell (diff) | |
download | advent-of-code-fd1fbb916f1ff33142e6fdadfe7a9800ebe240d1.tar.gz advent-of-code-fd1fbb916f1ff33142e6fdadfe7a9800ebe240d1.tar.bz2 advent-of-code-fd1fbb916f1ff33142e6fdadfe7a9800ebe240d1.zip |
2023-05 in haskell
Diffstat (limited to '2023/05-If_You_Give_A_Seed_A_Fertilizer/second.hs')
-rw-r--r-- | 2023/05-If_You_Give_A_Seed_A_Fertilizer/second.hs | 71 |
1 files changed, 71 insertions, 0 deletions
diff --git a/2023/05-If_You_Give_A_Seed_A_Fertilizer/second.hs b/2023/05-If_You_Give_A_Seed_A_Fertilizer/second.hs new file mode 100644 index 0000000..66d47db --- /dev/null +++ b/2023/05-If_You_Give_A_Seed_A_Fertilizer/second.hs @@ -0,0 +1,71 @@ +-- requires cabal install --lib megaparsec parser-combinators +module Main (main) where + +import Control.Applicative.Permutations +import Control.Monad (void, when) +import Data.Char qualified as C +import Data.Either +import Data.List qualified as L +import Data.Map qualified as M +import Data.Maybe +import Data.Set qualified as S +import Data.Void (Void) +import Text.Megaparsec +import Text.Megaparsec.Char + +exampleExpectedOutput = 46 + +data Range = Range Int Int deriving Show -- start range +data Map = Map Int Range deriving Show -- destination range +data Mapping = Mapping String String [Map] deriving Show -- sourceStr destStr +data Input = Input [Range] [Mapping] deriving Show -- seeds mappings + +type Parser = Parsec Void String + +parseNumber :: Parser Int +parseNumber = read <$> some digitChar <* many (char ' ') + +parseRange :: Parser Range +parseRange = Range <$> parseNumber + <*> parseNumber + +parseMap :: Parser Map +parseMap = Map <$> parseNumber + <*> parseRange <* eol + +parseMapping :: Parser Mapping +parseMapping = Mapping <$> (some letterChar <* string "-to-") + <*> (some letterChar <* string " map:" <* eol) + <*> some parseMap <* optional eol + +parseInput' :: Parser Input +parseInput' = Input <$> (string "seeds: " *> some parseRange <* some eol) + <*> some parseMapping <* eof + +parseInput :: String -> IO Input +parseInput filename = do + input <- readFile filename + case runParser parseInput' filename input of + Left bundle -> error $ errorBundlePretty bundle + Right input' -> return input' + +step :: [Map] -> Range -> [Range] +step [] n = [n] +step (Map dest (Range src range):ms) r@(Range n l) | n+l<=src || n>=src+range = step ms r + | n>=src && n+l<=src+range = [Range (n-src+dest) l] + | n>=src = Range (n-src+dest) (range+src-n) : step ms (Range (src+range) (l-range-src+n)) + | otherwise = Range dest (l-src+n) : step ms (Range n (src-n)) + +stepMapping :: [Range] -> Mapping -> [Range] +stepMapping ranges (Mapping _ _ ms) = concatMap (step ms) ranges + +compute :: Input -> Int +compute (Input ranges mappings) = minimum $ map (\(Range start _) -> start) $ L.foldl' stepMapping ranges mappings + +main :: IO () +main = do + example <- parseInput "example" + let exampleOutput = compute example + when (exampleOutput /= exampleExpectedOutput) (error $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput) + input <- parseInput "input" + print $ compute input |