J'ai besoin d'aide pour afficher un arbre AVL en Haskell

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

Voici l'état actuel de mon implémentation d'un arbre AVL. L'entrée normale est habituellement :

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

ce qui entraîne :

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

Je veux maintenant disposer d'une fonction permettant d'afficher un arbre saisi de manière soignée, par exemple l'arbre ci-dessus :

2
 1
  Empty
  Empty
 3
  Empty
  4
   Empty
   Empty

Quelqu'un a-t-il des suggestions sur la façon dont cela pourrait être mis en œuvre ? Je souhaite que seuls les nœuds soient affichés, et qu'une fois qu'il atteint la fin d'une branche, il imprime "Empty". Je me suis heurté à un mur et j'ai essayé plusieurs fois sans grand succès.

EDIT : Salut les gars, merci pour les réponses rapides. Vos suggestions fonctionnent, cependant, j'aimerais une implémentation de l'affichage de l'arbre sans l'utilisation de paquets ou de bibliothèques. Désolé de ne pas avoir clarifié ce point !

Answer 1

Ce que vous cherchez, c'est une jolie imprimante ! J'utilise toujours les " joli "sur Hackage.

import Text.PrettyPrint

Votre arbre est une structure assez simple, je vais donc le définir en une seule fois. Il existe de nombreux combinateurs utiles dans Text.PrettyPrint mais, alors, regardez-les ! Ils sont aussi très faciles à utiliser dans GHCi, donc si vous ne comprenez pas la documentation, essayez-les.

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 a un Show qui vous conviendra probablement, ou vous pouvez utiliser les fonctions de style plus puissantes.

λ 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

---

Si vous voulez faire cela sans aucune dépendance externe, il vous suffit de copier le style mais d'ajouter vos propres cales pour les combinateurs.

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

Answer 2

Vous pouvez utiliser la bibliothèque Data.Tree en convertissant d'abord votre arbre AVL en un arbre Data.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)

Running test des empreintes :

2 -1
|
+- 1 0
|  |
|  +- Empty
|  |
|  `- Empty
|
`- 3 -1
   |
   +- Empty
   |
   `- 4 0
      |
      +- Empty
      |
      `- Empty