import Control.Applicative
import Data.List
import qualified Data.IntMap as M
+import Data.IntMap ((!))
import Control.Lens
-
-data Expression = Expression Operation Operand
- deriving (Show, Eq)
-data Operation = Plus | Times deriving (Show, Eq)
-data Operand = Literal Int | Old deriving (Show, Eq)
+import Control.Monad.State.Strict
+import Control.Monad.Reader
+import Control.Monad.Writer
+import Control.Monad.RWS.Strict
data MonkeyCode = MonkeyCode
{ _operation :: Expression
, _falseTarget :: Int
}
deriving (Show, Eq)
-makeLenses ''MonkeyCode
-type MoneyDescription = M.IntMap MonkeyCode
+data Expression = Expression Operator Operand deriving (Show, Eq)
+data Operator = Plus | Times deriving (Show, Eq)
+data Operand = Literal Int | Old deriving (Show, Eq)
+
+type MonkeyCodes = M.IntMap MonkeyCode
+data MonkeyDescription = MonkeyDescription { _limit :: Int -> Int
+ , _codes :: MonkeyCodes
+ }
type MonkeyHolds = M.IntMap [Int]
+data MonkeyLog = MonkeyLog Int Int -- monkey ID, number of items handled this round
+ deriving (Show, Eq)
+type MonkeyHandler = RWS MonkeyDescription [MonkeyLog] MonkeyHolds
+
+makeLenses ''MonkeyCode
main :: IO ()
main =
do dataFileName <- getDataFileName
text <- TIO.readFile dataFileName
- let monkeys = successfulParse text
- print monkeys
- -- let steps = expandPath path
- -- print $ part1 steps
- -- print $ part2 steps
+ let (monkeyCode, monkeyHold) = successfulParse text
+ print $ part1 monkeyCode monkeyHold
+ print $ part2 monkeyCode monkeyHold
--- part1, part2 :: Path -> Int
--- part1 steps = S.size $ rope ^. trace
--- where rope = ropeSteps (newRope 1) steps
+part1, part2 :: MonkeyCodes -> MonkeyHolds -> Int
+part1 monkeyCode monkeyHold = monkeyBusinessLevel logs
+ where monkeyDesc = MonkeyDescription { _limit = (`div` 3)
+ , _codes = monkeyCode
+ }
+ (_, logs) = execRWS (replicateM_ 20 throwRound)
+ monkeyDesc monkeyHold
+part2 monkeyCode monkeyHold = monkeyBusinessLevel logs
+ where monkeyDesc = MonkeyDescription { _limit = (`mod` threshold)
+ , _codes = monkeyCode
+ }
+ (_, logs) = execRWS (replicateM_ 10000 throwRound)
+ monkeyDesc monkeyHold
+ threshold = product $ monkeyCode ^.. folded . test
--- Parse the input file
+throwRound :: MonkeyHandler ()
+throwRound =
+ do mIds <- gets M.keys
+ mapM_ throwItems mIds
--- pathP :: Parser [Direction]
--- directionP, upP, leftP, downP, rightP :: Parser Direction
+throwItems :: Int -> MonkeyHandler ()
+throwItems mId =
+ do items <- gets (! mId)
+ mapM_ (throwItem mId) items
+ modify (M.insert mId [])
+ tell [MonkeyLog mId (length items)]
+throwItem :: Int -> Int -> MonkeyHandler ()
+throwItem mId currentWorry =
+ do monkey <- asks ((! mId) . _codes)
+ threshold <- asks _limit
+ let newWorry = updateWorry currentWorry (monkey ^. operation) threshold
+ let testResult = worryTest (monkey ^. test) newWorry
+ let recipient = if testResult
+ then (monkey ^. trueTarget)
+ else (monkey ^. falseTarget)
+ modify (receivesItem recipient newWorry)
+
+updateWorry :: Int -> Expression -> (Int -> Int) -> Int
+updateWorry current (Expression operator operand) threshold
+ | operator == Plus = threshold (current + n)
+ | operator == Times = threshold (current * n)
+ where n = evalOperand operand
+ evalOperand (Literal k) = k
+ evalOperand Old = current
+
+worryTest :: Int -> Int -> Bool
+worryTest divisor worry = worry `mod` divisor == 0
+
+receivesItem :: Int -> Int -> MonkeyHolds -> MonkeyHolds
+receivesItem mId worry items = M.adjust (++ [worry]) mId items
+
+sumLogs :: [MonkeyLog] -> M.IntMap Int
+sumLogs logs = foldl' addCount M.empty logs
+ where addCount m (MonkeyLog mId n)
+ | mId `M.member` m = M.adjust (+ n) mId m
+ | otherwise = M.insert mId n m
+
+monkeyBusinessLevel :: [MonkeyLog] -> Int
+monkeyBusinessLevel logs = prolifics!!0 * prolifics!!1
+ where prolifics = reverse $ sort $ M.elems $ sumLogs logs
+
+-- Parse the input file
+
+monkeysP :: Parser (MonkeyCodes, MonkeyHolds)
monkeysP = makeMonkeyMaps <$> (monkeyP `sepBy` (endOfLine <* endOfLine))
where makeMonkeyMaps monkeys =
( M.fromList $ map fst monkeys
, M.fromList $ map snd monkeys
)
-monkeyP = mkMonkeyPair <$> mIdP <*> startingP <*> operationP <*> testP <*> trueTargetP <*> falseTargetP
+monkeyP :: Parser ((Int, MonkeyCode), (Int, [Int]))
+monkeyP = mkMonkeyPair <$> mIdP <*> startingP <*> operatorP
+ <*> testP <*> trueTargetP <*> falseTargetP
where mkMonkeyPair mId holding _operation _test _trueTarget _falseTarget =
((mId, MonkeyCode{..}), (mId, holding))
+mIdP, testP, trueTargetP, falseTargetP :: Parser Int
+startingP :: Parser [Int]
+operatorP, expressionP :: Parser Expression
+opP :: Parser Operator
+operandP :: Parser Operand
+
mIdP = ("Monkey " *> decimal) <* ":" <* endOfLine
startingP = (" Starting items: " *> (decimal `sepBy` ", ")) <* endOfLine
-operationP = (" Operation: new = old " *> expressionP) <* endOfLine
+operatorP = (" Operation: new = old " *> expressionP) <* endOfLine
testP = (" Test: divisible by " *> decimal) <* endOfLine
trueTargetP = (" If true: throw to monkey " *> decimal) <* endOfLine
falseTargetP = (" If false: throw to monkey " *> decimal)
-expressionP = Expression <$> (operatorP <* " ") <*> operandP
-operatorP = (Plus <$ "+") <|> (Times <$ "*")
+expressionP = Expression <$> (opP <* " ") <*> operandP
+opP = (Plus <$ "+") <|> (Times <$ "*")
operandP = (Literal <$> decimal) <|> (Old <$ "old")
-successfulParse :: Text -> (MoneyDescription, MonkeyHolds)
+successfulParse :: Text -> (MonkeyCodes, MonkeyHolds)
successfulParse input =
case parseOnly monkeysP input of
Left _err -> (M.empty, M.empty) -- TIO.putStr $ T.pack $ parseErrorPretty err
projects / advent-of-code-22.git / blobdiff