5 (don't put f*** cycles in your graph)

1 files changed, 50 insertions, 0 deletions

diff --git a/2024/5.hs b/2024/5.hs
new file mode 100644
index 0000000..6c72b95
--- /dev/null
+++ b/2024/5.hs
@@ -0,0 +1,50 @@
+{-# 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