day11 part 2

day11/main.hs

@@ -32,16 +32,17 @@ 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
+parseTFunc :: Integer -> (Integer -> Bool)
+parseTFunc d = (\x -> (x `mod` d) == 0)
 
-parseMonkey :: [String] -> Monkey
-parseMonkey xs = Monkey n i o t 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 = parseTFunc $ last $ splitOn " " (xs !! 3)
+        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')
 
@@ -62,18 +63,18 @@ throw (Monkey from _ _ _ de _) throws = map throwMod -- trace ("THROWS: " ++ sho
             | 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)
+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 o i -- trace ("TURN: " ++ show m)
+        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 -> [Monkey] -> [Monkey] -> [Monkey]
-applyTurns _ [] ms = ms
-applyTurns wrd (t:ts) ms = applyTurns wrd ts (applyTurn wrd (ms !! (name t)) 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)
 
 
 
@@ -83,10 +84,11 @@ handler :: String -> String
 handler s = (show p1) ++ "\n" ++
             (show p2) ++ "\n"
     where
-        monkeys = map parseMonkey $ splitOn [""] $ lines s
+        (monkeys,divisors) = unzip $ map parseMonkey $ splitOn [""] $ lines s
+        lcmd    = foldl1 lcm divisors
         turns   = (\nt -> take (nt * length monkeys) $ concat $ repeat monkeys)
-        final1  = applyTurns 3 (turns 20) monkeys
-        final2  = applyTurns 1 (turns 10000) 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]