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

Question

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

有人对如何实现有任何建议吗？我希望仅显示节点，并且一旦到达分支的末尾，它就会打印“空”。我碰壁了，尝试了几次但收效甚微。

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

Answer 1

您正在寻找的是一台 pretty-print !我总是使用“pretty ” Hackage 上的包。

import Text.PrettyPrint

你的树是一个非常简单的结构，所以我将一次性定义它。不过，Text.PrettyPrint 中有许多有用的组合器，所以请查看它们!它们在 GHCi 中也非常易于使用，因此当您不理解文档时，只需尝试一下即可。

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)

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