{- 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 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

-- | The neighbors of a 'Vertex' in a 'Graph'.
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)]

-- | The number of vertices in a 'Graph'.
gsize :: Graph -> Int
gsize :: Graph -> Int
gsize Graph
v = Graph -> Int
forall a. Vector a -> Int
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 -> [VertexSet]
ltmis (Bool
bt1,Bool
bt2) (Component Graph
g VertexSet
comp) =
    -- the map reverse is because we use (:) to add vertices to r
    -- when branching
    (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)
    -- h[v] = neighbours g v `intersectsWith` r || v `elem` r || v `notElem` comp
    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)

    -- 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 :: 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

    -- 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 :: 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

-- | The classic Bron-Kerbosch algorithm for determining the maximal
-- independent sets in a 'Graph'.
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)

-- * Generating graphs

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 -- list monad
    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)

-- | Enumerate all (simple) graphs of a given size (number of vertices).
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 of the n elements [s..(s+n-1)] (each subset is ordered)
  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

-- * 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 = [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
            -- mark v as visited
            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

-- * 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 -> 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

-- | 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 -> 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

-- | 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 -> [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

-- | 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 =
  (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)

-- | 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
_ 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

-- | 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 -> [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

-- | 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 -> 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

-- | Whether a 'VertexSet' of a 'Graph' is connected.
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

-- | 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 VertexSet
vs) =
  Graph -> VertexSet -> Bool
prop_self_contained Graph
g VertexSet
vs Bool -> Bool -> Bool
&& Graph -> VertexSet -> Bool
prop_connected Graph
g VertexSet
vs

-- | Complete specification of the 'components' function.
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])