所有可能存儲值的二叉樹

Question

我想編寫一個函數allTrees來生成所有可能的二叉樹的列表，這些二叉樹存儲每棵樹的葉子數。

這是我的數據類型和我對allTrees函數的嘗試：

data BTree = L | B BTree BTree
    deriving (Eq, Ord, Show)

data SpecTree = S Integer BTree
    deriving (Eq, Ord, Show)

leafNode :: SpecTree
leafNode = S 1 L

branch :: SpecTree -> SpecTree -> SpecTree
branch (S size1 sub1) (S size2 sub2) = S (size1 + size2) (B sub1 sub2)

allTrees :: [SpecTree]
allTrees = leafNode : branch allTrees allTrees

預期輸出：

take 9 allTrees = [S 1 L,S 2 (B L L),S 3 (B L (B L L)),S 3 (B (B L L) L),S 4 (B L (B L (B L L))),S 4 (B L (B (B L L) L)),S 4 (B (B L L) (B L L)),S 4 (B (B L (B L L)) L),S 4 (B (B (B L L) L) L)]

實際輸出：

take 9 allTrees = [S 1 L,S 2 (B L L),S 3 (B L (B L L)),S 4 (B L (B L (B L L))),S 5 (B L (B L (B L (B L L)))),S 6 (B L (B L (B L (B L (B L L))))),S 7 (B L (B L (B L (B L (B L (B L L)))))),S 8 (B L (B L (B L (B L (B L (B L (B L L))))))),S 9 (B L (B L (B L (B L (B L (B L (B L (B L L))))))))]

我的輸出很接近，但並不完全。 我認為foldM在這里可能有用，但不確定如何使用它。

Answer 1

問題正如卡爾在評論中描述的那樣。 您正在生成無限多不同的樹，但由於生成它們的順序，您不會全部獲得它們。 這就像通過從 1 開始並每次加倍來生成“所有整數”。 每個整數都是新的，你永遠不會用完，但你會錯過大多數整數。 在您的情況下，您只生成退化的僅右子樹，因為這是您偏向探索的方向，並且您永遠不會用完探索該方向的空間。

相反，正如 Carl 在評論中所建議的那樣，如果您想確保擊中每棵可能的樹，請按照確保不會錯過任何樹的順序生成它們：最小的優先。

allTreesOfSize :: Integer -> [BTree]
allTreesOfSize 0 = [] -- Not used in the recursive case
allTreesOfSize 1 = [L]
allTreesOfSize n = do
  lSize <- [1..n-1]
  let rSize = n - lSize
  B <$> allTreesOfSize lSize <*> allTreesOfSize rSize

allTrees :: [SpecTree]
allTrees = do
  n <- [1..]
  S n <$> allTreesOfSize n

> take 5 allTrees
[ S 1 L
, S 2 (B L L)
, S 3 (B L (B L L))
, S 3 (B (B L L) L)
, S 4 (B L (B L (B L L)))
]

Answer 2

@amalloy 的答案很優雅，但它確實需要您考慮一種在特定域中生成數據的方法（即，如何在子樹之間拆分“大小”）。

通常，您可能真的想將一個函數應用於兩個無限列表中的所有對。 這是一個執行此操作的函數。 我敢打賭，它仍然可以做得更優雅。

data BTree = L | B BTree BTree
    deriving (Eq, Ord, Show)

data SpecTree = S Integer BTree
    deriving (Eq, Ord, Show)

leafNode :: SpecTree
leafNode = S 1 L

branch :: SpecTree -> SpecTree -> SpecTree
branch (S size1 sub1) (S size2 sub2) = S (size1 + size2) (B sub1 sub2)

allTrees :: [SpecTree]
allTrees = leafNode : infApply branch allTrees allTrees

infApply :: (a -> b -> c) -> [a] -> [b] -> [c]
infApply f xs ys = map (uncurry f) (infProduct xs ys)

-- All possible pairs from two infinite lists.
infProduct xs ys = infterleave (infNested xs ys)

-- A nested (infinite) list of (infinite) lists of pairs from the two given (infinite) lists.
infNested xs ys = [[(x, y) | x <- xs] | y <- ys]

-- Interleave the elements of an infinite collection of infinite lists.
infterleave xss =
  infterleave' xss 0 0
  where
    infterleave' :: [[a]] -> Int -> Int -> [a]
    infterleave' xss n m =
      let (result, remainder) = snoc (xss !! n)
          newXss = take n xss ++ [remainder] ++ drop (n+1) xss
      in
        result : (infterleave' newXss (if n < m then n+1 else 0) (if n < m then m else m+1))

snoc (x:xs) = (x, xs)