在Haskell中的樹狀結構中列印二叉搜索樹

我創建了一個二叉搜索樹并嘗試用這個實體列印二叉搜索樹

data Tree a = Nil | Node (Tree a) a (Tree a)
instance Show a => Show (Tree a) where
        show t = intercalate "\n"  (map snd (draw t))

draw :: Show a => Tree a -> [(Int,String)]
draw Nil                = [(1,"*")]
draw (Node Nil x Nil)   = [(1,show x)]
draw (Node tl x tr)     = zip (repeat 0) (map shiftl (draw tl))    [(1,show x    "- ")]    zip (repeat 2) (map shiftr (draw tr)) where
        shiftl (0,x)    =       spaces    "  "    x 
        shiftl (1,x)    =       spaces    " -"    x 
        shiftl (2,x)    =       spaces    "| "    x 
        shiftr (0,x)    =       spaces    "| "    x 
        shiftr (1,x)    =       spaces    " -"    x 
        shiftr (2,x)    =       spaces    "  "    x
        spaces          =       replicate  (length (show x) 1) ' '
createTree :: [a] -> BTree a
createTree []   = Nil
createTree xs    = Node
    (createTree front) x (createTree back) where
        n = length xs
        (front, x:back) = splitAt (n `div` 2) xs

現在我想水平列印它，但我無法這樣做。我想列印如下圖所示的二叉搜索樹。（對不起，圖片質量低，但你明白了）。我該怎么做 ？

使用示例 [1..50]

更新答案：-

我自己找到了答案。我創建了一個這樣顯示的函式。代碼在評論中。

如果您有其他解決方案，請分享

uj5u.com熱心網友回復：

我自己找到了答案。我創建了一個這樣顯示的函式。這是代碼

import Data.List (intercalate)
data BTree a    = Nil | Node (BTree a) a (BTree a) deriving Eq
-- Instances of BST
instance Show a => Show (BTree a) where
    show t = "\n"    intercalate "\n" (map (map snd) (fst $ draw5 t))    "\n"

-- End of instances
data Tag        = L | M | R deriving (Eq,Show)
type Entry      = (Tag, Char)
type Line       = [Entry] 
--the tag thing is for my own understanding that do no work here.
createTree :: [a] -> BTree a
createTree []   = Nil
createTree xs    = Node
    (createTree front) x (createTree back) where
        n = length xs
        (front, x:back) = splitAt (n `div` 2) xs
        
-- my own draw
draw5 :: Show a => BTree a -> ([Line],(Int,Int,Int))
draw5 Nil               =   ([zip [M] "*"],(0,1,0) )
draw5 (Node Nil x Nil)  =   
    let (sx,n,m) = (show x, length sx, n `div` 2) in
        ([zip (replicate m L    [M]    replicate (n-m-1) R) sx], (m,1,n-m-1)) 

draw5 (Node tl x tr) = (l1:l2:l3:l4:mainline,(a,b,c)) where
    (mainline ,(a,b,c)) = drawing xs ys
    (xs,(xsa,xsb,xsc)) = draw5 tl
    (ys,(ysa,ysb,ysc)) = draw5 tr 
    drawing xs ys = (join xs ys, (xsa xsb xsc 1, 1, ysa ysb ysc 1) )
    join (as:ass) (bs:bss) = go as bs : join ass bss
    join xss []  = map (    ([(L,' '),(M, ' '),(R,' ')]    replicate (ysa ysb ysc) (R,' ') )) xss
    join [] yss  = map ((replicate (xsa xsb xsc) (L,' ')     [(L,' '),(M, ' '),(R,' ')])    ) yss
    go xss yss = xss    [(L,' '),(M, ' '),(R,' ')]    yss
    ([cs],(m,n,o)) = draw5 (Node Nil x Nil)
    l1 = replicate (a-m) (L,' ')    cs    replicate (c-o) (R,' ')
    l2 = replicate a (L,' ')    [(M, '|')]    replicate c (R,' ')
    l3 = replicate xsa (L,' ')    [(L,' ')]    replicate (xsc 1) (L,'-')    [(M,' ')]    replicate (ysa 1) (R,'-')    [(R,' ')]    replicate ysc (R,' ')
    l4 = replicate xsa (L,' ')    [(L,'|')]    replicate (xsc ysa 3) (M,' ')    [(R,'|')]    replicate ysc (R,' ')

uj5u.com熱心網友回復：

這是我的解決方案。這并不完美。它假設值最多有 3 位數字。它還將Nil節點列印為*.

基本思想是首先將左右樹的可視化作為兩個字串串列。然后使用連接對它們進行壓縮，以生成一個字串串列，表示并排的兩棵樹。

myShow :: Show a => Tree a -> [Char]
myShow tree =
    let (s, _, _) = show' tree
        in intercalate "\n" s
    where
        show' :: Show a => Tree a -> ([String], Int, Int)
        show' Nil = (["*"], 1, 0)
        show' (Node ltree value rtree) = (ashow, awidth, acenter)
            where
                centerAtColumn :: String -> Int -> Int -> String
                centerAtColumn string width column =
                    let
                        whitespaceWidth = width - length string
                        leftPadding  = whitespaceWidth `div` 2
                        rightPadding = whitespaceWidth - leftPadding
                    in
                        replicate leftPadding ' '    string    replicate rightPadding ' '

                middle_padding_length = 1
                middle_padding = replicate (2*middle_padding_length 1) ' '

                (lshow, lwidth, lcenter) = show' ltree
                (rshow, rwidth, rcenter) = show' rtree

                awidth  = lwidth   length middle_padding   rwidth
                acenter = lwidth   middle_padding_length

                -- Put subtrees side by side with some padding
                ldepth = length lshow
                rdepth = length rshow
                sdepth = max ldepth rdepth

                sshow = take sdepth $
                    zipWith (\s1 s2 -> s1    middle_padding    s2)
                        (lshow    replicate (sdepth-ldepth) (replicate lwidth ' '))
                        (rshow    replicate (sdepth-rdepth) (replicate rwidth ' '))

                wshow = map (\s -> s    replicate (awidth - length s) ' ') sshow

                vshow =
                    replicate lcenter ' '    [' ']    replicate (lwidth-lcenter-1) ' '
                      
                    centerAtColumn (show value) (length middle_padding) middle_padding_length
                      
                    replicate rcenter ' '    [' ']    replicate (rwidth-rcenter-1) ' '


                position :: [Char] -> String
                position [c1, c2, c3, c4, c5, c6, c7] =
                    replicate lcenter c1    [c2]    replicate (lwidth-lcenter-1) c3
                      
                    [ c3, c4, c5 ]
                      
                    replicate rcenter c5    [c6]    replicate (rwidth-rcenter-1) c7
                position _ = error "position called with list with wrong count of elements"

                pipes    = position " |   | "
                splitter = position "  - -  "

                ashow = vshow : (replicate lwidth ' '    " | "    replicate rwidth ' ') : splitter : pipes : wshow

輸出createTree [0..10]：

標籤：哈斯克尔 二叉搜索树

上一篇：在QuickCheck屬性測驗中使用IO？

下一篇：使用megaparsec parser-combinators進行置換決議過于寬松