haskell pretty print binary tree not displaying properly

Question

I am trying to pretty print a binary tree in Haskell so that if you turn your head to the left, it should look like a tree. Each level in the tree should be indented 2 spaces from the previous level.

This is the expected output:

--        18
--      17
--        16
--    15
--          14
--        13
--      12
--        11
--  10
--        9
--          8
--      7
--        6
--    5
--        4
--      3
--          2
--        1

For this tree:

treeB = (Node (Node (Node (Node Empty 1 (Node Empty 2 Empty)) 3 (Node Empty 4 Empty)) 5 (Node (Node Empty 6 Empty) 7 (Node (Node Empty 8 Empty) 9 Empty))) 10 (Node (Node (Node Empty 11 Empty) 12 (Node Empty 13 (Node Empty 14 Empty))) 15 (Node (Node Empty 16 Empty) 17 (Node Empty 18 Empty))))

This is how tree is defined:

data BinTree a =
    Empty
  | Node (BinTree a) a (BinTree a)
  deriving (Eq,Show)

However, my result does not look like that. Here is my result:

      18
  17
    16
  15
        14
  13
  12
    11
10
      9  
  8
  7
    6
  5
      4
  3
      2
  1

Here is my code:

prettyTree :: (Show a) => BinTree a -> String
prettyTree Empty = "\n"
prettyTree (Node Empty x Empty) = "  " ++ show x ++ "\n"
prettyTree (Node Empty x r) = prettyTree' r ++ "  " ++ show x ++ "\n"
prettyTree (Node l x Empty) = show x ++ "\n" ++ "  " ++ prettyTree' l
prettyTree (Node l x r) = prettyTree' r ++ show x ++ "\n" ++ prettyTree' l

prettyTree' :: (Show a) => BinTree a -> String
prettyTree' Empty = "\n"
prettyTree' (Node Empty x Empty) = "  " ++ show x ++ "\n"
prettyTree' (Node Empty x r) = "  " ++ prettyTree' r ++ "  " ++ show x ++ "\n"
prettyTree' (Node l x Empty) = "  " ++ show x ++ "  " ++ "\n" ++ prettyTree' l
prettyTree' (Node l x r) = "  " ++ prettyTree' r ++ "  " ++ show x ++ "\n" ++ "  " ++ prettyTree' l

I don't understand what I'm doing wrong. Any help would be greatly appreciated.

Answer 1

How to think about this problem

I think you need to think more recursively about this problem. Your data structure

data BinTree a =
    Empty
  | Node (BinTree a) a (BinTree a)
  deriving (Eq,Show)

is inherently recursive because it's defined in terms of itself, so we should exploit that. bheklilr's comment about lines is very sensible, but we can take it further. Here's the general plan for how to print a tree:

1. Print the right subtree, indented a bit from where we are,
2. Print the current node,
3. Print the left subtree, indented a bit from where we are.

You're trying to deal with the detail from one layer down by analysing all the cases for whether there's a Node or Empty subtree. Don't. Let recursion do that. Here's how we deal with the empty tree:

1. Output nothing.

Notice that we can still go ahead with the general plan, because if you indent nothing you still get nothing

Writing the functions

Great. Now we've got that sorted, we can write some code. First let's sort that indentation thing:

indent :: [String] -> [String]
indent = map ("  "++)

So whatever strings there are get " " appended on the front. Good. (Notice that it works on the empty list and leaves it alone.)

layoutTree :: Show a => BinTree a -> [String]
layoutTree Empty = []  -- wow, that was easy
layoutTree (Node left here right) 
         = indent (layoutTree right) ++ [show here] ++ indent (layoutTree left)

Wasn't that nice? We just did the left, then the current, then the right. Isn't recursion great!

Here's your sample tree again:

treeB = (Node (Node (Node (Node Empty 1 (Node Empty 2 Empty)) 3 (Node Empty 4 Empty)) 5 (Node (Node Empty 6 Empty) 7 (Node (Node Empty 8 Empty) 9 Empty))) 10 (Node (Node (Node Empty 11 Empty) 12 (Node Empty 13 (Node Empty 14 Empty))) 15 (Node (Node Empty 16 Empty) 17 (Node Empty 18 Empty))))

> layoutTree treeB
["      1","        2","    3","      4","  5","      6","    7","        8","      9","10","      11","    12","      13","        14","  15","      16","    17","      18"]

You can see we've just made a String representing line for each element, but each line has been indented as many times as it's been included inside another Node.

Now we just need to actually put that together, but that's not hard. Notice that the previous function was easy because this step was left till the end.

prettyTree :: Show a => BinTree a -> String
prettyTree = unlines.layoutTree

We just needed to compose the two functions layoutTree and unlines. (unlines concatenates all the strings with newlines between.)

And the finished product:

> putStrLn (prettyTree treeB)
      18
    17
      16
  15
        14
      13
    12
      11
10
      9
        8
    7
      6
  5
      4
    3
        2
      1

