Ordered association lists > module OrdAssList ( FM, OrdAssList, > -- construction > empty, singleton, union, unionMany, > add, (///), > -- construction with combining function > union_C, unionMany_C, add_C, addMany_C, > -- modification > intersect, delete, deleteMany, minus, > amapFM, > -- conversion > toList, fromList, > -- size > -- length, genericLength > -- testing > --null > isSingleton, > -- extraction > elemsFM, indicesFM, > -- lookup > lookup, lookupWithDefault, > lookupWithContinuation, > -- *additional functions* > toSortedList, fromSortedList, > prefixLookup > ) > where > import Sort ( mergeSortBy, uniqueBy ) > import Subsequences ( isPrefixOf ) > import Support ( applyWithDefault, applyWithContinuation ) > applyWithDefault :: (a -> Maybe b) -> b -> a -> b > applyWithDefault f def a = case f a of Nothing -> def; Just v -> v > applyWithContinuation :: (a -> Maybe b) -> (b -> c) -> c -> a -> c > applyWithContinuation f succ err a > = case f a of Nothing -> err; Just v -> succ v Note: many functions are identical to those of OrdList except for the compare function. Type definitions > type FM a b = OrdAssList a b Lists ordered by the first component containing no duplicates. > type OrdAssList a b = [(a, b)] Lists are already instances of Eq and Ord. > --instance Eq a => Eq (FM a b) > --instance Ord a => Ord (FM a b) Construction > empty :: FM a b > empty = [] > singleton :: (a,b) -> FM a b > singleton b = [b] union corresponds to merge. > union :: Ord a => FM a b -> FM a b -> FM a b > union [] y = y > union x@(_:_) [] = x > union x@(a:x') y@(b:y') = case comparet a b of > LT -> a : union x' y > EQ -> a : union x' y' > GT -> b : union x y' > unionMany :: Ord a => [FM a b] -> FM a b > unionMany = foldl union empty > add :: Ord a => (a,b) -> FM a b -> FM a b > add a [] = [a] > add a x@(b:x') = case comparet a b of > LT -> a : x > EQ -> a : x' > GT -> b : add a x' Note: /// instead of //. > (///) :: Ord a => FM a b -> [(a,b)] -> FM a b > --x /// bs = foldr add x bs -- insertion sort > x /// bs = x `union` fromList bs -- merge sort Construction with combining function The combining function is called as combine old new and combine left right, respectively. > union_C :: Ord a => (b -> b -> b) > -> FM a b -> FM a b -> FM a b > union_C combine [] y = y > union_C combine x@(_:_) [] = x > union_C combine x@(b1@(a1,v1):x') y@(b2@(a2,v2):y') > = case compare a1 a2 of > LT -> b1 : union_C combine x' y > EQ -> (a1,combine v1 v2) : union_C combine x' y' > GT -> b2 : union_C combine x y' > unionMany_C :: Ord a => (b -> b -> b) -> [FM a b] -> FM a b > unionMany_C combine = foldl (union_C combine) empty > add_C :: Ord a => (b -> b -> b) > -> (a,b) -> FM a b -> FM a b > add_C combine b [] = [b] > add_C combine b1@(a1,v1) x@(b2@(a2,v2):x') > = case compare a1 a2 of > LT -> b1 : x > EQ -> (a1,combine v1 v2) : x' > GT -> b2 : add_C combine b1 x' > addMany_C :: Ord a => (b -> b -> b) > -> FM a b -> [(a,b)] -> FM a b > addMany_C combine x bs = union_C combine x (fromList bs) Modification > intersect :: Ord a => FM a b -> FM a b -> FM a b > intersect [] y = [] > intersect x@(_:_) [] = [] > intersect x@(a:x') y@(b:y') = case comparet a b of > LT -> intersect x' y > EQ -> a : intersect x' y' > GT -> intersect x y' > delete :: Ord a => a -> FM a b -> FM a b > delete a [] = [] > delete a x@(b:x') = case compare a (fst b) of > LT -> x > EQ -> x' > GT -> b : delete a x' > deleteMany :: Ord a => FM a b -> [a] -> FM a b > deleteMany = foldr delete > minus :: Ord a => FM a b -> FM a b -> FM a b > minus [] y = [] > minus x@(_:_) [] = x > minus x@(a:x') y@(b:y') = case comparet a b of > LT -> a : minus x' y > EQ -> minus x' y' > GT -> minus x y' > amapFM :: ((a,b) -> c) -> (FM a b -> FM a c) > amapFM f bs = [ (a,f b) | b@(a,v)<-bs ] Note: partition, filter, foldl, foldr need no redefinition. Conversion > toList :: FM a b -> [(a,b)] > toList = id > fromList :: Ord a => [(a,b)] -> FM a b > fromList = fromSortedList > . mergeSortBy (\p q -> fst p <= fst q) Size Note: length and genericLength need no redefinition. > --length :: FM a b -> Int > --genericLength :: Integral i => FM a b -> i Testing Note: null needs no redefinition. > --null :: FM a b -> Bool > isSingleton :: FM a b -> Bool > isSingleton [a] = True > isSingleton _ = False > intersecting :: Ord a => FM a b -> FM a b -> Bool > intersecting [] y = False > intersecting x@(_:_) [] = False > intersecting x@(a:x') y@(b:y')= case comparet a b of > LT -> intersecting x' y > EQ -> True > GT -> intersecting x y' > isSubsetOf :: Ord a => FM a b -> FM a b -> Bool > isSubsetOf [] y = True > isSubsetOf x@(_:_) [] = False > isSubsetOf x@(a:x') y@(b:y') = case comparet a b of > LT -> False > EQ -> isSubsetOf x' y' > GT -> isSubsetOf x y' Extraction Note: elemsFM instead of elems. Dito: indicesFM. > elemsFM :: FM a b -> [b] > elemsFM = map snd > indicesFM :: FM a b -> [a] > indicesFM = map fst Lookup Note: ! is predefined. > --(!) :: Ord a => FM a b -> a -> b > --x ! a = lookupWithDefault x > -- (error "OrdAssList.!: elem not found") a > lookupt :: Ord a => FM a b -> a -> Maybe b > lookupt [] a = Nothing > lookupt x@(b:x') a = case compare a (fst b) of > LT -> Nothing > EQ -> Just (snd b) > GT -> lookupt x' a > lookupWithDefault :: Ord a => FM a b -> b -> a -> b > lookupWithDefault = applyWithDefault . lookupt > lookupWithContinuation :: Ord a => FM a b -> (b -> c) -> c -> a -> c > lookupWithContinuation = applyWithContinuation . lookupt Additional functions > toSortedList :: FM a b -> [(a,b)] > toSortedList = id > fromSortedList :: Eq a => [(a,b)] -> FM a b > fromSortedList = uniqueBy (\p q -> fst p == fst q) prefixLookup returns the list of all completions of the given list. > prefixLookup :: Ord a => FM [a] b -> [a] -> [([a],b)] > prefixLookup x s = [ b | b@(a, _)<-x, s `isPrefixOf` a ] Auxiliary functions > comparet :: Ord a => (a,b) -> (a,b) -> Ordering > comparet p q = compare (fst p) (fst q)