{-# 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 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
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)]
gsize :: Graph -> Int
gsize :: Graph -> Vertex
gsize Graph
v = forall a. Vector a -> Vertex
V.length Graph
v
type Helper = U.Vector Bool
ltmis :: (Bool,Bool) -> Component -> [VertexSet]
ltmis :: (Bool, Bool) -> Component -> [[Vertex]]
ltmis (Bool
bt1,Bool
bt2) (Component Graph
g [Vertex]
comp) =
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)
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)
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
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
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)
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
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)
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 :: 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
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
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
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
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
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
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)
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
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
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
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
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
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])