Print Binary Search Tree in a tree like structure in Haskell

Question

I created a binary search tree and tried to print the binary search tree with this instance

data Tree a = Nil | Node (Tree a) a (Tree a)
instance Show a => Show (Tree a) where
        show t = intercalate "\n"  (map snd (draw t))

draw :: Show a => Tree a -> [(Int,String)]
draw Nil                = [(1,"*")]
draw (Node Nil x Nil)   = [(1,show x)]
draw (Node tl x tr)     = zip (repeat 0) (map shiftl (draw tl)) ++ [(1,show x ++ "-+")] ++ zip (repeat 2) (map shiftr (draw tr)) where
        shiftl (0,x)    =       spaces ++ "  " ++ x 
        shiftl (1,x)    =       spaces ++ "+-" ++ x 
        shiftl (2,x)    =       spaces ++ "| " ++ x 
        shiftr (0,x)    =       spaces ++ "| " ++ x 
        shiftr (1,x)    =       spaces ++ "+-" ++ x 
        shiftr (2,x)    =       spaces ++ "  " ++ x
        spaces          =       replicate  (length (show x)+1) ' '
createTree :: [a] -> BTree a
createTree []   = Nil
createTree xs    = Node
    (createTree front) x (createTree back) where
        n = length xs
        (front, x:back) = splitAt (n `div` 2) xs

Now I want to print it horizontally, which i am not able to do so. I want to print the binary search tree like this picture below. (Sorry for the low quality of the picture but you get the idea). How can i do it ?

Use the sample example [1..50]

UPDATE ANSWER :-

I found my answer myself. I created one function that shows like that. The code is in the comments.

If you have an other solution please share

About the same technique as I showed in this answer to a similar question should work fine for you. — Daniel Wagner
– Daniel Wagner, Commented Dec 27, 2021 at 17:54
Whatever you do with this drawing really shouldn't be part of the Show instance. That should produce code you could paste into a Haskell program. — dfeuer
– dfeuer, Commented Dec 27, 2021 at 20:13
@SohamChatterjee: you can post an answer to your own question and mark it as accepted. :) — willeM_ Van Onsem
– willeM_ Van Onsem, Commented Dec 27, 2021 at 21:06
The answer proposed here seems a bit buggy. For example, try createTree [0..3] and createTree [0,100000,2,3,4]. — Daniel Wagner
– Daniel Wagner, Commented Dec 27, 2021 at 23:03
The shown example has a complete tree ($2^n-1$ elements). Can you show how you want a tree with for example 10 elements ([0..9]) to look? — md2perpe
– md2perpe, Commented Jan 1, 2022 at 20:19

md2perpe · Accepted Answer · 2022-01-02 15:47:13Z

Here's my solution. It's might not be perfect. It prints Nil nodes as a *.

The basic idea is to first get the visualizations of the left and right trees as two lists of strings. Then they are zipped using concatenation to produce a list of strings representing the two trees side-by-side.

instance Show a => Show (Tree a) where
    show tree =
        let (s, _) = show' tree
        in intercalate "\n" s
        where
            show' :: Show a => Tree a -> ([String], Int)
            show' Nil = (["*"], 0)
            show' (Node ltree value rtree) = (ashow, acenter)
                where
                    -- middle_padding_length = 1
                    -- middle_padding = replicate (2*middle_padding_length+1) ' '
                    middle_padding = "   "
                    pwidth = length middle_padding

                    lshow, rshow :: [String]
                    lcenter, rcenter :: Int
                    (lshow, lcenter) = show' ltree
                    (rshow, rcenter) = show' rtree

                    lwidth, rwidth :: Int
                    lwidth = length (head lshow)
                    rwidth = length (head rshow)

                    awidth, acenter :: Int
                    awidth  = lwidth + length middle_padding + rwidth
                    acenter = lwidth + pwidth `div` 2

                    -- Put subtrees side by side with some padding
                    sshow :: [String]
                    sshow =
                        zipWith (\s1 s2 -> s1 ++ middle_padding ++ s2)
                            (extend_depth lwidth lshow)
                            (extend_depth rwidth rshow)
                        where
                            extend_depth twidth tshow =
                                let
                                    sdepth = max (length lshow) (length rshow)
                                in
                                    tshow ++ replicate (sdepth - length tshow) (replicate twidth ' ')

                    vshow :: String
                    vshow =
                        let
                            text = show value
                            textWidth = length text
                            whitespaceWidth = awidth - textWidth
                            leftPadding = acenter - textWidth `div` 2
                            rightPadding = whitespaceWidth - leftPadding
                        in
                            replicate leftPadding ' ' ++ text ++ replicate rightPadding ' '


                    row :: [Char] -> String
                    row [lc, mc, rc, hc, sc] =
                        replicate lcenter sc ++ [lc] ++ replicate (acenter-lcenter-1) hc ++
                        [mc] ++
                        replicate (lwidth+pwidth+rcenter-acenter-1) hc ++ [rc] ++ replicate (awidth-lwidth-pwidth-rcenter-1) sc
                    row _ = error "incorrect number of characters"

                    two_pipes, splitter, one_pipe :: String
                    two_pipes = row "| |  "
                    splitter  = row "/^\\- "
                    one_pipe  = row " |   "

                    ashow :: [String]
                    ashow =
                        vshow :
                        one_pipe :
                        splitter :
                        two_pipes :
                        sshow

