diff --git a/day11/Day11Part1.hs b/day11/Day11Part1.hs new file mode 100644 index 0000000..409d440 --- /dev/null +++ b/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 diff --git a/day11/input b/day11/input new file mode 100644 index 0000000..d831dc0 --- /dev/null +++ b/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 diff --git a/src/Day10Lib.hs b/src/Day10Lib.hs index 00cab3f..83c9b6e 100644 --- a/src/Day10Lib.hs +++ b/src/Day10Lib.hs @@ -1,4 +1,7 @@ -module Day10Lib where +module Day10Lib + ( day10 + , day10' + ) where import Data.List (transpose) diff --git a/src/Day11Lib.hs b/src/Day11Lib.hs new file mode 100644 index 0000000..6e8abbc --- /dev/null +++ b/src/Day11Lib.hs @@ -0,0 +1,159 @@ +module Day11Lib where + +import Debug.Trace +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 + +data Monkey = Monkey + { monkeyId :: Target + , worryFunction :: (Worry -> Worry) + -- , testFunction :: (Worry -> Target) + , divisor :: Int + } +instance Show Monkey where + show (Monkey monkeId b c) = "" + +-- 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 + +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 + where + sLines = lines s + testValue = parseTest $ getValue $ head sLines + trueValue = parseTestResult $ getValue (sLines !! 1) + falseValue = parseTestResult $ getValue (sLines !! 2) + +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) + parsedTestFunction = parseTestFunction $ unlines [iSplitOnLines !! 3, iSplitOnLines !! 4, iSplitOnLines !! 5] + parsedMonkey = Monkey { monkeyId = parsedId, worryFunction = parsedWorryFunction, testFunction = parsedTestFunction} + +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 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) = + 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 testF), 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 + thrownItems = zip itemTargets newItems + +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' 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 + +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 + + +relief :: Worry -> Worry +relief w = w `div` 3 + +inspect :: Monkey -> Item -> Item +inspect (Monkey _ worryF _) item = relief $ worryF item + +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 + +day11 :: String -> Integer +day11 input = monkeyBusinessResult + where + monkeys = parseInput input + allRounds = rounds monkeys + twentiethRound = allRounds !! 19 + monkeyBusinessResult = monkeyBusiness twentiethRound