Как я могу проверить, действителен ли BST?

Question

Как я могу проверить, является ли BST действительным, учитывая его определение и используя обобщенную версию сгиба для BST?

data(Ord a, Show a, Read  a) => BST a = Void | Node {
    val :: a,
    left, right :: BST a
} deriving (Eq,  Ord,  Read, Show)


fold :: (Read a, Show a, Ord a) => (a -> b -> b ->  b) -> b -> BST a -> b
fold _ z Void         = z
fold f z (Node x l r) = f x (fold f z l) (fold f z r)

Идея состоит в том, чтобы проверить, что значение узла больше, чем все значения в левом поддереве, и меньше, чем все значения в его правом поддереве. Это должно быть True для всех узлов в дереве. Функция bstList просто выводит список (упорядоченных) значений в BST.

Конечно, что-то вроде этого не будет работать:

--isBST :: (Read a, Show a, Ord a) => BST a -> Bool
isBST t = fold (\x l r -> all (<x) (bstList l) && all (>x) (bstList r)) (True) t

потому что, например, применение функции сгиба к узлу 19 заканчивается all (<19) (bstList True) && all (>19) (bstList True).

Answer 1

(Пожалуйста, не устанавливайте ограничения класса типов на тип data.)

BST действует, если обход в порядке монотонно увеличивается.

flatten tree = fold (\a l r -> l . (a:) . r) id tree []

ordered list@(_:rest) = and $ zipWith (<) list rest
ordered _ = True

isBST = ordered . flatten

Answer 2

Ваша проблема в том, что вы теряете информацию, потому что ваша функция возвращает логическое значение только тогда, когда она проверяет левое и правое поддеревья. Поэтому измените его так, чтобы оно также возвращало минимальное и максимальное значения поддеревьев. (Возможно, это также более эффективно, поскольку вам больше не нужно использовать bslist для проверки всех элементов)

И, конечно, сделайте функцию-оболочку, чтобы игнорировать эти «вспомогательные» значения после того, как вы закончите.

Answer 3

Хороший способ кодирования этого состоит в том, чтобы опираться на обход, предоставляемый Data.Foldable.

{-# LANGUAGE DeriveFunctor, DeriveFoldable #-}
import Data.Foldable
import Data.Monoid

Мы можем получить его экземпляр автоматически, используя расширение, но нам нужно изменить порядок полей конструктора Node, чтобы обеспечить нам обход в порядке.

Пока мы 'в связи с этим мы должны устранить ограничения на сам тип данных.Они фактически не дают никакой пользы и были удалены из языка с Haskell 2011. (Если вы хотите использовать такие ограничения, вы должны помещать их в экземпляры классов, а не в тип данных.)

data BST a 
  = Void
  | Node
    { left :: BST a
    , val :: a
    , right :: BST a 
    } deriving (Eq, Ord, Read, Show, Foldable)

Сначала мы определим, что означает список для строгой сортировки.

sorted :: Ord a => [a] -> Bool
sorted [] = True
sorted [x] = True
sorted (x:xs) = x < head xs && sorted xs 
-- head is safe because of the preceeding match.

Затем мы можем использовать метод toList, предоставленный Data.Foldable и вышеприведенным помощником.

isBST :: Ord a => BST a -> Bool
isBST = sorted . toList

Мы также можем реализовать это более напрямую, как вы и просили.Так как мы удалили ложные ограничения на тип данных, мы можем упростить определение вашего сгиба.

cata :: (b -> a -> b -> b) -> b -> BST a -> b
cata _ z Void         = z
cata f z (Node l x r) = f (cata f z l) x (cata f z r)

Теперь нам нужен тип данных для моделирования результата нашего катаморфизма, то есть у нас либо нетузлы (Z), либо диапазон строго увеличивающихся узлов (T), либо произошел сбой (X)

data T a = Z | T a a | X deriving Eq

И тогда мы можем реализовать isBST напрямую

isBST' :: Ord a => BST a -> Bool
isBST' b = cata phi Z b /= X where
  phi X _ _ = X
  phi _ _ X = X
  phi Z a Z = T a a
  phi Z a (T b c) = if a < b then T a c else X
  phi (T a b) c Z = if b < c then T a c else X
  phi (T a b) c (T d e) = if b < c && c < d then T a e else X

Это немного утомительно, так что, возможно, было бы лучше разложить способ составления промежуточных состояний немного:

cons :: Ord a => a -> T a -> T a
cons _ X = X
cons a Z = T a a
cons a (T b c) = if a < b then T a c else X

instance Ord a => Monoid (T a) where
  mempty = Z
  Z `mappend` a = a
  a `mappend` Z = a
  X `mappend` _ = X
  _ `mappend` X = X
  T a b `mappend` T c d = if b < c then T a d else X

isBST'' :: Ord a => BST a -> Bool
isBST'' b = cata phi Z b /= X where
  phi l a r = l `mappend` cons a r

Лично я, вероятно, просто использовал бы экземпляр Foldable.

Answer 4

Если вы не настаиваете на использовании фолда, вы можете сделать это следующим образом:

ord Void = True
ord (Node v l r) = every (< v) l && every (> v) r && ord l && ord r where
    every p Void = True
    every p (Node v l r) = p v && every p l && every p r