{- The idea of the ltmis algorithm is based on this paper:

Loukakis, E & Tsouros, Constantin. (1981). A depth first search algorithm to
generate the family of maximal independent sets of a graph
lexicographically. Computing. 27. 349-366. 10.1007/BF02277184.

This is basically the same as Bron-Kerbosch but with two special
optimizations, one to avoid needless backtracking and one to avoid needless
branching. For large graphs the gains in efficiency are significant. On my
computer generating all MIS for the first 100000 graphs of size 12 takes
0.757 seconds with ltmis (True,True) and over 10 seconds with bkmis.

-}

{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Darcs.Util.Graph
  ( Graph
  , Vertex
  , VertexSet
  , Component(..)
  -- * Algorithms
  , ltmis
  , bkmis
  , components
  -- * Generating graphs
  , genGraphs
  , genComponents
  -- * Properties
  , 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

-- | Vertices are represented as 'Int'.
type Vertex = Int

-- | Set of vertices, represented as a list for efficiency (yes, indeed).
type VertexSet = [Vertex]

-- | Undirected graph represented as a 'V.Vector' of adjacency 'VertexSet's.
type Graph = V.Vector VertexSet

data Component = Component Graph VertexSet deriving Vertex -> Component -> ShowS
[Component] -> ShowS
Component -> String
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Component] -> ShowS
$cshowList :: [Component] -> ShowS
show :: Component -> String
$cshow :: Component -> String
showsPrec :: Vertex -> Component -> ShowS
$cshowsPrec :: Vertex -> Component -> ShowS
Show

-- | The neighbors of a 'Vertex' in a 'Graph'.
neighbours :: Graph -> Vertex -> VertexSet
neighbours :: Graph -> Vertex -> [Vertex]
neighbours Graph
g Vertex
v = Graph
g forall a. Vector a -> Vertex -> a
V.! Vertex
v

has_edge :: Graph -> Vertex -> Vertex -> Bool
has_edge :: Graph -> Vertex -> Vertex -> Bool
has_edge Graph
g Vertex
u Vertex
v = Vertex
u forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Graph -> Vertex -> [Vertex]
neighbours Graph
g Vertex
v

has_any_edge :: Graph -> VertexSet -> Vertex -> Bool
has_any_edge :: Graph -> [Vertex] -> Vertex -> Bool
has_any_edge Graph
g [Vertex]
vs Vertex
u = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Graph -> Vertex -> Vertex -> Bool
has_edge Graph
g Vertex
u) [Vertex]
vs

all_vertices :: Graph -> VertexSet
all_vertices :: Graph -> [Vertex]
all_vertices Graph
g = [Vertex
0..(Graph -> Vertex
gsize Graph
g forall a. Num a => a -> a -> a
- Vertex
1)]

-- | The number of vertices in a 'Graph'.
gsize :: Graph -> Int
gsize :: Graph -> Vertex
gsize Graph
v = forall a. Vector a -> Vertex
V.length Graph
v

-- * Maximal independent sets

-- | Simple helper type used in the 'ltmis' and 'components' algorithms.
type Helper = U.Vector Bool

-- | Determine the maximal independent sets in a 'Component' of a 'Graph'.
ltmis :: (Bool,Bool) -> Component -> [VertexSet]
ltmis :: (Bool, Bool) -> Component -> [[Vertex]]
ltmis (Bool
bt1,Bool
bt2) (Component Graph
g [Vertex]
comp) =
    -- the map reverse is because we use (:) to add vertices to r
    -- when branching
    forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [Vertex] -> Vertex -> Helper -> [[Vertex]]
go [] Vertex
0 Helper
init_h
  where
    size :: Vertex
size = Graph -> Vertex
gsize Graph
g
    init_h :: Helper
init_h = forall a. Unbox a => Vertex -> a -> Vector a
U.replicate (Graph -> Vertex
gsize Graph
g) Bool
True forall a. Unbox a => Vector a -> [(Vertex, a)] -> Vector a
U.// forall a b. [a] -> [b] -> [(a, b)]
zip [Vertex]
comp (forall a. a -> [a]
repeat Bool
False)
    -- h[v] = neighbours g v `intersectsWith` r || v `elem` r || v `notElem` comp
    go :: VertexSet -> Vertex -> Helper -> [VertexSet]
    go :: [Vertex] -> Vertex -> Helper -> [[Vertex]]
go [Vertex]
r !Vertex
sep Helper
h =
      case Vertex -> Helper -> [Vertex]
