Как отмечается в комментариях, ваш тип не совсем обрезает его. Разумная реализация набора в виде дерева может иметь тип:
data Set a = Leaf | Node a (Set a) (Set a) deriving (Show)
^- note this extra `a`
, где каждый внутренний Node x l r
имеет все элементы в l
меньше x
и все элементы в r
больше x
.
Вы можете рекурсивно разбить такой Set
следующим образом:
partition :: (a -> Bool) -> Set a -> (Set a, Set a)
Случай Leaf
очевиден:
partition _ Leaf = (Leaf, Leaf)
Вот как мы делаем дело Node
. Для под-случая, где предикат содержит значение x
в узле, обратите внимание, что мы хотим:
partition f (Node x l r) | f x = (Node x l1 r1, ...)
, где l1
и r1
- это подмножества элементов в l
и r
, которые удовлетворяют предикату, который мы можем получить путем рекурсивного разделения l
и r
.
where (l1, l2) = partition f l
(r1, r2) = partition f r
Инвариант Set
будет сохранен здесь, потому что все элементы в l
в том числе в подмножестве l1
меньше x
; по той же причине все элементы в r1
больше, чем x
. Единственный недостающий элемент - нам нужно как-то объединить l2
и r2
для формирования второй части кортежа:
partition f (Node x l r) | f x = (Node x l1 r1, combine l2 r2)
Поскольку combine
- это функция, которая принимает два дерева со всеми элементами в первом дереве меньше, чем все элементы во втором дереве, следующая рекурсивная функция будет делать:
combine Leaf r' = r'
combine (Node x l r) r' = Node x l (combine r r')
Случай, когда предикат не удерживается для x
, обрабатывается аналогично , давая полное определение:
data Set a = Leaf | Node a (Set a) (Set a)
partition :: (a -> Bool) -> Set a -> (Set a, Set a)
partition _ Leaf = (Leaf, Leaf)
partition f (Node x l r)
| f x = (Node x l1 r1, combine l2 r2)
| otherwise = (combine l1 r1, Node x l2 r2)
where (l1, l2) = partition f l
(r1, r2) = partition f r
combine Leaf r' = r'
combine (Node x l r) r' = Node x l (combine r r')
Вот полный код плюс тест QuickCheck, что эта функция разбиения работает как положено:
import Test.QuickCheck
import qualified Data.List (nub, partition, sort)
import Data.List (nub, sort)
data Set a = Leaf | Node a (Set a) (Set a) deriving (Show)
partition :: (a -> Bool) -> Set a -> (Set a, Set a)
partition _ Leaf = (Leaf, Leaf)
partition f (Node x l r)
| f x = (Node x l1 r1, combine l2 r2)
| otherwise = (combine l1 r1, Node x l2 r2)
where (l1, l2) = partition f l
(r1, r2) = partition f r
combine Leaf r' = r'
combine (Node x l r) r' = Node x l (combine r r')
insert :: (Ord a) => a -> Set a -> Set a
insert x Leaf = Node x Leaf Leaf
insert x (Node y l r) = case compare x y of
LT -> Node y (insert x l) r
GT -> Node y l (insert x r)
EQ -> Node y l r
fromList :: (Ord a) => [a] -> Set a
fromList = foldr insert Leaf
toList :: (Ord a) => Set a -> [a]
toList Leaf = []
toList (Node x l r) = toList l ++ x : toList r
prop_partition :: [Int] -> Bool
prop_partition lst =
let (l, r) = Main.partition even (fromList lst') in (toList l, toList r)
== Data.List.partition even (sort $ lst')
where lst' = nub lst
main = quickCheck (withMaxSuccess 10000 prop_partition)