In Haskell, how to generate a perfectly balanced binary search tree?

Question

The function should takes a list xs and constructs a balanced binary search tree consisting of exactly the same set of elements as xs.

The result should be like this: (if the list is [1,2,3,4,5,6,7,8])

Node (Node (Node (Node Empty 1 Empty) 2 Empty) 4 (Node Empty 4 Empty)) 5 (Node (Node Empty 6 Empty) 7 (Node Empty 8 Empty))

that is to say the tree should look like this:

                5
               / \
              3   7
             / \ / \
            2  4 6  8
           /
          1

rather than this:

                5
               / \
              4   6
             /     \
            3       7
           /         \
          2           8
         /
        1

Could anybody tell me how to do this? I find I can do the second tree which is not perfectly balanced, but don't know how to do the first one.

I appreciate any help!! Thank you in advance!

Answer 1

Sort the input list. Now create a tree whose root node is the middle element of the list, and whose left and right subtrees are the subtrees generated by applying this process to the sublists to the left and right of the center, respectively.

In Haskell:

buildBalanced []   = Empty
buildBalanced elts = Node (buildBalanced $ take half elts) 
                          (elts !! half) 
                          (buildBalanced $ drop (half+1) elts)
    where half = length elts `quot` 2

main = putStrLn $ show $ buildBalanced [1,2,3,4,5,6,7,8]
-- prints Node (Node (Node (Node Empty 1 Empty) 2 Empty) 3 (Node Empty 4 Empty)) 5 (Node (Node Empty 6 Empty) 7 (Node Empty 8 Empty))

Answer 2

If the top of the tree must be the middle element:

mkBalanced [] = Empty
mkBalanced xs = Node mid (mkBalanced half0) (mkBalanced half1)
    where (half0, half') = splitAt ((length xs `div` 2) - 1) xs
          half1 = tail half'
          mid = head half'

If not:

mkBalanced [] = Empty
mkBalanced (x:xs) = Node x (mkBalanced half0) (mkBalanced half1)
    where (half0, half1) = splitAt (length xs `div` 2) xs