From 99dcde4240c2f823af21d05985152fa58e84f9ed Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Fri, 24 Mar 2023 01:17:50 +0100 Subject: 2020-13 in haskell --- 2020/13-Shuttle_Search/example | 2 ++ 2020/13-Shuttle_Search/first.hs | 53 +++++++++++++++++++++++++++ 2020/13-Shuttle_Search/input | 2 ++ 2020/13-Shuttle_Search/second.hs | 77 ++++++++++++++++++++++++++++++++++++++++ 4 files changed, 134 insertions(+) create mode 100644 2020/13-Shuttle_Search/example create mode 100644 2020/13-Shuttle_Search/first.hs create mode 100644 2020/13-Shuttle_Search/input create mode 100644 2020/13-Shuttle_Search/second.hs (limited to '2020') diff --git a/2020/13-Shuttle_Search/example b/2020/13-Shuttle_Search/example new file mode 100644 index 0000000..d76f619 --- /dev/null +++ b/2020/13-Shuttle_Search/example @@ -0,0 +1,2 @@ +939 +7,13,x,x,59,x,31,19 diff --git a/2020/13-Shuttle_Search/first.hs b/2020/13-Shuttle_Search/first.hs new file mode 100644 index 0000000..c59097f --- /dev/null +++ b/2020/13-Shuttle_Search/first.hs @@ -0,0 +1,53 @@ +-- requires cabal install --lib megaparsec parser-combinators +module Main (main) where +import Control.Monad (void, when) +import Data.List (elemIndex) +import Data.Maybe (catMaybes, fromJust) +import Data.Void (Void) +import Text.Megaparsec +import Text.Megaparsec.Char +import System.Exit (die) + +exampleExpectedOutput = 295 + +type Input = (Int, [Maybe Int]) + +type Parser = Parsec Void String + +parseShuttle :: Parser (Maybe Int) +parseShuttle = do + num <- (Just . read <$> some digitChar) <|> (char 'x' *> return Nothing) + void . optional $ char ',' + return $ num + +parseOps :: Parser Input +parseOps = do + time <- some digitChar + void $ char '\n' + shuttles <- some parseShuttle + void $ char '\n' + void $ eof + return $ ((read time), shuttles) + +parseInput :: String -> IO Input +parseInput filename = do + input <- readFile filename + case runParser parseOps filename input of + Left bundle -> die $ errorBundlePretty bundle + Right ops -> return ops + +compute :: Input -> Int +compute (time, shuttles) = departure * busId + where + busId = allShuttles !! (fromJust $ elemIndex departure nextDepartures) + departure = minimum nextDepartures + nextDepartures = map (\a -> (-time) `mod` a) allShuttles + allShuttles = catMaybes shuttles + +main :: IO () +main = do + example <- parseInput "example" + let exampleOutput = compute example + when (exampleOutput /= exampleExpectedOutput) (die $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput) + input <- parseInput "input" + print $ compute input diff --git a/2020/13-Shuttle_Search/input b/2020/13-Shuttle_Search/input new file mode 100644 index 0000000..c16c8bb --- /dev/null +++ b/2020/13-Shuttle_Search/input @@ -0,0 +1,2 @@ +1001612 +19,x,x,x,x,x,x,x,x,41,x,x,x,37,x,x,x,x,x,821,x,x,x,x,x,x,x,x,x,x,x,x,13,x,x,x,17,x,x,x,x,x,x,x,x,x,x,x,29,x,463,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,23 diff --git a/2020/13-Shuttle_Search/second.hs b/2020/13-Shuttle_Search/second.hs new file mode 100644 index 0000000..242824d --- /dev/null +++ b/2020/13-Shuttle_Search/second.hs @@ -0,0 +1,77 @@ +-- requires cabal install --lib megaparsec parser-combinators +module Main (main) where +import Control.Monad (void, when, zipWithM) +import Data.Either (fromRight) +import Data.List (foldl') +import Data.Void (Void) +import Text.Megaparsec +import Text.Megaparsec.Char +import System.Exit (die) + +exampleExpectedOutput = 1068781 + +type Input = [Maybe Int] + +type Parser = Parsec Void String + +parseShuttle :: Parser (Maybe Int) +parseShuttle = do + num <- (Just . read <$> some digitChar) <|> (char 'x' *> return Nothing) + void . optional $ char ',' + return $ num + +parseOps :: Parser Input +parseOps = do + void $ some digitChar + void $ char '\n' + shuttles <- some parseShuttle + void $ char '\n' + void $ eof + return $ shuttles + +parseInput :: String -> IO Input +parseInput filename = do + input <- readFile filename + case runParser parseOps filename input of + Left bundle -> die $ errorBundlePretty bundle + Right ops -> return ops + +-- From rosetta code https://rosettacode.org/wiki/Chinese_remainder_theorem#Haskell +egcd :: Int -> Int -> (Int, Int) +egcd _ 0 = (1, 0) +egcd a b = (t, s - q * t) + where + (s, t) = egcd b r + (q, r) = a `quotRem` b + +modInv :: Int -> Int -> Either String Int +modInv a b = + case egcd a b of + (x, y) + | a * x + b * y == 1 -> Right x + | otherwise -> + Left $ "No modular inverse for " ++ show a ++ " and " ++ show b + +chineseRemainder :: [Int] -> [Int] -> Either String Int +chineseRemainder residues modulii = + zipWithM modInv crtModulii modulii >>= + (Right . (`mod` modPI) . sum . zipWith (*) crtModulii . zipWith (*) residues) + where + modPI = product modulii + crtModulii = (modPI `div`) <$> modulii +-- end of snippet from rosetta code + +compute :: Input -> Int +compute input = fromRight 0 . uncurry chineseRemainder $ unzip $ fst $ foldl' accumul ([], 0) input + where + accumul :: ([(Int, Int)], Int) -> Maybe Int -> ([(Int, Int)], Int) + accumul (acc, i) Nothing = (acc, i+1) + accumul (acc, i) (Just v) = (acc ++ [(-i, v)], i+1) + +main :: IO () +main = do + example <- parseInput "example" + let exampleOutput = compute example + when (exampleOutput /= exampleExpectedOutput) (die $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput) + input <- parseInput "input" + print $ compute input -- cgit v1.2.3