Do the modulos good

day11/Day11Part1.hs

@@ -0,0 +1,11 @@
+module Day11Part1 (main) where
+
+import Day11Lib
+
+convertToString :: Integer -> String
+convertToString i = show i
+
+main :: IO ()
+main = do
+  contents <- getContents
+  putStrLn $ convertToString $ day11 contents

day11/Day11Part2.hs

@@ -0,0 +1,11 @@
+module Day11Part2 (main) where
+
+import Day11Lib
+
+convertToString :: Integer -> String
+convertToString i = show i
+
+main :: IO ()
+main = do
+  contents <- getContents
+  putStrLn $ convertToString $ day11' contents

day11/input

@@ -0,0 +1,55 @@
+Monkey 0:
+  Starting items: 98, 97, 98, 55, 56, 72
+  Operation: new = old * 13
+  Test: divisible by 11
+    If true: throw to monkey 4
+    If false: throw to monkey 7
+
+Monkey 1:
+  Starting items: 73, 99, 55, 54, 88, 50, 55
+  Operation: new = old + 4
+  Test: divisible by 17
+    If true: throw to monkey 2
+    If false: throw to monkey 6
+
+Monkey 2:
+  Starting items: 67, 98
+  Operation: new = old * 11
+  Test: divisible by 5
+    If true: throw to monkey 6
+    If false: throw to monkey 5
+
+Monkey 3:
+  Starting items: 82, 91, 92, 53, 99
+  Operation: new = old + 8
+  Test: divisible by 13
+    If true: throw to monkey 1
+    If false: throw to monkey 2
+
+Monkey 4:
+  Starting items: 52, 62, 94, 96, 52, 87, 53, 60
+  Operation: new = old * old
+  Test: divisible by 19
+    If true: throw to monkey 3
+    If false: throw to monkey 1
+
+Monkey 5:
+  Starting items: 94, 80, 84, 79
+  Operation: new = old + 5
+  Test: divisible by 2
+    If true: throw to monkey 7
+    If false: throw to monkey 0
+
+Monkey 6:
+  Starting items: 89
+  Operation: new = old + 1
+  Test: divisible by 3
+    If true: throw to monkey 0
+    If false: throw to monkey 5
+
+Monkey 7:
+  Starting items: 70, 59, 63
+  Operation: new = old + 3
+  Test: divisible by 7
+    If true: throw to monkey 4
+    If false: throw to monkey 3

package.yaml

@@ -279,6 +279,30 @@ executables:
     dependencies:
     - aoc2022
 
+  Day11Part1:
+    main:                Day11Part1.hs
+    other-modules:       []
+    source-dirs:         day11
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    - -main-is Day11Part1
+    dependencies:
+    - aoc2022
+
+  Day11Part2:
+    main:                Day11Part2.hs
+    other-modules:       []
+    source-dirs:         day11
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    - -main-is Day11Part2
+    dependencies:
+    - aoc2022
+
 tests:
   Day1-test:
     main:                Day1.hs

src/Day10Lib.hs

@@ -1,4 +1,7 @@
-module Day10Lib where
+module Day10Lib
+    ( day10
+    , day10'
+    ) where
 
 import Data.List (transpose)
 

src/Day11Lib.hs

