diff --git a/11/Main.idr b/11/Main.idr index f903991..daeaed9 100644 --- a/11/Main.idr +++ b/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 - | Add Nat + Multiply Integer + | 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 inputMonkeys@(MkMonkeys monkeys) idx = +turn : (calmOp : Item -> Item) -> Monkeys c -> Fin c -> Monkeys c +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} input = +round : {c : Nat} -> (calmOp : Item -> Item) -> Monkeys c -> Monkeys c +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 0 x = [] -rounds (S k) x = - let newMonkeys = round x - in newMonkeys :: rounds k 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 +rounds : {c: Nat} -> (d: Nat) -> (calmOp : Item -> Item) -> Monkeys c -> Vect d (Monkeys c) +rounds 0 calmOp x = [] +rounds (S k) calmOp x = + let newMonkeys = round calmOp x + in newMonkeys :: rounds k calmOp newMonkeys 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)