2024 Day Five

DayFive.hs

module DayFive (partOne, partTwo) where
import Data.List (tails)
import Data.Graph


testRules = [(47,53),
  (97,13),
  (97,61),
  (97,47),
  (75,29),
  (61,13),
  (75,53),
  (29,13),
  (97,29),
  (53,29),
  (61,53),
  (97,53),
  (61,29),
  (47,13),
  (75,47),
  (97,75),
  (47,61),
  (75,61),
  (47,29),
  (75,13),
  (53,13)]



testOrderings = [[75,47,61,53,29],
  [97,61,53,29,13],
  [75,29,13],
  [75,97,47,61,53],
  [61,13,29],
  [97,13,75,29,47]]



validate rules candidate = null $ bads rules candidate

middlePoint items = items !! (length items `div` 2)

bads :: [(Int, Int)] -> [Int] -> [(Int, Int)]
bads rules candidate = filter connected pairs
  where pairs = tailPairs candidate
        connected (before, after) = path digraph after before
        tailPairs xs = concatMap splat $ zip xs $ drop 1 $ tails xs
        splat (a, bs) = [(a,b) | b <- bs]
        digraph = buildG (0,1000) [(a,b) | (a,b) <- rules, a `elem` candidate, b `elem` candidate]

rectify rules ordering = filter isRelevant $ topSort digraph
  where digraph = buildG (0,1000) [(a,b) | (a,b) <- rules, a `elem` ordering, b `elem` ordering]
        isRelevant n = n `elem` ordering

partOne rules candidates = sum $ map middlePoint $ filter (validate rules) candidates

partTwo rules candidates = sum $ map (middlePoint . (rectify rules)) needsHelp
  where needsHelp = filter (not . (validate rules)) candidates