Rel.hs revision 1880a161e00b3ef874b408c013c0e5e9b4af9181
1N/A
1N/A{- |
1N/AModule : $Header$
1N/ACopyright : (c) Christian Maeder and Uni Bremen 2003
1N/ALicence : similar to LGPL, see HetCATS/LICENCE.txt or LIZENZ.txt
1N/A
1N/AMaintainer : maeder@tzi.de
1N/AStability : provisional
1N/APortability : portable
1N/A
1N/A
1N/Asupply a simple data type for (precedence or subsort) relations. A
1N/Arelation is conceptually a set of (ordered) pairs (see 'toList' and
1N/A'fromList'). But the hidden implementation is based on a map of sets.
1N/A
1N/A'Rel' replaces a directed graph with unique node labels (Ord a) and
1N/Aunlabelled edges (without multiplicity higher than one).
1N/A
1N/AUsage: start with an 'empty' relation, 'insert' edges, and test for
1N/Aan edge 'member' (before or after calling 'transClosure').
1N/A
1N/AIt is possible to insert self edges or bigger cycles.
1N/A
1N/AA transitive path can be checked by 'transMember' without computing
1N/Athe full transitive closure. A further 'insert', however,
1N/Amay destroy the closedness property of a relation.
1N/A
1N/ACurrently, no further functions seem to be necessary:
1N/A
1N/A- deletion
1N/A
1N/A- filtering, mapping
1N/A
1N/A- transposing
1N/A
1N/A- reflexive closure (for a finite domain)
1N/A
1N/A- computing a minimal relation whose transitive closure
1N/A covers a given relation
1N/A
1N/A-}
1N/A
1N/Amodule Common.Lib.Rel (Rel(), empty, isEmpty, insert, member, toMap
1N/A , transMember, transClosure, fromList, toList
1N/A , image, restrict, toSet, fromSet) where
1N/A
1N/Aimport qualified Common.Lib.Map as Map
1N/Aimport qualified Common.Lib.Set as Set
1N/A
1N/Anewtype Rel a = Rel { toMap :: Map.Map a (Set.Set a) } deriving Eq
1N/A
1N/A-- | the empty relation
1N/Aempty :: Rel a
1N/Aempty = Rel Map.empty
1N/A
1N/A-- | test for 'empty'
1N/AisEmpty :: Rel a -> Bool
1N/AisEmpty = Map.isEmpty . toMap
1N/A
1N/A-- | insert an ordered pair
1N/Ainsert :: Ord a => a -> a -> Rel a -> Rel a
1N/Ainsert a b =
1N/A let update m = Map.insert a ((b `Set.insert`) $
1N/A Map.findWithDefault Set.empty a m) m
1N/A in
1N/A Rel . update .toMap
1N/A
1N/A-- | test for an (previously inserted) ordered pair
1N/Amember :: Ord a => a -> a -> Rel a -> Bool
1N/Amember a b r = Set.member b $ getDAdjs r a
1N/A
1N/A-- | get direct right neighbours
1N/AgetDAdjs :: Ord a => Rel a -> a -> Set.Set a
1N/AgetDAdjs r a = Map.findWithDefault Set.empty a $ toMap r
1N/A
1N/A-- | get right neighbours and right neighbours of right neighbours
1N/AgetTAdjs :: Ord a => Rel a -> Set.Set a -> Set.Set a -> Set.Set a
1N/A-- transitive right neighbours
1N/A-- initial call 'getTAdjs succs r Set.empty $ Set.single a'
1N/AgetTAdjs r given new =
1N/A if Set.isEmpty new then given else
1N/A let ds = Set.unions $ map (getDAdjs r) $ Set.toList new in
1N/A getTAdjs r (ds `Set.union` given) (ds Set.\\ new Set.\\ given)
1N/A
1N/A-- | test for 'member' or transitive membership
1N/AtransMember :: Ord a => a -> a -> Rel a -> Bool
1N/AtransMember a b r = Set.member b $ getTAdjs r Set.empty $ Set.single a
1N/A
1N/A-- | compute transitive closure (make all transitive members direct members)
1N/AtransClosure :: Ord a => Rel a -> Rel a
1N/AtransClosure r = Rel $ Map.map ( \ s -> getTAdjs r s s) $ toMap r
1N/A
1N/A-- | convert a list of ordered pairs to a relation
1N/AfromList :: Ord a => [(a, a)] -> Rel a
1N/AfromList = foldr (\ (a, b) r -> insert a b r ) empty
1N/A
1N/A-- | convert a relation to a list of ordered pairs
1N/AtoList :: Ord a => Rel a -> [(a, a)]
1N/AtoList = concatMap (\ (a , bs) -> map ( \ b -> (a, b) ) (Set.toList bs))
1N/A . Map.toList . toMap
1N/A
1N/Ainstance (Show a, Ord a) => Show (Rel a) where
1N/A show = show . Set.fromList . toList
1N/A
1N/A{--------------------------------------------------------------------
1N/A Image (Added by T.M.)
1N/A--------------------------------------------------------------------}
1N/A-- | /n/. Image of a relation under a function
1N/Aimage :: Ord b => (a -> b) -> Rel a -> Rel b
1N/Aimage f = Rel
1N/A .
1N/A Map.foldWithKey
1N/A (\a ra -> Map.insert (f a) (Set.image f ra))
1N/A Map.empty
1N/A .
1N/A toMap
1N/A
1N/A{--------------------------------------------------------------------
1N/A Restriction (Added by T.M.)
1N/A--------------------------------------------------------------------}
1N/A-- | /n/. Image of a relation under a function
1N/Arestrict :: Ord a => Rel a -> Set.Set a -> Rel a
1N/Arestrict r s =
1N/A Rel
1N/A $
1N/A Map.foldWithKey
1N/A (\a ra -> if a `Set.member` s
1N/A then Map.insert a (ra `Set.intersection` s)
1N/A else id)
1N/A Map.empty
1N/A $
1N/A toMap r
1N/A
1N/A{--------------------------------------------------------------------
1N/A Conversion from/to sets (Added by T.M.)
1N/A--------------------------------------------------------------------}
1N/AtoSet :: (Ord a) => Rel a -> Set.Set (a, a)
1N/AtoSet = Map.foldWithKey (\a ra -> Set.fold (\b -> (Set.insert (a,b) .) ) id ra) Set.empty
1N/A . toMap
1N/A
1N/AfromSet :: (Ord a) => Set.Set (a, a) -> Rel a
1N/AfromSet = Rel .
1N/A Set.fold (\(a,b) -> Map.setInsert a b) Map.empty
1N/A