Do the modulos good

2022-12-11 19:11:58 -05:00 · 2022-12-11 19:11:58 -05:00 · 0ecaa576a3
commit 0ecaa576a3
parent 9ff03d18b2
3 changed files with 118 additions and 29 deletions
--- a/day11/Day11Part2.hs
+++ b/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
--- a/package.yaml
+++ b/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
--- a/src/Day11Lib.hs
+++ b/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)
-parseTest s = \x -> x `mod` divisibleBy == 0
-    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
+parseTestFunction :: String -> (Int, Target, Target)
+parseTestFunction s = (divisibleBy, trueValue, 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]
-        parsedMonkey = Monkey { monkeyId = parsedId, worryFunction = parsedWorryFunction, testFunction = parsedTestFunction}
+        (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
@ -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) = 
-    -- trace ("\nMonke is " ++ show monke ++ "\n startingItems: " ++ show items ++ "\n thrownItems" ++ show thrownItems ++ "\n\n\n")
+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 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 =
-    -- 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' ms@((m, items, inspections):monkeys) newMs =
    (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