diff --git a/day11/Day11Part2.hs b/day11/Day11Part2.hs new file mode 100644 index 0000000..a7eb68b --- /dev/null +++ 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 diff --git a/package.yaml b/package.yaml index 243b5db..b6a068c 100644 --- 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 diff --git a/src/Day11Lib.hs b/src/Day11Lib.hs index 6e8abbc..1ee0b38 100644 --- 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) = "" + show Monkey{monkeyId = mId, divisor=d, trueTarget = tT, falseTarget = 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