How to efficiently enumerate binary black-white trees, while accounting for symmetry?

Question

Consider the following type of black-white binary trees:

data BW = Black BW BW | White BW BW | Leaf Nat

With the following equivalence relation:

∀ a b c d . Black (White a b) (White c d) == White (Black a c) (Black b d)

So, for example, Black (White 0 1) (White 2 3) and White (Black 0 2) (Black 1 3) are equivalent. I'm interested in enumerating all unique trees of given size (where the size of a tree is just the count of constructors) as efficiently as possible. A brute-force approach would involve just enumerating all trees of given depth, and filtering out equivalent trees. This would be very inefficient for two reasons:

1. It would wastefully generate / consider a huge number of equivalent trees

2. Filtering would be quadratic, as it would require comparing with all former trees

Is there an efficient algorithm to generate all BW trees of given depth, without generating identical trees?

Answer 1

Here's a solution for numberless trees, that should easily adapt to your problem.

data BW = Black BW BW | White BW BW | Leaf deriving Show

notBlack :: BW -> Bool
notBlack (Black _ _ ) = False
notBlack _ = True

-- generate BW trees in which no White node has two Black children
gen :: Int -> [BW]
gen 1 = [Leaf]
gen n = do
  n1 <- [1..n-2]
  t1 <- gen n1
  let n2 = n-1-n1
  t2 <- gen n2
  Black t1 t2 : [White t1 t2 | notBlack t1 || notBlack t2]

main = mapM_ print (gen 7)

While it's possible to enforce the constraint in the type system, the result is rather more cumbersome:

data BlackT = Black T T deriving Show
data NotBlackT = WW NotBlackT NotBlackT | WB NotBlackT BlackT | BW BlackT NotBlackT | Leaf deriving Show
data T = B BlackT | NB NotBlackT deriving Show

genB :: Int -> [BlackT]
genB n = [Black t1 t2 | n1 <- [1..n-2], t1 <- gen n1, t2 <- gen (n-1-n1)]

genNB :: Int -> [NotBlackT]
genNB 1 = [Leaf]
genNB n = [WW t1 t2 | n1 <- [1..n-2], t1 <- genNB n1, t2 <- genNB (n-1-n1)]
       ++ [WB t1 t2 | n1 <- [1..n-2], t1 <- genNB n1, t2 <- genB  (n-1-n1)]
       ++ [BW t1 t2 | n1 <- [1..n-2], t1 <- genB  n1, t2 <- genNB (n-1-n1)]

gen :: Int -> [T]
gen n = map B (genB n) ++ map NB (genNB n)

main = mapM_ print (gen 7)