Moving code around with branches
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:
Mapof rule names (
Ranges, and a
Rangeis two limits.
Ticketis a list of
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)
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
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:
- Weed out the invalid tickets
- For each rule, find the column indices that could match that rule
- Solve the CSP to find the assignments of column indices to rules
- Use the assignment to build a ticket with named fields
- 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
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 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
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