Changes to QC/RBTree.hs. All files

QC/RBTree.hs

new file mode 100644@@ -0,0 +1,61 @@+{-# LANGUAGE MultiParamTypeClasses #-}++module QC.RBTree+where++-- much of this code adapted from Functional Pearls+-- Red-Black Trees in a Functional Setting++import Data.Monoid++data Color = Red+           | Black deriving (Eq)++data Ord a => RBTree a = Empty | Node Color (RBTree a) a (RBTree a) deriving+           (Eq, Show)++instance Show Color where+    show Red = "Red"+    show Black = "Black"++instance Ord a => Monoid (RBTree a) where+    mempty = Empty+    mappend = undefined++--this shit is weird+--instance Show a => Show (RBTree a) where+--    show (Node c l v r) = "(" ++ show c ++ show l ++ show v ++ show r ++ ")"+--    show Empty = "Empty"++member :: Ord a => a -> RBTree a -> Bool+member elem Empty = False+member elem (Node _ l x r) | elem < x  = (member elem l)+                           | elem > x  = (member elem r)+                           | elem == x = True++rbify :: Ord a => [a] -> RBTree a+rbify = foldr insert Empty++insert :: Ord a => a -> RBTree a -> RBTree a+insert elem tree = makeBlack (ins tree)+  where ins Empty = Node Red Empty elem Empty+        ins (Node color l val r) | elem < val  = balance color (ins l) val r+                                 | elem == val = Node color l val r+                                 | elem > val  = balance color l val (ins r)++makeBlack :: Ord a => RBTree a -> RBTree a+makeBlack (Node _ l a r) = Node Black l a r++--makeRed :: (Ord a) => RBTree a -> RBTree a+--makeRed (Node _ l a r) = Node Red l a r++balance :: Ord a => Color -> RBTree a -> a -> RBTree a -> RBTree a+balance Black (Node Red (Node Red a x b) y c) z d =+          Node Red (Node Black a x b) y (Node Black c z d)+balance Black (Node Red a x (Node Red b y c)) z d =+          Node Red (Node Black a x b) y (Node Black c z d)+balance Black a x (Node Red (Node Red b y c) z d) =+          Node Red (Node Black a x b) y (Node Black c z d)+balance Black a x (Node Red b y (Node Red c z d)) =+          Node Red (Node Black a x b) y (Node Black c z d)+balance color a x b = Node color a x b