我需要帮助在Haskell中显示AVL树

时间:2016-08-08 22:04:58

标签: haskell avl-tree display

data AVL t = Empty | Node t (AVL t) (AVL t) Int
                 deriving (Eq, Ord, Show)


insertNode :: (Ord a) => a -> AVL a -> AVL a
insertNode x Empty = Node x Empty Empty 0
insertNode x (Node n left right balanceFactor)
    | x < n = let leftNode = insertNode x left
              in
               balanceTree (Node n leftNode right ((treeHeight leftNode) - (treeHeight right)))
    | otherwise = let rightNode = insertNode x right
                  in
                   balanceTree (Node n left rightNode ((treeHeight left) - (treeHeight rightNode)))

findNode :: AVL a -> a
findNode Empty = error "findNode from Empty"
findNode (Node a _ _ _) = a

findLeftNode :: AVL a -> AVL a
findLeftNode Empty = error "findLeftNode from Empty"
findLeftNode (Node _ left _ _) = left

findRightNode :: AVL a -> AVL a
findRightNode Empty = error "findRightNode from Empty"
findRightNode (Node _ _ right _) = right

findBalanceFactor :: AVL a -> Int
findBalanceFactor Empty = 0
findBalanceFactor (Node _ _ _ bf) = bf

treeHeight :: AVL a -> Int
treeHeight Empty = 0
treeHeight (Node _ left right _) = 1 + (max (treeHeight left) (treeHeight right))

balanceTree :: AVL a -> AVL a
balanceTree Empty = Empty
balanceTree (Node r Empty Empty bf) = Node r Empty Empty bf
balanceTree (Node r left right bf)
    | bf == -2 && rbf == -1 = let rl = (findLeftNode right)
                              in
                               (Node (findNode right)                                                               -- This is for the
                               (Node r left rl ((treeHeight left) - (treeHeight rl)))                               -- "right right" case
                               (findRightNode right)
                               ((1 + (max (treeHeight left) (treeHeight rl))) - (treeHeight (findRightNode right)))
                               )
    | bf == -2 && rbf == 1 = let rl = findLeftNode right
                                 rr = findRightNode right
                             in
                              (Node (findNode (rl))                                                                 -- This is for the
                              (Node r left (findLeftNode rl) ((treeHeight left) - (treeHeight (findLeftNode rl))))  -- "right left" case
                              (Node (findNode right) (findRightNode rl) rr ((treeHeight (findRightNode rl)) - (treeHeight rr)))
                              ((max (treeHeight left) (treeHeight (findLeftNode rl))) - (max (treeHeight (findRightNode rl)) (treeHeight rr)))
                              )
    | bf == 2 && lbf == 1 = let lr = findRightNode left
                            in
                             (Node (findNode left)                                                                  -- This is for the
                             (findLeftNode left)                                                                    -- "left left" case
                             (Node r lr right ((treeHeight lr) - (treeHeight right)))
                             ((treeHeight (findLeftNode left)) - (1 + (max (treeHeight lr) (treeHeight right))))
                             )
    | bf == 2 && lbf == -1 = let lr = findRightNode left
                                 ll = findLeftNode left
                             in
                              (Node (findNode lr)                                                                              -- This is for the
                              (Node (findNode left) ll (findLeftNode lr) ((treeHeight ll) - (treeHeight (findLeftNode lr))))   -- "left right" case
                              (Node r (findRightNode lr) right ((treeHeight (findRightNode lr)) - (treeHeight right)))
                              ((max (treeHeight ll) (treeHeight (findLeftNode lr))) - (max (treeHeight(findRightNode lr)) (treeHeight right)))
                              )
    | otherwise = (Node r left right bf)
    where rbf = findBalanceFactor right
          lbf = findBalanceFactor left

这是我实现AVL树的当前状态。正常输入通常是:

insertNode 4 (Node 2 (Node 1 Empty Empty 0) (Node 3 Empty Empty 0) 0)

导致:

Node 2 (Node 1 Empty Empty 0) (Node 3 Empty (Node 4 Empty Empty 0) (-1)) (-1)

我现在想要一个能够以整洁的方式显示输入树的功能,例如,正上方的树:

2
 1
  Empty
  Empty
 3
  Empty
  4
   Empty
   Empty

有没有人对如何实施这一点有任何建议?我希望仅显示节点,一旦到达分支的末尾,它就会打印“空”。我碰到了一堵砖墙,尝试了一些尝试但收效甚微。

编辑:大家好,感谢您的快速回复。您的建议确实有效,但是,我希望在不使用包或库的情况下显示树的实现。很抱歉没有澄清这个!

2 个答案:

答案 0 :(得分:4)

您正在寻找的是一台漂亮的打印机!我总是在Hackage上使用“pretty”包。

Text.PrettyPrint

你的树是一个非常简单的结构,所以我只是一次性定义它。 prettyTree :: Show t => AVL t -> Doc prettyTree Empty = text "Empty" prettyTree (Node t l r _) = text (show t) $+$ nest 1 (prettyTree l) $+$ nest 1 (prettyTree r) 中有许多有用的组合器,所以请查看它们!它们在GHCi中也很容易使用,所以当你不理解文档时,只需给它一个旋转。

Doc

Show有一个λ let tree = Node 2 (Node 1 Empty Empty 0) (Node 3 Empty (Node 4 Empty Empty 0) (-1)) (-1) λ prettyTree (tree :: AVL Int) 2 1 Empty Empty 3 Empty 4 Empty Empty 实例,你可能会很好,或者你可以使用更强大的样式函数。

type Doc = [String]

text :: String -> Doc
text = pure

indent :: Doc -> Doc
indent = map (' ':)

vertical :: Doc -> Doc -> Doc
vertical = (++)

prettyTree :: Show t => AVL t -> Doc
prettyTree Empty          = text "Empty"
prettyTree (Node t l r _) = vertical (text (show t))
                                     (indent (vertical (prettyTree l)
                                                       (prettyTree r)))

render :: Doc -> String
render = concat

如果您想在没有任何外部依赖关系的情况下执行此操作,只需将样式标记为自己的垫片,然后将其放入组合器中。

{{1}}

答案 1 :(得分:0)

您可以首先将AVL树转换为使用Data.Tree库 一个Data.Tree.Tree:

import qualified Data.Tree as T

data AVL t = Empty | Node t (AVL t) (AVL t) Int
                 deriving (Eq, Ord, Show)

toTree :: Show t => AVL t -> T.Tree String
toTree Empty = T.Node "Empty" [] 
toTree (Node t left right a)
  = T.Node (show t ++ " " ++ show a) [toTree left, toTree right]

avl = Node 2 (Node 1 Empty Empty 0) (Node 3 Empty (Node 4 Empty Empty 0) (-1)) (-1)

test = putStrLn $ T.drawTree (toTree avl)

运行test打印:

2 -1
|
+- 1 0
|  |
|  +- Empty
|  |
|  `- Empty
|
`- 3 -1
   |
   +- Empty
   |
   `- 4 0
      |
      +- Empty
      |
      `- Empty
相关问题