From 00062fcb2a5754e782ec2e52848fb30452d22f97 Mon Sep 17 00:00:00 2001 From: "Jill \"oatmealine\" Monoids" Date: Sun, 11 Dec 2022 16:52:35 +0300 Subject: [PATCH] day 11 part 2 actually worked without optimizations, but i almost made out of ram so i made the optimizations --- 11-a.hs | 150 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 11-b.hs | 153 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 303 insertions(+) create mode 100644 11-a.hs create mode 100644 11-b.hs diff --git a/11-a.hs b/11-a.hs new file mode 100644 index 0000000..75b0504 --- /dev/null +++ b/11-a.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE OverloadedStrings #-} + +import qualified Data.Text as T +import Data.Char (isSpace, isNumber) +import Data.List (find, isPrefixOf, stripPrefix, intercalate, sort) +import Data.Maybe (fromJust) +import Data.List.Split (startsWith, splitOn) +import GHC.Utils.Misc (nTimes) + +{- cabal: +build-depends: base, split +-} + +-- i've been told this needs bigints so i've switched all Ints storing worry values to Integers + +data Operation = Add Integer | Multiply Integer | MultiplySelf + deriving (Show, Eq) + +execOperation :: Operation -> Integer -> Integer +execOperation (Add n) x = x + n +execOperation (Multiply n) x = x * n +execOperation MultiplySelf x = x * x + +newtype Condition = Divisible Integer + deriving (Show, Eq) + +check :: Condition -> Integer -> Bool +check (Divisible n) x = x `mod` n == 0 + +newtype Test = Test (Condition, Int, Int) + deriving (Show, Eq) + +executeTest :: Test -> Integer -> Int +executeTest (Test (cond, a, b)) n = if check cond n then a else b + +data Monkey = Monkey { + monkeyItems :: [Integer], + monkeyOperation :: Operation, + monkeyTest :: Test +} deriving (Show, Eq) + +trim :: String -> String +trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace + +replace :: Int -> a -> [a] -> [a] +replace pos newVal list = take pos list ++ newVal : drop (pos+1) list + +findByPrefix :: String -> [String] -> Maybe String +findByPrefix prefix = find (prefix `isPrefixOf`) + +findByPrefixAndStrip :: String -> [String] -> Maybe String +findByPrefixAndStrip prefix list = do + el <- findByPrefix prefix list + stripPrefix prefix el + +giveMonkeyItem :: Monkey -> Integer -> Monkey +giveMonkeyItem monkey item = Monkey (monkeyItems monkey ++ [item]) (monkeyOperation monkey) (monkeyTest monkey) + +parseMonkey :: String -> Monkey +parseMonkey m = monkey + where + -- let's just assume the dataset isn't malformed, okay................. just This Once, index promise + monkey = Monkey (fromJust parseItems) (fromJust parseOperation) (fromJust parseTest) + + parseItems :: Maybe [Integer] + parseItems = do + itemsStr <- findByPrefixAndStrip "Starting items: " ln + return $ map read $ splitOn "," itemsStr + parseOperation :: Maybe Operation + parseOperation = do + operationStr <- findByPrefixAndStrip "Operation: new = " ln + let [leftHand, op, rightHand] = words operationStr + return $ case op of + "+" -> Add $ read rightHand + "*" -> if rightHand == "old" then MultiplySelf else Multiply $ read rightHand + p -> error $ "Unknown operator " ++ p + parseTest :: Maybe Test + parseTest = do + cond <- parseCondition + outcomeTrue <- parseOutcome "true" + outcomeFalse <- parseOutcome "false" + return $ Test (cond, outcomeTrue, outcomeFalse) + parseCondition :: Maybe Condition + parseCondition = do + conditionStr <- findByPrefixAndStrip "Test: " ln + let w = words conditionStr + nStr <- find (isNumber . head) w + let n = read nStr + return $ case head w of + "divisible" -> Divisible n + cond -> error $ "Unknown condition" ++ cond + parseOutcome :: String -> Maybe Int + parseOutcome s = do + outcomeStr <- findByPrefixAndStrip ("If " ++ s ++ ": ") ln + return $ read $ last $ words outcomeStr + + ln = map trim $ lines m + +parse :: String -> [Monkey] +parse l = map (parseMonkey . unlines . drop 1 . lines . T.unpack) $ T.splitOn "\n\n" $ T.pack l + +-- > The process of each monkey taking a single turn is called a round. +executeRound :: [Monkey] -> [(Monkey, Int)] +executeRound monkeys = foldl executeTurn (zip monkeys (repeat 0)) [0 .. length monkeys - 1] + where + executeTurn :: [(Monkey, Int)] -> Int -> [(Monkey, Int)] + executeTurn monkeys idx = replace idx (newMonkeys !! idx, inspectCount + itemCount) $ zip newMonkeys (map snd monkeys) + where + newMonkeys = processItem (map fst monkeys) idx + itemCount = length $ monkeyItems $ fst $ monkeys !! idx + inspectCount = snd $ monkeys !! idx + + processItem :: [Monkey] -> Int -> [Monkey] + processItem monkeys idx + | null items = monkeys + | otherwise = processItem' + where + items = monkeyItems monkey + operation = monkeyOperation monkey + test = monkeyTest monkey + monkey = monkeys !! idx + + -- processItem' is called when we know the list is not empty. prevents Dumb Errors + processItem' = processItem afterThrowItem idx + where + afterThrowItem = replace throwItemTo (giveMonkeyItem throwItemToMonkey newItem) afterRemoveItem + afterRemoveItem = replace idx (Monkey newItems operation test) monkeys + newItems = tail items + throwItemToMonkey = monkeys !! throwItemTo + throwItemTo = executeTest test newItem + newItem = execOperation operation item `div` 3 + item = head items + +executeRoundAccum :: [(Monkey, Int)] -> [(Monkey, Int)] +executeRoundAccum m = zipWith (\x (m, y) -> (m, x + y)) inspections (executeRound monkeys) + where + monkeys = map fst m + inspections = map snd m + +-- lol +getMonkeyBusiness :: [Int] -> Int +getMonkeyBusiness values = sorted !! 0 * sorted !! 1 + where sorted = reverse $ sort values + +main = interact $ + show + . getMonkeyBusiness . map snd + . nTimes 20 executeRoundAccum + . (\monkeys -> zip monkeys (repeat 0)) + . parse \ No newline at end of file diff --git a/11-b.hs b/11-b.hs new file mode 100644 index 0000000..0a2a133 --- /dev/null +++ b/11-b.hs @@ -0,0 +1,153 @@ +{-# LANGUAGE OverloadedStrings #-} + +import qualified Data.Text as T +import Data.Char (isSpace, isNumber) +import Data.List (find, isPrefixOf, stripPrefix, intercalate, sort) +import Data.Maybe (fromJust) +import Data.List.Split (startsWith, splitOn) +import GHC.Utils.Misc (nTimes) + +{- cabal: +build-depends: base, split +-} + +-- i've been told this needs bigints so i've switched all Ints storing worry values to Integers + +data Operation = Add Integer | Multiply Integer | MultiplySelf + deriving (Show, Eq) + +execOperation :: Operation -> Integer -> Integer +execOperation (Add n) x = x + n +execOperation (Multiply n) x = x * n +execOperation MultiplySelf x = x * x + +-- part 2 optimization checks mean that this can only be Divisible, sorry! +newtype Condition = Divisible Integer + deriving (Show, Eq) + +check :: Condition -> Integer -> Bool +check (Divisible n) x = x `mod` n == 0 + +newtype Test = Test (Condition, Int, Int) + deriving (Show, Eq) + +executeTest :: Test -> Integer -> Int +executeTest (Test (cond, a, b)) n = if check cond n then a else b + +data Monkey = Monkey { + monkeyItems :: [Integer], + monkeyOperation :: Operation, + monkeyTest :: Test +} deriving (Show, Eq) + +trim :: String -> String +trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace + +replace :: Int -> a -> [a] -> [a] +replace pos newVal list = take pos list ++ newVal : drop (pos+1) list + +findByPrefix :: String -> [String] -> Maybe String +findByPrefix prefix = find (prefix `isPrefixOf`) + +findByPrefixAndStrip :: String -> [String] -> Maybe String +findByPrefixAndStrip prefix list = do + el <- findByPrefix prefix list + stripPrefix prefix el + +giveMonkeyItem :: Monkey -> Integer -> Monkey +giveMonkeyItem monkey item = Monkey (monkeyItems monkey ++ [item]) (monkeyOperation monkey) (monkeyTest monkey) + +parseMonkey :: String -> Monkey +parseMonkey m = monkey + where + -- let's just assume the dataset isn't malformed, okay................. just This Once, index promise + monkey = Monkey (fromJust parseItems) (fromJust parseOperation) (fromJust parseTest) + + parseItems :: Maybe [Integer] + parseItems = do + itemsStr <- findByPrefixAndStrip "Starting items: " ln + return $ map read $ splitOn "," itemsStr + parseOperation :: Maybe Operation + parseOperation = do + operationStr <- findByPrefixAndStrip "Operation: new = " ln + let [leftHand, op, rightHand] = words operationStr + return $ case op of + "+" -> Add $ read rightHand + "*" -> if rightHand == "old" then MultiplySelf else Multiply $ read rightHand + p -> error $ "Unknown operator " ++ p + parseTest :: Maybe Test + parseTest = do + cond <- parseCondition + outcomeTrue <- parseOutcome "true" + outcomeFalse <- parseOutcome "false" + return $ Test (cond, outcomeTrue, outcomeFalse) + parseCondition :: Maybe Condition + parseCondition = do + conditionStr <- findByPrefixAndStrip "Test: " ln + let w = words conditionStr + nStr <- find (isNumber . head) w + let n = read nStr + return $ case head w of + "divisible" -> Divisible n + cond -> error $ "Unknown condition" ++ cond + parseOutcome :: String -> Maybe Int + parseOutcome s = do + outcomeStr <- findByPrefixAndStrip ("If " ++ s ++ ": ") ln + return $ read $ last $ words outcomeStr + + ln = map trim $ lines m + +parse :: String -> [Monkey] +parse l = map (parseMonkey . unlines . drop 1 . lines . T.unpack) $ T.splitOn "\n\n" $ T.pack l + +-- > The process of each monkey taking a single turn is called a round. +executeRound :: [Monkey] -> [(Monkey, Int)] +executeRound monkeys = foldl executeTurn (zip monkeys (repeat 0)) [0 .. length monkeys - 1] + where + executeTurn :: [(Monkey, Int)] -> Int -> [(Monkey, Int)] + executeTurn monkeys idx = replace idx (newMonkeys !! idx, inspectCount + itemCount) $ zip newMonkeys (map snd monkeys) + where + newMonkeys = processItem (map fst monkeys) idx + itemCount = length $ monkeyItems $ fst $ monkeys !! idx + inspectCount = snd $ monkeys !! idx + + processItem :: [Monkey] -> Int -> [Monkey] + processItem monkeys idx + | null items = monkeys + | otherwise = processItem' + where + items = monkeyItems monkey + operation = monkeyOperation monkey + test = monkeyTest monkey + monkey = monkeys !! idx + + -- processItem' is called when we know the list is not empty. prevents Dumb Errors + processItem' = processItem afterThrowItem idx + where + afterThrowItem = replace throwItemTo (giveMonkeyItem throwItemToMonkey newItem) afterRemoveItem + afterRemoveItem = replace idx (Monkey newItems operation test) monkeys + newItems = tail items + throwItemToMonkey = monkeys !! throwItemTo + throwItemTo = executeTest test newItem + newItem = execOperation operation item `mod` worryLimit + item = head items + -- bit ugly but it's alright + worryLimit = product $ map ((\(Test (Divisible n, _, _)) -> n) . monkeyTest) monkeys + +executeRoundAccum :: [(Monkey, Int)] -> [(Monkey, Int)] +executeRoundAccum m = zipWith (\x (m, y) -> (m, x + y)) inspections (executeRound monkeys) + where + monkeys = map fst m + inspections = map snd m + +-- lol +getMonkeyBusiness :: [Int] -> Int +getMonkeyBusiness values = sorted !! 0 * sorted !! 1 + where sorted = reverse $ sort values + +main = interact $ + show + . getMonkeyBusiness . map snd + . nTimes 10000 executeRoundAccum + . (\monkeys -> zip monkeys (repeat 0)) + . parse \ No newline at end of file