Day10Part1

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/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

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,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) = "<monkey: " ++ show monkeId ++ ">"
+
+-- 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