Rel.hs revision db3b74383c0afcd7a0aec50c263aec4f4e09df8d
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterModule : $Header$
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterDescription : Relations, based on maps
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterCopyright : (c) Uni Bremen 2003-2005
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterLicense : GPLv2 or higher, see LICENSE.txt
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterMaintainer : Christian.Maeder@dfki.de
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterStability : provisional
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterPortability : portable
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fostersupply a simple data type for (precedence or subsort) relations. A
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterrelation is conceptually a set of (ordered) pairs,
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterbut the hidden implementation is based on a map of sets.
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterAn alternative view is that of a directed Graph possibly
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterwith isolated nodes.
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster'Rel' is a directed graph with elements (Ord a) as (uniquely labelled) nodes
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterand (unlabelled) edges (with a multiplicity of at most one).
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterUsage: start with an 'empty' relation, 'insert' edges, and test for
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosteran edge 'member' (before or after calling 'transClosure').
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterIt is possible to insert self edges or bigger cycles. But rather than
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterinserting self edges and element can be mapped to the empty set.
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterChecking for a 'path' corresponds to checking for a member in the
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fostertransitive (possibly non-reflexive) closure. A further 'insert', however,
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fostermay destroy the closedness property of a relation.
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster ( Rel, empty, nullKeys, rmNullSets
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster , insertPair, insertDiffPair, insertKeyOrPair
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster , member, toMap, map
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster , noPairs, insertKey, deleteKey, memberKey, keysSet
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster , fromKeysSet
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster , union, intersection, isSubrelOf, difference, path
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster , delete, succs, predecessors, irreflex, sccOfClosure
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster , transClosure, fromList, toList, toPrecMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster , intransKernel, mostRight, restrict, delSet
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David Luna , toSet, fromSet, topSort, depSort, nodes, collaps
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David Luna , transpose, transReduce
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David Luna , fromMap, locallyFiltered
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David Luna , flatSet, partSet, partList, leqClasses
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterimport Prelude hiding (map, null)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterimport qualified Data.Map as Map
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterimport qualified Data.Set as Set
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterimport qualified Data.List as List
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterimport qualified Common.Lib.MapSet as MapSet
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David Luna-- | no invariant is ensured for relations!
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David Lunanewtype Rel a = Rel { toMap :: Map.Map a (Set.Set a) } deriving (Eq, Ord)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterinstance Show a => Show (Rel a) where
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster show = show . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterinstance (Ord a, Read a) => Read (Rel a) where
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster readsPrec d = List.map (\ (m, r) -> (fromMap m , r)) . readsPrec d
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterfromMap = Rel
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | the empty relation
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterempty :: Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | test for 'empty'
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosternullKeys :: Rel a -> Bool
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosternullKeys (Rel m) = Map.null m
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | keys of the relation
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterkeysSet :: Rel a -> Set.Set a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterkeysSet = Map.keysSet . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterrmNullSets :: Ord a => Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterrmNullSets = Rel . MapSet.rmNullSets . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | test for 'empty'
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosternoPairs :: Ord a => Rel a -> Bool
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosternoPairs = nullKeys . rmNullSets
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | difference of two relations
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterdifference :: Ord a => Rel a -> Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterdifference (Rel m) = Rel . Map.differenceWith MapSet.setDifference m . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | union of two relations
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterunion :: Ord a => Rel a -> Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterunion (Rel m) = Rel . Map.unionWith Set.union m . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | intersection of two relations
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterintersection :: Ord a => Rel a -> Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterintersection (Rel m) = Rel . Map.intersectionWith Set.intersection m . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | is the first relation a sub-relation of the second
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterisSubrelOf :: Ord a => Rel a -> Rel a -> Bool
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterisSubrelOf (Rel m) = Map.isSubmapOfBy Set.isSubsetOf m . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | insert an ordered pair
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterinsertPair :: Ord a => a -> a -> Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterinsertPair a b = Rel . MapSet.setInsert a b . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | insert a pair only if both sides are different
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterinsertDiffPair :: Ord a => a -> a -> Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterinsertDiffPair a b = if a == b then id else insertPair a b
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | insert a pair only if both sides are different
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterinsertKeyOrPair :: Ord a => a -> a -> Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterinsertKeyOrPair a b = if a == b then insertKey a else insertPair a b
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | insert an unrelated node
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterinsertKey :: Ord a => a -> Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterinsertKey k r@(Rel m) = if Map.member k m then r else
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | delete an ordered pair
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterdelete :: Ord a => a -> a -> Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterdelete a b (Rel m) =
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster Rel $ if Set.null t then Map.delete a m else Map.insert a t m
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | delete a node and all its relations
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterdeleteKey :: Ord a => a -> Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterdeleteKey k = Rel . Map.delete k . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | test for an (previously inserted) ordered pair
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fostermember :: Ord a => a -> a -> Rel a -> Bool
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fostermember a b r = Set.member b $ succs r a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostermemberKey :: Ord a => a -> Rel a -> Bool
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostermemberKey k = Map.member k . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | get direct successors
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fostersuccs :: Ord a => Rel a -> a -> Set.Set a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fostersuccs (Rel m) a = Map.findWithDefault Set.empty a m
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | get all transitive successors
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterreachable :: Ord a => Rel a -> a -> Set.Set a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterreachable r a = Set.fold reach Set.empty $ succs r a where
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster reach e s = if Set.member e s then s
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster else Set.fold reach (Set.insert e s) $ succs r e
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | predecessors of one node in the given set of a nodes
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterpreds :: Ord a => Rel a -> a -> Set.Set a -> Set.Set a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterpreds r a = Set.filter ( \ s -> member s a r)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | get direct predecessors
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterpredecessors :: Ord a => Rel a -> a -> Set.Set a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterpredecessors (Rel m) a = Map.keysSet $ Map.filter (Set.member a) m
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | test for 'member' or transitive membership (non-empty path)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterpath :: Ord a => a -> a -> Rel a -> Bool
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterpath a b r = Set.member b $ reachable r a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | compute transitive closure (make all transitive members direct members)
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostertransClosure :: Ord a => Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostertransClosure r@(Rel m) = Rel $ Map.mapWithKey ( \ k _ -> reachable r k) m
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | get transposed relation (losing unrelated keys)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fostertranspose :: Ord a => Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fostertranspose = Rel . MapSet.toMap . MapSet.transpose . MapSet.fromMap . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | make relation irreflexive
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterirreflex :: Ord a => Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterirreflex = Rel . Map.mapWithKey Set.delete . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | add all keys as reflexive elements
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterreflexive :: Ord a => Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterreflexive = Rel . Map.mapWithKey Set.insert . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | get entries that contain the key as element
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostergetCycles :: Ord a => Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostergetCycles = Rel . Map.filterWithKey Set.member . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | compute strongly connected components for a transitively closed relation
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostersccOfClosure :: Ord a => Rel a -> [Set.Set a]
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostersccOfClosure r@(Rel m) =
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster else let ((k, v), p) = Map.deleteFindMin m in
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster if Set.member k v then -- has a cycle
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster let c = preds r k v in -- get the cycle
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster c : sccOfClosure (delSet c r)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster else sccOfClosure (Rel p)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster{- | restrict strongly connected components to its minimal representative
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster (input sets must be non-null). Direct cycles may remain. -}
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fostercollaps :: Ord a => [Set.Set a] -> Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fostercollaps = delSet . Set.unions . List.map Set.deleteMin
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster{- | transitive reduction (minimal relation with the same transitive closure)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster of a transitively closed DAG (i.e. without cycles)! -}
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostertransReduce :: Ord a => Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostertransReduce (Rel m) = Rel
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- keep all (i, j) in rel for which no c with (i, c) and (c, j) in rel
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster $ Map.mapWithKey ( \ i s -> let d = MapSet.setToMap $ Set.delete i s in
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | convert a list of ordered pairs to a relation
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterfromList :: Ord a => [(a, a)] -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterfromList = foldr (uncurry insertPair) empty
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | convert a relation to a list of ordered pairs (this loses isolated keys!)
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostertoList :: Rel a -> [(a, a)]
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostertoList (Rel m) = concatMap (\ (a , bs) -> List.map ( \ b -> (a, b) )
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | map the values of a relation
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fostermap :: (Ord a, Ord b) => (a -> b) -> Rel a -> Rel b
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fostermap f = Rel . Map.mapKeysWith Set.union f . Map.map (Set.map f) . toMap
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | Restriction of a relation under a set
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterrestrict :: Ord a => Rel a -> Set.Set a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterrestrict r s = delSet (nodes r Set.\\ s) r
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | restrict to elements not in the input set
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterdelSet :: Ord a => Set.Set a -> Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterdelSet s (Rel m) = Rel $ Map.map (Set.\\ s) $ m Map.\\ MapSet.setToMap s
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | convert a relation to a set of ordered pairs
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostertoSet :: Ord a => Rel a -> Set.Set (a, a)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | convert a set of ordered pairs to a relation
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterfromSet :: Ord a => Set.Set (a, a) -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterfromSet = fromAscList . Set.toList
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | convert a plain node set to a relation
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterfromKeysSet :: Ord a => Set.Set a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterfromKeysSet = Rel . Set.fold (`Map.insert` Set.empty) Map.empty
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | convert a sorted list of ordered pairs to a relation
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterfromAscList :: Ord a => [(a, a)] -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterfromAscList = Rel . Map.fromDistinctAscList
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster . List.map ( \ l -> (fst (head l),
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster . List.groupBy ( \ (a, _) (b, _) -> a == b)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | all nodes of the edges
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosternodes :: Ord a => Rel a -> Set.Set a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosternodes (Rel m) = Set.union (Map.keysSet m) $ MapSet.setElems m
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster{- | Construct a precedence map from a closed relation. Indices range
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster between 1 and the second value that is output. -}
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostertoPrecMap :: Ord a => Rel a -> (Map.Map a Int, Int)
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostertoPrecMap = foldl ( \ (m1, c) s -> let n = c + 1 in
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster (Map.empty, 0) . topSort
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostertopSortDAG :: Ord a => Rel a -> [Set.Set a]
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostertopSortDAG r@(Rel m) = if Map.null m then [] else
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster ml = Map.keysSet m Set.\\ es -- most left
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster Rel m2 = delSet ml r
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster rs = es Set.\\ Map.keysSet m2 -- re-insert loose ends
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster in ml : topSortDAG (Rel $ Set.fold (`Map.insert` Set.empty) m2 rs)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | topologically sort a closed relation (ignore isolated cycles)
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostertopSort :: Ord a => Rel a -> [Set.Set a]
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostertopSort r = let cs = sccOfClosure r in
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster List.map (expandCycle cs) $ topSortDAG $ irreflex $ collaps cs r
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | find the cycle and add it to the result set
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterexpandCycle :: Ord a => [Set.Set a] -> Set.Set a -> Set.Set a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterexpandCycle cs s = case cs of
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster if Set.null $ Set.intersection c s then expandCycle r s else Set.union c s
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- dependency sort
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterdepSort :: Ord a => Rel a -> [Set.Set a]
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterdepSort r = let cs = sccOfClosure r in
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster List.concatMap (List.map (depCycle cs) . Set.toList)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster $ topSortDAG $ irreflex $ collaps cs r
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterdepCycle :: Ord a => [Set.Set a] -> a -> Set.Set a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterdepCycle cs a = case cs of
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster if Set.member a c then c else depCycle r a
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | gets the most right elements of a relation,
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostermostRightOfCollapsed :: Ord a => Rel a -> Set.Set a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostermostRightOfCollapsed r@(Rel m) =
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster Set.difference (nodes r) . Map.keysSet $ Map.filterWithKey
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster (\ i s -> not (Set.null s) && s /= Set.singleton i) m
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterfind s such that x in s => forall y . yRx or not yRx and not xRy
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster * precondition: (transClosure r == r)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster * strongly connected components (cycles) are treated as a compound node
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostermostRight :: Ord a => Rel a -> Set.Set a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FostermostRight r = let
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster cs = sccOfClosure r
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster in expandCycle cs (mostRightOfCollapsed $ collaps cs r)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterintransitive kernel of a reflexive and transitive closure
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster * precondition: (transClosure r == r)
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster * cycles are uniquely represented (according to Ord)
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterintransKernel :: Ord a => Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterintransKernel r =
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster let cs = sccOfClosure r
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster in foldr addCycle (transReduce $ collaps cs r) cs
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- add a cycle given by a set in the collapsed node
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosteraddCycle :: Ord a => Set.Set a -> Rel a -> Rel a
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosteraddCycle c r = if Set.null c then error "Common.Lib.Rel.addCycle" else
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster in insertPair m a $ foldr (uncurry insertPair) (delete a a r) $
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster{- | calculates if two given elements have a common left element
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster * if one of the arguments is not present False is returned
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David LunahaveCommonLeftElem :: Ord a => a -> a -> Rel a -> Bool
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David LunahaveCommonLeftElem t1 t2 =
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David Luna Map.fold (\ e -> (|| Set.member t1 e && Set.member t2 e)) False . toMap
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David Luna{- | partitions a set into a list of disjoint non-empty subsets
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David Lunadetermined by the given function as equivalence classes -}
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David LunapartSet :: Ord a => (a -> a -> Bool) -> Set.Set a -> [Set.Set a]
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David Luna{- | partitions a list into a list of disjoint non-empty lists
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fosterdetermined by the given function as equivalence classes -}
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David LunapartList :: (a -> a -> Bool) -> [a] -> [[a]]
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterpartList f l = case l of
57a1b25dcdf865eacb2fe2e17c5ca83e942da047David Luna x : r -> let
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster (ds, es) = List.partition (not . any (f x)) $ partList f r
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster in (x : concat es) : ds
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster-- | Divide a Set (List) into equivalence classes w.r.t. eq
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterleqClasses :: Ord a => (a -> a -> Bool) -> Set.Set a -> [[a]]
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterleqClasses f = partList f . Set.toList
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster{- | flattens a list of non-empty sets and uses the minimal element of
8af80418ba1ec431c8027fa9668e5678658d3611Allan Fostereach set to represent the set -}
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterflatSet = Set.fromList . List.map (\ s -> if Set.null s
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster{- | checks if a given relation is locally filtered
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster * precondition: the relation must already be closed by transitive closure
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterlocallyFiltered :: Ord a => Rel a -> Bool
8af80418ba1ec431c8027fa9668e5678658d3611Allan FosterlocallyFiltered rel = check . flatSet . partSet iso $ mostRight rel
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster where iso x y = member x y rel && member y x rel
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster check s = Set.null s ||
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster (&& not (haveCommonLeftElem x y rel))) True s'
8af80418ba1ec431c8027fa9668e5678658d3611Allan Foster where (x, s') = Set.deleteFindMin s