module GF.Data.Relation (Rel, mkRel, mkRel'
, allRelated , isRelatedTo
, transitiveClosure
, reflexiveClosure, reflexiveClosure_
, symmetricClosure
, symmetricSubrelation, reflexiveSubrelation
, reflexiveElements
, equivalenceClasses
, isTransitive, isReflexive, isSymmetric
, isEquivalence
, isSubRelationOf
, topologicalSort, findCycles) where
import Data.Foldable (toList)
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import GF.Data.Utilities
type Rel a = Map a (Set a)
mkRel :: Ord a => [(a,a)] -> Rel a
mkRel :: [(a, a)] -> Rel a
mkRel [(a, a)]
ps = [(a, a)] -> Rel a -> Rel a
forall a. Ord a => [(a, a)] -> Rel a -> Rel a
relates [(a, a)]
ps Rel a
forall k a. Map k a
Map.empty
mkRel' :: Ord a => [(a,[a])] -> Rel a
mkRel' :: [(a, [a])] -> Rel a
mkRel' [(a, [a])]
xs = (Set a -> Set a -> Set a) -> [(a, Set a)] -> Rel a
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union [(a
x,[a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
ys) | (a
x,[a]
ys) <- [(a, [a])]
xs]
relToList :: Ord a => Rel a -> [(a,a)]
relToList :: Rel a -> [(a, a)]
relToList Rel a
r = [ (a
x,a
y) | (a
x,Set a
ys) <- Rel a -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toList Rel a
r, a
y <- Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
ys ]
relate :: Ord a => a -> a -> Rel a -> Rel a
relate :: a -> a -> Rel a -> Rel a
relate a
x a
y Rel a
r = (Set a -> Set a -> Set a) -> a -> Set a -> Rel a -> Rel a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union a
x (a -> Set a
forall a. a -> Set a
Set.singleton a
y) Rel a
r
relates :: Ord a => [(a,a)] -> Rel a -> Rel a
relates :: [(a, a)] -> Rel a -> Rel a
relates [(a, a)]
ps Rel a
r = (Rel a -> (a, a) -> Rel a) -> Rel a -> [(a, a)] -> Rel a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Rel a
r' (a
x,a
y) -> a -> a -> Rel a -> Rel a
forall a. Ord a => a -> a -> Rel a -> Rel a
relate a
x a
y Rel a
r') Rel a
r [(a, a)]
ps
isRelatedTo :: Ord a => Rel a -> a -> a -> Bool
isRelatedTo :: Rel a -> a -> a -> Bool
isRelatedTo Rel a
r a
x a
y = Bool -> (Set a -> Bool) -> Maybe (Set a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (a
y a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member`) (a -> Rel a -> Maybe (Set a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
x Rel a
r)
allRelated :: Ord a => Rel a -> a -> Set a
allRelated :: Rel a -> a -> Set a
allRelated Rel a
r a
x = Set a -> Maybe (Set a) -> Set a
forall a. a -> Maybe a -> a
fromMaybe Set a
forall a. Set a
Set.empty (a -> Rel a -> Maybe (Set a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
x Rel a
r)
domain :: Ord a => Rel a -> Set a
domain :: Rel a -> Set a
domain Rel a
r = (Set a -> Set a -> Set a) -> Set a -> [Set a] -> Set a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Rel a -> Set a
forall k a. Map k a -> Set k
Map.keysSet Rel a
r) (Rel a -> [Set a]
forall k a. Map k a -> [a]
Map.elems Rel a
r)
reverseRel :: Ord a => Rel a -> Rel a
reverseRel :: Rel a -> Rel a
reverseRel Rel a
r = [(a, a)] -> Rel a
forall a. Ord a => [(a, a)] -> Rel a
mkRel [(a
y,a
x) | (a
x,a
y) <- Rel a -> [(a, a)]
forall a. Ord a => Rel a -> [(a, a)]
relToList Rel a
r]
intersectSetRel :: Ord a => Set a -> Rel a -> Rel a
intersectSetRel :: Set a -> Rel a -> Rel a
intersectSetRel Set a
s = (a -> a -> Bool) -> Rel a -> Rel a
forall a. Ord a => (a -> a -> Bool) -> Rel a -> Rel a
filterRel (\a
x a
y -> a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
s Bool -> Bool -> Bool
&& a
y a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
s)
transitiveClosure :: Ord a => Rel a -> Rel a
transitiveClosure :: Rel a -> Rel a
transitiveClosure Rel a
r = (Rel a -> Rel a) -> Rel a -> Rel a
forall a. Eq a => (a -> a) -> a -> a
fix ((Set a -> Set a) -> Rel a -> Rel a
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Set a -> Set a
growSet) Rel a
r
where growSet :: Set a -> Set a
growSet Set a
ys = (Set a -> Set a -> Set a) -> Set a -> [Set a] -> Set a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
ys ((a -> Set a) -> [a] -> [Set a]
forall a b. (a -> b) -> [a] -> [b]
map (Rel a -> a -> Set a
forall a. Ord a => Rel a -> a -> Set a
allRelated Rel a
r) ([a] -> [Set a]) -> [a] -> [Set a]
forall a b. (a -> b) -> a -> b
$ Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
ys)
reflexiveClosure_ :: Ord a => [a]
-> Rel a -> Rel a
reflexiveClosure_ :: [a] -> Rel a -> Rel a
reflexiveClosure_ [a]
u Rel a
r = [(a, a)] -> Rel a -> Rel a
forall a. Ord a => [(a, a)] -> Rel a -> Rel a
relates [(a
x,a
x) | a
x <- [a]
u] Rel a
r
reflexiveClosure :: Ord a => Rel a -> Rel a
reflexiveClosure :: Rel a -> Rel a
reflexiveClosure Rel a
r = [a] -> Rel a -> Rel a
forall a. Ord a => [a] -> Rel a -> Rel a
reflexiveClosure_ (Set a -> [a]
forall a. Set a -> [a]
Set.toList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ Rel a -> Set a
forall a. Ord a => Rel a -> Set a
domain Rel a
r) Rel a
r
symmetricClosure :: Ord a => Rel a -> Rel a
symmetricClosure :: Rel a -> Rel a
symmetricClosure Rel a
r = [(a, a)] -> Rel a -> Rel a
forall a. Ord a => [(a, a)] -> Rel a -> Rel a
relates [ (a
y,a
x) | (a
x,a
y) <- Rel a -> [(a, a)]
forall a. Ord a => Rel a -> [(a, a)]
relToList Rel a
r ] Rel a
r
symmetricSubrelation :: Ord a => Rel a -> Rel a
symmetricSubrelation :: Rel a -> Rel a
symmetricSubrelation Rel a
r = (a -> a -> Bool) -> Rel a -> Rel a
forall a. Ord a => (a -> a -> Bool) -> Rel a -> Rel a
filterRel ((a -> a -> Bool) -> a -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> Bool) -> a -> a -> Bool)
-> (a -> a -> Bool) -> a -> a -> Bool
forall a b. (a -> b) -> a -> b
$ Rel a -> a -> a -> Bool
forall a. Ord a => Rel a -> a -> a -> Bool
isRelatedTo Rel a
r) Rel a
r
reflexiveSubrelation :: Ord a => Rel a -> Rel a
reflexiveSubrelation :: Rel a -> Rel a
reflexiveSubrelation Rel a
r = Set a -> Rel a -> Rel a
forall a. Ord a => Set a -> Rel a -> Rel a
intersectSetRel (Rel a -> Set a
forall a. Ord a => Rel a -> Set a
reflexiveElements Rel a
r) Rel a
r
reflexiveElements :: Ord a => Rel a -> Set a
reflexiveElements :: Rel a -> Set a
reflexiveElements Rel a
r = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [ a
x | (a
x,Set a
ys) <- Rel a -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toList Rel a
r, a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
ys ]
filterRel :: Ord a => (a -> a -> Bool) -> Rel a -> Rel a
filterRel :: (a -> a -> Bool) -> Rel a -> Rel a
filterRel a -> a -> Bool
p = (Rel a, Set a) -> Rel a
forall a b. (a, b) -> a
fst ((Rel a, Set a) -> Rel a)
-> (Rel a -> (Rel a, Set a)) -> Rel a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> (Rel a, Set a)
forall a. Ord a => Rel a -> (Rel a, Set a)
purgeEmpty (Rel a -> (Rel a, Set a))
-> (Rel a -> Rel a) -> Rel a -> (Rel a, Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Set a -> Set a) -> Rel a -> Rel a
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey ((a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ((a -> Bool) -> Set a -> Set a)
-> (a -> a -> Bool) -> a -> Set a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Bool
p)
purgeEmpty :: Ord a => Rel a -> (Rel a, Set a)
purgeEmpty :: Rel a -> (Rel a, Set a)
purgeEmpty Rel a
r = let (Rel a
r',Rel a
r'') = (Set a -> Bool) -> Rel a -> (Rel a, Rel a)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partition (Bool -> Bool
not (Bool -> Bool) -> (Set a -> Bool) -> Set a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Bool
forall a. Set a -> Bool
Set.null) Rel a
r
in (Rel a
r', Rel a -> Set a
forall k a. Map k a -> Set k
Map.keysSet Rel a
r'')
equivalenceClasses :: Ord a => Rel a -> [Set a]
equivalenceClasses :: Rel a -> [Set a]
equivalenceClasses Rel a
r = [a] -> Rel a -> [Set a]
forall a. Ord a => [a] -> Map a (Set a) -> [Set a]
equivalenceClasses_ (Rel a -> [a]
forall k a. Map k a -> [k]
Map.keys Rel a
r) Rel a
r
where equivalenceClasses_ :: [a] -> Map a (Set a) -> [Set a]
equivalenceClasses_ [] Map a (Set a)
_ = []
equivalenceClasses_ (a
x:[a]
xs) Map a (Set a)
r = Set a
ysSet a -> [Set a] -> [Set a]
forall a. a -> [a] -> [a]
:[a] -> Map a (Set a) -> [Set a]
equivalenceClasses_ [a]
zs Map a (Set a)
r
where ys :: Set a
ys = Map a (Set a) -> a -> Set a
forall a. Ord a => Rel a -> a -> Set a
allRelated Map a (Set a)
r a
x
zs :: [a]
zs = [a
x' | a
x' <- [a]
xs, Bool -> Bool
not (a
x' a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
ys)]
isTransitive :: Ord a => Rel a -> Bool
isTransitive :: Rel a -> Bool
isTransitive Rel a
r = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [a
z a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
ys | (a
x,Set a
ys) <- Rel a -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toList Rel a
r,
a
y <- Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
ys, a
z <- Set a -> [a]
forall a. Set a -> [a]
Set.toList (Rel a -> a -> Set a
forall a. Ord a => Rel a -> a -> Set a
allRelated Rel a
r a
y)]
isReflexive :: Ord a => Rel a -> Bool
isReflexive :: Rel a -> Bool
isReflexive Rel a
r = ((a, Set a) -> Bool) -> [(a, Set a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ (a
x,Set a
ys) -> a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
ys) (Rel a -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toList Rel a
r)
isSymmetric :: Ord a => Rel a -> Bool
isSymmetric :: Rel a -> Bool
isSymmetric Rel a
r = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Rel a -> a -> a -> Bool
forall a. Ord a => Rel a -> a -> a -> Bool
isRelatedTo Rel a
r a
y a
x | (a
x,a
y) <- Rel a -> [(a, a)]
forall a. Ord a => Rel a -> [(a, a)]
relToList Rel a
r]
isEquivalence :: Ord a => Rel a -> Bool
isEquivalence :: Rel a -> Bool
isEquivalence Rel a
r = Rel a -> Bool
forall a. Ord a => Rel a -> Bool
isReflexive Rel a
r Bool -> Bool -> Bool
&& Rel a -> Bool
forall a. Ord a => Rel a -> Bool
isSymmetric Rel a
r Bool -> Bool -> Bool
&& Rel a -> Bool
forall a. Ord a => Rel a -> Bool
isTransitive Rel a
r
isSubRelationOf :: Ord a => Rel a -> Rel a -> Bool
isSubRelationOf :: Rel a -> Rel a -> Bool
isSubRelationOf Rel a
r1 Rel a
r2 = ((a, a) -> Bool) -> [(a, a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((a -> a -> Bool) -> (a, a) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Rel a -> a -> a -> Bool
forall a. Ord a => Rel a -> a -> a -> Bool
isRelatedTo Rel a
r2)) (Rel a -> [(a, a)]
forall a. Ord a => Rel a -> [(a, a)]
relToList Rel a
r1)
topologicalSort :: Ord a => Rel a -> Either [a] [[a]]
topologicalSort :: Rel a -> Either [a] [[a]]
topologicalSort Rel a
r = Rel' a -> Seq a -> Seq a -> Either [a] [[a]]
forall a. Ord a => Rel' a -> Seq a -> Seq a -> Either [a] [[a]]
tsort Rel' a
r' Seq a
noIncoming Seq a
forall a. Seq a
Seq.empty
where r' :: Rel' a
r' = Rel a -> Rel' a
forall a. Ord a => Rel a -> Rel' a
relToRel' Rel a
r
noIncoming :: Seq a
noIncoming = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList [a
x | (a
x,(Set a
is,Set a
_)) <- Rel' a -> [(a, (Set a, Set a))]
forall k a. Map k a -> [(k, a)]
Map.toList Rel' a
r', Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
is]
tsort :: Ord a => Rel' a -> Seq a -> Seq a -> Either [a] [[a]]
tsort :: Rel' a -> Seq a -> Seq a -> Either [a] [[a]]
tsort Rel' a
r Seq a
xs Seq a
l = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
Seq.viewl Seq a
xs of
ViewL a
Seq.EmptyL | Rel' a -> Bool
forall a. Ord a => Rel' a -> Bool
isEmpty' Rel' a
r -> [a] -> Either [a] [[a]]
forall a b. a -> Either a b
Left (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
l)
| Bool
otherwise -> [[a]] -> Either [a] [[a]]
forall a b. b -> Either a b
Right (Rel a -> [[a]]
forall a. Ord a => Rel a -> [[a]]
findCycles (Rel' a -> Rel a
forall a. Ord a => Rel' a -> Rel a
rel'ToRel Rel' a
r))
a
x Seq.:< Seq a
xs -> Rel' a -> Seq a -> Seq a -> Either [a] [[a]]
forall a. Ord a => Rel' a -> Seq a -> Seq a -> Either [a] [[a]]
tsort Rel' a
r' (Seq a
xs Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
Seq.>< [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList [a]
new) (Seq a
l Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
x)
where (Rel' a
r',Set a
_,Set a
os) = a -> Rel' a -> (Rel' a, Set a, Set a)
forall a. Ord a => a -> Rel' a -> (Rel' a, Set a, Set a)
remove a
x Rel' a
r
new :: [a]
new = [a
o | a
o <- Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
os, Set a -> Bool
forall a. Set a -> Bool
Set.null (a -> Rel' a -> Set a
forall a. Ord a => a -> Rel' a -> Set a
incoming a
o Rel' a
r')]
findCycles :: Ord a => Rel a -> [[a]]
findCycles :: Rel a -> [[a]]
findCycles = (Set a -> [a]) -> [Set a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map Set a -> [a]
forall a. Set a -> [a]
Set.toList ([Set a] -> [[a]]) -> (Rel a -> [Set a]) -> Rel a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> [Set a]
forall a. Ord a => Rel a -> [Set a]
equivalenceClasses (Rel a -> [Set a]) -> (Rel a -> Rel a) -> Rel a -> [Set a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Rel a
forall a. Ord a => Rel a -> Rel a
reflexiveSubrelation (Rel a -> Rel a) -> (Rel a -> Rel a) -> Rel a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Rel a
forall a. Ord a => Rel a -> Rel a
symmetricSubrelation (Rel a -> Rel a) -> (Rel a -> Rel a) -> Rel a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Rel a
forall a. Ord a => Rel a -> Rel a
transitiveClosure
type Rel' a = Map a (Set a, Set a)
isEmpty' :: Ord a => Rel' a -> Bool
isEmpty' :: Rel' a -> Bool
isEmpty' = Rel' a -> Bool
forall k a. Map k a -> Bool
Map.null
relToRel' :: Ord a => Rel a -> Rel' a
relToRel' :: Rel a -> Rel' a
relToRel' Rel a
r = ((Set a, Set a) -> (Set a, Set a) -> (Set a, Set a))
-> Rel' a -> Rel' a -> Rel' a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (\ (Set a
i,Set a
_) (Set a
_,Set a
o) -> (Set a
i,Set a
o)) Rel' a
forall a. Map a (Set a, Set a)
ir Rel' a
forall a. Map a (Set a, Set a)
or
where ir :: Map a (Set a, Set a)
ir = (Set a -> (Set a, Set a)) -> Rel a -> Map a (Set a, Set a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\Set a
s -> (Set a
s,Set a
forall a. Set a
Set.empty)) (Rel a -> Map a (Set a, Set a)) -> Rel a -> Map a (Set a, Set a)
forall a b. (a -> b) -> a -> b
$ Rel a -> Rel a
forall a. Ord a => Rel a -> Rel a
reverseRel Rel a
r
or :: Map a (Set a, Set a)
or = (Set a -> (Set a, Set a)) -> Rel a -> Map a (Set a, Set a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\Set a
s -> (Set a
forall a. Set a
Set.empty,Set a
s)) (Rel a -> Map a (Set a, Set a)) -> Rel a -> Map a (Set a, Set a)
forall a b. (a -> b) -> a -> b
$ Rel a
r
rel'ToRel :: Ord a => Rel' a -> Rel a
rel'ToRel :: Rel' a -> Rel a
rel'ToRel = ((Set a, Set a) -> Set a) -> Rel' a -> Rel a
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Set a, Set a) -> Set a
forall a b. (a, b) -> b
snd
remove :: Ord a => a -> Rel' a -> (Rel' a, Set a, Set a)
remove :: a -> Rel' a -> (Rel' a, Set a, Set a)
remove a
x Rel' a
r = let (Maybe (Set a, Set a)
mss,Rel' a
r') = (a -> (Set a, Set a) -> Maybe (Set a, Set a))
-> a -> Rel' a -> (Maybe (Set a, Set a), Rel' a)
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey (\a
_ (Set a, Set a)
_ -> Maybe (Set a, Set a)
forall a. Maybe a
Nothing) a
x Rel' a
r
in case Maybe (Set a, Set a)
mss of
Maybe (Set a, Set a)
Nothing -> (Rel' a
r', Set a
forall a. Set a
Set.empty, Set a
forall a. Set a
Set.empty)
Just (Set a
is,Set a
os) ->
let r'' :: Rel' a
r'' = (a -> Rel' a -> Rel' a) -> Rel' a -> [a] -> Rel' a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
i -> ((Set a, Set a) -> (Set a, Set a)) -> a -> Rel' a -> Rel' a
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\ (Set a
is',Set a
os') -> (Set a
is', a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
x Set a
os')) a
i) Rel' a
r' ([a] -> Rel' a) -> [a] -> Rel' a
forall a b. (a -> b) -> a -> b
$ Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
is
r''' :: Rel' a
r''' = (a -> Rel' a -> Rel' a) -> Rel' a -> [a] -> Rel' a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
o -> ((Set a, Set a) -> (Set a, Set a)) -> a -> Rel' a -> Rel' a
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\ (Set a
is',Set a
os') -> (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
x Set a
is', Set a
os')) a
o) Rel' a
r'' ([a] -> Rel' a) -> [a] -> Rel' a
forall a b. (a -> b) -> a -> b
$ Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
os
in (Rel' a
r''', Set a
is, Set a
os)
incoming :: Ord a => a -> Rel' a -> Set a
incoming :: a -> Rel' a -> Set a
incoming a
x Rel' a
r = Set a -> ((Set a, Set a) -> Set a) -> Maybe (Set a, Set a) -> Set a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set a
forall a. Set a
Set.empty (Set a, Set a) -> Set a
forall a b. (a, b) -> a
fst (Maybe (Set a, Set a) -> Set a) -> Maybe (Set a, Set a) -> Set a
forall a b. (a -> b) -> a -> b
$ a -> Rel' a -> Maybe (Set a, Set a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
x Rel' a
r