{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Darcs.Util.Graph
( Graph
, Vertex
, VertexSet
, Component(..)
, ltmis
, bkmis
, components
, genGraphs
, genComponents
, prop_ltmis_eq_bkmis
, prop_ltmis_maximal_independent_sets
, prop_ltmis_all_maximal_independent_sets
, prop_components
) where
import Control.Monad ( filterM )
import Control.Monad.ST ( runST, ST )
import Data.List ( sort )
import qualified Data.Set as S
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as MU
import Darcs.Prelude
type Vertex = Int
type VertexSet = [Vertex]
type Graph = V.Vector VertexSet
data Component = Component Graph VertexSet deriving Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
(Int -> Component -> ShowS)
-> (Component -> String)
-> ([Component] -> ShowS)
-> Show Component
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Component] -> ShowS
$cshowList :: [Component] -> ShowS
show :: Component -> String
$cshow :: Component -> String
showsPrec :: Int -> Component -> ShowS
$cshowsPrec :: Int -> Component -> ShowS
Show
neighbours :: Graph -> Vertex -> VertexSet
neighbours :: Graph -> Int -> VertexSet
neighbours Graph
g Int
v = Graph
g Graph -> Int -> VertexSet
forall a. Vector a -> Int -> a
V.! Int
v
has_edge :: Graph -> Vertex -> Vertex -> Bool
has_edge :: Graph -> Int -> Int -> Bool
has_edge Graph
g Int
u Int
v = Int
u Int -> VertexSet -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Graph -> Int -> VertexSet
neighbours Graph
g Int
v
has_any_edge :: Graph -> VertexSet -> Vertex -> Bool
has_any_edge :: Graph -> VertexSet -> Int -> Bool
has_any_edge Graph
g VertexSet
vs Int
u = (Int -> Bool) -> VertexSet -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Graph -> Int -> Int -> Bool
has_edge Graph
g Int
u) VertexSet
vs
all_vertices :: Graph -> VertexSet
all_vertices :: Graph -> VertexSet
all_vertices Graph
g = [Int
0..(Graph -> Int
gsize Graph
g Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
gsize :: Graph -> Int
gsize :: Graph -> Int
gsize Graph
v = Graph -> Int
forall a. Vector a -> Int
V.length Graph
v
type Helper = U.Vector Bool
ltmis :: (Bool,Bool) -> Component -> [VertexSet]
ltmis :: (Bool, Bool) -> Component -> [VertexSet]
ltmis (Bool
bt1,Bool
bt2) (Component Graph
g VertexSet
comp) =
(VertexSet -> VertexSet) -> [VertexSet] -> [VertexSet]
forall a b. (a -> b) -> [a] -> [b]
map VertexSet -> VertexSet
forall a. [a] -> [a]
reverse ([VertexSet] -> [VertexSet]) -> [VertexSet] -> [VertexSet]
forall a b. (a -> b) -> a -> b
$ VertexSet -> Int -> Helper -> [VertexSet]
go [] Int
0 Helper
init_h
where
size :: Int
size = Graph -> Int
gsize Graph
g
init_h :: Helper
init_h = Int -> Bool -> Helper
forall a. Unbox a => Int -> a -> Vector a
U.replicate (Graph -> Int
gsize Graph
g) Bool
True Helper -> [(Int, Bool)] -> Helper
forall a. Unbox a => Vector a -> [(Int, a)] -> Vector a
U.// VertexSet -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip VertexSet
comp (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False)
go :: VertexSet -> Vertex -> Helper -> [VertexSet]
go :: VertexSet -> Int -> Helper -> [VertexSet]
go VertexSet
r !Int
sep Helper
h =
case Int -> Helper -> VertexSet
candidates Int
sep Helper
h of
[] -> [VertexSet
r]
Int
br:VertexSet
_ ->
(if Bool
bt1 Bool -> Bool -> Bool
&& Int -> Helper -> Bool
done_branching Int
sep' Helper
h' then [] else VertexSet -> Int -> Helper -> [VertexSet]
go (Int
brInt -> VertexSet -> VertexSet
forall a. a -> [a] -> [a]
:VertexSet
r) Int
sep' Helper
h')
[VertexSet] -> [VertexSet] -> [VertexSet]
forall a. [a] -> [a] -> [a]
++
(if Bool
bt2 Bool -> Bool -> Bool
&& Int -> Helper -> Int -> Bool
done_backtracking Int
sep' Helper
h Int
br then [] else VertexSet -> Int -> Helper -> [VertexSet]
go VertexSet
r Int
sep' Helper
h)
where
h' :: Helper
h' = Helper
h Helper -> [(Int, Bool)] -> Helper
forall a. Unbox a => Vector a -> [(Int, a)] -> Vector a
U.// VertexSet -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int
br Int -> VertexSet -> VertexSet
forall a. a -> [a] -> [a]
: Graph -> Int -> VertexSet
neighbours Graph
g Int
br) (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True)
sep' :: Int
sep' = Int
br Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
candidates :: Vertex -> Helper -> VertexSet
candidates :: Int -> Helper -> VertexSet
candidates Int
sep Helper
h = (Int -> Bool) -> VertexSet -> VertexSet
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Int -> Bool) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Helper
h Helper -> Int -> Bool
forall a. Unbox a => Vector a -> Int -> a
U.!)) (VertexSet -> VertexSet) -> VertexSet -> VertexSet
forall a b. (a -> b) -> a -> b
$ [Int
sep..(Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
excludes :: Vertex -> Helper -> [Vertex]
excludes :: Int -> Helper -> VertexSet
excludes Int
sep Helper
h = (Int -> Bool) -> VertexSet -> VertexSet
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Int -> Bool) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Helper
h Helper -> Int -> Bool
forall a. Unbox a => Vector a -> Int -> a
U.!)) [Int
0 .. (Int
sepInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
is_candidate :: Vertex -> Helper -> Vertex -> Bool
is_candidate :: Int -> Helper -> Int -> Bool
is_candidate Int
sep Helper
h Int
v = Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sep Bool -> Bool -> Bool
&& Bool -> Bool
not ((Helper
h Helper -> Int -> Bool
forall a. Unbox a => Vector a -> Int -> a
U.!) Int
v)
intersects_candidates :: Vertex -> Helper -> VertexSet -> Bool
intersects_candidates :: Int -> Helper -> VertexSet -> Bool
intersects_candidates Int
sep Helper
h = (Int -> Bool) -> VertexSet -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Helper -> Int -> Bool
is_candidate Int
sep Helper
h)
done_branching :: Vertex -> Helper -> Bool
done_branching :: Int -> Helper -> Bool
done_branching Int
sep Helper
h =
(VertexSet -> Bool) -> [VertexSet] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (VertexSet -> Bool) -> VertexSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Helper -> VertexSet -> Bool
intersects_candidates Int
sep Helper
h) ([VertexSet] -> Bool) -> [VertexSet] -> Bool
forall a b. (a -> b) -> a -> b
$ (Int -> VertexSet) -> VertexSet -> [VertexSet]
forall a b. (a -> b) -> [a] -> [b]
map (Graph -> Int -> VertexSet
neighbours Graph
g) (VertexSet -> [VertexSet]) -> VertexSet -> [VertexSet]
forall a b. (a -> b) -> a -> b
$ Int -> Helper -> VertexSet
excludes Int
sep Helper
h
done_backtracking :: Vertex -> Helper -> Vertex -> Bool
done_backtracking :: Int -> Helper -> Int -> Bool
done_backtracking Int
sep Helper
h Int
v = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Helper -> VertexSet -> Bool
intersects_candidates Int
sep Helper
h (VertexSet -> Bool) -> VertexSet -> Bool
forall a b. (a -> b) -> a -> b
$ Graph -> Int -> VertexSet
neighbours Graph
g Int
v
bkmis :: Graph -> [VertexSet]
bkmis :: Graph -> [VertexSet]
bkmis Graph
g = [VertexSet] -> [VertexSet]
forall a. [a] -> [a]
reverse ([VertexSet] -> [VertexSet]) -> [VertexSet] -> [VertexSet]
forall a b. (a -> b) -> a -> b
$ (VertexSet -> VertexSet) -> [VertexSet] -> [VertexSet]
forall a b. (a -> b) -> [a] -> [b]
map VertexSet -> VertexSet
forall a. [a] -> [a]
reverse ([VertexSet] -> [VertexSet]) -> [VertexSet] -> [VertexSet]
forall a b. (a -> b) -> a -> b
$ VertexSet -> VertexSet -> VertexSet -> [VertexSet]
go [] [] (Graph -> VertexSet
all_vertices Graph
g) where
go :: VertexSet -> VertexSet -> VertexSet -> [VertexSet]
go VertexSet
r [] [] = [VertexSet
r]
go VertexSet
r VertexSet
xs VertexSet
cs = VertexSet -> VertexSet -> [VertexSet]
loop VertexSet
xs VertexSet
cs where
loop :: VertexSet -> VertexSet -> [VertexSet]
loop VertexSet
_ [] = []
loop VertexSet
xs (Int
c:VertexSet
cs) = VertexSet -> VertexSet -> [VertexSet]
loop (Int
cInt -> VertexSet -> VertexSet
forall a. a -> [a] -> [a]
:VertexSet
xs) VertexSet
cs [VertexSet] -> [VertexSet] -> [VertexSet]
forall a. [a] -> [a] -> [a]
++ VertexSet -> VertexSet -> VertexSet -> [VertexSet]
go (Int
cInt -> VertexSet -> VertexSet
forall a. a -> [a] -> [a]
:VertexSet
r) (Int -> VertexSet -> VertexSet
res Int
c VertexSet
xs) (Int -> VertexSet -> VertexSet
res Int
c VertexSet
cs)
res :: Int -> VertexSet -> VertexSet
res Int
v = (Int -> Bool) -> VertexSet -> VertexSet
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Int -> Bool) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> Int -> Int -> Bool
has_edge Graph
g Int
v)
genGraph :: Monad m => (Int -> Int -> m VertexSet) -> Int -> m Graph
genGraph :: (Int -> Int -> m VertexSet) -> Int -> m Graph
genGraph Int -> Int -> m VertexSet
genSubset = Int -> Int -> m Graph
go Int
0 where
go :: Int -> Int -> m Graph
go Int
_ Int
0 = Graph -> m Graph
forall (m :: * -> *) a. Monad m => a -> m a
return Graph
forall a. Vector a
V.empty
go Int
s Int
n = do
Graph
g <- Int -> Int -> m Graph
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
VertexSet
vs <- Int -> Int -> m VertexSet
genSubset (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
Graph -> m Graph
forall (m :: * -> *) a. Monad m => a -> m a
return (Graph -> m Graph) -> Graph -> m Graph
forall a b. (a -> b) -> a -> b
$ (forall s. MVector s VertexSet -> ST s ()) -> Graph -> Graph
forall a.
(forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
V.modify (\MVector s VertexSet
h -> (Int -> ST s ()) -> VertexSet -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (MVector (PrimState (ST s)) VertexSet -> Int -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) VertexSet -> Int -> m ()
adjust MVector s VertexSet
MVector (PrimState (ST s)) VertexSet
h) VertexSet
vs) (VertexSet -> Graph -> Graph
forall a. a -> Vector a -> Vector a
V.cons VertexSet
vs Graph
g)
where
adjust :: MVector (PrimState m) VertexSet -> Int -> m ()
adjust MVector (PrimState m) VertexSet
g Int
i = do
VertexSet
vs <- MVector (PrimState m) VertexSet -> Int -> m VertexSet
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.read MVector (PrimState m) VertexSet
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s)
MVector (PrimState m) VertexSet -> Int -> VertexSet -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector (PrimState m) VertexSet
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s) (Int
sInt -> VertexSet -> VertexSet
forall a. a -> [a] -> [a]
:VertexSet
vs)
genGraphs :: Int -> [Graph]
genGraphs :: Int -> [Graph]
genGraphs = (Int -> Int -> [VertexSet]) -> Int -> [Graph]
forall (m :: * -> *).
Monad m =>
(Int -> Int -> m VertexSet) -> Int -> m Graph
genGraph Int -> Int -> [VertexSet]
forall t a. (Eq t, Num t, Num a) => a -> t -> [[a]]
subsets where
subsets :: a -> t -> [[a]]
subsets a
_ t
0 = [a] -> [[a]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
subsets a
s t
n = do
[a]
vs <- a -> t -> [[a]]
subsets (a
sa -> a -> a
forall a. Num a => a -> a -> a
+a
1) (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1)
[[a]
vs,a
sa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
vs]
genComponents :: Int -> [Component]
genComponents :: Int -> [Component]
genComponents Int
n = do
Graph
g <- Int -> [Graph]
genGraphs Int
n
Graph -> [Component]
components Graph
g
components :: Graph -> [Component]
components :: Graph -> [Component]
components Graph
g = [Component] -> [Component]
forall a. [a] -> [a]
reverse ([Component] -> [Component]) -> [Component] -> [Component]
forall a b. (a -> b) -> a -> b
$ (VertexSet -> Component) -> [VertexSet] -> [Component]
forall a b. (a -> b) -> [a] -> [b]
map (Graph -> VertexSet -> Component
Component Graph
g) ([VertexSet] -> [Component]) -> [VertexSet] -> [Component]
forall a b. (a -> b) -> a -> b
$ (forall s. ST s [VertexSet]) -> [VertexSet]
forall a. (forall s. ST s a) -> a
runST forall s. ST s [VertexSet]
go where
size :: Int
size = Graph -> Int
gsize Graph
g
go :: ST s [VertexSet]
go :: ST s [VertexSet]
go = do
MVector s Bool
mh <- Int -> Bool -> ST s (MVector (PrimState (ST s)) Bool)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> a -> m (MVector (PrimState m) a)
MU.replicate Int
size Bool
False
Int
-> MVector (PrimState (ST s)) Bool
-> [VertexSet]
-> ST s [VertexSet]
forall (m :: * -> *).
PrimMonad m =>
Int -> MVector (PrimState m) Bool -> [VertexSet] -> m [VertexSet]
loop Int
0 MVector s Bool
MVector (PrimState (ST s)) Bool
mh []
loop :: Int -> MVector (PrimState m) Bool -> [VertexSet] -> m [VertexSet]
loop Int
v MVector (PrimState m) Bool
mh [VertexSet]
r
| Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
size = [VertexSet] -> m [VertexSet]
forall (m :: * -> *) a. Monad m => a -> m a
return [VertexSet]
r
| Bool
otherwise = do
VertexSet
c <- Int -> m VertexSet
new_component Int
v
if VertexSet -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null VertexSet
c
then Int -> MVector (PrimState m) Bool -> [VertexSet] -> m [VertexSet]
loop (Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) MVector (PrimState m) Bool
mh [VertexSet]
r
else Int -> MVector (PrimState m) Bool -> [VertexSet] -> m [VertexSet]
loop (Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) MVector (PrimState m) Bool
mh (VertexSet
c VertexSet -> [VertexSet] -> [VertexSet]
forall a. a -> [a] -> [a]
: [VertexSet]
r)
where
new_component :: Int -> m VertexSet
new_component Int
v = do
Bool
visited <- MVector (PrimState m) Bool -> Int -> m Bool
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.read MVector (PrimState m) Bool
mh Int
v
if Bool
visited
then VertexSet -> m VertexSet
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
MVector (PrimState m) Bool -> Int -> Bool -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector (PrimState m) Bool
mh Int
v Bool
True
[VertexSet]
cs <- (Int -> m VertexSet) -> VertexSet -> m [VertexSet]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> m VertexSet
new_component (Graph -> Int -> VertexSet
neighbours Graph
g Int
v)
VertexSet -> m VertexSet
forall (m :: * -> *) a. Monad m => a -> m a
return (VertexSet -> m VertexSet) -> VertexSet -> m VertexSet
forall a b. (a -> b) -> a -> b
$ Int
v Int -> VertexSet -> VertexSet
forall a. a -> [a] -> [a]
: [VertexSet] -> VertexSet
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [VertexSet]
cs
prop_is_independent_set :: Graph -> VertexSet -> Bool
prop_is_independent_set :: Graph -> VertexSet -> Bool
prop_is_independent_set Graph
g VertexSet
vs = (Int -> Bool) -> VertexSet -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (Int -> Bool) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> VertexSet -> Int -> Bool
has_any_edge Graph
g VertexSet
vs) VertexSet
vs
prop_is_maximal_independent_set :: Component -> VertexSet -> Bool
prop_is_maximal_independent_set :: Component -> VertexSet -> Bool
prop_is_maximal_independent_set (Component Graph
g VertexSet
c) VertexSet
vs =
Graph -> VertexSet -> Bool
prop_is_independent_set Graph
g VertexSet
vs Bool -> Bool -> Bool
&&
(Int -> Bool) -> VertexSet -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Graph -> VertexSet -> Int -> Bool
has_any_edge Graph
g VertexSet
vs) VertexSet
other_vertices
where
other_vertices :: VertexSet
other_vertices = (Int -> Bool) -> VertexSet -> VertexSet
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> VertexSet -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` VertexSet
vs) VertexSet
c
prop_ltmis_eq_bkmis :: Graph -> Bool
prop_ltmis_eq_bkmis :: Graph -> Bool
prop_ltmis_eq_bkmis Graph
g =
(Bool, Bool) -> Component -> [VertexSet]
ltmis (Bool
True, Bool
True) (Graph -> VertexSet -> Component
Component Graph
g (Graph -> VertexSet
all_vertices Graph
g)) [VertexSet] -> [VertexSet] -> Bool
forall a. Eq a => a -> a -> Bool
== Graph -> [VertexSet]
bkmis Graph
g
prop_ltmis_maximal_independent_sets :: Component -> Bool
prop_ltmis_maximal_independent_sets :: Component -> Bool
prop_ltmis_maximal_independent_sets Component
sg =
(VertexSet -> Bool) -> [VertexSet] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Component -> VertexSet -> Bool
prop_is_maximal_independent_set Component
sg) ((Bool, Bool) -> Component -> [VertexSet]
ltmis (Bool
True, Bool
True) Component
sg)
prop_ltmis_all_maximal_independent_sets :: Component -> Bool
prop_ltmis_all_maximal_independent_sets :: Component -> Bool
prop_ltmis_all_maximal_independent_sets sg :: Component
sg@(Component Graph
_ VertexSet
c) =
(VertexSet -> Bool) -> [VertexSet] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (VertexSet -> Bool) -> VertexSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Component -> VertexSet -> Bool
prop_is_maximal_independent_set Component
sg) [VertexSet]
other_subsets
where
mis :: [VertexSet]
mis = (Bool, Bool) -> Component -> [VertexSet]
ltmis (Bool
True, Bool
True) Component
sg
all_subsets :: [VertexSet]
all_subsets = VertexSet -> [VertexSet]
powerset VertexSet
c
other_subsets :: [VertexSet]
other_subsets = (VertexSet -> Bool) -> [VertexSet] -> [VertexSet]
forall a. (a -> Bool) -> [a] -> [a]
filter (VertexSet -> [VertexSet] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [VertexSet]
mis) [VertexSet]
all_subsets
prop_is_partition :: Graph -> [VertexSet] -> Bool
prop_is_partition :: Graph -> [VertexSet] -> Bool
prop_is_partition Graph
g [VertexSet]
cs = VertexSet -> VertexSet
forall a. Ord a => [a] -> [a]
sort ([VertexSet] -> VertexSet
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [VertexSet]
cs) VertexSet -> VertexSet -> Bool
forall a. Eq a => a -> a -> Bool
== Graph -> VertexSet
all_vertices Graph
g
prop_self_contained :: Graph -> VertexSet -> Bool
prop_self_contained :: Graph -> VertexSet -> Bool
prop_self_contained Graph
g VertexSet
c =
[Set Int] -> Set Int
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ((Int -> Set Int) -> VertexSet -> [Set Int]
forall a b. (a -> b) -> [a] -> [b]
map (VertexSet -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList (VertexSet -> Set Int) -> (Int -> VertexSet) -> Int -> Set Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> Int -> VertexSet
neighbours Graph
g) VertexSet
c) Set Int -> Set Int -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` VertexSet -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList VertexSet
c
prop_connected :: Graph -> VertexSet -> Bool
prop_connected :: Graph -> VertexSet -> Bool
prop_connected Graph
g = Bool -> Bool
not (Bool -> Bool) -> (VertexSet -> Bool) -> VertexSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VertexSet -> Bool) -> [VertexSet] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Graph -> VertexSet -> Bool
prop_self_contained Graph
g) ([VertexSet] -> Bool)
-> (VertexSet -> [VertexSet]) -> VertexSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexSet -> [VertexSet]
proper_non_empty_subsets
where
proper_non_empty_subsets :: VertexSet -> [VertexSet]
proper_non_empty_subsets = (VertexSet -> Bool) -> [VertexSet] -> [VertexSet]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (VertexSet -> Bool) -> VertexSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexSet -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([VertexSet] -> [VertexSet])
-> (VertexSet -> [VertexSet]) -> VertexSet -> [VertexSet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VertexSet] -> [VertexSet]
forall a. [a] -> [a]
tail ([VertexSet] -> [VertexSet])
-> (VertexSet -> [VertexSet]) -> VertexSet -> [VertexSet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexSet -> [VertexSet]
powerset
prop_connected_component :: Component -> Bool
prop_connected_component :: Component -> Bool
prop_connected_component (Component Graph
g VertexSet
vs) =
Graph -> VertexSet -> Bool
prop_self_contained Graph
g VertexSet
vs Bool -> Bool -> Bool
&& Graph -> VertexSet -> Bool
prop_connected Graph
g VertexSet
vs
prop_components :: Graph -> Bool
prop_components :: Graph -> Bool
prop_components Graph
g =
(Component -> Bool) -> [Component] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Component -> Bool
prop_connected_component [Component]
cs Bool -> Bool -> Bool
&&
Graph -> [VertexSet] -> Bool
prop_is_partition Graph
g ((Component -> VertexSet) -> [Component] -> [VertexSet]
forall a b. (a -> b) -> [a] -> [b]
map Component -> VertexSet
vertices [Component]
cs) Bool -> Bool -> Bool
&& (Graph -> Bool) -> [Graph] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Graph -> Graph -> Bool
forall a. Eq a => a -> a -> Bool
== Graph
g) ((Component -> Graph) -> [Component] -> [Graph]
forall a b. (a -> b) -> [a] -> [b]
map Component -> Graph
graph [Component]
cs)
where
vertices :: Component -> VertexSet
vertices (Component Graph
_ VertexSet
vs) = VertexSet
vs
graph :: Component -> Graph
graph (Component Graph
g VertexSet
_) = Graph
g
cs :: [Component]
cs = Graph -> [Component]
components Graph
g
powerset :: VertexSet -> [VertexSet]
powerset :: VertexSet -> [VertexSet]
powerset = (VertexSet -> VertexSet) -> [VertexSet] -> [VertexSet]
forall a b. (a -> b) -> [a] -> [b]
map VertexSet -> VertexSet
forall a. Ord a => [a] -> [a]
sort ([VertexSet] -> [VertexSet])
-> (VertexSet -> [VertexSet]) -> VertexSet -> [VertexSet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Bool]) -> VertexSet -> [VertexSet]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ([Bool] -> Int -> [Bool]
forall a b. a -> b -> a
const [Bool
True, Bool
False])