module SimpleMap (FiniteMap(..),
emptyFM,addToFM,delFromFM,
updFM,
accumFM,
splitFM,
isEmptyFM,sizeFM,lookupFM,elemFM,
rangeFM,
minFM,maxFM,predFM,succFM,
splitMinFM,
fmToList
) where
import Data.Maybe (isJust)
data FiniteMap a b = Empty
| Node (FiniteMap a b) (a,b) (FiniteMap a b)
deriving (Eq)
emptyFM :: Ord a => FiniteMap a b
isEmptyFM :: FiniteMap a b -> Bool
elemFM :: Ord a => FiniteMap a b -> a -> Bool
sizeFM :: Ord a => FiniteMap a b -> Int
minFM :: Ord a => FiniteMap a b -> Maybe (a,b)
maxFM :: Ord a => FiniteMap a b -> Maybe (a,b)
lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b
succFM :: Ord a => FiniteMap a b -> a -> Maybe (a,b)
predFM :: Ord a => FiniteMap a b -> a -> Maybe (a,b)
succFM' :: Ord a => FiniteMap a b -> a -> Maybe (a,b) -> Maybe (a,b)
predFM' :: Ord a => FiniteMap a b -> a -> Maybe (a,b) -> Maybe (a,b)
rangeFM :: Ord a => FiniteMap a b -> a -> a -> [b]
delFromFM :: Ord a => FiniteMap a b -> a -> FiniteMap a b
addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
updFM :: Ord a => FiniteMap a b -> a -> (b -> b) -> FiniteMap a b
accumFM :: Ord a => FiniteMap a b -> a -> (b -> b -> b) -> b -> FiniteMap a b
fmToList :: Ord a => FiniteMap a b -> [(a,b)]
merge :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
splitMax :: Ord a => FiniteMap a b -> (FiniteMap a b,(a,b))
splitMinFM :: Ord a => FiniteMap a b -> Maybe (FiniteMap a b,(a,b))
splitFM :: Ord a => FiniteMap a b -> a -> Maybe (FiniteMap a b,(a,b))
emptyFM = Empty
isEmptyFM Empty = True
isEmptyFM _ = False
sizeFM(Empty ) = 0
sizeFM (Node l _ r) = sizeFM l + 1 + sizeFM r
minFM (Empty ) = Nothing
minFM (Node Empty x _____) = Just x
minFM (Node l x _____) = minFM l
maxFM (Empty ) = Nothing
maxFM (Node _____ x Empty) = Just x
maxFM (Node _____ x r ) = maxFM r
predFM m i = predFM' m i Nothing
succFM m i = succFM' m i Nothing
rangeFM m i j = rangeFMa m i j []
elemFM m i = case lookupFM m i of {Nothing -> False; _ -> True}
addToFM (Empty ) i x = Node Empty ( i, x) Empty
addToFM (Node l (j,y) r) i x | i < j = Node (addToFM l i x) (j ,y ) r
| i > j = Node l (j ,y ) (addToFM r i x)
| otherwise = Node l (j , x) r
accumFM (Empty ) i f x = Node Empty (i , x ) Empty
accumFM (Node l (j,y) r) i f x | i < j = Node (accumFM l i f x) ( j, y) r
| i > j = Node l ( j, y) (accumFM r i f x)
| otherwise = Node l ( j,f x y) r
updFM (Empty ) _ _ = Empty
updFM (Node l (j,x) r) i f | i < j = Node (updFM l i f) (j, x) r
| i > j = Node l (j, x) (updFM r i f)
| otherwise = Node l (j,f x) r
delFromFM (Empty ) _ = Empty
delFromFM (Node l (j,x) r) i | i < j = Node (delFromFM l i) (j,x) r
| i > j = Node l (j,x) (delFromFM r i)
| otherwise = merge l r
lookupFM (Empty ) _ = Nothing
lookupFM (Node l (j,x) r) i | i < j = lookupFM l i
| i > j = lookupFM r i
| otherwise = Just x
rangeFMa (Empty ) _ _ a = a
rangeFMa (Node l (k,x) r) i j a | k < i = rangeFMa r i j a
| k > j = rangeFMa l i j a
| otherwise = rangeFMa l i j (x : rangeFMa r i j a)
predFM' (Empty ) _ p = p
predFM' (Node l (j,x) r) i p | i < j = predFM' l i p
| i > j = predFM' r i (Just (j,x))
| isJust ml = ml
| otherwise = p
where ml = maxFM l
succFM' (Empty ) _ p = p
succFM' (Node l (j,x) r) i p | i < j = succFM' l i (Just (j,x))
| i > j = succFM' r i p
| isJust mr = mr
| otherwise = p
where mr = minFM r
fmToList m = scan m []
where scan Empty xs = xs
scan (Node l x r) xs = scan l (scan r (x:xs))
splitFM (Empty ) _ = Nothing
splitFM (Node l (j,x) r) i = if i < j then case splitFM l i of Just (l',y) -> Just (Node l' (j,x) r ,y)
Nothing -> Nothing
else
if i > j then case splitFM r i of Just (r',y) -> Just (Node l (j,x) r',y)
Nothing -> Nothing
else Just (merge l r ,(j,x))
splitMinFM (Empty ) = Nothing
splitMinFM (Node Empty x r) = Just (r,x)
splitMinFM (Node l x r) = Just (Node l' x r,y)
where Just (l' ,y) = splitMinFM l
splitMax (Node l x Empty) = (l,x)
splitMax (Node l x r ) = (Node l x m , y) where
(m , y) = splitMax r
merge l Empty = l
merge Empty r = r
merge l r = Node l' x r where
(l',x) = splitMax l
showsMap :: (Show a,Show b,Ord a) => FiniteMap a b -> ShowS
showsMap (Empty ) = id
showsMap (Node l (i,x) r) = showsMap l . (' ':) .
shows i . (" -> "++) . shows x . showsMap r
instance (Show a,Show b,Ord a) => Show (FiniteMap a b) where
showsPrec _ m = showsMap m