在haskell中使用Diagrams库（绘制二叉树）

Question

我正在尝试使用Haskell Diagrams库来绘制二叉树。

这是我的树型：

data Tree a = Empty
            | Node { label :: a, left,right :: Tree a }

leaf :: a -> Tree a
leaf a = Node a Empty Empty

这是一个随机树：

t0 = Node 1 (Node 2 (leaf 3) (leaf 4))   (Node 5 (leaf 6) (leaf 7))

为了在中间绘制一个带有char的圆圈，我正在使用这个简单的函数（工作正常）：

diagNode :: String -> Diag

这是我绘制二叉树的代码：

diagTree :: Show s => Tree s -> Diag
diagTree Empty = diagNode "Empty"

diagTree (Node x Empty Empty) = connectOutside "X" "L" $
                                connectOutside "X" "R" $
          nx
          ===
      (nl ||| nr) # center
  where
    nx = named "X" ( diagNode (show x) )  
    nl = named "L" (diagNode "Empty" )
    nr = named "R" (diagNode "Empty" )  

diagTree (Node x left right) = connectOutside "X" "L" $
                               connectOutside "X" "R" $
          nx
          ===
      (nl ||| nr) # center
  where
    nx = named "X" ( diagNode (show x) ) 
    nl = named "L" (diagTree left )
    nr = named "R" (diagTree right )

您可以看到我的代码仅适用于最后一个“叶子”，但它不会将上层节点与下面的节点连接。我认为问题是，我以递归方式调用diagTree 。

我该如何解决这个问题？

Answer 1

我认为问题在于您正在命名为内部节点提供相同的名称，以便connectOutside连接它找到的名字（这恰好是树中的最后一个节点）。您可以通过为每个节点根据其位置赋予唯一名称来解决此问题：

diagTree :: Show s => Tree s -> Diagram Rasterific
diagTree = go [] where
  go nm Empty        = diagNode  "Empty" # named nm
  go nm (Node x l r) = 
    connectOutside nm nmL .
    connectOutside nm nmR $
          nx
          ===
      (nl ||| nr) # centerX
    where
      (nmL, nmR) = ('L':nm, 'R':nm)
      nx = diagNode (show x) # named nm 
      nl = go nmL l # named nmL
      nr = go nmR r # named nmR

与

data Tree a = Empty
            | Node { label :: a, left,right :: Tree a }
  deriving Show

leaf :: a -> Tree a
leaf a = Node a Empty Empty

diagNode :: String -> Diagram Rasterific
diagNode txt = text txt # fontSizeL 0.4 <> circle 1 & pad 2

我得到