我有一个树数据类型：
data Tree a b = Branch b (Tree a b) (Tree a b) | Leaf a
...而且我需要使它成为 的实例Show，而不使用deriving. 我发现很好地展示一个带有两片叶子的小树枝很容易：
instance (Show a, Show b) => Show (Tree a b) where
show (Leaf x) = show x
show (Branch val l r) = " " ++ show val ++ "\n" ++ show l ++ " " ++ show r
但是如何将一个好的结构扩展到任意大小的树呢？似乎确定间距需要我知道有多少叶子在最底部（或者可能总共有多少叶子），这样我就可以在那里分配我需要的所有空间，然后继续工作。 ' 我可能需要调用一个大小函数。我可以看到这是可行的，但这会让它变得更难吗？
您可以研究drawTree基本Data.Tree模块中的功能。只是无耻地导入它会给你这样的东西：
import Data.Tree hiding (Tree )
data Tree a b = Branch b (Tree a b) (Tree a b)
| Leaf a deriving (Eq,Ord,Show)
toDataTree (Leaf a) = Node a []
toDataTree (Branch b cs ds) = Node b [toDataTree cs, toDataTree ds]
d = Branch "1" (Branch "11" (Leaf "111") (Leaf "112"))
(Branch "12" (Leaf "121") (Leaf "122"))
e = toDataTree d
f = putStrLn $ drawTree e
{-
*Main> f
1
|
+- 11
| |
| +- 111
| |
| `- 112
|
`- 12
|
+- 121
|
`- 122
-}
使用应用程序的链接到Data.Tree源我想出了这个。我想写自己的，这样我就可以了解更多。源代码中的drawTree方法被推广到具有多个子节点的节点；我的只是用于二叉树。
注意：我的树定义与 OP 的有点不同。我不太明白atype 参数是做什么用的，但方法应该还是一样的
data Tree a
= Branch (Tree a) a (Tree a)
| Leaf
prettyprint (Leaf)
= "Empty root."
-- unlines concats a list with newlines
prettyprint (Branch left node right) = unlines (prettyprint_helper (Branch left node right n h))
prettyprint_helper (Branch left node right)
= (show node) : (prettyprint_subtree left right)
where
prettyprint_subtree left right =
((pad "+- " "| ") (prettyprint_helper right))
++ ((pad "`- " " ") (prettyprint_helper left))
pad first rest = zipWith (++) (first : repeat rest)
prettyprint_helper (Leaf)
= []
这会产生一棵树
4
+- 8
| +- 9
| | +- 10
| `- 6
| +- 7
| `- 5
`- 2
+- 3
`- 1
我只是想解释一下这个pad函数是如何工作的，因为这对我来说是最难理解的（shift在源代码中调用）。
首先，zipWith应用一个函数（第一个参数）来“加入”两个列表。zipWith (+) [1, 2, 3] [4, 5, 6]返回[5, 7, 9]。当列表之一为空时，它会停止。zipWith仅应用于一个列表返回一个可应用于压缩第二个列表的函数（我相信这被称为函数 currying）。这是该函数的更简单版本pad：
> let pad = zipWith (++) (repeat " ")
> :type pad
pad :: [[Char]] -> [[Char]]
> pad ["1", "2", "3"]
[" 1", " 2", " 3"]
注意：1.其中一个列表是无限的（repeat " "），但是当其中一个列表为空时它会停止压缩 2.zipWith只接受一个函数和一个列表。pad然后是一个函数，它接受字符/字符串列表并返回字符/字符串列表的压缩列表。因此，您申请pad一个列表以将其与第一个列表一起压缩
现在让我们看看
prettyprint_subtree left right =
((pad "+- " "| ") (prettyprint_helper left))
++ ((pad "`- " " ") (prettyprint_helper right))
(pad "+- " "| ")创建一个无限列表，如["+- ", "| ", "| ", "| ", ...]. (prettyprint_helper right)从右侧的根节点开始构建表示右侧子树的行列表。但是整棵树需要向右移动；我们通过用填充物压缩它来做到这一点。我们使用无限列表是因为我们不知道子树有多大；总会有足够"| "的 s 来填充额外的行（这也适用于惰性求值）。注意第一行；即子树根节点，用"+- "右节点的“符号”填充。
左侧几乎相同。左节点的符号是"`- "。唯一的其他区别是填充。" "而不是"| ". 那么为什么左节点不需要“分支”呢？好吧，您可以将其视为右侧节点后面（附加了填充；在左侧）到下面的左侧节点。您需要右侧后面的填充将左侧节点/子树连接到父节点。树的左侧后面没有任何东西，可能除了父树。这使我想到了最后一点；每个子树，表示为prettyprint_helper函数中的行列表，都会获得一个额外的填充每个父树的级别。我认为最好用一个例子来说明。
在创建上面的树时（注意，我不知道确切的执行顺序，尤其是延迟评估，但这只是为了帮助可视化它的工作原理）：
假设我们递归到10. 那么左边的子树和右边的子树都是空的，所以prettyprint_helper (Branch Leaf 10 Leaf)返回["10"]。
现在我们到了9。它的子树是：（"9" : ([] ++ ((pad "+- " "| ") [10]))没有左边），或"9" : ["+- 10"]，或：
9
+- 10
现在我们到了8。((pad "+- " "| ") (prettyprint_helper right))创建：
+- 9
| +- 10
您可以自己跟踪它，但左侧是：
6
+- 7
`- 5
哪个填充到（第一个元素"`- "，休息" "）：
`- 6
+- 7
`- 5
因此，总共 8，即左侧附加到右侧，我们有：
8
+- 9
| +- 10
`- 6
+- 7
`- 5
如果我们上一步，这个8子树会被填充到4树上，你可以再次追踪另一侧来验证它是否有效。你得到
+- 8
| +- 9
| | +- 10
| `- 6
| +- 7
| `- 5
最终结果如上。请记住，在整个过程中，树表示为行列表。只有在最后才与unlines. 也许我的图纸具有误导性，因为它可能看起来像子树作为多行字符串传递。一旦理解了这一点，就很容易像 in的函数"|"一样在左右节点之间添加额外的分支 ( ) 。我会让你弄清楚:)Data.TreedrawTree
如果这太过分了，我深表歉意；作为初学者，我很难从源头上理解，这对我来说是一个很大的飞跃。我希望它可以帮助其他人试图解决这个问题。
另一个实现：
───"a"
└──"b"
└──"c"
| ┌──"g"
| ┌──"c"
| | └──"f"
| ┌──"a"
| | | ┌──"e"
| | └──"b"
| | └──"d"
| ┌──"x"
| | | ┌──"g"
| | | ┌──"c"
| | | | └──"f"
| | └──"a"
| | | ┌──"e"
| | └──"b"
| | └──"d"
| ┌──"f"
└──"d"
import Data.List
data Btree a = Empty | Node a (Btree a) (Btree a) deriving Show
tr_l = Node "b" (Node "d" Empty Empty) (Node "e" Empty Empty)
tr_r = Node "c" (Node "f" Empty Empty) (Node "g" Empty Empty)
tr = Node "a" tr_l tr_r :: Btree String
tx = Node "x" tr tr
trr = Node "a" (Node "b" (Node "c" (Node "d" Empty (Node "f" Empty tx)) Empty) Empty) Empty:: Btree String
data ParentDir = PLeft | PRight | NoParent deriving (Show,Eq)
type ParentPos = Int
type Level = Int
dline = '|'
factor = 4
m c1 c2 = if c1 == dline then c1 else c2
zipWith' f xs [] = xs
zipWith' f [] xs = xs
zipWith' f (x:xs) (y:ys) = f x y : zipWith' f xs ys
build_line pd a pp level = foldl (zipWith' m) "" (((++"|").(flip replicate ' ') <$> (factor*) <$> pp)++[(replicate (factor*level) ' ')++cn++show a])
where cn = case pd of PLeft -> "└──"
PRight -> "┌──"
NoParent -> "───"
tprint :: Show a => ParentDir -> [ParentPos] -> Level -> Btree a -> [String]
tprint _ _ _ Empty = []
tprint pd pp level (Node a l r) = tprint PRight new_pp_r (level+1) r ++
[build_line pd a pp level] ++
tprint PLeft new_pp_l (level+1) l
where new_pp_r = case pd of PRight -> pp
PLeft -> pp++[level]
NoParent -> pp
new_pp_l = case pd of PRight -> pp++[level]
PLeft -> pp
NoParent -> pp
printt t = putStr $ (intercalate "\r\n" (tprint NoParent [] 0 t))++"\r\n"