-- -- Diet.hs -- Implementation of Discrete Interval Encoding Trees -- (described in the paper "Diets for Fat Sets", JFP) -- module Diet (Diet(..), member,insert,delete, foldDiet,size,toList ) where import Discrete -- -- Discrete is an extension of Ix -- -- module Discrete (Discrete(..)) where -- -- class Ix a => Discrete a where -- pre, suc :: a -> a -- adjacent :: a -> a -> Bool -- adjacent x y = suc x==y -- -- instance Discrete Int where -- pre x = x-1 -- suc x = x+1 data Discrete a => Diet a = Empty | Node (Diet a) (a,a) (Diet a) deriving (Eq) -- for a convenient debugging: -- showsDiscrete :: (Show a,Discrete a) => (a,a) -> ShowS showsDiscrete (i,j) = (" ["++) . shows i . (',':) . shows j . ("] "++) showsDiet :: (Show a,Discrete a) => Diet a -> ShowS showsDiet Empty = id showsDiet (Node l int r) = ('(':) . showsDiet l . showsDiscrete int . showsDiet r . (')':) instance (Show a,Discrete a) => Show (Diet a) where showsPrec _ d = showsDiet d ---------------------------------------------------------------------- -- UTILITIES ---------------------------------------------------------------------- splitMin :: Discrete a => Diet a -> (Diet a,(a,a)) splitMin (Node Empty i r) = (r,i) splitMin (Node l i r) = (Node d i r,i') where (d,i') = splitMin l splitMax :: Discrete a => Diet a -> (Diet a,(a,a)) splitMax (Node l i Empty) = (l,i) splitMax (Node l i r) = (Node l i d,i') where (d,i') = splitMax r joinLeft :: Discrete a => Diet a -> Diet a joinLeft d@(Node Empty _ _) = d joinLeft (Node l (i,j) r) | adjacent lj i = Node l' (li,j) r | otherwise = Node l (i,j) r where (l',(li,lj)) = splitMax l joinRight :: Discrete a => Diet a -> Diet a joinRight d@(Node _ _ Empty) = d joinRight (Node l (i,j) r) | adjacent j ri = Node l (i,rj) r' | otherwise = Node l (i,j) r where (r',(ri,rj)) = splitMin r merge :: Discrete a => Diet a -> Diet a -> Diet a merge l Empty = l merge Empty r = r merge l r = Node l' i r where (l',i) = splitMax l ---------------------------------------------------------------------- -- MAIN FUNCTIONS ---------------------------------------------------------------------- member :: Discrete a => a -> Diet a -> Bool member x Empty = False member x (Node l (i,j) r) | inRange (i,j) x = True | x a -> Diet a -> Diet a insert x Empty = Node Empty (x,x) Empty insert x d@(Node l (i,j) r) = if xj then if adjacent j x then joinRight (Node l (i,x) r) else Node l (i,j) (insert x r) else d delete :: Discrete a => a -> Diet a -> Diet a delete x Empty = Empty delete x (Node l (i,j) r) | xj = Node l (i,j) (delete x r) | x==i = if i==j then merge l r else Node l (suc i,j) r | x==j = Node l (i,pre j) r | otherwise = Node l (i,pre x) (Node Empty (suc x,j) r) ---------------------------------------------------------------------- -- MORE FUNCTIONS ... ---------------------------------------------------------------------- foldDiet :: Discrete a => (b -> (a,a) -> b -> b) -> b -> Diet a -> b foldDiet f u Empty = u foldDiet f u (Node l i r) = f (foldDiet f u l) i (foldDiet f u r) size :: Discrete a => Diet a -> Int size = foldDiet (\x i y->x+rangeSize i+y) 0 toList :: Discrete a => Diet a -> [a] toList = foldDiet (\xs i ys->xs++range i++ys) [] ---------------------------------------------------------------------- -- APPLICATION FUNCTIONS, EXAMPLES ---------------------------------------------------------------------- build :: Discrete a => [a] -> Diet a build = foldl (flip insert) Empty l = [6,9,2,13,8,14,10,7,5] d = build l