candidates Vertex
sep Helper
h of
        [] -> [[Vertex]
r]
        Vertex
br:[Vertex]
_ ->
          (if Bool
bt1 Bool -> Bool -> Bool
&& Vertex -> Helper -> Bool
done_branching Vertex
sep' Helper
h' then [] else [Vertex] -> Vertex -> Helper -> [[Vertex]]
go (Vertex
brforall a. a -> [a] -> [a]
:[Vertex]
r) Vertex
sep' Helper
h')
          forall a. [a] -> [a] -> [a]
++
          (if Bool
bt2 Bool -> Bool -> Bool
&& Vertex -> Helper -> Vertex -> Bool
done_backtracking Vertex
sep' Helper
h Vertex
br then [] else [Vertex] -> Vertex -> Helper -> [[Vertex]]
go [Vertex]
r Vertex
sep' Helper
h)
          where
            h' :: Helper
h' = Helper
h forall a. Unbox a => Vector a -> [(Vertex, a)] -> Vector a
U.// forall a b. [a] -> [b] -> [(a, b)]
zip (Vertex
br forall a. a -> [a] -> [a]
: Graph -> Vertex -> [Vertex]
neighbours Graph
g Vertex
br) (forall a. a -> [a]
repeat Bool
True)
            sep' :: Vertex
sep' = Vertex
br forall a. Num a => a -> a -> a
+ Vertex
1

    candidates :: Vertex -> Helper -> VertexSet
    candidates :: Vertex -> Helper -> [Vertex]
candidates Vertex
sep Helper
h = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Helper
h forall a. Unbox a => Vector a -> Vertex -> a
U.!)) forall a b. (a -> b) -> a -> b
$ [Vertex
sep..(Vertex
sizeforall a. Num a => a -> a -> a
-Vertex
1)]

    excludes :: Vertex -> Helper -> [Vertex]
    excludes :: Vertex -> Helper -> [Vertex]
excludes Vertex
sep Helper
h = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Helper
h forall a. Unbox a => Vector a -> Vertex -> a
U.!)) [Vertex
0 .. (Vertex
sepforall a. Num a => a -> a -> a
-Vertex
1)]

    is_candidate :: Vertex -> Helper -> Vertex -> Bool
    is_candidate :: Vertex -> Helper -> Vertex -> Bool
is_candidate Vertex
sep Helper
h Vertex
v = Vertex
v forall a. Ord a => a -> a -> Bool
>= Vertex
sep Bool -> Bool -> Bool
&& Bool -> Bool
not ((Helper
h forall a. Unbox a => Vector a -> Vertex -> a
U.!) Vertex
v)

    intersects_candidates :: Vertex -> Helper -> VertexSet -> Bool
    intersects_candidates :: Vertex -> Helper -> [Vertex] -> Bool
intersects_candidates Vertex
sep Helper
h = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Vertex -> Helper -> Vertex -> Bool
is_candidate Vertex
sep Helper
h)

    -- for some x in X, N(x) does not intersect C
    -- means whatever candidate we add we won't get an MIS
    -- so can stop branching
    done_branching :: Vertex -> Helper -> Bool
    done_branching :: Vertex -> Helper -> Bool
done_branching Vertex
sep Helper
h =
      forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex -> Helper -> [Vertex] -> Bool
intersects_candidates Vertex
sep Helper
h) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Graph -> Vertex -> [Vertex]
neighbours Graph
g) forall a b. (a -> b) -> a -> b
$ Vertex -> Helper -> [Vertex]
excludes Vertex
sep Helper
h

    -- if done_backtracking (neighbours g v), then v must
    -- be a member of any MIS containing R
    done_backtracking :: Vertex -> Helper -> Vertex -> Bool
    done_backtracking :: Vertex -> Helper -> Vertex -> Bool
done_backtracking Vertex
sep Helper
h Vertex
v = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Vertex -> Helper -> [Vertex] -> Bool
intersects_candidates Vertex
sep Helper
h forall a b. (a -> b) -> a -> b
$ Graph -> Vertex -> [Vertex]
neighbours Graph
g Vertex
v

-- | The classic Bron-Kerbosch algorithm for determining the maximal
-- independent sets in a 'Graph'.
bkmis :: Graph -> [VertexSet]
bkmis :: Graph -> [[Vertex]]
bkmis Graph
g = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [Vertex] -> [Vertex] -> [Vertex] -> [[Vertex]]
go [] [] (Graph -> [Vertex]
all_vertices Graph
g) where
  go :: [Vertex] -> [Vertex] -> [Vertex] -> [[Vertex]]
