X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent11%2FMain.hs;fp=advent11%2FMain.hs;h=42b0a5865d49096a46a93b40b8fb280b8319746d;hb=fa67b5346cae1f97e6955b3dd1eafb29734e9542;hp=98e80f4fd6c795aebbcd5c19bdd2232bfaf29760;hpb=ee33ca141d4dcd7d07e5c35be1e670b728a1483d;p=advent-of-code-22.git

diff --git a/advent11/Main.hs b/advent11/Main.hs
index 98e80f4..42b0a58 100644
--- a/advent11/Main.hs
+++ b/advent11/Main.hs
@@ -7,12 +7,12 @@ import Data.Attoparsec.Text hiding (take, D)
 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
@@ -21,54 +21,127 @@ data MonkeyCode = MonkeyCode
   , _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