aboutsummaryrefslogtreecommitdiff
path: root/2020
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--2020/13-Shuttle_Search/example2
-rw-r--r--2020/13-Shuttle_Search/first.hs53
-rw-r--r--2020/13-Shuttle_Search/input2
-rw-r--r--2020/13-Shuttle_Search/second.hs77
4 files changed, 134 insertions, 0 deletions
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