go [Vertex]
r [] [] = [[Vertex]
r]
  go [Vertex]
r [Vertex]
xs [Vertex]
cs = [Vertex] -> [Vertex] -> [[Vertex]]
loop [Vertex]
xs [Vertex]
cs where
    loop :: [Vertex] -> [Vertex] -> [[Vertex]]
loop [Vertex]
_ [] = []
    loop [Vertex]
xs (Vertex
c:[Vertex]
cs) = [Vertex] -> [Vertex] -> [[Vertex]]
loop (Vertex
cforall a. a -> [a] -> [a]
:[Vertex]
xs) [Vertex]
cs forall a. [a] -> [a] -> [a]
++ [Vertex] -> [Vertex] -> [Vertex] -> [[Vertex]]
go (Vertex
cforall a. a -> [a] -> [a]
:[Vertex]
r) (Vertex -> [Vertex] -> [Vertex]
res Vertex
c [Vertex]
xs) (Vertex -> [Vertex] -> [Vertex]
res Vertex
c [Vertex]
cs)
    res :: Vertex -> [Vertex] -> [Vertex]
res Vertex
v = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> Vertex -> Vertex -> Bool
has_edge Graph
g Vertex
v)

-- * Generating graphs

genGraph :: Monad m => (Int -> Int -> m VertexSet) -> Int -> m Graph
genGraph :: forall (m :: * -> *).
Monad m =>
(Vertex -> Vertex -> m [Vertex]) -> Vertex -> m Graph
genGraph Vertex -> Vertex -> m [Vertex]
genSubset = Vertex -> Vertex -> m Graph
go Vertex
0 where
  go :: Vertex -> Vertex -> m Graph
go Vertex
_ Vertex
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Vector a
V.empty
  go Vertex
s Vertex
n = do -- list monad
    Graph
g <- Vertex -> Vertex -> m Graph
go (Vertex
sforall a. Num a => a -> a -> a
+Vertex
1) (Vertex
nforall a. Num a => a -> a -> a
-Vertex
1)
    [Vertex]
vs <- Vertex -> Vertex -> m [Vertex]
genSubset (Vertex
sforall a. Num a => a -> a -> a
+Vertex
1) (Vertex
nforall a. Num a => a -> a -> a
-Vertex
1)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
V.modify (\MVector s [Vertex]
h -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {m :: * -> *}.
PrimMonad m =>
MVector (PrimState m) [Vertex] -> Vertex -> m ()
adjust MVector s [Vertex]
h) [Vertex]
vs) (forall a. a -> Vector a -> Vector a
V.cons [Vertex]
vs Graph
g)
    where
      adjust :: MVector (PrimState m) [Vertex] -> Vertex -> m ()
adjust MVector (PrimState m) [Vertex]
g Vertex
i = do
        [Vertex]
vs <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Vertex -> m a
MV.read MVector (PrimState m) [Vertex]
g (Vertex
iforall a. Num a => a -> a -> a
-Vertex
s)
        forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Vertex -> a -> m ()
MV.write MVector (PrimState m) [Vertex]
g (Vertex
iforall a. Num a => a -> a -> a
-Vertex
s) (Vertex
sforall a. a -> [a] -> [a]
:[Vertex]
vs)

-- | Enumerate all (simple) graphs of a given size (number of vertices).
genGraphs :: Int -> [Graph]
genGraphs :: Vertex -> [Graph]
genGraphs = forall (m :: * -> *).
Monad m =>
(Vertex -> Vertex -> m [Vertex]) -> Vertex -> m Graph
genGraph forall {t} {a}. (Eq t, Num t, Num a) => a -> t -> [[a]]
subsets where
  -- Subsets of the n elements [s..(s+n-1)] (each subset is ordered)
  subsets :: a -> t -> [[a]]
subsets a
_ t
0 = forall (m :: * -> *) a. Monad m => a -> m a
return []
  subsets a
s t
n = do
    [a]
vs <- a -> t -> [[a]]
subsets (a
sforall a. Num a => a -> a -> a
+a
1) (t
nforall a. Num a => a -> a -> a
-t
1)
    [[a]
vs,a
sforall a. a -> [a] -> [a]
:[a]
vs]

genComponents :: Int -> [Component]
genComponents :: Vertex -> [Component]
genComponents Vertex
n = do
  Graph
