RosettaCodeData/Task/Tree-traversal/Haskell/tree-traversal-1.hs

56 lines
1.4 KiB
Haskell

data Tree a
= Empty
| Node { value :: a
, left :: Tree a
, right :: Tree a}
preorder, inorder, postorder, levelorder :: Tree a -> [a]
preorder Empty = []
preorder (Node v l r) = v : preorder l ++ preorder r
inorder Empty = []
inorder (Node v l r) = inorder l ++ (v : inorder r)
postorder Empty = []
postorder (Node v l r) = postorder l ++ postorder r ++ [v]
levelorder x = loop [x]
where
loop [] = []
loop (Empty:xs) = loop xs
loop (Node v l r:xs) = v : loop (xs ++ [l, r])
-- TEST --------------------------------------------------------------
tree :: Tree Int
tree =
Node
1
(Node 2 (Node 4 (Node 7 Empty Empty) Empty) (Node 5 Empty Empty))
(Node 3 (Node 6 (Node 8 Empty Empty) (Node 9 Empty Empty)) Empty)
asciiTree :: String
asciiTree =
unlines
[ " 1"
, " / \\"
, " / \\"
, " / \\"
, " 2 3"
, " / \\ /"
, " 4 5 6"
, " / / \\"
, " 7 8 9"
]
-- OUTPUT --------------------------------------------------------------
main :: IO ()
main = do
putStrLn asciiTree
mapM_ putStrLn $
zipWith
(\s xs -> justifyLeft 14 ' ' (s ++ ":") ++ unwords (show <$> xs))
["preorder", "inorder", "postorder", "level-order"]
([preorder, inorder, postorder, levelorder] <*> [tree])
where
justifyLeft n c s = take n (s ++ replicate n c)