From 714980da64f02043d966296e66562ae71dcc6ce8 Mon Sep 17 00:00:00 2001 From: Jens Kadenbach Date: Wed, 14 Dec 2022 17:28:11 +0100 Subject: [PATCH] Day 11 --- aoc2022.cabal | 12 +++++ package.yaml | 3 ++ ressources/day11-input | 55 ++++++++++++++++++++++ src/Day10.hs | 3 -- src/Day11.hs | 101 +++++++++++++++++++++++++++++++++++++++++ src/Day11/Parser.hs | 98 +++++++++++++++++++++++++++++++++++++++ src/Lib.hs | 3 +- test/Day11Spec.hs | 68 +++++++++++++++++++++++++++ 8 files changed, 339 insertions(+), 4 deletions(-) create mode 100644 ressources/day11-input create mode 100644 src/Day11.hs create mode 100644 src/Day11/Parser.hs create mode 100644 test/Day11Spec.hs diff --git a/aoc2022.cabal b/aoc2022.cabal index ac66317..273151c 100644 --- a/aoc2022.cabal +++ b/aoc2022.cabal @@ -28,6 +28,8 @@ library Day1 Day1.Internal Day10 + Day11 + Day11.Parser Day2 Day2.Part1 Day2.Part2 @@ -63,10 +65,13 @@ library , containers , heredoc , hspec + , hspec-megaparsec , lens , matrix , megaparsec + , mtl , parsec + , sort , split , text , transformers @@ -87,10 +92,13 @@ executable aoc2022-exe , containers , heredoc , hspec + , hspec-megaparsec , lens , matrix , megaparsec + , mtl , parsec + , sort , split , text , transformers @@ -102,6 +110,7 @@ test-suite aoc2022-test main-is: Spec.hs other-modules: Day10Spec + Day11Spec Day1Spec Day2Spec Day3Spec @@ -122,10 +131,13 @@ test-suite aoc2022-test , containers , heredoc , hspec + , hspec-megaparsec , lens , matrix , megaparsec + , mtl , parsec + , sort , split , text , transformers diff --git a/package.yaml b/package.yaml index 2fcedee..0364c56 100644 --- a/package.yaml +++ b/package.yaml @@ -34,6 +34,9 @@ dependencies: - vector - megaparsec - transformers +- hspec-megaparsec +- mtl +- sort ghc-options: - -Wall diff --git a/ressources/day11-input b/ressources/day11-input new file mode 100644 index 0000000..4013e06 --- /dev/null +++ b/ressources/day11-input @@ -0,0 +1,55 @@ +Monkey 0: + Starting items: 52, 78, 79, 63, 51, 94 + Operation: new = old * 13 + Test: divisible by 5 + If true: throw to monkey 1 + If false: throw to monkey 6 + +Monkey 1: + Starting items: 77, 94, 70, 83, 53 + Operation: new = old + 3 + Test: divisible by 7 + If true: throw to monkey 5 + If false: throw to monkey 3 + +Monkey 2: + Starting items: 98, 50, 76 + Operation: new = old * old + Test: divisible by 13 + If true: throw to monkey 0 + If false: throw to monkey 6 + +Monkey 3: + Starting items: 92, 91, 61, 75, 99, 63, 84, 69 + Operation: new = old + 5 + Test: divisible by 11 + If true: throw to monkey 5 + If false: throw to monkey 7 + +Monkey 4: + Starting items: 51, 53, 83, 52 + Operation: new = old + 7 + Test: divisible by 3 + If true: throw to monkey 2 + If false: throw to monkey 0 + +Monkey 5: + Starting items: 76, 76 + Operation: new = old + 4 + Test: divisible by 2 + If true: throw to monkey 4 + If false: throw to monkey 7 + +Monkey 6: + Starting items: 75, 59, 93, 69, 76, 96, 65 + Operation: new = old * 19 + Test: divisible by 17 + If true: throw to monkey 1 + If false: throw to monkey 3 + +Monkey 7: + Starting items: 89 + Operation: new = old + 2 + Test: divisible by 19 + If true: throw to monkey 2 + If false: throw to monkey 4 diff --git a/src/Day10.hs b/src/Day10.hs index 43a7d14..c394b7f 100644 --- a/src/Day10.hs +++ b/src/Day10.hs @@ -10,10 +10,7 @@ module Day10 where import Control.Arrow ((>>>)) -import qualified Data.Matrix as M -import Debug.Trace (trace) import Data.List.Split (chunksOf) -import Data.List (intercalate) data Instruction = Addx Int | Noop deriving (Show, Eq) diff --git a/src/Day11.hs b/src/Day11.hs new file mode 100644 index 0000000..9071494 --- /dev/null +++ b/src/Day11.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Day11 + ( runMonkeyMachine, + mostActiveMonkeys, + monkeyBusiness, + day11, + runPart1Machine, + runPart2Machine, + worryLimit, + divideBy3, + ) +where + +import Control.Monad.State.Strict (execState, get, modify', put) +import qualified Control.Monad.State.Strict as St +import Data.Foldable (forM_, toList) +import Data.List (sortOn) +import Data.Ord (Down (..)) +import Data.Sequence ((|>)) +import qualified Data.Sequence as S +import Data.Text (pack) +import Day11.Parser + +day11 :: IO () +day11 = do + input <- readFile "ressources/day11-input" + putStrLn "Day11" + let monkeys = (monkeyBusiness . mostActiveMonkeys . runPart1Machine . parseMonkeys) (pack input) + putStrLn ("Part 1 monkey business: " ++ show monkeys) + let monkeys' = (monkeyBusiness . mostActiveMonkeys . runPart2Machine . parseMonkeys) (pack input) + putStrLn ("Part 2 monkey business: " ++ show monkeys') + +type MonkeyState = St.State (S.Seq Monkey) + +runPart1Machine :: [Monkey] -> [Monkey] +runPart1Machine = runMonkeyMachine divideBy3 20 + +runPart2Machine :: [Monkey] -> [Monkey] +runPart2Machine monkeys = runMonkeyMachine (worryLimit monkeys) 10000 monkeys + +worryLimit :: [Monkey] -> WorryReducer +worryLimit monkeys = (`mod` limit) + where + limit = product $ map _test monkeys + + +runMonkeyMachine :: WorryReducer -> Int -> [Monkey] -> [Monkey] +runMonkeyMachine eval i monkeys = toList (infiniteMachine !! i) + where + infiniteMachine = iterate go $ S.fromList monkeys + go :: S.Seq Monkey -> S.Seq Monkey + go m = execState go' m + go' :: MonkeyState () + go' = mapM_ (doMonkey eval) [0 .. length monkeys - 1] + +mostActiveMonkeys :: [Monkey] -> [Monkey] +mostActiveMonkeys = take 2 . sortOn (Down . _inspectionCount) + +monkeyBusiness :: [Monkey] -> Int +monkeyBusiness = product . map _inspectionCount + +-- update a sequence of monkeys according to the moves of the monkey at position idx +doMonkey :: WorryReducer -> Int -> MonkeyState () +doMonkey reducer idx = do + horde <- get + let m = horde `S.index` idx + let targets = fmap (evalMonkey reducer m) (_items m) + let m' = m {_items = S.empty, _inspectionCount = _inspectionCount m + S.length (_items m)} + put $ S.update idx m' horde + forM_ targets $ \movement -> + modify' (move movement) + +-- update other monkeys according to a list of calculated moves +move :: (Int, Int) -> S.Seq Monkey -> S.Seq Monkey +move (to, item) horde + | item < 0 = error ("Item worry level overflow: " ++ show (to, item)) + | otherwise = + let m = horde `S.index` to + m' = m {_items = _items m |> item} + in S.update to m' horde + +type WorryReducer = Int -> Int + +divideBy3 :: WorryReducer +divideBy3 = flip div 3 + +evalMonkey :: WorryReducer -> Monkey -> Int -> (Int, Int) +evalMonkey reducer monkey item = (target, newLevel) + where + afterOp = case _operation monkey of + Add Old -> item * 2 + Add (Fixed x) -> item + x + Multiply Old -> item * item + Multiply (Fixed x) -> item * x + newLevel = reducer afterOp + isDivisible = newLevel `mod` _test monkey == 0 + target = + if isDivisible + then _ifDivisible monkey + else _otherwise monkey diff --git a/src/Day11/Parser.hs b/src/Day11/Parser.hs new file mode 100644 index 0000000..e99d4c7 --- /dev/null +++ b/src/Day11/Parser.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE OverloadedStrings #-} +module Day11.Parser ( + parseMonkeys, + Monkey (..), + Operation (..), + Op (..), +) + where + +import Text.Megaparsec +import Text.Megaparsec.Char +import Data.Text (Text) +import Data.Void (Void) +import Control.Monad (void) +import qualified Data.Sequence as S + +type Parser = Parsec Void Text + +data Op = Fixed Int | Old + deriving (Show, Eq) + +data Operation = Add Op | Multiply Op + deriving (Show, Eq) + +data Monkey = Monkey + { _nr :: Int + , _items :: S.Seq Int + , _operation :: Operation + , _test :: Int + , _ifDivisible :: Int + , _otherwise :: Int + , _inspectionCount :: Int } + deriving (Show, Eq) + +parseMonkeys :: Text -> [Monkey] +parseMonkeys input = case parse (monkey `sepBy` void eol) "" input of + Left err -> error (show err) + Right result -> result + +monkey :: Parser Monkey +monkey = do + void (string "Monkey ") + nr <- many numberChar + void (char ':') + void eol + startingItems <- items + operation <- op + d <- divisor + ifDiv <- ifDivisible + ifOther <- ifOtherwise + return Monkey + { _nr=read nr + , _items=S.fromList startingItems + , _operation=operation + , _test=d + , _ifDivisible=ifDiv + , _otherwise=ifOther + , _inspectionCount=0 } + +ifDivisible :: Parser Int +ifDivisible = do + x <- read <$> (string " If true: throw to monkey " >> many numberChar) + void eol + return x + +ifOtherwise :: Parser Int +ifOtherwise = do + x <- read <$> (string " If false: throw to monkey " >> many numberChar) + void eol + return x + +divisor :: Parser Int +divisor = do + d <- read <$> (string " Test: divisible by " >> many numberChar) + void eol + return d + +items :: Parser [Int] +items = do + void (string " Starting items: ") + startingItems <- sepBy1 (many numberChar) (string ", ") + void eol + return (map read startingItems) + +op :: Parser Operation +op = do + o <- void (string " Operation: new = old ") >> addOp <|> mulOp + void eol + return o + where + old = string "old" >> return Old + num = Fixed . read <$> many numberChar + addOp = do + void (string "+ ") + Add <$> (old <|> num) + mulOp = do + void (string "* ") + Multiply <$> (old <|> num) diff --git a/src/Lib.hs b/src/Lib.hs index d91ad39..b3bf374 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -12,9 +12,10 @@ import Day7 (day7) import Day8 (day8) import Day9 (day9) import Day10 (day10) +import Day11 (day11) days :: [IO ()] -days = [day1, day2, day3, day4, day5, day6, day7, day8, day9, day10] +days = [day1, day2, day3, day4, day5, day6, day7, day8, day9, day10, day11] sep :: IO () sep = putStrLn "---------" diff --git a/test/Day11Spec.hs b/test/Day11Spec.hs new file mode 100644 index 0000000..0f57def --- /dev/null +++ b/test/Day11Spec.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +module Day11Spec (spec) where + +import Data.Foldable (toList) +import qualified Data.Sequence as S +import Data.Text (Text) +import Day11 +import Day11.Parser +import Test.Hspec +import Text.Heredoc +import Data.Int (Int64) + +testInput :: Text +testInput = + [str|Monkey 0: + | Starting items: 79, 98 + | Operation: new = old * 19 + | Test: divisible by 23 + | If true: throw to monkey 2 + | If false: throw to monkey 3 + | + |Monkey 1: + | Starting items: 54, 65, 75, 74 + | Operation: new = old + 6 + | Test: divisible by 19 + | If true: throw to monkey 2 + | If false: throw to monkey 0 + | + |Monkey 2: + | Starting items: 79, 60, 97 + | Operation: new = old * old + | Test: divisible by 13 + | If true: throw to monkey 1 + | If false: throw to monkey 3 + | + |Monkey 3: + | Starting items: 74 + | Operation: new = old + 3 + | Test: divisible by 17 + | If true: throw to monkey 0 + | If false: throw to monkey 1 + |] + +exampleMonkeys :: [Monkey] +exampleMonkeys = parseMonkeys testInput + +spec :: Spec +spec = + describe "Day11" $ do + describe "Part1" $ do + it "parses" $ do + head exampleMonkeys `shouldBe` Monkey 0 (S.fromList [79, 98]) (Multiply (Fixed 19)) 23 2 3 0 + _items (exampleMonkeys !! 1) `shouldBe` S.fromList [54, 65, 75, 74] + it "runs part 1 monkey machine for 20 rounds" $ do + let monkeys = runMonkeyMachine divideBy3 20 exampleMonkeys + map _inspectionCount monkeys + `shouldBe` [101, 95, 7, 105] + map _inspectionCount (mostActiveMonkeys monkeys) `shouldBe` [105, 101] + map _nr (mostActiveMonkeys monkeys) `shouldBe` [3, 0] + monkeyBusiness (mostActiveMonkeys monkeys) `shouldBe` 10605 + + it "runs part 2 monkey machine for 10000 rounds" $ do + let monkeys = runMonkeyMachine (worryLimit exampleMonkeys) 10000 exampleMonkeys + map _inspectionCount monkeys + `shouldBe` [52166, 47830, 1938, 52013] + monkeyBusiness (mostActiveMonkeys monkeys) `shouldBe` 2713310158