{-# LANGUAGE MultiWayIf #-} {-# OPTIONS -Wno-incomplete-uni-patterns #-} import Data.List (tails, find, sortBy) import Data.Maybe (isNothing, mapMaybe) import qualified Data.Set as Set import qualified Data.Map.Strict as Map import Control.Monad (forM_) splitOn :: Eq a => a -> [a] -> [[a]] splitOn _ [] = [[]] splitOn sep (x:xs) | x == sep = [] : splitOn sep xs | otherwise = let l = splitOn sep xs in (x : head l) : tail l main :: IO () main = do (rules', _ : seqs') <- break null . lines <$> getContents let rules = map (\s -> let (a, _:b) = break (=='|') s in (read @Int a, read @Int b)) rules' let seqs = map (map (read @Int) . splitOn ',') seqs' let pairsOf l = concatMap (\(x:xs) -> map (x,) xs) (init (tails l)) let validPair (a, b) = isNothing (find (== (b, a)) rules) let validSeq = all validPair . pairsOf let middle l = l !! (length l `div` 2) print $ sum [middle l | l <- seqs, validSeq l] let lookups x = map snd . filter ((== x) . fst) cmp a b = let na = lookups a rules nb = lookups b rules in if | b `elem` na -> LT | a `elem` nb -> GT | otherwise -> EQ print $ sum . map (\l -> if validSeq l then 0 else middle (sortBy cmp l)) $ seqs -- let postSet = \start -> go mempty (Map.singleton start []) -- where go seen fringe = -- let news = Map.fromList (mapMaybe (\(a,b) -> case Map.lookup a fringe of Just hist -> Just (b, a:hist) ; Nothing -> Nothing) rules) -- Map.\\ seen -- in if Map.null news then seen else go (seen <> news) news -- cmp a b | a == b = EQ -- | b `Map.member` postSet a = LT -- | a `Map.member` postSet b = GT -- | otherwise = error $ "Cannot compare: " ++ show a ++ " and " ++ show b -- let allnums = Set.toList (Set.fromList (map fst rules ++ map snd rules)) -- forM_ allnums $ \n -> do -- putStrLn $ "post: " ++ show n ++ " -> " ++ show (Map.toList (postSet n)) ++ " (" ++ show (Map.keys (postSet n) == allnums) ++ ")" -- -- forM_ seqs $ \l -> do -- -- if validSeq l -- -- then putStrLn $ "valid: " ++ show l -- -- else putStrLn $ "sort " ++ show l ++ " -> " ++ show (sortBy cmp l) -- print $ sum . map (\l -> if validSeq l then 0 else middle (sortBy cmp l)) $ seqs