38 lines
1.3 KiB
Haskell
38 lines
1.3 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
module Main where
|
|
|
|
import Data.Functor
|
|
import Data.List
|
|
import Data.List.Split
|
|
import Data.Map (Map)
|
|
import qualified Data.Map as Map
|
|
|
|
parse :: String -> (Map Int [Int], [[Int]])
|
|
parse s = let [a,b] = splitOn "\n\n" s in
|
|
( foldr (\[x,y] m -> Map.insertWith (++) (read x) ([read y]) m) Map.empty . (splitOn "|" <$>) $ lines a
|
|
, ((read <$>) . splitOn "," <$>) $ lines b)
|
|
|
|
|
|
inOrder :: Map Int [Int] -> [Int] -> [Int] -> Bool
|
|
inOrder _ _ [] = True
|
|
inOrder r p (x:xs) = (case Map.lookup x r of
|
|
Just l -> (== []) $ p `intersect` l
|
|
Nothing -> True) && inOrder r (x:p) xs
|
|
|
|
solve1 :: Map Int [Int] -> [[Int]] -> Int
|
|
solve1 r l = sum $ filter (inOrder r []) l <&> (\a -> let t = length a in a !! (t `div` 2))
|
|
|
|
sort' :: Map Int [Int] -> [Int] -> [Int] -> [Int]
|
|
sort' _ p [] = p
|
|
sort' r p (x:xs) = case Map.lookup x r of
|
|
Nothing -> sort' r (p ++ [x]) xs
|
|
Just l -> let t = p `intersect` l in sort' r ((p \\ t) ++ [x] ++ t) xs
|
|
|
|
solve2 :: Map Int [Int] -> [[Int]] -> Int
|
|
solve2 r l = sum $ filter (not . inOrder r []) l <&> (\a -> let t = length a in a !! (t `div` 2)) . sort' r []
|
|
|
|
main :: IO ()
|
|
main = readFile "inputs/5" <&> parse >>= \i ->
|
|
print (uncurry solve1 i) >>
|
|
print (uncurry solve2 i)
|