import System.IO import Data.List import Data.List.Split --import Debug.Trace data Monkey = Monkey { name :: Int , items :: [Integer] , op :: (Integer -> Integer) , cond :: (Integer -> Bool) , dest :: (Bool -> Int) , counter :: Int } instance Show Monkey where show (Monkey n i _ _ _ c) = "Monkey " ++ show n ++ " " ++ show i ++ " " ++ show c instance Eq Monkey where m1 == m2 = (name m1) == (name m2) instance Ord Monkey where compare m1 m2 = compare (counter m1) (counter m2) parseOFunc :: [String] -> (Integer -> Integer) parseOFunc ["+","old"] = (\x -> x + x) parseOFunc ["+",num] = (\x -> x + n) where n = read num :: Integer parseOFunc ["*","old"] = (\x -> x * x) parseOFunc ["*",num] = (\x -> x * n) where n = read num :: Integer parseTFunc :: Integer -> (Integer -> Bool) parseTFunc d = (\x -> (x `mod` d) == 0) parseMonkey :: [String] -> (Monkey,Integer) parseMonkey xs = (Monkey n i o t d 0,t') where n = read [head $ drop 7 (xs !! 0)] :: Int i = map (\x -> read x :: Integer) $ splitOn ", " $ drop 18 (xs !! 1) o = parseOFunc $ splitOn " " $ drop 23 (xs !! 2) t'= read (last $ splitOn " " (xs !! 3)) :: Integer t = parseTFunc t' d'= map (\x -> read (last $ splitOn " " x) :: Int) $ drop 4 xs d = (\x -> if x then head d' else last d') throw :: Monkey -> [(Integer,Int)] -> [Monkey] -> [Monkey] throw (Monkey from _ _ _ de _) throws = map throwMod -- trace ("THROWS: " ++ show throws) where deT = de True deF = de False (thT,thF) = partition (\(_,y) -> y == deT) throws toT = map (\(x,_) -> x) thT toF = map (\(x,_) -> x) thF throwMod m@(Monkey n i o t d c) | n == from = Monkey n [] o t d (c + length throws) | n == deT = Monkey n (i ++ toT) o t d c | n == deF = Monkey n (i ++ toF) o t d c | otherwise = m applyTurn :: Integer -> Integer -> Monkey -> [Monkey] -> [Monkey] applyTurn lcmd wrd m@(Monkey n i o t d _) ms = nms -- trace ("NEW: " ++ show nms) where postInsp = map ((`mod` lcmd) . o) i -- trace ("TURN: " ++ show m) postBore = map (`div` wrd) postInsp postTest = map t postBore throwTo = map d postTest nms = throw m (zip postBore throwTo) ms applyTurns :: Integer -> Integer -> [Monkey] -> [Monkey] -> [Monkey] applyTurns _ _ [] ms = ms applyTurns l wrd (t:ts) ms = applyTurns l wrd ts (applyTurn l wrd (ms !! (name t)) ms) handler :: String -> String handler s = (show p1) ++ "\n" ++ (show p2) ++ "\n" where (monkeys,divisors) = unzip $ map parseMonkey $ splitOn [""] $ lines s lcmd = foldl1 lcm divisors turns = (\nt -> take (nt * length monkeys) $ concat $ repeat monkeys) final1 = applyTurns lcmd 3 (turns 20) monkeys final2 = applyTurns lcmd 1 (turns 10000) monkeys topprod = product . map counter . take 2 . reverse . sort [p1,p2] = map topprod [final1,final2] main :: IO () main = do interact handler