Output for createTree [0..10]:

Sassy Math · Accepted Answer · 2022-01-01 16:17:23Z

I found my answer myself. I created one function that shows like that. Here is the code

import Data.List (intercalate)
data BTree a    = Nil | Node (BTree a) a (BTree a) deriving Eq
-- Instances of BST
instance Show a => Show (BTree a) where
    show t = "\n" ++ intercalate "\n" (map (map snd) (fst $ draw5 t)) ++ "\n"

-- End of instances
data Tag        = L | M | R deriving (Eq,Show)
type Entry      = (Tag, Char)
type Line       = [Entry] 
--the tag thing is for my own understanding that do no work here.
createTree :: [a] -> BTree a
createTree []   = Nil
createTree xs    = Node
    (createTree front) x (createTree back) where
        n = length xs
        (front, x:back) = splitAt (n `div` 2) xs
        
-- my own draw
draw5 :: Show a => BTree a -> ([Line],(Int,Int,Int))
draw5 Nil               =   ([zip [M] "*"],(0,1,0) )
draw5 (Node Nil x Nil)  =   
    let (sx,n,m) = (show x, length sx, n `div` 2) in
        ([zip (replicate m L ++ [M] ++ replicate (n-m-1) R) sx], (m,1,n-m-1)) 

draw5 (Node tl x tr) = (l1:l2:l3:l4:mainline,(a,b,c)) where
    (mainline ,(a,b,c)) = drawing xs ys
    (xs,(xsa,xsb,xsc)) = draw5 tl
    (ys,(ysa,ysb,ysc)) = draw5 tr 
    drawing xs ys = (join xs ys, (xsa+xsb+xsc+1, 1, ysa+ysb+ysc+1) )
    join (as:ass) (bs:bss) = go as bs : join ass bss
    join xss []  = map (++  ([(L,' '),(M, ' '),(R,' ')] ++ replicate (ysa+ysb+ysc) (R,' ') )) xss
    join [] yss  = map ((replicate (xsa+xsb+xsc) (L,' ') ++  [(L,' '),(M, ' '),(R,' ')]) ++ ) yss
    go xss yss = xss ++ [(L,' '),(M, ' '),(R,' ')] ++ yss
    ([cs],(m,n,o)) = draw5 (Node Nil x Nil)
    l1 = replicate (a-m) (L,' ') ++ cs ++ replicate (c-o) (R,' ')
    l2 = replicate a (L,' ') ++ [(M, '|')] ++ replicate c (R,' ')
    l3 = replicate xsa (L,' ') ++ [(L,'+')] ++ replicate (xsc+1) (L,'-') ++ [(M,'+')] ++ replicate (ysa+1) (R,'-') ++ [(R,'+')] ++ replicate ysc (R,' ')
    l4 = replicate xsa (L,' ') ++ [(L,'|')] ++ replicate (xsc+ysa+3) (M,' ') ++ [(R,'|')] ++ replicate ysc (R,' ')

Collectives™ on Stack Overflow

Print Binary Search Tree in a tree like structure in Haskell

2 Answers 2

Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related