Description : Relations, based on maps
Copyright : (c) Uni Bremen 2003-2005
Maintainer : Christian.Maeder@dfki.de
supply a simple data type for (precedence or subsort) relations. A
relation is conceptually a set of (ordered) pairs,
but the hidden implementation is based on a map of sets.
An alternative view is that of a directed Graph
'Rel' is a directed graph with elements (Ord a) as (uniquely labelled) nodes
and (unlabelled) edges (with a multiplicity of at most one).
Usage: start with an 'empty' relation, 'insert' edges, and test for
an edge 'member' (before or after calling 'transClosure').
It is possible to insert self edges or bigger cycles.
Checking for a 'path' corresponds to checking for a member in the
transitive (possibly non-reflexive) closure. A further 'insert', however,
may destroy the closedness property of a relation.
The functions 'image', and 'setInsert' are utility functions
for plain maps involving sets.
( Rel(), empty, null, insert, member, toMap, map
, union, intersection, isSubrelOf, difference, path
, delete, succs, predecessors, irreflex, sccOfClosure
, transClosure, fromList, toList, image, toPrecMap
, intransKernel, mostRight, restrict, delSet
, toSet, fromSet, topSort, nodes, collaps
, transpose, transReduce, setInsert, setToMap
, fromDistinctMap, locallyFiltered
, flatSet, partSet, partList, leqClasses
import Prelude hiding (map, null)
data Rel a = Rel { toMap ::
Map.Map a (
Set.Set a) } deriving (Eq, Ord)
-- the invariant is that set values are never empty
-- | difference of two relations
difference :: Ord a => Rel a -> Rel a -> Rel a
difference a b = fromSet (toSet a Set.\\ toSet b)
-- | union of two relations
union :: Ord a => Rel a -> Rel a -> Rel a
union a b = fromSet $
Set.union (toSet a) $ toSet b
-- | intersection of two relations
intersection :: Ord a => Rel a -> Rel a -> Rel a
-- | is the first relation a sub-relation of the second
isSubrelOf :: Ord a => Rel a -> Rel a -> Bool
-- | insert an ordered pair
insert :: Ord a => a -> a -> Rel a -> Rel a
insert a b = Rel . setInsert a b . toMap
-- | delete an ordered pair
delete :: Ord a => a -> a -> Rel a -> Rel a
-- | test for an (previously inserted) ordered pair
member :: Ord a => a -> a -> Rel a -> Bool
-- | get direct successors
succs :: Ord a => Rel a -> a ->
Set.Set a
-- | get all transitive successors
reachable :: Ord a => Rel a -> a ->
Set.Set a
-- | predecessors of one node in the given set of a nodes
-- | get direct predecessors inefficiently
predecessors :: Ord a => Rel a -> a ->
Set.Set a
-- | test for 'member' or transitive membership (non-empty path)
path :: Ord a => a -> a -> Rel a -> Bool
-- | compute transitive closure (make all transitive members direct members)
transClosure :: Ord a => Rel a -> Rel a
transClosure r@(Rel m) = Rel $
Map.mapWithKey ( \ k _ -> reachable r k) m
-- | get reverse relation
transpose :: Ord a => Rel a -> Rel a
transpose = fromList .
List.map ( \ (a, b) -> (b, a)) . toList
-- | establish the invariant
-- | make relation irreflexive
irreflex :: Ord a => Rel a -> Rel a
-- | compute strongly connected components for a transitively closed relation
sccOfClosure :: Ord a => Rel a -> [
Set.Set a]
let c = preds r k v in -- get the cycle
else sccOfClosure (Rel p)
{- | restrict strongly connected components to its minimal representative
(input sets must be non-null). Direct cycles may remain. -}
collaps :: Ord a => [
Set.Set a] -> Rel a -> Rel a
{- | transitive reduction (minimal relation with the same transitive closure)
of a transitively closed DAG (
i.e. without cycles)! -}
transReduce :: Ord a => Rel a -> Rel a
transReduce (Rel m) = Rel $ rmNull $
-- keep all (i, j) in rel for which no c with (i, c) and (c, j) in rel
-- | convert a list of ordered pairs to a relation
fromList :: Ord a => [(a, a)] -> Rel a
fromList = foldr (uncurry insert) empty
-- | convert a relation to a list of ordered pairs
toList :: Rel a -> [(a, a)]
toList (Rel m) = concatMap (\ (a , bs) ->
List.map ( \ b -> (a, b) )
instance (Show a, Ord a) => Show (Rel a) where
-- | Insert into a set of values
-- | map the values of a relation
map :: (Ord a, Ord b) => (a -> b) -> Rel a -> Rel b
-- | Restriction of a relation under a set
restrict :: Ord a => Rel a ->
Set.Set a -> Rel a
restrict r s = delSet (nodes r Set.\\ s) r
-- | restrict to elements not in the input set
delSet :: Ord a =>
Set.Set a -> Rel a -> Rel a
delSet s (Rel m) = Rel $ rmNull (
Map.map (Set.\\ s) m) Map.\\ setToMap s
-- | convert a relation to a set of ordered pairs
toSet :: (Ord a) => Rel a ->
Set.Set (a, a)
-- | convert a set of ordered pairs to a relation
fromSet :: (Ord a) =>
Set.Set (a, a) -> Rel a
-- | convert a sorted list of ordered pairs to a relation
fromAscList :: (Ord a) => [(a, a)] -> Rel a
-- | all nodes of the edges
nodes :: Ord a => Rel a ->
Set.Set a
{- | Construct a precedence map from a closed relation. Indices range
between 1 and the second value that is output. -}
toPrecMap :: Ord a => Rel a -> (
Map.Map a Int, Int)
toPrecMap = foldl ( \ (m1, c) s -> let n = c + 1 in
topSortDAG :: Ord a => Rel a -> [
Set.Set a]
topSortDAG r@(Rel m) = if
Map.null m then [] else
-- | topologically sort a closed relation (ignore isolated cycles)
topSort :: Ord a => Rel a -> [
Set.Set a]
topSort r = let cs = sccOfClosure r in
List.map (expandCycle cs) $ topSortDAG $ irreflex $ collaps cs r
-- | find the cycle and add it to the result set
expandCycle cs s = case cs of
{- | gets the most right elements of the irreflexive relation,
unless no hierarchy is left then isolated nodes are output -}
mostRightOfCollapsed :: Ord a => Rel a ->
Set.Set a
else let Rel im = irreflex r
find s such that x in s => forall y . yRx or not yRx and not xRy
* precondition: (transClosure r == r)
* strongly connected components (cycles) are treated as a compound node
mostRight :: (Ord a) => Rel a -> (
Set.Set a)
in expandCycle cs (mostRightOfCollapsed $ collaps cs r)
intransitive kernel of a reflexive and transitive closure
* precondition: (transClosure r == r)
* cycles are uniquely represented (according to Ord)
intransKernel :: Ord a => Rel a -> Rel a
in foldr addCycle (transReduce $ collaps cs r) cs
-- add a cycle given by a set in the collapsed node
addCycle :: Ord a =>
Set.Set a -> Rel a -> Rel a
in insert m a $ foldr (uncurry insert) (delete a a r) $
{- | calculates if two given elements have a common left element
* if one of the arguments is not present False is returned
haveCommonLeftElem :: (Ord a) => a -> a -> Rel a -> Bool
haveCommonLeftElem t1 t2 =
-- | partitions a set into a list of disjoint non-empty subsets
-- determined by the given function as equivalence classes
-- | partitions a list into a list of disjoint non-empty lists
-- determined by the given function as equivalence classes
partList :: (a -> a -> Bool) -> [a] -> [[a]]
-- | Divide a Set (List) into equivalence classes
w.r.t. eq
leqClasses :: Ord a => (a -> a -> Bool) ->
Set.Set a -> [[a]]
-- | flattens a list of non-empty sets and uses the minimal element of
-- each set to represent the set
{- | checks if a given relation is locally filtered
* precondition: the relation must already be closed by transitive closure
locallyFiltered :: (Ord a) => Rel a -> Bool
locallyFiltered rel = (check . flatSet . partSet iso . mostRight) rel
where iso x y = member x y rel && member y x rel
(&& not (haveCommonLeftElem x y rel))) True s'