Answer 2

I just want to provide an alternative approach that some readers may find intriguing; I support user2727321's answer as better for your purposes.

What I'm about to demonstrate is called a "final encoding" (as opposed to an "initial encoding," which is what your ADT representation is), called such because it's an encoding of a data type in terms of its semantics (its interpretation) rather than in terms of its syntax (its construction). Let's say we don't have a data type but instead want to just use functions instead of constructors. This means we can encode the logic directly into our "constructors" instead of making a separate function to interpret the data.

Representing a Tree As Its Own Pretty Printer

Observe that every interpretation of a data structure, pretty printing included, places some meaning on the data. In this particular case, the meaning of a tree is a depth-dependent string. That is, the same subtree could be rendered at different depths. For example, here is a tree rendered at depth 0:

  3
2
  1

And here is the same tree rendered at depth 4:

          3
        2
          1

We can furthermore assume, for this case, that the depth is only going to be used to generate a prefix of spaces, so let's instead say that a tree is a string that depends on some given prefix, which is just another string. We can say that our tree has the following representation:

type BinTree a = String -> String

Interestingly, the type parameter a is never actually used here, but to retain some unnecessary similarity with your original problem, I'll leave it there.

The Constructors

Now we can define each of our "constructors." Recall that your original Empty constructor has the following type:

Empty :: BinTree a

We would therefore like our own empty value to have the same type, just in terms of our final encoding instead of your initial encoding:

empty :: BinTree a

If we expand the type synonym, we have this:

empty :: String -> String

All empty is is the empty string, totally ignoring the prefix:

empty _prefix = ""

Now we move on to internal nodes. Recall the type of your original Node constructor:

Node :: BinTree a -> a -> BinTree a -> BinTree a

So we want to write a node function with roughly the same type. However, we will be making use of show, so the Show constraint will reveal itself here:

node :: Show a => BinTree a -> a -> BinTree a -> BinTree a

Expanding the type synonyms is pretty messy, but perhaps helpful for reference while learning this technique:

node :: Show a =>
        (String -> String) -> a -> (String -> String) ->
        (String -> String)

To render internal nodes at a given prefix, we render the right branch first, with a slightly longer prefix, then render the current value with our prefix, adding a newline, then render the left branch with the longer prefix:

node l x r prefix =
  let prefix' = "  " ++ prefix
  in r prefix' ++ prefix ++ show x ++ "\n" ++ l prefix'

Wrapping Up

We write a function to conveniently pretty print a tree with no prefix:

prettyTree :: BinTree a -> String
prettyTree tree = tree ""

It might be interesting that since we're using show in node instead of in prettyTree we don't actually have to add the Show constraint here. We're only requiring Show in the only function that actually uses that a parameter.

Testing it out in GHCi:

> let treeB = (node (node (node (node empty 1 (node empty 2 empty)) 3 (node empty 4 empty)) 5 (node (node empty 6 empty) 7 (node (node empty 8 empty) 9 empty))) 10 (node (node (node empty 11 empty) 12 (node empty 13 (node empty 14 empty))) 15 (node (node empty 16 empty) 17 (node empty 18 empty))))
> putStr $ prettyTree treeB
      18
    17
      16
  15
        14
      13
    12
      11
10
      9
        8
    7
      6
  5
      4
    3
        2
      1

What About Multiple Interpretations?

One might reasonably object to all this that you don't always want to only pretty print a tree. I completely agree. Fortunately, type classes have our back. All we have to do is overload our constructor-like functions using a type class:

class BinaryTree f where
  empty :: f a
  node  :: Show a => f a -> a -> f a -> f a

Our previous implementation is but one instance of this class (with appropriate newtype wrapping instead of a type synonym, since that is necessary to make it an instance of a type class). Other interpretations can have other representations. You can even construct a tree once and interpret it multiple ways by using polymorphism.

Here is a complete implementation with a type class, using -XConstraintKinds and -XTypeFamilies to move the annoying Show constraint from the type class to this particular instance:

class BinaryTree f where
  type Elem f a
  empty :: Elem f a => f a
  node  :: Elem f a => f a -> a -> f a -> f a

newtype BinTree a = BinTree { prettyTree' :: String -> String }

instance BinaryTree BinTree where
  type Elem BinTree a = Show a
  empty      = BinTree $ const ""
  node l x r =
    BinTree $ \prefix ->
    let prefix' = "  " ++ prefix
    in prettyTree' r prefix' ++ prefix ++ show x ++ "\n" ++ prettyTree' l prefix'

prettyTree :: (forall f. BinaryTree f => f a) -> String
prettyTree tree = prettyTree' tree ""

I did one thing which I didn't explain already, which is force the actual type of binary tree argument to prettyTree to be polymorphic. This prevents you from using prettyTree with some tree that was constructed using special knowledge of the particular representation of BinTree; it has to have been built only using empty and node, just like with an ADT.