g <- Vertex -> [Graph]
genGraphs Vertex
n
  Graph -> [Component]
components Graph
g

-- * Connected components

-- | Split a 'Graph' into connected components. For efficiency we don't
-- represent the result as a list of Graphs, but rather of 'VertexSet's.
components :: Graph -> [Component]
components :: Graph -> [Component]
components Graph
g = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Graph -> [Vertex] -> Component
Component Graph
g) forall a b. (a -> b) -> a -> b
$ forall a. (forall s. ST s a) -> a
runST forall s. ST s [[Vertex]]
go where
  size :: Vertex
size = Graph -> Vertex
gsize Graph
g
  go :: ST s [VertexSet]
  go :: forall s. ST s [[Vertex]]
go = do
    MVector s Bool
mh <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Vertex -> a -> m (MVector (PrimState m) a)
MU.replicate Vertex
size Bool
False
    forall {m :: * -> *}.
PrimMonad m =>
Vertex -> MVector (PrimState m) Bool -> [[Vertex]] -> m [[Vertex]]
loop Vertex
0 MVector s Bool
mh []
  loop :: Vertex -> MVector (PrimState m) Bool -> [[Vertex]] -> m [[Vertex]]
loop Vertex
v MVector (PrimState m) Bool
mh [[Vertex]]
r
    | Vertex
v forall a. Eq a => a -> a -> Bool
== Vertex
size = forall (m :: * -> *) a. Monad m => a -> m a
return [[Vertex]]
r
    | Bool
otherwise = do
      [Vertex]
c <- Vertex -> m [Vertex]
new_component Vertex
v
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Vertex]
c
        then Vertex -> MVector (PrimState m) Bool -> [[Vertex]] -> m [[Vertex]]
loop (Vertex
v forall a. Num a => a -> a -> a
+ Vertex
1) MVector (PrimState m) Bool
mh [[Vertex]]
r
        else Vertex -> MVector (PrimState m) Bool -> [[Vertex]] -> m [[Vertex]]
loop (Vertex
v forall a. Num a => a -> a -> a
+ Vertex
1) MVector (PrimState m) Bool
mh ([Vertex]
c forall a. a -> [a] -> [a]
: [[Vertex]]
r)
    where
      new_component :: Vertex -> m [Vertex]
new_component Vertex
v = do
        Bool
visited <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Vertex -> m a
MU.read MVector (PrimState m) Bool
mh Vertex
v
        if Bool
visited
          then forall (m :: * -> *) a. Monad m => a -> m a
return []
          else do
            -- mark v as visited
            forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Vertex -> a -> m ()
MU.write MVector (PrimState m) Bool
mh Vertex
v Bool
True
            [[Vertex]]
cs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Vertex -> m [Vertex]
new_component (Graph -> Vertex -> [Vertex]
neighbours Graph
g Vertex
v)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Vertex
v forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Vertex]]
cs

-- * Properties

-- | Whether a 'VertexSet' is independent i.e. no edge exists between any
-- two of its vertices.
prop_is_independent_set :: Graph -> VertexSet -> Bool
prop_is_independent_set :: Graph -> [Vertex] -> Bool
prop_is_independent_set Graph
g [Vertex]
vs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> [Vertex] -> Vertex -> Bool
has_any_edge Graph
g [Vertex]
vs) [Vertex]
vs

-- | Whether a 'VertexSet' is maximally independent i.e. it is independent
-- and no longer independent if we add any other vertex.
prop_is_maximal_independent_set :: Component -> VertexSet -> Bool
prop_is_maximal_independent_set :: Component -> [Vertex] -> Bool
prop_is_maximal_independent_set (Component Graph
g [Vertex]
c) [Vertex]
vs =
    Graph -> [Vertex] -> Bool
prop_is_independent_set Graph
g [Vertex]
vs Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Graph -> [Vertex] -> Vertex -> Bool
has_any_edge Graph
g [Vertex]
vs) [Vertex]
other_vertices
  where
    other_vertices :: [Vertex]
other_vertices = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Vertex]
vs) [Vertex]
c

-- | Whether 'ltmis' is equivalent to 'bkmis'.
prop_ltmis_eq_bkmis :: Graph -> Bool
prop_ltmis_eq_bkmis :: Graph -> Bool
prop_ltmis_eq_bkmis Graph
g =
  (Bool, Bool) -> Component -> [[Vertex]]
