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
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]:
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,' ')
I'd like to instance show function for my binary tree, constructed this way: data Tree a = Nil | Leaf a | Branch a (Tree a) (Tree a).
I'd like to achieve a representation like "tree" unix command. For instance:
The showing function would be:
> 27
>> 14
>>> 10
>>> 19
>> 35
>>> 31
>>> 42
I want to tabulate each "subtree" with a recursive function but i don't kwow how this is my actual code:
instance (Show a)=>Show (Tree a) where
show Nil = ""
show (Leaf e) = show e
show (Branch e ls rs) = show e ++ "\n\t" ++ show ls ++ "\n\t" ++ show rs
So the question is: how can i implement a recursive tabulation function, because each time i use new line and tabulate just once instead of subtree depth
You can define a helper function, let's call it showWithDepth like this:
showWithDepth :: (Show a) => Tree a -> Int -> String
showWithDepth Nil _ = ""
showWithDepth (Leaf e) depth = (replicate depth '\t') ++ show e ++ "\n"
showWithDepth (Branch e ls rs) depth = (replicate depth '\t') ++ show e ++ "\n" ++ showWithDepth ls (depth+1) ++ showWithDepth rs (depth+1)
And now we can simply define Your instance like this:
instance (Show a)=>Show (Tree a) where
show x = showWithDepth x 0
How would I get this piece of code to accept a list of strings and output a frame around the outside. I understand the concept but just cannot execute the code in the final frame function.
minusdots :: Int -> String
minusdots 1 = "-."
minusdots n
| n > 1 = "-." ++ (minusdots (n-1))
| otherwise = error "please enter greater than 1"
bar :: Int -> String
bar n
| even n = minusdots (div n 2)
| otherwise = (minusdots (div n 2)) ++ ['-']
frame :: [String] -> IO String
frame text = map putStrLn (bar m) ++ "\n" ++ textshown ++ "\n" ++ (bar m)
where
textshown = "- " ++ text ++ " -"
m = length textshown
I have worked on this all day and come up with this but there's still some bugs I need to work out 1. When I pass the border string into the frameM function, If I was to pass say "S S" is there any way I could make the S'S frame on top of each other,istead of side by side so the more letters i put into the first argument the bigger the total perimeter of the frame gets? heres what I've done:
minusdots :: Int -> String -> String
minusdots 1 a = a
minusdots n a
| n > 1 = a ++ (minusdots (n-1) a)
| otherwise = error "argument not addmissible"
bar :: String -> Int -> String
bar s n
| even n = minusdots (div n 2) s
| otherwise = (minusdots (div n 2) s) ++ s
frameM :: String -> String -> String
frameM a text = (bar a m) ++ "\n" ++ textshown ++ "\n" ++ (bar a m)
where
textshown = b ++ text ++ b
m = length textshown
b = a
I believe the type of your frame should be frame :: String -> IO () — it takes a string a puts a "framed" version of it to stdout. Then you don't need map putStrLn and can just use putStrLn.
Now, consider this line:
putStrLn (bar m) ++ "\n" ++ textshown ++ "\n" ++ (bar m)
you are calling putStrLn (bar m) and then trying to append some stuff to the result of that (hint: use parentheses or $).
SOLUTION
Thanks to Karolis Juodelė, here is my elegant solution to this problem! Thank you Karolis Juodelė :
prettyTree :: Show a=>BinTree a -> String
prettyTree Empty = ""
prettyTree (Node l x r) = prettyTree2((Node l x r),2)
prettyTree2 :: Show a=> (BinTree a, Int)-> String
prettyTree2 (Empty,_) = ""
prettyTree2 ((Node l x r),z) = prettyTree2(r,z+2) ++ replicate z ' ' ++ (show x) ++ ['\n'] ++ prettyTree2(l,z+2)
OLD
So I am trying to print a binary tree like so:
putStr (prettyTree (Node (Node Empty 3 (Node Empty 7 Empty)) 8 (Node (Node Empty 8 Empty) 4 (Node Empty 3 Empty))))
3
4
8
8
7
3
What I have is the following which only prints them in two different lines:
data BinTree a = Empty | Node (BinTree a) a (BinTree a) deriving (Eq)
prettyTree :: Show a => BinTree a -> String
prettyTree Empty = ""
prettyTree (Node l x r) = prettyTree l ++ middle ++ prettyTree r
where
maxHeight = max (treeHeight l) (treeHeight r) + 1
middle = printSpace (maxHeight, maxHeight) ++ show x ++ "\n"
treeHeight :: BinTree a -> Integer
treeHeight Empty = 0
treeHeight (Node l x r) = 1 + max (treeHeight l) (treeHeight r)
printSpace :: (Integer,Integer) -> String
printSpace (0, _) = []
printSpace (_, 0) = []
printSpace (x, y) = " " ++ printSpace ((x `mod` y), y)
What I am trying to acomplish is that based on the total height of the tree, I will modulate the current height at the node, hence the root will be 0, then level 1 will be 1 and so fort.
I understand that I am actually passing the height twice for each level and I am not passing the total height of the tree. What can I do to actually get the total height of the tree for every level of the recursion?
Simply add another parameter to prettyTree. Something like padding :: Int. Then add replicate padding ' ' spaces to middle and pass padding + 2 to prettyTree of left and right subtrees.
Note, what you actually want is to define prettyTree t = paddedPrettyTree t 2 so as not to change the type of prettyTree.
Let's say I have a binary tree.
main = putStrLn $ printTree tree
data Tree = Empty | Node Int (Tree) (Tree) deriving (Show)
tree = Node 4 (Node 3 Empty (Node 2 Empty Empty)) Empty
printTree :: Tree -> String
printTree x = case x of
Node num treeA treeB -> show num ++ "\n" ++ printTree treeA ++ "\n" ++ printTree treeB
Empty -> "Empty"
Output
*Main> main
4
3
Empty
2
Empty
Empty
Empty
Desired Output (delimited by tabs or double space is fine)
*Main> main
4
3
Empty
2
Empty
Empty
Empty
You can use an accumulator (here, depth) to keep track of how deep you currently are in the tree - then create a number of spaces corresponding to the depth the line is at:
main = putStrLn $ printTree tree
data Tree = Empty | Node Int (Tree) (Tree) deriving (Show)
tree = Node 4 (Node 3 Empty (Node 2 Empty Empty)) Empty
printTree :: Tree -> String
printTree x = printTree' x 0
where
printTree' x depth = case x of
Node num treeA treeB -> (replicate (2 * depth) ' ') ++ show num ++ "\n" ++ (printTree' treeA (depth + 1)) ++ "\n" ++ (printTree' treeB (depth + 1))
Empty -> (replicate (2 * depth) ' ') ++ "Empty"
Output:
*Main> main
4
3
Empty
2
Empty
Empty
Empty
Here's a solution using -XImplicitParams in GHC
{-# LANGUAGE ImplicitParams #-}
module ImplicitTabs where
data Tree = Empty | Node Int (Tree) (Tree) deriving (Show)
tree = Node 4 (Node 3 Empty (Node 2 Empty Empty)) Empty
tab :: (?tab_level :: Int) => String
tab = replicate (2 * ?tab_level) ' '
printTree :: (?tab_level :: Int) => Tree -> String
printTree x = let
?tab_level = ?tab_level + 1
in case x of
Node num treeA treeB -> tab ++ show num ++ "\n" ++ tab ++ printTree treeA ++ "\n" ++ tab ++ printTree treeB
Empty -> tab ++ "Empty"
main = let ?tab_level = -1 in putStrLn $ printTree tree
> runhaskell implicit-tabulation.hs
4
3
Empty
2
Empty
Empty
Empty
Ok I think I got it to work.
printTree :: Tree -> String
printTree x = printT 0 x
space x = take x $ cycle " "
printT :: Int -> Tree -> String
printT num x =
case x of
(Node o treeA treeB) -> show o ++
"\n" ++
space num ++
printT (num+1) treeA ++
"\n" ++
space num ++
printT (num+1) treeB
Empty -> "Empty"
If you convert to a Data.Tree, then you can use the library function drawTree which does almost what you are looking for (it also draws branches with ASCII art).