module RedBlack where
import Persistent
import Control.Monad
import Test.QuickCheck
import Data.Maybe as Maybe
data Color = R | B deriving (Eq, Show)
data RBT a = E | N Color (RBT a) a (RBT a)
deriving Show
color :: RBT a -> Color
color E = B
color (N c _ _ _) = c
instance Set RBT where
-- empty :: RBT a
empty = E
-- member :: Ord a => a -> RBT a -> Bool
member x E = False
member x (N _ a y b)
| x < y = member x a
| x > y = member x b
| otherwise = True
-- elements :: Ord a => RBT a -> [a]
elements t = aux t [] where
aux E xs = xs
aux (N _ a y b) xs = aux a (y : aux b xs)
insert = bst_insert
ins :: Ord a => a -> RBT a -> RBT a
ins x E = undefined
ins x s@(N c a y b)
| x < y = undefined
| x > y = undefined
| otherwise = s
bst_insert :: Ord a => a -> RBT a -> RBT a
bst_insert x t = blacken (ins x t) where
blacken = undefined
balance :: Ord a => RBT a -> RBT a
balance (N B (N R (N R a x b) y c) z d) = undefined
balance (N B (N R a x (N R b y c)) z d) = undefined
balance (N B a x (N R (N R b y c) z d)) = undefined
balance (N B a x (N R b y (N R c z d))) = undefined
balance t = t
instance (Ord a, Arbitrary a) => Arbitrary (RBT a) where
arbitrary = liftM (foldr insert empty) arbitrary
prop_Rb1 :: Bool
prop_Rb1 = color E == B
prop_Rb2 :: RBT Int -> Bool
prop_Rb2 t = color t == B
prop_Rb3 :: RBT Int -> Bool
prop_Rb3 t = Maybe.isJust (aux t) where
aux E = Just 1
aux (N c l _ r) = do
bh1 <- aux l
bh2 <- aux r
guard (bh1 == bh2)
return $ case c of { R -> bh1 ; B -> bh1 + 1 }
prop_Rb4 :: RBT Int -> Bool
prop_Rb4 (N col l _ r) = prop_Rb4 l && prop_Rb4 r
&& if col == R
then (color l == B && color r == B)
else True
prop_Rb4 E = True
prop_BST :: RBT Int -> Bool
prop_BST E = True
prop_BST (N _ l x r) =
prop_BST l && prop_BST r &&
maybe True (x >) (tmax l) &&
maybe True (x <) (tmin r)
maybes :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
maybes f (Just x) (Just y) = Just (f x y)
maybes _ Nothing m = m
maybes _ m Nothing = m
tmin :: RBT Int -> Maybe Int
tmin E = Nothing
tmin (N _ l x r) =
maybes min (tmin l) (tmin r)
tmax :: RBT Int -> Maybe Int
tmax E = Nothing
tmax (N _ l x r) =
maybes max (tmax l) (tmax r)
rbt :: Proxy RBT
rbt = undefined
main :: IO ()
main = do
quickCheck prop_BST
quickCheck $ prop_empty rbt
quickCheck $ prop_insert1 rbt
quickCheck $ prop_insert2 rbt
quickCheck prop_Rb1
quickCheck prop_Rb2
quickCheck prop_Rb3
quickCheck prop_Rb4