module BST where
import Persistent
import Test.QuickCheck hiding (elements)
import System.Random (Random)
import Control.Monad (liftM, liftM2, liftM3)
import Data.List hiding (insert,delete)
import Data.Monoid
data BST a = E -- empty
| N (BST a) a (BST a) -- nonempty
deriving (Eq, Show)
prop_BST :: BST Int -> Bool
prop_BST E = True
prop_BST (N l x r) = undefined
tree_min :: BST Int -> Maybe Int
tree_min E = Nothing
tree_min (N l x r) =
maybes min (tree_min l) (tree_min r)
tree_max :: BST Int -> Maybe Int
tree_max E = Nothing
tree_max (N l x r) =
maybes max (tree_max l) (tree_max 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
instance Set BST where
-- empty :: BST a
empty = E
-- member :: Ord a => a -> BST a -> Bool
member x E = undefined
-- elements :: Ord a => BST a -> [a]
elements E = []
elements (N a y b) = elements a ++ [y] ++ elements b
-- insert :: Ord a => a -> BST a -> BST a
insert = undefined
prop_insert_preserves :: Int -> BST Int -> Bool
prop_insert_preserves x t = prop_BST (insert x t)
-- instance (Ord a, Arbitrary a) => Arbitrary (BST a) where
-- arbitrary = liftM (foldr insert empty) arbitrary
instance (Ord a, Bounded a, Random a, Num a, Arbitrary a) => Arbitrary (BST a) where
arbitrary = gen 0 100 where
gen :: (Ord a, Num a, Random a) => a -> a -> Gen (BST a)
gen min max | (max - min) <= 3 = return E
gen min max = do
elt <- choose (min, max)
frequency [ (1, return E),
(6, liftM3 N (gen min (elt - 1))
(return elt) (gen (elt + 1) max)) ]
delete :: Ord a => a -> BST a -> BST a
delete x E = E
delete x (N a y b) | x < y = N (delete x a) y b
| x > y = N a y (delete x b)
| x == y =
case (a,b) of
(E,_) -> b
(_,E) -> a
(N _ _ _,_) -> N a' z b where
(z,a') = deleteMax a
deleteMax :: Ord a => BST a -> (a, BST a)
deleteMax E = error "Impossible case"
deleteMax (N a y E) = (y, a)
deleteMax (N a y b) = (x, N a y b') where
(x,b') = deleteMax b
prop_delete :: Int -> [Int]-> Bool
prop_delete x xs =
not (member y (delete y (foldr insert empty xs))) where
y = xs !! z
z = x `mod` length xs
bst :: Proxy BST
bst = undefined
main :: IO ()
main = do
quickCheck prop_BST
quickCheck $ prop_empty bst
quickCheck $ prop_insert1 bst
quickCheck $ prop_insert2 bst
quickCheck prop_insert_preserves
quickCheck prop_delete