Discussion on: Advent of Code 2020 Solution Megathread - Day 13: Shuttle Search

[Benedict Gaster]

Well today's AOC 2020 was interesting, initally I thought it was going to be very straightforward, but that turned out not to be the case. Part 1 I could just do by force, but I got very stuck on part 2, as it was going to take a very long time :-) So after some pointers on reddit I ended up learning a new bit of number theory to make it work, utlizing a extended GCD from stack overflow.
Once I knew about that, it was a lot easier, not to mention quicker:

-- IDs paired with offsets
parse :: String -> Integer -> [(Integer,Integer)]
parse [] _ = []
parse xs offset 
    | head xs == 'x' = parse (tail xs) (offset+1)
    | head xs == ',' = parse (tail xs) offset
    | otherwise = let (n,xs') = span isDigit xs
                  in (read n :: Integer, offset) : parse xs' (offset + 1)
task1 ts = head . filter isJust . concatMap (\(ts, ids) -> map (check ts) ids)
  where
    check ts' id | ts' `mod` id == 0 = Just ((ts' - ts) * id)
                 | otherwise        = Nothing

-- Chinese Remainder Gaussian
-- https://en.wikipedia.org/wiki/Chinese_remainder_theorem
crt :: [Integer] -> Integer -> [Integer] -> Integer
crt diffs mprod ids = let ins = zip diffs ids
                       in foldr (\(x,y) r -> r + aux x y) 0 ins `mod` mprod
    where
      aux x y = let f = (mprod `div` y) `inv` y
                in ((x * mprod) `div` y) * f
      -- Modular multiplicative inverse
      -- https://en.wikipedia.org/wiki/Modular_multiplicative_inverse
      a `inv` m = let (_, i, _) = gcd' a m in i `mod` m
      -- Extended Euclidean Algorithm
      -- stack overflow 
      -- (https://stackoverflow.com/questions/35529211/chinese-remainder-theorem-haskell)
      gcd' 0 b = (b, 0, 1)
      gcd' a b = (g, t - (b `div` a) * s, s)
          where (g, s, t) = gcd' (b `mod` a) a
main = do
  [timestamp, ids] <- readFile "day13_input" <&> lines
  let ts = read timestamp :: Integer
      ids' = parse ids 0
      ids'' = map fst ids'
  putStrLn ("Part 1: " ++ show (fromJust $ task1 ts (zip [ts, ts+1..] (repeat ids''))))
  putStrLn ("Part 2: " ++ show (crt (map (uncurry (-)) ids') (product ids'') ids''))