advent16/src/advent16.hs

   1 -- import Debug.Trace
   2
   3 import Data.Text (Text)
   4 -- import qualified Data.Text as T
   5 import qualified Data.Text.IO as TIO
   6
   7 import Data.Attoparsec.Text hiding (take)
   8 -- import Data.Attoparsec.Combinator
   9 import Control.Applicative
  10 import qualified Data.Map.Strict as M
  11 import Data.List
  12 import Control.Monad.CSP
  13
  14
  15 type RuleSet = M.Map String Body
  16
  17 data Body = Body Range Range -- the two ranges
  18   deriving (Show, Eq)
  19
  20 data Range = Range Int Int -- lower, upper bounds
  21   deriving (Show, Eq)
  22
  23 type Ticket = [Int]
  24
  25 type ColCandidateSet = M.Map String [Int]
  26
  27
  28 main :: IO ()
  29 main =
  30   do  text <- TIO.readFile "data/advent16.txt"
  31       let (rules, myTicket, nearbyTickets) = successfulParse text
  32       print $ part1 rules nearbyTickets
  33       print $ part2 rules myTicket nearbyTickets
  34
  35 part1 = ticketErrorRate
  36
  37 part2 rules myTicket nearbyTickets = product $ M.elems departureTicket
  38   where
  39     columnDomains = possibleColumnsAll rules nearbyTickets
  40     namedCols = knownCols columnDomains
  41     filledTicket = buildTicket namedCols myTicket
  42     departureTicket = M.filterWithKey (\k _ -> "departure" `isPrefixOf` k) filledTicket
  43
  44
  45 inRange (Range lower upper) value = (lower <= value) && (value <= upper)
  46 matchesRule (Body a b) value = (inRange a value) || (inRange b value)
  47
  48 validForAnyField :: RuleSet -> Int -> Bool
  49 validForAnyField rules value = any (flip matchesRule value) $ M.elems rules
  50
  51 ticketErrorRate :: RuleSet -> [Ticket] -> Int
  52 ticketErrorRate rules tickets =
  53   sum [ v
  54       | t <- tickets
  55       , v <- t
  56       , (not $ validForAnyField rules v) ]
  57
  58 isValidTicket :: RuleSet -> Ticket -> Bool
  59 isValidTicket rules ticket = and $ map (validForAnyField rules) ticket
  60
  61 possibleColumnsAll :: RuleSet -> [Ticket] -> ColCandidateSet
  62 possibleColumnsAll rules tickets = M.map (possibleColumns ticketCols) rules
  63   where validTickets = filter (isValidTicket rules) tickets
  64         ticketCols = transpose validTickets
  65
  66 possibleColumns ticketCols body = map fst $ filter columnMatches $ zip [0..] ticketCols
  67   where columnMatches (_, col) = all (matchesRule body) col
  68
  69
  70 knownCols :: ColCandidateSet -> M.Map String Int
  71 knownCols colCandidates = M.fromList $ zip names cols
  72   where
  73     (names, colDomains) = unzip $ M.toList colCandidates
  74     cols = solveColumns colDomains
  75
  76 solveColumns :: [[Int]] -> [Int]
  77 solveColumns colDomains = oneCSPSolution $ do
  78   dvs <- mapM mkDV colDomains
  79   mapAllPairsM_ (constraint2 (/=)) dvs
  80   return dvs
  81
  82 mapAllPairsM_ :: Monad m => (a -> a -> m b) -> [a] -> m ()
  83 mapAllPairsM_ f []     = return ()
  84 mapAllPairsM_ f (_:[]) = return ()
  85 mapAllPairsM_ f (a:l) = mapM_ (f a) l >> mapAllPairsM_ f l
  86
  87 buildTicket :: M.Map String Int -> Ticket -> M.Map String Int
  88 buildTicket namedCols ticketData = M.map (ticketData!!) namedCols
  89
  90
  91 -- Parse the input file
  92
  93 inputP = (,,) <$> rulesP <* blankLines <*> myTicketP <* blankLines <*> nearbyTicketsP
  94
  95 blankLines = skipMany1 endOfLine
  96
  97 rulesP = M.fromList <$> (ruleP `sepBy` endOfLine)
  98
  99 ruleP = (,) <$> nameP <* ": " <*> ruleBodyP
 100 nameP = many1 (letter <|> space)
 101 ruleBodyP = Body <$> rangeP <* " or " <*> rangeP
 102 rangeP = Range <$> decimal <* "-" <*> decimal
 103
 104 myTicketP = "your ticket:" *> endOfLine *> ticketValsP
 105 nearbyTicketsP = "nearby tickets:" *> endOfLine *> (ticketValsP `sepBy` endOfLine)
 106
 107 ticketValsP = decimal `sepBy1` (string ",")
 108
 109 -- successfulParse :: Text -> (Integer, [Maybe Integer])
 110 successfulParse input =
 111   case parseOnly inputP input of
 112     Left  _err -> (M.empty, [], []) -- TIO.putStr $ T.pack $ parseErrorPretty err
 113     Right ticketInfo -> ticketInfo