compile haskell online

Language: Layout:

--Title of this code
--ghc 7.6.3

import qualified Data.Map as M
import qualified Data.List as L(sortBy)

main = print $ map levelWithMaxApples2 [tree1,tree2]

data Fruit = Peach | Apple deriving (Read,Show,Eq)
data BTree a = Empty | Node a (BTree a) (BTree a) deriving (Read,Show,Eq)

tree1 = Node Peach Empty Empty

tree2 = Node Peach 
          (Node Peach
            (Node Apple
              Empty
              Empty)
            (Node Peach
              (Node Peach
                Empty
                Empty)
              (Node Peach
                Empty
                Empty)))
          (Node Apple
            (Node Apple
              Empty
              (Node Peach
                Empty
                Empty))
            Empty)

levelWithMaxApples  :: BTree Fruit -> Int
levelWithMaxApples  Empty = error "Empty tree"
levelWithMaxApples  x = fst $ head $ L.sortBy (\(k1,v1) (k2,v2) -> compare v2 v1) $ M.toList $ M.fromListWith (+) $ countApples' x 0

countApples' :: BTree Fruit -> Int -> [(Int,Int)]
countApples' Empty _ = []
countApples' (Node Apple l r) n = (n,1) : (countApples' l (n+1)) ++ (countApples' r (n+1))
countApples' (Node Peach l r) n = (n,0) : (countApples' l (n+1)) ++ (countApples' r (n+1))

countApples2 :: BTree Fruit -> Int -> M.Map Int Int
countApples2 Empty _ = M.empty
countApples2 (Node Apple l r) n = M.union (M.singleton n 1 ) (M.unionWith (+) (countApples2 l (n+1)) (countApples2 r (n+1))) 
countApples2 (Node Peach l r) n = M.union (M.singleton n 0 ) (M.unionWith (+) (countApples2 l (n+1)) (countApples2 r (n+1)))

countApples2' :: BTree Fruit -> Int -> M.Map Int Int
countApples2' Empty _ = M.empty
countApples2' (Node Apple l r) n = M.unionsWith (+) [(M.singleton n 1 ),(countApples2 l (n+1)),(countApples2 r (n+1))] 
countApples2' (Node Peach l r) n = M.unionsWith (+) [(M.singleton n 0 ),(countApples2 l (n+1)),(countApples2 r (n+1))]

levelWithMaxApples2  :: BTree Fruit -> Int
levelWithMaxApples2 t = fst $ M.foldWithKey (\k v acc@(k',v') -> if v >= v' then (k,v) else acc) (-1,-1) $ countApples2' t 0

Show compiler warnings [ + ] Compiler args [ + ] Show input
Compilation time: 0.62 sec, absolute running time: 0.14 sec, cpu time: 0 sec, memory peak: 4 Mb, absolute service time: 0.77 sec