Day 11 Part 2

11/Main.idr

@@ -4,7 +4,6 @@ import Data.SnocList
 import Data.String
 import Data.Fin
 import System.File.ReadWrite
-import Debug.Trace
 
 allFins' : (n : Nat) -> List (Fin n)
 allFins' n = toList (allFins'' n)
@@ -34,7 +33,7 @@ Show Error where
 
 record Item where
   constructor MkItem
-  worryLevel : Nat
+  worryLevel : Integer
 
 Show Item where
   show (MkItem worryLevel) = "(worry: " ++ show worryLevel ++ ")"
@@ -56,7 +55,7 @@ parseItems str =
 
 record Test (monkeys : Nat) where
   constructor MkTest
-  divisible_by : Nat
+  divisible_by : Integer
   true_monkey : Fin monkeys
   false_monkey : Fin monkeys
 
@@ -66,7 +65,7 @@ Show (Test monkeys) where
 
 parseTest : {monkeys : Nat } -> Vect 3 String -> Either Error (Test monkeys)
 parseTest {monkeys} input@[line_1, line_2, line_3] =
-  do Just divisible_by <- pure . lineToNat $ line_1
+  do Just divisible_by <- pure . parsePositive . pack . dropWhile (not . isDigit) . unpack $ line_1
        | Nothing => Left error
      Just true_monkey <- pure . (lineToNat >=> finify) $ line_2
        | Nothing => Left error
@@ -87,8 +86,8 @@ applyTest (MkTest divisible_by true_monkey false_monkey) (MkItem worryLevel) =
     else false_monkey
 
 data Operation =
-  Multiply Nat
+  Multiply Integer
-  | Add Nat
+  | Add Integer
   | MultiplySelf
 
 Show Operation where
@@ -172,23 +171,16 @@ parseMonkeys str =
         monkeys <- traverse (parseMonkey {monkeys = count}) vects
         Right (count ** MkMonkeys monkeys)
 
-tag : Show a => String -> a -> a
-tag str = traceValBy (\x => str ++ ": " ++ show x)
-
-appendEnd : a -> Vect n a -> Vect (S n) a
-appendEnd x [] = [x]
-appendEnd x (y :: xs) = y :: appendEnd x xs
-
 throw : Monkeys c -> Item -> Fin c -> Monkeys c
 throw (MkMonkeys monkeys) item idx =
   let monkey@(MkMonkey id item_count items operation test inspected) = index idx monkeys
-      newItems = appendEnd item items
+      newItems = snoc items item
       newMonkey = MkMonkey id (S item_count) newItems operation test inspected
       newMonkeys = replaceAt idx newMonkey monkeys
   in MkMonkeys newMonkeys
 
-turn : Monkeys c -> Fin c -> Monkeys c
+turn : (calmOp : Item -> Item) -> Monkeys c -> Fin c -> Monkeys c
-turn inputMonkeys@(MkMonkeys monkeys) idx =
+turn calmOp inputMonkeys@(MkMonkeys monkeys) idx =
   let inputMonkey@(MkMonkey id item_count items operation test inspected) = index idx monkeys
       (outputMonkey, (MkMonkeys resMonkeys)) = itemsHelper inputMonkey inputMonkeys
       outputMonkeys = replaceAt idx outputMonkey resMonkeys
@@ -197,64 +189,32 @@ turn inputMonkeys@(MkMonkeys monkeys) idx =
         itemsHelper monkey@(MkMonkey id 0 [] operation test inspected) y = (monkey, y)
         itemsHelper monkey@(MkMonkey id (S len) (x :: xs) operation test inspected) y =
           let operated = applyOperation operation x
-              calmed = calmItem operated
+              calmed = calmOp operated
               throwTo = applyTest test calmed
               monkeys = throw y calmed throwTo
           in itemsHelper (assert_smaller monkey (MkMonkey id len xs operation test (S inspected))) monkeys
 
-round : {c : Nat} -> Monkeys c -> Monkeys c
+round : {c : Nat} -> (calmOp : Item -> Item) -> Monkeys c -> Monkeys c
-round {c} input =
+round {c} calmOp input =
   let indexes = allFins' c
-  in foldl turn input indexes
+  in foldl (turn calmOp) input indexes
 
-rounds : {c: Nat} -> (d: Nat) -> Monkeys c -> Vect d (Monkeys c)
+rounds : {c: Nat} -> (d: Nat) -> (calmOp : Item -> Item) -> Monkeys c -> Vect d (Monkeys c)
-rounds 0 x = []
+rounds 0 calmOp x = []
-rounds (S k) x =
+rounds (S k) calmOp x =
-  let newMonkeys = round x
+  let newMonkeys = round calmOp x
-  in newMonkeys :: rounds k newMonkeys
+  in newMonkeys :: rounds k calmOp newMonkeys
-
-simple = """
-  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
-  """
-
-testPart1 : IO ()
-testPart1 =
-  do Right (count ** inputMonkeys) <- pure (parseMonkeys simple)
-       | Left err => printLn err
-     let rounds = rounds 20 inputMonkeys
-     let lastRound = last rounds
-     let activity = foldl (*) 1 . take 2 . reverse . sort . toList . map inspected . monkeys $ lastRound
-     printLn activity
 
 part1 : {c : Nat} -> Monkeys c -> Nat
 part1 x =
-  let rounds = rounds 20 x
+  let rounds = rounds 20 calmItem x
+      lastRound = last rounds
+  in foldl (*) 1 . take 2 . reverse . sort . toList . map inspected . monkeys $ lastRound
+
+part2 : {c : Nat} -> Monkeys c -> Nat
+part2 x =
+  let multiple = product . map divisible_by . map test . monkeys $ x
+      rounds = rounds 10000 (\(MkItem x) => MkItem (x `mod` multiple)) x
       lastRound = last rounds
   in foldl (*) 1 . take 2 . reverse . sort . toList . map inspected . monkeys $ lastRound
 
@@ -264,6 +224,7 @@ main =
        | Left err => printLn err
      Right (count ** monkeys) <- pure (parseMonkeys file)
        | Left err => printLn err
-     printLn monkeys
      putStr "Part 1: "
      printLn (part1 monkeys)
+     putStr "Part 2: "
+     printLn (part2 monkeys)