Abhiroop

delL x t@(T R t1 y t2) = T R (del x t1) y t2

delR x t@(T R t1 y t2) = T R t1 y (del x t2)

Abhiroop

delL :: (Ord a) => a -> Tree a -> Tree a

delR :: (Ord a) => a -> Tree a -> Tree a

Abhiroop

data Nat = Zero | Succ Nat

data T n a = NodeR (Tree n a) a (Tree (Succ n) a) -- right subtree has height + 1
           | NodeL (Tree (Succ n) a) a (Tree n a) -- left subtree has height + 1
           | Node (Tree n a) a (Tree n a)     -- both subtrees are of equal height

data Tree n a where
  Branch :: T n a -> Tree (Succ n) a
  Leaf :: Tree Zero a

Abhiroop

{-# LANGUAGE GADTs, DataKinds  #-}

Abhiroop

delete :: (Ord a) => a -> Tree a -> Tree a
delete x t = makeBlack $ del x t
  where makeBlack (T _ a y b) = T B a y b
        makeBlack E           = E

del :: (Ord a) => a -> Tree a -> Tree a
del x t@(T _ l y r)
  | x < y = delL x t
  | x > y = delR x t
  | otherwise = fuse l r

Abhiroop

fuse (T B t1 x t2) (T B t3 y t4)  =
  let s = fuse t2 t3
  in case s of
       (T R s1 z s2) -> (T R (T B t1 x s1) z (T B s2 y t4)) -- consfusing case
       (T B s1 z s2) -> balL (T B t1 x (T B s y t4))

Abhiroop

fuse (T R t1 x t2) (T R t3 y t4)  =
  let s = fuse t2 t3
  in case s of
       (T R s1 z s2) -> (T R (T R t1 x s1) z (T R s2 y t4))
       (T B _ _ _)   -> (T R t1 x (T R s y t4))

Abhiroop

fuse t1@(T B _ _ _) (T R t3 y t4) = T R (fuse t1 t3) y t4
fuse (T R t1 x t2) t3@(T B _ _ _) = T R t1 x (fuse t2 t3)

Abhiroop

delL x t@(T B t1 y t2) = balL $ T B (del x t1) y t2

delR x t@(T B t1 y t2) = balR $ T B t1 y (del x t2)

Abhiroop

balR :: Tree a -> Tree a
balR (T B t1 y (T R t2 x t3)) = T R t1 y (T B t2 x t3)
balR (T B (T B t1 z t2) y t3) = balance' (T B (T R t1 z t2) y t3)
balR (T B (T R t1@(T B l value r) z (T B t2 u t3)) y t4) =
  T R (balance' (T B (T R l value r) z t2)) u (T B t3 y t4)