98 lines
3.0 KiB
Haskell
98 lines
3.0 KiB
Haskell
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 :: String -> (Integer -> Bool)
|
|
parseTFunc divi = (\x -> (x `mod` d) == 0) where d = read divi :: Integer
|
|
|
|
parseMonkey :: [String] -> Monkey
|
|
parseMonkey xs = Monkey n i o t d 0
|
|
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 = parseTFunc $ last $ splitOn " " (xs !! 3)
|
|
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 -> Monkey -> [Monkey] -> [Monkey]
|
|
applyTurn wrd m@(Monkey n i o t d _) ms = nms -- trace ("NEW: " ++ show nms)
|
|
where
|
|
postInsp = map 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 -> [Monkey] -> [Monkey] -> [Monkey]
|
|
applyTurns _ [] ms = ms
|
|
applyTurns wrd (t:ts) ms = applyTurns wrd ts (applyTurn wrd (ms !! (name t)) ms)
|
|
|
|
|
|
|
|
|
|
|
|
handler :: String -> String
|
|
handler s = (show p1) ++ "\n" ++
|
|
(show p2) ++ "\n"
|
|
where
|
|
monkeys = map parseMonkey $ splitOn [""] $ lines s
|
|
turns = (\nt -> take (nt * length monkeys) $ concat $ repeat monkeys)
|
|
final1 = applyTurns 3 (turns 20) monkeys
|
|
final2 = applyTurns 1 (turns 10000) monkeys
|
|
topprod = product . map counter . take 2 . reverse . sort
|
|
[p1,p2] = map topprod [final1,final2]
|
|
|
|
main :: IO ()
|
|
main = do
|
|
interact handler
|
|
|
|
|