58 lines
1.8 KiB
Haskell
58 lines
1.8 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Aoc.Y2020.D16
|
|
( day
|
|
) where
|
|
|
|
import Data.Bifunctor
|
|
import Data.List
|
|
|
|
import qualified Data.Text as T
|
|
|
|
import Aoc.Day
|
|
import Aoc.Parse
|
|
|
|
data Input = Input [(T.Text, Int -> Bool)] [Int] [[Int]]
|
|
|
|
parser :: Parser Input
|
|
parser = Input
|
|
<$> many (field <* newline)
|
|
<*> (string "\nyour ticket:\n" *> ticket)
|
|
<*> (string "\nnearby tickets:\n" *> many ticket)
|
|
where
|
|
bound = around (string "-") decimal decimal
|
|
field = do
|
|
name <- lineUntil (==':') <* string ": "
|
|
((a, b), (c, d)) <- around (string " or ") bound bound
|
|
pure (name, \n -> (a <= n && n <= b) || (c <= n && n <= d))
|
|
ticket = (decimal `sepBy` string ",") <* newline
|
|
|
|
anyValid :: [(T.Text, Int -> Bool)] -> Int -> Bool
|
|
anyValid fields n = any (($ n) . snd) fields
|
|
|
|
anyOf :: [a] -> [(a, [a])]
|
|
anyOf [] = []
|
|
anyOf (a:as) = (a, as) : map (second (a:)) (anyOf as)
|
|
|
|
findFields :: [(a, [T.Text])] -> [[(a, T.Text)]]
|
|
findFields [] = pure []
|
|
findFields variants = do
|
|
((i, [name]), rest) <- anyOf variants
|
|
rest2 <- findFields $ map (second $ delete name) rest
|
|
pure $ (i, name) : rest2
|
|
|
|
solver :: Input -> IO ()
|
|
solver (Input fields ownTicket nearbyTickets) = do
|
|
putStrLn ">> Part 1"
|
|
print $ sum $ filter (not . anyValid fields) $ concat nearbyTickets
|
|
|
|
putStrLn ""
|
|
putStrLn ">> Part 2"
|
|
let validTickets = filter (all (anyValid fields)) nearbyTickets
|
|
possibleNames = map (\ns -> map fst $ filter (\(_, p) -> all p ns) fields) $ transpose validTickets
|
|
actualNames = map snd $ sortOn fst $ head $ findFields $ zip [(0::Int)..] possibleNames
|
|
relevantValues = map snd $ filter (T.isPrefixOf "departure" . fst) $ zip actualNames ownTicket
|
|
print $ product relevantValues
|
|
|
|
day :: Day
|
|
day = dayParse parser solver
|