Advent of Code 2020 day 16

I took more of an "engineering" approach to Day 16 than a "pure programming" exercise. A few minutes fixing some data structures made the first challenge (parsing the input)  easier, and a look around Haskell's extended library eased the challenge of part 2.

Data structures and Parsing

The input looks complex to parse, so I spent some time thinking about how to represent the data in a form I wanted.

The input looks like this:

class: 1-3 or 5-7
row: 6-11 or 33-44
seat: 13-40 or 45-50

your ticket:
7,1,14

nearby tickets:
7,3,47
40,4,50
55,2,20
38,6,12

That's three sections: a bunch of rules, my ticket, and a bunch of nearby tickets. Some data structures to hold these:

• A RuleSet is a Map of rule names (Strings) to Bodys. A Body is two Ranges, and a Range is two limits.
• A Ticket is a list of Ints.

type RuleSet = M.Map String Body

data Body = Body Range Range -- the two ranges
  deriving (Show, Eq)

data Range = Range Int Int -- lower, upper bounds
  deriving (Show, Eq)

type Ticket = [Int]

Now I know what I'm creating, parsing the input file follows the data types. The overall input is a triple of (rules, my ticket, nearby tickets), with the sections separated by blank lines. The rest of the parser is fairly readable, assuming you know the applicative operators.

inputP = (,,) <$> rulesP <* blankLines <*> myTicketP <* blankLines <*> nearbyTicketsP

blankLines = skipMany1 endOfLine

rulesP = M.fromList <$> (ruleP `sepBy` endOfLine)

ruleP = (,) <$> nameP <* ": " <*> ruleBodyP
nameP = many1 (letter <|> space)
ruleBodyP = Body <$> rangeP <* " or " <*> rangeP
rangeP = Range <$> decimal <* "-" <*> decimal

myTicketP = "your ticket:" *> endOfLine *> ticketValsP
nearbyTicketsP = "nearby tickets:" *> endOfLine *> (ticketValsP `sepBy` endOfLine)

ticketValsP = decimal `sepBy1` (string ",")

This worked first time! It says something about the ease of using this style of parser.

Going back to using these rules, checking that a value is in a range, and passes a rule, are straightforward.

inRange (Range lower upper) value = (lower <= value) && (value <= upper)
matchesRule (Body a b) value = (inRange a value) || (inRange b value)

Part 1

Given the apparatus above, part 1 is almost trivial (as I think it was supposed to be). I define a function for testing if a value is valid for any field, and use that as a filter over all the values in the nearby tickets. Using a list comprehension is, I think, a clear way of doing the two levels of iteration.

main = 
  do  text <- TIO.readFile "data/advent16.txt"
      let (rules, myTicket, nearbyTickets) = successfulParse text
      print $ part1 rules nearbyTickets

part1 = ticketErrorRate

ticketErrorRate :: RuleSet -> [Ticket] -> Int
ticketErrorRate rules tickets = 
  sum [ v 
      | t <- tickets
      , v <- t
      , (not $ validForAnyField rules v) ]

validForAnyField :: RuleSet -> Int -> Bool
validForAnyField rules value = any (flip matchesRule value) $ M.elems rules

Part 2

This is, fundamentally, a constraint satisfaction problem (CSP): find an assignment of column indexes to field names, such that all values in the column match the field's rule, and no two columns are assigned to the same field. Luckily for me, Haskell's libraries contain a CSP solver. It even has an example for solving Sudoku, a larger problem than this one.

That left me to express the problem in terms the solver could understand, and use the results to solve the problem. The steps are:

1. Weed out the invalid tickets
2. For each rule, find the column indices that could match that rule
3. Solve the CSP to find the assignments of column indices to rules
4. Use the assignment to build a ticket with named fields
5. Extract the needed answer

A ticket is valid if every value is valid for some rule.

isValidTicket :: RuleSet -> Ticket -> Bool
isValidTicket rules ticket = and $ map (validForAnyField rules) ticket

A column is a possible match for a rule if all values in that column match the rule. I can find all the canddate column indexes for a rule by maping that test over all the columns (zipped with the indexes).

possibleColumns ticketCols body = map fst $ filter columnMatches $ zip [0..] ticketCols
  where columnMatches (_, col) = all (matchesRule body) col

I find all the columns that match for all the rules by mapping possibleColumns over rule. This is where I filter out the invalid tickets, and transpose them to have a list of columns rather than a list of tickets.

type ColCandidateSet = M.Map String [Int]

possibleColumnsAll :: RuleSet -> [Ticket] -> ColCandidateSet
possibleColumnsAll rules tickets = M.map (possibleColumns ticketCols) rules
  where validTickets = filter (isValidTicket rules) tickets
        ticketCols = transpose validTickets

I now have, for each rule/field name, a list of column indexes that it could match. Time to engage the CSP solver! This code is lifted straight from the library's documentation. knownCols does the wrapping and unwrapping of data to feed solveColumns.  solveColumns takes a list of candidate sets, creates a CSP variable for each one, applies the "all different" constraint (by enuring that all pairs of variables are different), then finds oneCSPSolution.

knownCols :: ColCandidateSet -> M.Map String Int
knownCols colCandidates = M.fromList $ zip names cols
  where 
    (names, colDomains) = unzip $ M.toList colCandidates
    cols = solveColumns colDomains

solveColumns :: [[Int]] -> [Int]
solveColumns colDomains = oneCSPSolution $ do
  dvs <- mapM mkDV colDomains
  mapAllPairsM_ (constraint2 (/=)) dvs
  return dvs

mapAllPairsM_ :: Monad m => (a -> a -> m b) -> [a] -> m ()
mapAllPairsM_ f []     = return ()
mapAllPairsM_ f (_:[]) = return ()
mapAllPairsM_ f (a:l) = mapM_ (f a) l >> mapAllPairsM_ f l

Now I know which column index goes with each field, I can build a ticket as a Map of name:value pairs.

buildTicket :: M.Map String Int -> Ticket -> M.Map String Int
buildTicket namedCols ticketData = M.map (ticketData!!) namedCols

Finally, I put it all together, extract the information about the "departure" fields, and return the result.

part2 rules myTicket nearbyTickets = product $ M.elems departureTicket
  where 
    columnDomains = possibleColumnsAll rules nearbyTickets
    namedCols = knownCols columnDomains
    filledTicket = buildTicket namedCols myTicket
    departureTicket = M.filterWithKey (\k _ -> "departure" `isPrefixOf` k) filledTicket

Code

You can find the code here or on GitLab.