ltmis (Bool
True, Bool
True) (Graph -> [Vertex] -> Component
Component Graph
g (Graph -> [Vertex]
all_vertices Graph
g)) forall a. Eq a => a -> a -> Bool
== Graph -> [[Vertex]]
bkmis Graph
g

-- | Whether 'ltmis' generates only maximal independent sets.
prop_ltmis_maximal_independent_sets :: Component -> Bool
prop_ltmis_maximal_independent_sets :: Component -> Bool
prop_ltmis_maximal_independent_sets Component
sg =
  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Component -> [Vertex] -> Bool
prop_is_maximal_independent_set Component
sg) ((Bool, Bool) -> Component -> [[Vertex]]
ltmis (Bool
True, Bool
True) Component
sg)

-- | Whether 'ltmis' generates /all/ maximal independent sets.
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
_ [Vertex]
c) =
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Component -> [Vertex] -> Bool
prop_is_maximal_independent_set Component
sg) [[Vertex]]
other_subsets
  where
    mis :: [[Vertex]]
mis = (Bool, Bool) -> Component -> [[Vertex]]
ltmis (Bool
True, Bool
True) Component
sg
    all_subsets :: [[Vertex]]
all_subsets = [Vertex] -> [[Vertex]]
powerset [Vertex]
c
    other_subsets :: [[Vertex]]
other_subsets = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Vertex]]
mis) [[Vertex]]
all_subsets

-- | Whether a list of 'VertexSet's of a 'Graph' is a partition of
-- the set of all its vertices.
prop_is_partition :: Graph -> [VertexSet] -> Bool
prop_is_partition :: Graph -> [[Vertex]] -> Bool
prop_is_partition Graph
g [[Vertex]]
cs = forall a. Ord a => [a] -> [a]
sort (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Vertex]]
cs) forall a. Eq a => a -> a -> Bool
== Graph -> [Vertex]
all_vertices Graph
g

-- | Whether there is no edge between a 'VertexSet' of a 'Graph' and the rest
-- of the 'Graph'.
prop_self_contained :: Graph -> VertexSet -> Bool
prop_self_contained :: Graph -> [Vertex] -> Bool
prop_self_contained Graph
g [Vertex]
c =
  forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> Vertex -> [Vertex]
neighbours Graph
g) [Vertex]
c) forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` forall a. Ord a => [a] -> Set a
S.fromList [Vertex]
c

-- | Whether a 'VertexSet' of a 'Graph' is connected.
prop_connected :: Graph -> VertexSet -> Bool
prop_connected :: Graph -> [Vertex] -> Bool
prop_connected Graph
g = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Graph -> [Vertex] -> Bool
prop_self_contained Graph
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vertex] -> [[Vertex]]
proper_non_empty_subsets
  where
    proper_non_empty_subsets :: [Vertex] -> [[Vertex]]
proper_non_empty_subsets = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vertex] -> [[Vertex]]
powerset

-- | Whether a 'VertexSet' is a connected component of the 'Graph'.
prop_connected_component :: Component -> Bool
prop_connected_component :: Component -> Bool
prop_connected_component (Component Graph
g [Vertex]
vs) =
  Graph -> [Vertex] -> Bool
prop_self_contained Graph
g [Vertex]
vs Bool -> Bool -> Bool
&& Graph -> [Vertex] -> Bool
prop_connected Graph
g [Vertex]
vs

-- | Complete specification of the 'components' function.
prop_components :: Graph -> Bool
prop_components :: Graph -> Bool
prop_components Graph
g =
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Component -> Bool
prop_connected_component [Component]
cs Bool -> Bool -> Bool
&&
      Graph -> [[Vertex]] -> Bool
prop_is_partition Graph
g (forall a b. (a -> b) -> [a] -> [b]
map Component -> [Vertex]
vertices [Component]
cs) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Graph
g) (forall a b. (a -> b) -> [a] -> [b]
map Component -> Graph
graph [Component]
cs)
  where
    vertices :: Component -> [Vertex]
vertices (Component Graph
_ [Vertex]
vs) = [Vertex]
vs
    graph :: Component -> Graph
graph (Component Graph
g [Vertex]
_) = Graph
g
    cs :: [Component]
cs = Graph -> [Component]
components Graph
g

powerset :: VertexSet -> [VertexSet]
powerset :: [Vertex] -> [[Vertex]]
powerset = forall a b. (a -> b) -> [a] -> [b]
map forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall a b. a -> b -> a
const [Bool
True, Bool
False])