2020-13 in haskell

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