day11 part1 (and part2 if i had infinite RAM)

Makefile

@@ -1,4 +1,4 @@
-DAY = 7
+DAY = 11
 
 DIR = day$(DAY)
 

day11/main.hs

@@ -0,0 +1,97 @@
+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
+
+