2024-12-10 00:09:53 +01:00
|
|
|
module Main where
|
|
|
|
|
|
|
|
import System.Environment (getArgs)
|
|
|
|
import Data.Maybe (mapMaybe)
|
2024-12-11 13:59:43 +01:00
|
|
|
import Data.List (find)
|
2024-12-10 00:09:53 +01:00
|
|
|
|
|
|
|
import Text.Parsec (parse, Parsec, endBy, sepBy1, char, newline, many)
|
|
|
|
import Text.ParserCombinators.Parsec.Number (decimal)
|
|
|
|
|
2024-12-11 13:59:43 +01:00
|
|
|
type OrderingRule = (Int, Int)
|
2024-12-10 00:09:53 +01:00
|
|
|
type PagesUpdate = [Int]
|
|
|
|
|
2024-12-11 13:59:43 +01:00
|
|
|
printInfo :: Parsec String () ([OrderingRule], [PagesUpdate])
|
|
|
|
printInfo = (,) <$> orderingRules <*> (newline *> pagesUpdates) <* many (char '\n')
|
2024-12-10 00:09:53 +01:00
|
|
|
where
|
|
|
|
pagesUpdates :: Parsec String () [PagesUpdate]
|
|
|
|
pagesUpdates = endBy (sepBy1 decimal $ char ',') newline
|
|
|
|
|
2024-12-11 13:59:43 +01:00
|
|
|
orderingRules :: Parsec String () [OrderingRule]
|
|
|
|
orderingRules = endBy ((,) <$> decimal <*> (char '|' *> decimal)) $ char '\n'
|
2024-12-10 00:09:53 +01:00
|
|
|
|
|
|
|
allDependencies :: [a] -> [(a, a)]
|
|
|
|
allDependencies (h:tl) = map (flip (,) h) tl ++ allDependencies tl
|
|
|
|
allDependencies [] = []
|
|
|
|
|
|
|
|
middleElement :: [a] -> Maybe a
|
|
|
|
middleElement [] = Nothing
|
|
|
|
middleElement [a] = Just a
|
|
|
|
middleElement (_:h':tl) = case reverse (h':tl) of
|
|
|
|
(_:middle) -> middleElement middle
|
|
|
|
[] -> Nothing
|
|
|
|
|
2024-12-11 13:59:43 +01:00
|
|
|
isWellOrdered :: [OrderingRule] -> PagesUpdate -> Bool
|
|
|
|
isWellOrdered orderingRules = all (`notElem` orderingRules) . allDependencies
|
|
|
|
|
|
|
|
part1 :: [OrderingRule] -> [PagesUpdate] -> Int
|
|
|
|
part1 orderingRules pagesUpdates = (sum . mapMaybe middleElement) onlyWellOrdered
|
|
|
|
where onlyWellOrdered = filter (isWellOrdered orderingRules) pagesUpdates
|
|
|
|
|
|
|
|
partitions :: [a] -> [([a], a, [a])]
|
|
|
|
partitions (h:tl) = ([], h, tl) : map (\(as, a, bs) -> (h:as, a, bs)) (partitions tl)
|
|
|
|
partitions [] = []
|
|
|
|
|
|
|
|
doublePartitions :: [a] -> [([a], a, [a], a, [a])]
|
|
|
|
doublePartitions ls = [(as, a, bs, b, cs)
|
|
|
|
| (as, a, bs') <- partitions ls
|
|
|
|
, (bs, b, cs) <- partitions bs']
|
|
|
|
|
|
|
|
reorder :: [OrderingRule] -> PagesUpdate -> PagesUpdate
|
|
|
|
reorder orderingRules pagesUpdate = case find badlyOrdered $ doublePartitions pagesUpdate of
|
|
|
|
Just (as, a, bs, b, cs) -> reorder orderingRules (as ++ b : bs ++ a : cs)
|
|
|
|
Nothing -> pagesUpdate
|
|
|
|
where
|
|
|
|
badlyOrdered :: ([Int], Int, [Int], Int, [Int]) -> Bool
|
|
|
|
badlyOrdered (_, a, _, b, _) = (b, a) `elem` orderingRules
|
|
|
|
|
|
|
|
part2 :: [OrderingRule] -> [PagesUpdate] -> Int
|
|
|
|
part2 orderingRules = sum
|
|
|
|
. mapMaybe (middleElement . reorder orderingRules)
|
|
|
|
. filter (not . isWellOrdered orderingRules)
|
2024-12-10 00:09:53 +01:00
|
|
|
|
|
|
|
main :: IO ()
|
|
|
|
main = do
|
|
|
|
args <- getArgs
|
|
|
|
(fp:_) <- return args
|
2024-12-11 13:59:43 +01:00
|
|
|
content <- readFile fp
|
|
|
|
input <- either (fail . show) return $ parse printInfo fp content
|
|
|
|
-- putStrLn $ "Solution (Part 1) : " ++ show (uncurry part1 input)
|
|
|
|
putStrLn $ "Solution (Part 2) : " ++ show (uncurry part2 input)
|