[hs] Clean up 2020_13 even more

This commit is contained in:
Joscha 2020-12-13 12:48:10 +00:00
parent 7b1f57f563
commit 82297cd5f2

View file

@ -7,7 +7,6 @@ module Aoc.Y2020.D13
import Control.Monad import Control.Monad
import Data.Foldable import Data.Foldable
import Data.Function import Data.Function
import Data.Maybe
import Aoc.Day import Aoc.Day
import Aoc.Parse import Aoc.Parse
@ -25,21 +24,24 @@ parser = do
void newline void newline
pure (earliest, [Bus bid delta | (Just bid, delta) <- zip buses [0..]]) pure (earliest, [Bus bid delta | (Just bid, delta) <- zip buses [0..]])
waitTime :: Integer -> Bus -> Integer
waitTime time bus = time `mod` bId bus
departsAt :: Bus -> Integer -> Bool departsAt :: Bus -> Integer -> Bool
departsAt bus time = (time + bDelta bus) `mod` bId bus == 0 departsAt bus time = (time + bDelta bus) `mod` bId bus == 0
-- See https://en.wikipedia.org/wiki/Chinese_remainder_theorem#Search_by_sieving
earliestTimestamp :: [Bus] -> Integer -> Integer -> Integer earliestTimestamp :: [Bus] -> Integer -> Integer -> Integer
earliestTimestamp [] start _ = start earliestTimestamp [] time _ = time
earliestTimestamp (b:bs) start step = earliestTimestamp bs time (lcm step $ bId b) earliestTimestamp (b:bs) time step
where | b `departsAt` time = earliestTimestamp bs time (step * bId b)
time = fromJust $ find (b `departsAt`) $ iterate (+ step) start | otherwise = earliestTimestamp (b:bs) (time + step) step
solver :: (Integer, [Bus]) -> IO () solver :: (Integer, [Bus]) -> IO ()
solver (earliest, buses) = do solver (earliest, buses) = do
putStrLn ">> Part 1" putStrLn ">> Part 1"
let busTimes = [(bid, earliest `mod` bid) | Bus bid _ <- buses] let nextBus = minimumBy (compare `on` waitTime earliest) buses
(nextBus, waitTime) = minimumBy (compare `on` snd) busTimes print $ bId nextBus * waitTime earliest nextBus
print $ nextBus * waitTime
putStrLn "" putStrLn ""
putStrLn ">> Part 2" putStrLn ">> Part 2"