module Algebra.Graph.Relation (
Relation, domain, relation,
empty, vertex, edge, overlay, connect, vertices, edges, overlays, connects,
isSubgraphOf,
isEmpty, hasVertex, hasEdge, vertexCount, edgeCount, vertexList, edgeList,
adjacencyList, vertexSet, edgeSet, preSet, postSet,
path, circuit, clique, biclique, star, stars, tree, forest,
removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap,
induce, induceJust,
compose, closure, reflexiveClosure, symmetricClosure, transitiveClosure,
consistent
) where
import Control.DeepSeq
import Data.Set (Set, union)
import Data.Tree
import Data.Tuple
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Data.Tree as Tree
import Algebra.Graph.Internal
data Relation a = Relation {
Relation a -> Set a
domain :: Set a,
Relation a -> Set (a, a)
relation :: Set (a, a)
} deriving Relation a -> Relation a -> Bool
(Relation a -> Relation a -> Bool)
-> (Relation a -> Relation a -> Bool) -> Eq (Relation a)
forall a. Eq a => Relation a -> Relation a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relation a -> Relation a -> Bool
$c/= :: forall a. Eq a => Relation a -> Relation a -> Bool
== :: Relation a -> Relation a -> Bool
$c== :: forall a. Eq a => Relation a -> Relation a -> Bool
Eq
instance (Ord a, Show a) => Show (Relation a) where
showsPrec :: Int -> Relation a -> ShowS
showsPrec Int
p (Relation Set a
d Set (a, a)
r)
| Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
d = String -> ShowS
showString String
"empty"
| Set (a, a) -> Bool
forall a. Set a -> Bool
Set.null Set (a, a)
r = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [a] -> ShowS
forall a. Show a => [a] -> ShowS
vshow (Set a -> [a]
forall a. Set a -> [a]
Set.toAscList Set a
d)
| Set a
d Set a -> Set a -> Bool
forall a. Eq a => a -> a -> Bool
== Set a
used = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [(a, a)] -> ShowS
forall a a. (Show a, Show a) => [(a, a)] -> ShowS
eshow (Set (a, a) -> [(a, a)]
forall a. Set a -> [a]
Set.toAscList Set (a, a)
r)
| Bool
otherwise = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"overlay (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[a] -> ShowS
forall a. Show a => [a] -> ShowS
vshow (Set a -> [a]
forall a. Set a -> [a]
Set.toAscList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set a
d Set a
used) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString String
") (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, a)] -> ShowS
forall a a. (Show a, Show a) => [(a, a)] -> ShowS
eshow (Set (a, a) -> [(a, a)]
forall a. Set a -> [a]
Set.toAscList Set (a, a)
r) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString String
")"
where
vshow :: [a] -> ShowS
vshow [a
x] = String -> ShowS
showString String
"vertex " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x
vshow [a]
xs = String -> ShowS
showString String
"vertices " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [a]
xs
eshow :: [(a, a)] -> ShowS
eshow [(a
x, a
y)] = String -> ShowS
showString String
"edge " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
y
eshow [(a, a)]
xs = String -> ShowS
showString String
"edges " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(a, a)] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [(a, a)]
xs
used :: Set a
used = Set (a, a) -> Set a
forall a. Ord a => Set (a, a) -> Set a
referredToVertexSet Set (a, a)
r
instance Ord a => Ord (Relation a) where
compare :: Relation a -> Relation a -> Ordering
compare Relation a
x Relation a
y = [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat
[ Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Relation a -> Int
forall a. Relation a -> Int
vertexCount Relation a
x) (Relation a -> Int
forall a. Relation a -> Int
vertexCount Relation a
y)
, Set a -> Set a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Relation a -> Set a
forall a. Relation a -> Set a
vertexSet Relation a
x) (Relation a -> Set a
forall a. Relation a -> Set a
vertexSet Relation a
y)
, Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Relation a -> Int
forall a. Relation a -> Int
edgeCount Relation a
x) (Relation a -> Int
forall a. Relation a -> Int
edgeCount Relation a
y)
, Set (a, a) -> Set (a, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
edgeSet Relation a
x) (Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
edgeSet Relation a
y) ]
instance NFData a => NFData (Relation a) where
rnf :: Relation a -> ()
rnf (Relation Set a
d Set (a, a)
r) = Set a -> ()
forall a. NFData a => a -> ()
rnf Set a
d () -> () -> ()
`seq` Set (a, a) -> ()
forall a. NFData a => a -> ()
rnf Set (a, a)
r () -> () -> ()
`seq` ()
instance (Ord a, Num a) => Num (Relation a) where
fromInteger :: Integer -> Relation a
fromInteger = a -> Relation a
forall a. a -> Relation a
vertex (a -> Relation a) -> (Integer -> a) -> Integer -> Relation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
+ :: Relation a -> Relation a -> Relation a
(+) = Relation a -> Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a -> Relation a
overlay
* :: Relation a -> Relation a -> Relation a
(*) = Relation a -> Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a -> Relation a
connect
signum :: Relation a -> Relation a
signum = Relation a -> Relation a -> Relation a
forall a b. a -> b -> a
const Relation a
forall a. Relation a
empty
abs :: Relation a -> Relation a
abs = Relation a -> Relation a
forall a. a -> a
id
negate :: Relation a -> Relation a
negate = Relation a -> Relation a
forall a. a -> a
id
empty :: Relation a
empty :: Relation a
empty = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation Set a
forall a. Set a
Set.empty Set (a, a)
forall a. Set a
Set.empty
vertex :: a -> Relation a
vertex :: a -> Relation a
vertex a
x = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation (a -> Set a
forall a. a -> Set a
Set.singleton a
x) Set (a, a)
forall a. Set a
Set.empty
overlay :: Ord a => Relation a -> Relation a -> Relation a
overlay :: Relation a -> Relation a -> Relation a
overlay Relation a
x Relation a
y = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation (Relation a -> Set a
forall a. Relation a -> Set a
domain Relation a
x Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`union` Relation a -> Set a
forall a. Relation a -> Set a
domain Relation a
y) (Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation Relation a
x Set (a, a) -> Set (a, a) -> Set (a, a)
forall a. Ord a => Set a -> Set a -> Set a
`union` Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation Relation a
y)
connect :: Ord a => Relation a -> Relation a -> Relation a
connect :: Relation a -> Relation a -> Relation a
connect Relation a
x Relation a
y = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation (Relation a -> Set a
forall a. Relation a -> Set a
domain Relation a
x Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`union` Relation a -> Set a
forall a. Relation a -> Set a
domain Relation a
y)
(Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation Relation a
x Set (a, a) -> Set (a, a) -> Set (a, a)
forall a. Ord a => Set a -> Set a -> Set a
`union` Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation Relation a
y Set (a, a) -> Set (a, a) -> Set (a, a)
forall a. Ord a => Set a -> Set a -> Set a
`union` (Relation a -> Set a
forall a. Relation a -> Set a
domain Relation a
x Set a -> Set a -> Set (a, a)
forall a b. Set a -> Set b -> Set (a, b)
`setProduct` Relation a -> Set a
forall a. Relation a -> Set a
domain Relation a
y))
edge :: Ord a => a -> a -> Relation a
edge :: a -> a -> Relation a
edge a
x a
y = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a
x, a
y]) ((a, a) -> Set (a, a)
forall a. a -> Set a
Set.singleton (a
x, a
y))
vertices :: Ord a => [a] -> Relation a
vertices :: [a] -> Relation a
vertices [a]
xs = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs) Set (a, a)
forall a. Set a
Set.empty
edges :: Ord a => [(a, a)] -> Relation a
edges :: [(a, a)] -> Relation a
edges [(a, a)]
es = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ ([a] -> [a] -> [a]) -> ([a], [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) (([a], [a]) -> [a]) -> ([a], [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ [(a, a)] -> ([a], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, a)]
es) ([(a, a)] -> Set (a, a)
forall a. Ord a => [a] -> Set a
Set.fromList [(a, a)]
es)
overlays :: Ord a => [Relation a] -> Relation a
overlays :: [Relation a] -> Relation a
overlays [Relation a]
xs = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation ([Set a] -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set a] -> Set a) -> [Set a] -> Set a
forall a b. (a -> b) -> a -> b
$ (Relation a -> Set a) -> [Relation a] -> [Set a]
forall a b. (a -> b) -> [a] -> [b]
map Relation a -> Set a
forall a. Relation a -> Set a
domain [Relation a]
xs) ([Set (a, a)] -> Set (a, a)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set (a, a)] -> Set (a, a)) -> [Set (a, a)] -> Set (a, a)
forall a b. (a -> b) -> a -> b
$ (Relation a -> Set (a, a)) -> [Relation a] -> [Set (a, a)]
forall a b. (a -> b) -> [a] -> [b]
map Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation [Relation a]
xs)
connects :: Ord a => [Relation a] -> Relation a
connects :: [Relation a] -> Relation a
connects = (Relation a -> Relation a -> Relation a)
-> Relation a -> [Relation a] -> Relation a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Relation a -> Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a -> Relation a
connect Relation a
forall a. Relation a
empty
isSubgraphOf :: Ord a => Relation a -> Relation a -> Bool
isSubgraphOf :: Relation a -> Relation a -> Bool
isSubgraphOf Relation a
x Relation a
y = Relation a -> Set a
forall a. Relation a -> Set a
domain Relation a
x Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Relation a -> Set a
forall a. Relation a -> Set a
domain Relation a
y
Bool -> Bool -> Bool
&& Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation Relation a
x Set (a, a) -> Set (a, a) -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation Relation a
y
isEmpty :: Relation a -> Bool
isEmpty :: Relation a -> Bool
isEmpty = Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set a -> Bool) -> (Relation a -> Set a) -> Relation a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set a
forall a. Relation a -> Set a
domain
hasVertex :: Ord a => a -> Relation a -> Bool
hasVertex :: a -> Relation a -> Bool
hasVertex a
x = a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
x (Set a -> Bool) -> (Relation a -> Set a) -> Relation a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set a
forall a. Relation a -> Set a
domain
hasEdge :: Ord a => a -> a -> Relation a -> Bool
hasEdge :: a -> a -> Relation a -> Bool
hasEdge a
x a
y = (a, a) -> Set (a, a) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (a
x, a
y) (Set (a, a) -> Bool)
-> (Relation a -> Set (a, a)) -> Relation a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation
vertexCount :: Relation a -> Int
vertexCount :: Relation a -> Int
vertexCount = Set a -> Int
forall a. Set a -> Int
Set.size (Set a -> Int) -> (Relation a -> Set a) -> Relation a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set a
forall a. Relation a -> Set a
domain
edgeCount :: Relation a -> Int
edgeCount :: Relation a -> Int
edgeCount = Set (a, a) -> Int
forall a. Set a -> Int
Set.size (Set (a, a) -> Int)
-> (Relation a -> Set (a, a)) -> Relation a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation
vertexList :: Relation a -> [a]
vertexList :: Relation a -> [a]
vertexList = Set a -> [a]
forall a. Set a -> [a]
Set.toAscList (Set a -> [a]) -> (Relation a -> Set a) -> Relation a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set a
forall a. Relation a -> Set a
domain
edgeList :: Relation a -> [(a, a)]
edgeList :: Relation a -> [(a, a)]
edgeList = Set (a, a) -> [(a, a)]
forall a. Set a -> [a]
Set.toAscList (Set (a, a) -> [(a, a)])
-> (Relation a -> Set (a, a)) -> Relation a -> [(a, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation
vertexSet :: Relation a -> Set.Set a
vertexSet :: Relation a -> Set a
vertexSet = Relation a -> Set a
forall a. Relation a -> Set a
domain
edgeSet :: Relation a -> Set.Set (a, a)
edgeSet :: Relation a -> Set (a, a)
edgeSet = Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation
adjacencyList :: Eq a => Relation a -> [(a, [a])]
adjacencyList :: Relation a -> [(a, [a])]
adjacencyList Relation a
r = [a] -> [(a, a)] -> [(a, [a])]
forall a a. Eq a => [a] -> [(a, a)] -> [(a, [a])]
go (Set a -> [a]
forall a. Set a -> [a]
Set.toAscList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ Relation a -> Set a
forall a. Relation a -> Set a
domain Relation a
r) (Set (a, a) -> [(a, a)]
forall a. Set a -> [a]
Set.toAscList (Set (a, a) -> [(a, a)]) -> Set (a, a) -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation Relation a
r)
where
go :: [a] -> [(a, a)] -> [(a, [a])]
go [] [(a, a)]
_ = []
go [a]
vs [] = (a -> (a, [a])) -> [a] -> [(a, [a])]
forall a b. (a -> b) -> [a] -> [b]
map ((,[])) [a]
vs
go (a
x:[a]
vs) [(a, a)]
es = let ([(a, a)]
ys, [(a, a)]
zs) = ((a, a) -> Bool) -> [(a, a)] -> ([(a, a)], [(a, a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x) (a -> Bool) -> ((a, a) -> a) -> (a, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> a
forall a b. (a, b) -> a
fst) [(a, a)]
es in (a
x, ((a, a) -> a) -> [(a, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> a
forall a b. (a, b) -> b
snd [(a, a)]
ys) (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: [a] -> [(a, a)] -> [(a, [a])]
go [a]
vs [(a, a)]
zs
preSet :: Ord a => a -> Relation a -> Set.Set a
preSet :: a -> Relation a -> Set a
preSet a
x = ((a, a) -> a) -> Set (a, a) -> Set a
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (a, a) -> a
forall a b. (a, b) -> a
fst (Set (a, a) -> Set a)
-> (Relation a -> Set (a, a)) -> Relation a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> Bool) -> Set (a, a) -> Set (a, a)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) (a -> Bool) -> ((a, a) -> a) -> (a, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> a
forall a b. (a, b) -> b
snd) (Set (a, a) -> Set (a, a))
-> (Relation a -> Set (a, a)) -> Relation a -> Set (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation
postSet :: Ord a => a -> Relation a -> Set.Set a
postSet :: a -> Relation a -> Set a
postSet a
x = ((a, a) -> a) -> Set (a, a) -> Set a
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (a, a) -> a
forall a b. (a, b) -> b
snd (Set (a, a) -> Set a)
-> (Relation a -> Set (a, a)) -> Relation a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> Bool) -> Set (a, a) -> Set (a, a)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) (a -> Bool) -> ((a, a) -> a) -> (a, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> a
forall a b. (a, b) -> a
fst) (Set (a, a) -> Set (a, a))
-> (Relation a -> Set (a, a)) -> Relation a -> Set (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Set (a, a)
forall a. Relation a -> Set (a, a)
relation
path :: Ord a => [a] -> Relation a
path :: [a] -> Relation a
path [a]
xs = case [a]
xs of [] -> Relation a
forall a. Relation a
empty
[a
x] -> a -> Relation a
forall a. a -> Relation a
vertex a
x
(a
_:[a]
ys) -> [(a, a)] -> Relation a
forall a. Ord a => [(a, a)] -> Relation a
edges ([a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs [a]
ys)
circuit :: Ord a => [a] -> Relation a
circuit :: [a] -> Relation a
circuit [] = Relation a
forall a. Relation a
empty
circuit (a
x:[a]
xs) = [a] -> Relation a
forall a. Ord a => [a] -> Relation a
path ([a] -> Relation a) -> [a] -> Relation a
forall a b. (a -> b) -> a -> b
$ [a
x] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x]
clique :: Ord a => [a] -> Relation a
clique :: [a] -> Relation a
clique [a]
xs = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs) ((Set (a, a), Set a) -> Set (a, a)
forall a b. (a, b) -> a
fst ((Set (a, a), Set a) -> Set (a, a))
-> (Set (a, a), Set a) -> Set (a, a)
forall a b. (a -> b) -> a -> b
$ [a] -> (Set (a, a), Set a)
forall a. Ord a => [a] -> (Set (a, a), Set a)
go [a]
xs)
where
go :: [a] -> (Set (a, a), Set a)
go [] = (Set (a, a)
forall a. Set a
Set.empty, Set a
forall a. Set a
Set.empty)
go (a
x:[a]
xs) = (Set (a, a) -> Set (a, a) -> Set (a, a)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (a, a)
res ((a -> (a, a)) -> Set a -> Set (a, a)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (a
x,) Set a
set), a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
set)
where
(Set (a, a)
res, Set a
set) = [a] -> (Set (a, a), Set a)
go [a]
xs
biclique :: Ord a => [a] -> [a] -> Relation a
biclique :: [a] -> [a] -> Relation a
biclique [a]
xs [a]
ys = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation (Set a
x Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set a
y) (Set a
x Set a -> Set a -> Set (a, a)
forall a b. Set a -> Set b -> Set (a, b)
`setProduct` Set a
y)
where
x :: Set a
x = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs
y :: Set a
y = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
ys
star :: Ord a => a -> [a] -> Relation a
star :: a -> [a] -> Relation a
star a
x [] = a -> Relation a
forall a. a -> Relation a
vertex a
x
star a
x [a]
ys = Relation a -> Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a -> Relation a
connect (a -> Relation a
forall a. a -> Relation a
vertex a
x) ([a] -> Relation a
forall a. Ord a => [a] -> Relation a
vertices [a]
ys)
stars :: Ord a => [(a, [a])] -> Relation a
stars :: [(a, [a])] -> Relation a
stars [(a, [a])]
as = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
vs) ([(a, a)] -> Set (a, a)
forall a. Ord a => [a] -> Set a
Set.fromList [(a, a)]
es)
where
vs :: [a]
vs = ((a, [a]) -> [a]) -> [(a, [a])] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((a -> [a] -> [a]) -> (a, [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:)) [(a, [a])]
as
es :: [(a, a)]
es = [ (a
x, a
y) | (a
x, [a]
ys) <- [(a, [a])]
as, a
y <- [a]
ys ]
tree :: Ord a => Tree.Tree a -> Relation a
tree :: Tree a -> Relation a
tree (Node a
x []) = a -> Relation a
forall a. a -> Relation a
vertex a
x
tree (Node a
x [Tree a]
f ) = a -> [a] -> Relation a
forall a. Ord a => a -> [a] -> Relation a
star a
x ((Tree a -> a) -> [Tree a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> a
forall a. Tree a -> a
rootLabel [Tree a]
f)
Relation a -> Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a -> Relation a
`overlay` [Tree a] -> Relation a
forall a. Ord a => Forest a -> Relation a
forest ((Tree a -> Bool) -> [Tree a] -> [Tree a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Tree a -> Bool) -> Tree a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Tree a] -> Bool) -> (Tree a -> [Tree a]) -> Tree a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> [Tree a]
forall a. Tree a -> Forest a
subForest) [Tree a]
f)
forest :: Ord a => Tree.Forest a -> Relation a
forest :: Forest a -> Relation a
forest = [Relation a] -> Relation a
forall a. Ord a => [Relation a] -> Relation a
overlays([Relation a] -> Relation a)
-> (Forest a -> [Relation a]) -> Forest a -> Relation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree a -> Relation a) -> Forest a -> [Relation a]
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> Relation a
forall a. Ord a => Tree a -> Relation a
tree
removeVertex :: Ord a => a -> Relation a -> Relation a
removeVertex :: a -> Relation a -> Relation a
removeVertex a
x (Relation Set a
d Set (a, a)
r) = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
x Set a
d) (((a, a) -> Bool) -> Set (a, a) -> Set (a, a)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (a, a) -> Bool
notx Set (a, a)
r)
where
notx :: (a, a) -> Bool
notx (a
a, a
b) = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x Bool -> Bool -> Bool
&& a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x
removeEdge :: Ord a => a -> a -> Relation a -> Relation a
removeEdge :: a -> a -> Relation a -> Relation a
removeEdge a
x a
y (Relation Set a
d Set (a, a)
r) = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation Set a
d ((a, a) -> Set (a, a) -> Set (a, a)
forall a. Ord a => a -> Set a -> Set a
Set.delete (a
x, a
y) Set (a, a)
r)
replaceVertex :: Ord a => a -> a -> Relation a -> Relation a
replaceVertex :: a -> a -> Relation a -> Relation a
replaceVertex a
u a
v = (a -> a) -> Relation a -> Relation a
forall b a. Ord b => (a -> b) -> Relation a -> Relation b
gmap ((a -> a) -> Relation a -> Relation a)
-> (a -> a) -> Relation a -> Relation a
forall a b. (a -> b) -> a -> b
$ \a
w -> if a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
u then a
v else a
w
mergeVertices :: Ord a => (a -> Bool) -> a -> Relation a -> Relation a
mergeVertices :: (a -> Bool) -> a -> Relation a -> Relation a
mergeVertices a -> Bool
p a
v = (a -> a) -> Relation a -> Relation a
forall b a. Ord b => (a -> b) -> Relation a -> Relation b
gmap ((a -> a) -> Relation a -> Relation a)
-> (a -> a) -> Relation a -> Relation a
forall a b. (a -> b) -> a -> b
$ \a
u -> if a -> Bool
p a
u then a
v else a
u
transpose :: Ord a => Relation a -> Relation a
transpose :: Relation a -> Relation a
transpose (Relation Set a
d Set (a, a)
r) = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation Set a
d (((a, a) -> (a, a)) -> Set (a, a) -> Set (a, a)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (a, a) -> (a, a)
forall a b. (a, b) -> (b, a)
swap Set (a, a)
r)
gmap :: Ord b => (a -> b) -> Relation a -> Relation b
gmap :: (a -> b) -> Relation a -> Relation b
gmap a -> b
f (Relation Set a
d Set (a, a)
r) = Set b -> Set (b, b) -> Relation b
forall a. Set a -> Set (a, a) -> Relation a
Relation ((a -> b) -> Set a -> Set b
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> b
f Set a
d) (((a, a) -> (b, b)) -> Set (a, a) -> Set (b, b)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\(a
x, a
y) -> (a -> b
f a
x, a -> b
f a
y)) Set (a, a)
r)
induce :: (a -> Bool) -> Relation a -> Relation a
induce :: (a -> Bool) -> Relation a -> Relation a
induce a -> Bool
p (Relation Set a
d Set (a, a)
r) = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation ((a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
Set.filter a -> Bool
p Set a
d) (((a, a) -> Bool) -> Set (a, a) -> Set (a, a)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (a, a) -> Bool
pp Set (a, a)
r)
where
pp :: (a, a) -> Bool
pp (a
x, a
y) = a -> Bool
p a
x Bool -> Bool -> Bool
&& a -> Bool
p a
y
induceJust :: Ord a => Relation (Maybe a) -> Relation a
induceJust :: Relation (Maybe a) -> Relation a
induceJust (Relation Set (Maybe a)
d Set (Maybe a, Maybe a)
r) = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation (Set (Maybe a) -> Set a
catMaybesSet Set (Maybe a)
d) (Set (Maybe a, Maybe a) -> Set (a, a)
forall a b. Set (Maybe a, Maybe b) -> Set (a, b)
catMaybesSet2 Set (Maybe a, Maybe a)
r)
where
catMaybesSet :: Set (Maybe a) -> Set a
catMaybesSet = (Maybe a -> a) -> Set (Maybe a) -> Set a
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic Maybe a -> a
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust (Set (Maybe a) -> Set a)
-> (Set (Maybe a) -> Set (Maybe a)) -> Set (Maybe a) -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Set (Maybe a) -> Set (Maybe a)
forall a. Ord a => a -> Set a -> Set a
Set.delete Maybe a
forall a. Maybe a
Nothing
catMaybesSet2 :: Set (Maybe a, Maybe b) -> Set (a, b)
catMaybesSet2 = ((Maybe a, Maybe b) -> (a, b))
-> Set (Maybe a, Maybe b) -> Set (a, b)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (\(Maybe a
x, Maybe b
y) -> (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust Maybe a
x, Maybe b -> b
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust Maybe b
y))
(Set (Maybe a, Maybe b) -> Set (a, b))
-> (Set (Maybe a, Maybe b) -> Set (Maybe a, Maybe b))
-> Set (Maybe a, Maybe b)
-> Set (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe a, Maybe b) -> Bool)
-> Set (Maybe a, Maybe b) -> Set (Maybe a, Maybe b)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Maybe a, Maybe b) -> Bool
forall a a. (Maybe a, Maybe a) -> Bool
p
p :: (Maybe a, Maybe a) -> Bool
p (Maybe a
Nothing, Maybe a
_) = Bool
False
p (Maybe a
_, Maybe a
Nothing) = Bool
False
p (Maybe a
_, Maybe a
_) = Bool
True
compose :: Ord a => Relation a -> Relation a -> Relation a
compose :: Relation a -> Relation a -> Relation a
compose Relation a
x Relation a
y = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation (Set (a, a) -> Set a
forall a. Ord a => Set (a, a) -> Set a
referredToVertexSet Set (a, a)
r) Set (a, a)
r
where
d :: Set a
d = Relation a -> Set a
forall a. Relation a -> Set a
domain Relation a
x Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Relation a -> Set a
forall a. Relation a -> Set a
domain Relation a
y
r :: Set (a, a)
r = [Set (a, a)] -> Set (a, a)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [ a -> Relation a -> Set a
forall a. Ord a => a -> Relation a -> Set a
preSet a
v Relation a
x Set a -> Set a -> Set (a, a)
forall a b. Set a -> Set b -> Set (a, b)
`setProduct` a -> Relation a -> Set a
forall a. Ord a => a -> Relation a -> Set a
postSet a
v Relation a
y | a
v <- Set a -> [a]
forall a. Set a -> [a]
Set.toAscList Set a
d ]
closure :: Ord a => Relation a -> Relation a
closure :: Relation a -> Relation a
closure = Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a
reflexiveClosure (Relation a -> Relation a)
-> (Relation a -> Relation a) -> Relation a -> Relation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a
transitiveClosure
reflexiveClosure :: Ord a => Relation a -> Relation a
reflexiveClosure :: Relation a -> Relation a
reflexiveClosure (Relation Set a
d Set (a, a)
r) =
Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation Set a
d (Set (a, a) -> Relation a) -> Set (a, a) -> Relation a
forall a b. (a -> b) -> a -> b
$ Set (a, a)
r Set (a, a) -> Set (a, a) -> Set (a, a)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` [(a, a)] -> Set (a, a)
forall a. [a] -> Set a
Set.fromDistinctAscList [ (a
a, a
a) | a
a <- Set a -> [a]
forall a. Set a -> [a]
Set.toAscList Set a
d ]
symmetricClosure :: Ord a => Relation a -> Relation a
symmetricClosure :: Relation a -> Relation a
symmetricClosure (Relation Set a
d Set (a, a)
r) = Set a -> Set (a, a) -> Relation a
forall a. Set a -> Set (a, a) -> Relation a
Relation Set a
d (Set (a, a) -> Relation a) -> Set (a, a) -> Relation a
forall a b. (a -> b) -> a -> b
$ Set (a, a)
r Set (a, a) -> Set (a, a) -> Set (a, a)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` ((a, a) -> (a, a)) -> Set (a, a) -> Set (a, a)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (a, a) -> (a, a)
forall a b. (a, b) -> (b, a)
swap Set (a, a)
r
transitiveClosure :: Ord a => Relation a -> Relation a
transitiveClosure :: Relation a -> Relation a
transitiveClosure Relation a
old
| Relation a
old Relation a -> Relation a -> Bool
forall a. Eq a => a -> a -> Bool
== Relation a
new = Relation a
old
| Bool
otherwise = Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a
transitiveClosure Relation a
new
where
new :: Relation a
new = Relation a -> Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a -> Relation a
overlay Relation a
old (Relation a
old Relation a -> Relation a -> Relation a
forall a. Ord a => Relation a -> Relation a -> Relation a
`compose` Relation a
old)
consistent :: Ord a => Relation a -> Bool
consistent :: Relation a -> Bool
consistent (Relation Set a
d Set (a, a)
r) = Set (a, a) -> Set a
forall a. Ord a => Set (a, a) -> Set a
referredToVertexSet Set (a, a)
r Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set a
d
referredToVertexSet :: Ord a => Set (a, a) -> Set a
referredToVertexSet :: Set (a, a) -> Set a
referredToVertexSet = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> (Set (a, a) -> [a]) -> Set (a, a) -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a] -> [a]) -> ([a], [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) (([a], [a]) -> [a])
-> (Set (a, a) -> ([a], [a])) -> Set (a, a) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, a)] -> ([a], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(a, a)] -> ([a], [a]))
-> (Set (a, a) -> [(a, a)]) -> Set (a, a) -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (a, a) -> [(a, a)]
forall a. Set a -> [a]
Set.toAscList