57 lines
1.8 KiB
Haskell
57 lines
1.8 KiB
Haskell
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
|
|
|
|
module Day05
|
|
( day05_1,
|
|
day05_2,
|
|
)
|
|
where
|
|
|
|
import Data.List ((\\))
|
|
import Data.List.Split (splitOn)
|
|
|
|
isSortedS :: [(String, String)] -> [String] -> Bool
|
|
isSortedS _ [_] = True
|
|
isSortedS rules (x : xs) =
|
|
let after = [p | (p, n) <- rules, n == x]
|
|
in not (any (`elem` after) xs) && isSortedS rules xs
|
|
|
|
isSortedI :: [(Int, Int)] -> [Int] -> Bool
|
|
isSortedI _ [_] = True
|
|
isSortedI rules (x : xs) =
|
|
let after = [p | (p, n) <- rules, n == x]
|
|
in not (any (`elem` after) xs) && isSortedI rules xs
|
|
|
|
getMiddleS :: [String] -> String
|
|
getMiddleS xs = xs !! (length xs `div` 2)
|
|
|
|
getMiddleI :: [Int] -> Int
|
|
getMiddleI xs = xs !! (length xs `div` 2)
|
|
|
|
sortOnRules :: [(Int, Int)] -> [Int] -> [Int]
|
|
sortOnRules _ [] = []
|
|
sortOnRules rules (x : xs) = sortOnRules rules beforeArray ++ [x] ++ sortOnRules rules afterArray
|
|
where
|
|
afterArray = xs \\ before
|
|
beforeArray = xs \\ afterArray
|
|
before = [p | (p, n) <- rules, n == x]
|
|
|
|
day05_1 :: IO ()
|
|
day05_1 = do
|
|
contents <- map (splitOn "|") . lines <$> readFile "input/day5.txt"
|
|
let rules = [(x, y) | [x, y] <- takeWhile (/= [""]) contents]
|
|
updates = concatMap (map (splitOn ",")) . drop 1 $ dropWhile (/= [""]) contents
|
|
sorted = filter (isSortedS rules) updates
|
|
putStrLn $
|
|
"Day 5, Puzzle 1 solution: "
|
|
++ (show :: Int -> String) (sum $ map (read . getMiddleS) sorted)
|
|
|
|
day05_2 :: IO ()
|
|
day05_2 = do
|
|
contents <- map (splitOn "|") . lines <$> readFile "input/day5.txt"
|
|
let rules = [(read x, read y) | [x, y] <- takeWhile (/= [""]) contents]
|
|
unsorted = filter (not . isSortedI rules) . map (map read) $ concatMap (map (splitOn ",")) . drop 1 $ dropWhile (/= [""]) contents
|
|
fixUnsorted = map (sortOnRules rules) unsorted
|
|
putStrLn $
|
|
"Day 5, Puzzle 2 solution: "
|
|
++ show (sum $ map getMiddleI fixUnsorted)
|