DEV Community

Discussion on: Advent of Code 2020 Solution Megathread - Day 16: Ticket Translation

Collapse
 
bgaster profile image
Benedict Gaster

Here's my Haskell solution. It was farily easy today, compared to some of the others, and I took my time between part 1 and part 2, to walk the dog in what turned out to be a very wet and muddy time.

pInt :: Parser Int
pInt = read <$> many1 digit

type Range = (Int,Int)

pRange :: Parser Range
pRange = do
  l <- pInt 
  char '-'
  u <- pInt
  pure (l,u)

pRanges :: Parser (Range, Range)
pRanges = do
  lower <- pRange
  spaces
  string "or"
  spaces
  upper <- pRange
  pure (lower, upper)

pField :: Parser (String, (Range,Range))
pField = do 
  cs <- many (noneOf ":")
  char ':' 
  spaces
  r <- pRanges
  pure (cs, r)

pInts :: Parser [Int]
pInts = sepBy1 pInt (char ',')

pParse :: Parser a -> String -> a
pParse p source =
  case parse p "" source of
    Right e -> e
    _ -> error "Parsing error"

withinRange :: Range -> Int -> Bool
withinRange (l,u) v = l <= v && v <= u

inRange :: Int -> (Range, Range)  -> Bool
inRange v (r,r') = withinRange r v || withinRange r' v

rules :: Int -> [(String, (Range,Range))] -> Bool
rules v = any (inRange v . snd)

errorRate rs = foldr aux 0
    where
      aux v er | rules v rs = er
               | otherwise  = v + er

removeInValid rs = filter ((==) 0 . errorRate rs)

classify []         _ = []
classify ((s,r):rs) vs | all (`inRange` r) vs = s : classify rs vs  
                       | otherwise            = classify rs vs

main = do
  is <- readFile "day16_input" <&> lines
  -- parse fields, myticket, and nearby tickets
  let cs = map (pParse pField) (takeWhile (/= "") is)
  let myTicket = pParse pInts (head . tail $ dropWhile (/= "your ticket:") is) 
  let nb = map (pParse pInts) (tail $ dropWhile (/= "nearby tickets:") is) 

  -- part 1
  print (sum $ map (errorRate cs) nb)

  -- part 2
  let vs = removeInValid cs nb
      fields = sortOn (length . snd) (zip [0..] (map (classify cs) $ transpose vs) )
      (o,m) = span (\(_, fs) -> length fs == 1) fields
      ones = S.fromList . concatMap snd $ o

      fields' = o ++ snd
              (foldl'
                (\ (ones, xs) (i, rs)
                    -> let rs' = filter (not . (`S.member` ones)) rs
                       in (S.insert (head rs') ones, (i, rs') : xs))
                (ones, []) m)

      depart = foldr (\i r -> (myTicket !! fst i) * r) 
                     1 (filter (isPrefixOf "departure" . concat . snd) fields')
  print depart
Enter fullscreen mode Exit fullscreen mode