Do the modulos good

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

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/Day11Lib.hs

@@ -1,6 +1,5 @@
 module Day11Lib where
 
-import Debug.Trace
 import Data.Char (isDigit)
 import Data.List (sort)
 import Data.List.Split (splitOn)
@@ -11,15 +10,18 @@ type Worry = Int
 type Item = Int
 type Target = Int
 type Inspections = Int
+type WorryBound = Int
 
 data Monkey = Monkey
     { monkeyId :: Target
     , worryFunction :: (Worry -> Worry)
-    -- , testFunction :: (Worry -> Target)
     , divisor :: Int
+    , trueTarget :: Int
+    , falseTarget :: Int
     }
 instance Show Monkey where
-    show (Monkey monkeId b c) = "<monkey: " ++ show monkeId ++ ">"
+    show Monkey{monkeyId = mId, divisor=d, trueTarget = tT, falseTarget = fT} =
+        "<monkey: " ++ show mId ++ " d: " ++ show d ++ " tT: " ++ show tT ++ " fT: " ++ show fT ++ ">"
 
 -- PARSING
 
@@ -51,23 +53,14 @@ parseWorryFunction s
 getValue:: String -> String
 getValue x = last $ splitOn ": " x
 
-parseTest :: String -> (Worry -> Bool)
+parseTestFunction :: String -> (Int, Target, Target)
-parseTest s = \x -> x `mod` divisibleBy == 0
+parseTestFunction s = (divisibleBy, trueValue, falseValue)
-    where
-        divisibleBy = convertToInt $ last $ words s
-
--- Take last element of the string and convert it to an int
--- Ex: throw to monkey 2 returns '2'
-parseTestResult :: String -> Target
-parseTestResult s = convertToInt $ last $ words s 
-
-parseTestFunction :: String -> (Worry -> Target)
-parseTestFunction s = \w -> if testValue w then trueValue else falseValue
     where
         sLines = lines s
-        testValue = parseTest $ getValue $ head sLines
+        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)
@@ -76,8 +69,8 @@ parseMonkey i = (parsedMonkey, parsedItems, 0)
         parsedItems = map convertToInt $ splitOn "," $ getValue (iSplitOnLines !! 1)
         parsedId = convertToInt $ filter isDigit $ last $ words $ head iSplitOnLines
         parsedWorryFunction = parseWorryFunction $ getValue (iSplitOnLines !! 2)
-        parsedTestFunction = parseTestFunction $ unlines [iSplitOnLines !! 3, iSplitOnLines !! 4, iSplitOnLines !! 5]
+        (pDivisor, pTrueTarget, pFalseTarget) = parseTestFunction $ unlines [iSplitOnLines !! 3, iSplitOnLines !! 4, iSplitOnLines !! 5]
-        parsedMonkey = Monkey { monkeyId = parsedId, worryFunction = parsedWorryFunction, testFunction = parsedTestFunction}
+        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
@@ -86,11 +79,11 @@ parseInput i = map parseMonkey $ splitOn "\n\n" i
 
 processThrow :: [(Monkey, [Item], Inspections)] -> (Target, Item) -> [(Monkey, [Item], Inspections)] 
 processThrow [] (target, item) = error "It should never get here"
-processThrow (ms@(m@(Monkey monkeId _ _), items, inspections):[]) (target, item) =
+processThrow (ms@(m@(Monkey{monkeyId = monkeId}), items, inspections):[]) (target, item) =
     if monkeId == target
     then [(m, items ++ [item], inspections)]
     else [ms]
-processThrow (ms@(m@(Monkey monkeId _ _), items, inspections):monkeys) (target, item) =
+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)
@@ -100,24 +93,36 @@ 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 testF), items, inspections) = 
+processMonkeyForRound (monke@(Monkey monkeId worryF d tT fT), items, inspections) = 
-    -- trace ("\nMonke is " ++ show monke ++ "\n startingItems: " ++ show items ++ "\n thrownItems" ++ show thrownItems ++ "\n\n\n")
     (monke, thrownItems, newInspectionCount)
     where
         newInspectionCount = inspections + length items
         newItems = map (inspect monke) items
-        itemTargets = map testF newItems
+        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@(Monkey _ _ _), items, inspections):monkeys) newMs =
+processRound' ms@((m, items, inspections):monkeys) newMs =
-    -- trace ("\nNew monkey list is: " ++ show newMonkeyList ++ "\nAfter throws: " ++ show realNewMonkeyList ++
-    --        "\nNext Turn to Process: " ++ show nextTurnToProcess ++ "\n\n\n" ++ 
-    --        "State In: " ++ show (newMs ++ ms) ++ "\nState out" ++ show (realNewMonkeyList ++ nextTurnToProcess))
     (processRound' nextTurnToProcess realNewMonkeyList)
     where
         (newM, throwList, newInspections) = processMonkeyForRound (m, items, inspections)
@@ -127,6 +132,27 @@ processRound' ms@((m@(Monkey _ _ _), items, inspections):monkeys) newMs =
         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 []
 
@@ -136,19 +162,39 @@ rounds' inputState previousState = thisRound : (rounds' thisRound newPreviousSta
         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 _ worryF _) item = relief $ worryF 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 = take 2 $ reverse $ sort inspections
+        topTwoInspections = map fromIntegral $ take 2 $ reverse $ sort inspections
 
 day11 :: String -> Integer
 day11 input = monkeyBusinessResult
@@ -157,3 +203,11 @@ day11 input = monkeyBusinessResult
         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