BinaryTree.hs

data Tree a = Empty | Leaf a | Tree a (Tree a) (Tree a) deriving Show


treeInsert :: Ord a => a -> Tree a -> Tree a
treeInsert n Empty = Leaf n
treeInsert n (Leaf m)
    | n <= m = Tree m (Leaf n) Empty
    | n >  m = Tree n (Leaf m) Empty
treeInsert n (Tree v left right)
    | n == v = Tree n left right
    | n <  v = Tree v (treeInsert n left) right
    | n >  v = Tree v left (treeInsert n right)


treeElem :: Ord a => a -> Tree a -> Bool
treeElem x Empty = False
treeElem x (Leaf y) = x == y
treeElem x (Tree y left right)
    | x == y = True
    | x <  y = treeElem x left
    | x >  y = treeElem x right


fromList :: Ord a => [a] -> Tree a
fromList [] = Empty
fromList xs = foldl (flip treeInsert) Empty xs


toList :: Ord a => Tree a -> [a]
toList Empty = []
toList (Leaf x) = [x]
toList (Tree v left right) = v : toList left ++ toList right


treeBalance :: Ord a => Tree a -> Tree a
treeBalance Empty = Empty
treeBalance ts = tb $ sort' $ toList ts
    where
        tb xs = let pos   = (length xs) `div` 2
                    pivot = xs !! pos
                    newxs = take pos xs ++ drop (pos + 1) xs
                 in foldl (flip treeInsert) (Leaf pivot) newxs


sort' :: (Ord a) => [a] -> [a]
sort' [] = []
sort' (pivot:xs) =
    sort' (filter (<pivot) xs)
    ++ [pivot]
    ++ sort' (filter (>=pivot) xs)