[hs] Clean up 2020_13 further

This commit is contained in:
Joscha 2020-12-13 11:51:09 +00:00
parent dde5269d39
commit 7b1f57f563

View file

@ -7,50 +7,43 @@ module Aoc.Y2020.D13
import Control.Monad import Control.Monad
import Data.Foldable import Data.Foldable
import Data.Function import Data.Function
import Data.List
import Data.Maybe import Data.Maybe
import Data.Ord
import Aoc.Day import Aoc.Day
import Aoc.Parse import Aoc.Parse
parser :: Parser (Integer, [Maybe Integer])
parser = do
earliest <- decimal
void newline
buses <- sepBy ((Just <$> decimal) <|> (Nothing <$ char 'x')) (char ',')
void newline
pure (earliest, buses)
data Bus = Bus data Bus = Bus
{ bId :: Integer { bId :: Integer
, bDelta :: Integer , bDelta :: Integer
} deriving (Show) } deriving (Show)
parser :: Parser (Integer, [Bus])
parser = do
earliest <- decimal
void newline
buses <- sepBy ((Just <$> decimal) <|> (Nothing <$ char 'x')) (char ',')
void newline
pure (earliest, [Bus bid delta | (Just bid, delta) <- zip buses [0..]])
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
includeBus :: Bus -> (Integer, Integer) -> (Integer, Integer) earliestTimestamp :: [Bus] -> Integer -> Integer -> Integer
includeBus bus (time, step) = earliestTimestamp [] start _ = start
let time' = fromJust $ find (bus `departsAt`) $ iterate (+ step) time earliestTimestamp (b:bs) start step = earliestTimestamp bs time (lcm step $ bId b)
step' = step * bId bus where
in (time', step') time = fromJust $ find (b `departsAt`) $ iterate (+ step) start
earliestTimestamp :: [Maybe Integer] -> Integer solver :: (Integer, [Bus]) -> IO ()
earliestTimestamp buses =
let busDeltas = sortOn (Down . bId) [Bus bus delta | (Just bus, delta) <- zip buses [0..]]
in fst $ foldl' (flip includeBus) (0, 1) busDeltas
solver :: (Integer, [Maybe Integer]) -> IO ()
solver (earliest, buses) = do solver (earliest, buses) = do
putStrLn ">> Part 1" putStrLn ">> Part 1"
let busTimes = [(bus, earliest - mod earliest bus + bus) | Just bus <- buses] let busTimes = [(bid, earliest `mod` bid) | Bus bid _ <- buses]
(nextBus, nextBusTime) = minimumBy (compare `on` snd) busTimes (nextBus, waitTime) = minimumBy (compare `on` snd) busTimes
print $ nextBus * (nextBusTime - earliest) print $ nextBus * waitTime
putStrLn "" putStrLn ""
putStrLn ">> Part 2" putStrLn ">> Part 2"
print $ earliestTimestamp buses print $ earliestTimestamp buses 0 1
day :: Day day :: Day
day = dayParse parser solver day = dayParse parser solver