@@ -0,0 +1,213 @@
+module Day11Lib where
+
+import Data.Char (isDigit)
+import Data.List (sort)
+import Data.List.Split (splitOn)
+import Data.Map (Map)
+import qualified Data.Map as M
+
+type Worry = Int
+type Item = Int
+type Target = Int
+type Inspections = Int
+type WorryBound = Int
+
+data Monkey = Monkey
+    { monkeyId :: Target
+    , worryFunction :: (Worry -> Worry)
+    , divisor :: Int
+    , trueTarget :: Int
+    , falseTarget :: Int
+    }
+instance Show Monkey where
+    show Monkey{monkeyId = mId, divisor=d, trueTarget = tT, falseTarget = fT} =
+        "<monkey: " ++ show mId ++ " d: " ++ show d ++ " tT: " ++ show tT ++ " fT: " ++ show fT ++ ">"
+
+-- PARSING
+
+convertToInt :: String -> Int
+convertToInt s = read s :: Int
+
+parseOperator ::  Char -> (Int -> Int -> Int)
+parseOperator '+' = (+)
+parseOperator '-' = (-)
+parseOperator '*' = (*)
+parseOperator '/' = div
+parseOperator otherwise = error "Oops invalid operator, this shouldn't happen"
+
+parseWorryFunction :: String -> (Worry -> Worry)
+parseWorryFunction s
+    | arg1 == "old" && arg2 == "old" = \x -> x `operator` x
+    | arg1 /= "old" && arg2 == "old" = \x -> (convertToInt arg1) `operator` x
+    | arg1 == "old" && arg2 /= "old" = \x -> x `operator` (convertToInt arg2)
+    | arg1 /= "old" && arg2 == "old" = \x -> (convertToInt arg1) `operator` (convertToInt arg2)
+    | otherwise = error "Oops invalid worry function, this shouldn't happen"
+    where
+        equation = last $ splitOn "=" s
+        equationWords = words equation
+        arg1 = head equationWords
+        arg2 = last equationWords
+        operator = parseOperator $ head (equationWords !! 1)
+
+-- Helper function to parse value from a line
+getValue:: String -> String
+getValue x = last $ splitOn ": " x
+
+parseTestFunction :: String -> (Int, Target, Target)
+parseTestFunction s = (divisibleBy, trueValue, falseValue)
+    where
+        sLines = lines s
+        divisibleBy = convertToInt $ last $ words $ getValue $ head sLines
+        trueValue = parseTestResult $ getValue (sLines !! 1)
+        falseValue = parseTestResult $ getValue (sLines !! 2)
+        parseTestResult = \s -> convertToInt $ last $ words s 
+
+parseMonkey :: String -> (Monkey, [Item], Inspections)
+parseMonkey i = (parsedMonkey, parsedItems, 0)
+    where
+        iSplitOnLines = lines i
+        parsedItems = map convertToInt $ splitOn "," $ getValue (iSplitOnLines !! 1)
+        parsedId = convertToInt $ filter isDigit $ last $ words $ head iSplitOnLines
+        parsedWorryFunction = parseWorryFunction $ getValue (iSplitOnLines !! 2)
+        (pDivisor, pTrueTarget, pFalseTarget) = parseTestFunction $ unlines [iSplitOnLines !! 3, iSplitOnLines !! 4, iSplitOnLines !! 5]
+        parsedMonkey = Monkey { monkeyId = parsedId, worryFunction = parsedWorryFunction, divisor = pDivisor, trueTarget = pTrueTarget, falseTarget = pFalseTarget}
+
+parseInput :: String -> [(Monkey, [Item], Inspections)]
+parseInput i = map parseMonkey $ splitOn "\n\n" i
+
+-- PROCESSING
+
+processThrow :: [(Monkey, [Item], Inspections)] -> (Target, Item) -> [(Monkey, [Item], Inspections)] 
+processThrow [] (target, item) = error "It should never get here"
+processThrow (ms@(m@(Monkey{monkeyId = monkeId}), items, inspections):[]) (target, item) =
+    if monkeId == target
+    then [(m, items ++ [item], inspections)]
+    else [ms]
+processThrow (ms@(m@(Monkey{monkeyId = monkeId}), items, inspections):monkeys) (target, item) =
+    if monkeId == target
+    then (m, items ++ [item], inspections) : monkeys
+    else ms : processThrow monkeys (target, item)
+
+processThrowList :: [(Monkey, [Item], Inspections)] -> [(Target, Item)] -> [(Monkey, [Item], Inspections)]
+processThrowList monkeyList [] = monkeyList
+processThrowList monkeyList (throw:throws) = processThrowList (processThrow monkeyList throw) throws
+
+processMonkeyForRound :: (Monkey, [Item], Inspections) -> (Monkey, [(Target, Item)], Inspections)
+processMonkeyForRound (monke@(Monkey monkeId worryF d tT fT), items, inspections) = 
+    (monke, thrownItems, newInspectionCount)
+    where
+        newInspectionCount = inspections + length items
+        newItems = map (inspect monke) items
+        itemTargets = map testFunction newItems
+        thrownItems = zip itemTargets newItems
+        testFunction = \x -> if x `mod` d == 0
+                             then tT 
+                             else fT
+
+processMonkeyForRound' :: WorryBound -> (Monkey, [Item], Inspections) -> (Monkey, [(Target, Item)], Inspections)
+processMonkeyForRound' worrybound (monke@(Monkey monkeId worryF d tT fT), items, inspections) = 
+    (monke, thrownItems, newInspectionCount)
+    where
+        newInspectionCount = inspections + length items
+        newItems = map (inspectAlter worrybound monke) items
+        itemTargets = map testFunction newItems
+        thrownItems = zip itemTargets newItems
+        testFunction = \x -> if x `mod` d == 0
+                             then tT 
+                             else fT
+
+-- part 1
+processRound :: [(Monkey, [Item], Inspections)] -> [(Monkey, [Item], Inspections)]
+processRound ms = processRound' ms []
+
+processRound' :: [(Monkey, [Item], Inspections)] -> [(Monkey, [Item], Inspections)] -> [(Monkey, [Item], Inspections)]
+processRound' [] newMs = newMs
+processRound' ms@((m, items, inspections):monkeys) newMs =
+    (processRound' nextTurnToProcess realNewMonkeyList)
+    where
+        (newM, throwList, newInspections) = processMonkeyForRound (m, items, inspections)
+        newMonkey = (newM, [], newInspections)
+        newMonkeyList = newMs ++ [newMonkey]
+        throwProcessedList = processThrowList (newMonkeyList ++ monkeys) throwList
+        nextTurnToProcess = drop (length newMonkeyList) throwProcessedList
+        realNewMonkeyList = take (length newMonkeyList) throwProcessedList
+
+processRoundAlter :: [(Monkey, [Item], Inspections)] -> [(Monkey, [Item], Inspections)]
+processRoundAlter ms = processRoundAlter' wb ms []
+    where
+        monkeyInspector = \(a,b,c) -> a
+        monkeys = map monkeyInspector ms
+        wb = getWorryBound monkeys
+    
+
+processRoundAlter' :: WorryBound -> [(Monkey, [Item], Inspections)] -> [(Monkey, [Item], Inspections)] -> [(Monkey, [Item], Inspections)]
+processRoundAlter' _ [] newMs = newMs
+processRoundAlter' wb ms@((m, items, inspections):monkeys) newMs =
+    (processRoundAlter' wb nextTurnToProcess realNewMonkeyList)
+    where
+        (newM, throwList, newInspections) = processMonkeyForRound' wb (m, items, inspections)
+        newMonkey = (newM, [], newInspections)
+        newMonkeyList = newMs ++ [newMonkey]
+        throwProcessedList = processThrowList (newMonkeyList ++ monkeys) throwList
+        nextTurnToProcess = drop (length newMonkeyList) throwProcessedList
+        realNewMonkeyList = take (length newMonkeyList) throwProcessedList
+
+-- part 1
+rounds :: [(Monkey, [Item], Inspections)] -> [[(Monkey, [Item], Inspections)]]
+rounds inputState = rounds' inputState []
+
+rounds' :: [(Monkey, [Item], Inspections)] -> [[(Monkey, [Item], Inspections)]] -> [[(Monkey, [Item], Inspections)]]
+rounds' inputState previousState = thisRound : (rounds' thisRound newPreviousState)
+    where
+        thisRound = processRound inputState
+        newPreviousState = thisRound : previousState
+
+-- part 2
+roundsAlter :: [(Monkey, [Item], Inspections)] -> [[(Monkey, [Item], Inspections)]]
+roundsAlter inputState = roundsAlter' inputState []
+
+roundsAlter' :: [(Monkey, [Item], Inspections)] -> [[(Monkey, [Item], Inspections)]] -> [[(Monkey, [Item], Inspections)]]
+roundsAlter' inputState previousState = thisRound : (roundsAlter' thisRound newPreviousState)
+    where
+        thisRound = processRoundAlter inputState
+        newPreviousState = thisRound : previousState
+
+
+relief :: Worry -> Worry
+relief w = w `div` 3
+
+inspect :: Monkey -> Item -> Item
+inspect Monkey{worryFunction = worryF} item = relief $ worryF item
+
+inspectAlter :: WorryBound -> Monkey -> Item -> Item
+inspectAlter wb Monkey{worryFunction = worryF} item =
+    worryMitigationApplied
+        where
+            worriedItem = worryF item 
+            worryMitigationApplied = worriedItem `mod` wb
+
+getWorryBound :: [Monkey] -> Int
+getWorryBound monkeys = product $ map divisor monkeys
+
+monkeyBusiness :: [(Monkey, [Item], Inspections)] -> Integer
+monkeyBusiness monkeys = foldl (*) 1 topTwoInspections
+    where
+        inspectionPeeler = \(x,y,z) -> z
+        inspections = map inspectionPeeler monkeys
+        topTwoInspections = map fromIntegral $ take 2 $ reverse $ sort inspections
+
+day11 :: String -> Integer
+day11 input = monkeyBusinessResult
+    where
+        monkeys = parseInput input
+        allRounds = rounds monkeys
+        twentiethRound = allRounds !! 19
+        monkeyBusinessResult = monkeyBusiness twentiethRound
+
+day11' :: String -> Integer
+day11' input = monkeyBusinessResult
+    where
+        monkeys = parseInput input
+        allRounds = roundsAlter monkeys
+        tenThousandthRound = allRounds !! 9999
+        monkeyBusinessResult = monkeyBusiness tenThousandthRound