2023-19 part 2 in haskell
This commit is contained in:
parent
2d84e26c37
commit
9a17e7eb99
GPG key ID:
F92E51B86E07177E
1 changed files with 130 additions and 0 deletions
130
2023/19-Aplenty/second.hs
Normal file
130
2023/19-Aplenty/second.hs
Normal file
|
|
@ -0,0 +1,130 @@
|
|||
-- requires cabal install --lib megaparsec parser-combinators heap vector
|
||||
module Main (main) where
|
||||
|
||||
import Control.Applicative.Permutations
|
||||
import Control.Monad (void, when)
|
||||
import qualified Data.Char as C
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import qualified Data.Heap as H
|
||||
import qualified Data.List as L
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Vector as V
|
||||
import qualified Data.Vector.Unboxed as VU
|
||||
import Data.Void (Void)
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
exampleExpectedOutput = 167409079868000
|
||||
|
||||
data Category = X | M | A | S deriving (Eq, Show)
|
||||
data Op = Gt | Lt deriving (Eq, Show)
|
||||
data Action = Accept | Reject | Jmp String deriving (Eq, Show)
|
||||
data Rule = Cmp Category Op Int Action | RuleAction Action deriving (Eq, Show)
|
||||
type Workflow = (String, [Rule])
|
||||
type Workflows = M.Map String [Rule]
|
||||
data Part = Part Int Int Int Int deriving (Eq, Show)
|
||||
type Parts = [Part]
|
||||
data Input = Input Workflows Parts deriving (Eq, Show)
|
||||
|
||||
type Parser = Parsec Void String
|
||||
|
||||
parseCategory :: Parser Category
|
||||
parseCategory = char 'x' $> X
|
||||
<|> char 'm' $> M
|
||||
<|> char 'a' $> A
|
||||
<|> char 's' $> S
|
||||
|
||||
parseOp :: Parser Op
|
||||
parseOp = char '>' $> Gt
|
||||
<|> char '<' $> Lt
|
||||
|
||||
parseNumber :: Parser Int
|
||||
parseNumber = read <$> some digitChar
|
||||
|
||||
parseLabel :: Parser String
|
||||
parseLabel = try $ count' 2 4 letterChar
|
||||
|
||||
parseAction :: Parser Action
|
||||
parseAction = char 'A' $> Accept
|
||||
<|> char 'R' $> Reject
|
||||
<|> (Jmp <$> parseLabel)
|
||||
|
||||
parseRule :: Parser Rule
|
||||
parseRule = (RuleAction <$> parseAction)
|
||||
<|> (Cmp <$> parseCategory <*> parseOp <*> parseNumber <* char ':' <*> parseAction)
|
||||
|
||||
parseWorkflow :: Parser Workflow
|
||||
parseWorkflow = (,) <$> parseLabel <* char '{'
|
||||
<*> some (parseRule <* optional (char ',')) <* char '}'
|
||||
|
||||
parseWorkflows :: Parser Workflows
|
||||
parseWorkflows = M.fromList <$> some (parseWorkflow <* eol)
|
||||
|
||||
parsePart :: Parser Part
|
||||
parsePart = Part <$> (string "{x=" *> parseNumber)
|
||||
<*> (string ",m=" *> parseNumber)
|
||||
<*> (string ",a=" *> parseNumber)
|
||||
<*> (string ",s=" *> parseNumber <* char '}')
|
||||
|
||||
parseParts :: Parser Parts
|
||||
parseParts = some (parsePart <* eol)
|
||||
|
||||
parseInput' :: Parser Input
|
||||
parseInput' = Input <$> (parseWorkflows <* eol)
|
||||
<*> (parseParts <* eof)
|
||||
|
||||
parseInput :: String -> IO Input
|
||||
parseInput filename = do
|
||||
input <- readFile filename
|
||||
case runParser parseInput' filename input of
|
||||
Left bundle -> error $ errorBundlePretty bundle
|
||||
Right input' -> return input'
|
||||
|
||||
type Interval = (Int, Int)
|
||||
data Combination = Combination Interval Interval Interval Interval deriving (Eq, Show)
|
||||
|
||||
compute :: Input -> Int
|
||||
compute (Input workflows _) = compute' (Combination (1, 4000) (1, 4000) (1, 4000) (1, 4000)) [RuleAction (Jmp "in")]
|
||||
where
|
||||
compute' :: Combination -> [Rule] -> Int
|
||||
compute' comb (RuleAction Accept:_) = score comb
|
||||
compute' comb (RuleAction Reject:_) = 0
|
||||
compute' comb (RuleAction (Jmp s):_) = compute' comb (workflows M.! s)
|
||||
compute' comb@(Combination (xl, xr) m a s) (Cmp X Lt n act:xs) | xr < n = compute' comb [(RuleAction act)]
|
||||
| xl >= n = compute' comb xs
|
||||
| otherwise = compute' (Combination (xl, n - 1) m a s) [(RuleAction act)] + compute' (Combination (n, xr) m a s) xs
|
||||
compute' comb@(Combination x (ml, mr) a s) (Cmp M Lt n act:xs) | mr < n = compute' comb [(RuleAction act)]
|
||||
| ml >= n = compute' comb xs
|
||||
| otherwise = compute' (Combination x (ml, n - 1) a s) [(RuleAction act)] + compute' (Combination x (n, mr) a s) xs
|
||||
compute' comb@(Combination x m (al, ar) s) (Cmp A Lt n act:xs) | ar < n = compute' comb [(RuleAction act)]
|
||||
| al >= n = compute' comb xs
|
||||
| otherwise = compute' (Combination x m (al, n - 1) s) [(RuleAction act)] + compute' (Combination x m (n, ar) s) xs
|
||||
compute' comb@(Combination x m a (sl, sr)) (Cmp S Lt n act:xs) | sr < n = compute' comb [(RuleAction act)]
|
||||
| sl >= n = compute' comb xs
|
||||
| otherwise = compute' (Combination x m a (sl, n - 1)) [(RuleAction act)] + compute' (Combination x m a (n, sr)) xs
|
||||
compute' comb@(Combination (xl, xr) m a s) (Cmp X Gt n act:xs) | xl > n = compute' comb [(RuleAction act)]
|
||||
| xr <= n = compute' comb xs
|
||||
| otherwise = compute' (Combination (xl, n) m a s) xs + compute' (Combination (n + 1, xr) m a s) [(RuleAction act)]
|
||||
compute' comb@(Combination x (ml, mr) a s) (Cmp M Gt n act:xs) | ml > n = compute' comb [(RuleAction act)]
|
||||
| mr <= n = compute' comb xs
|
||||
| otherwise = compute' (Combination x (ml, n) a s) xs + compute' (Combination x (n + 1, mr) a s) [(RuleAction act)]
|
||||
compute' comb@(Combination x m (al, ar) s) (Cmp A Gt n act:xs) | al > n = compute' comb [(RuleAction act)]
|
||||
| ar <= n = compute' comb xs
|
||||
| otherwise = compute' (Combination x m (al, n) s) xs + compute' (Combination x m (n + 1, ar) s) [(RuleAction act)]
|
||||
compute' comb@(Combination x m a (sl, sr)) (Cmp S Gt n act:xs) | sl > n = compute' comb [(RuleAction act)]
|
||||
| sr <= n = compute' comb xs
|
||||
| otherwise = compute' (Combination x m a (sl, n)) xs + compute' (Combination x m a (n + 1, sr)) [(RuleAction act)]
|
||||
score (Combination (xl, xr) (ml, mr) (al, ar) (sl, sr)) = (xr - xl + 1) * (mr - ml + 1) * (ar - al + 1) * (sr - sl + 1)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
example <- parseInput "example"
|
||||
let exampleOutput = compute example
|
||||
when (exampleOutput /= exampleExpectedOutput) (error $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput)
|
||||
input <- parseInput "input"
|
||||
print $ compute input
|
||||
Loading…
Add table
Reference in a new issue