module HGraph.Directed.Subgraph
       ( contains
       , isSubgraphOf
       , subgraphIsomorphism
       , subgraphIsomorphismI
       , isSubgraphIsomorphism
       , enumerateSubgraphs
       , enumerateSubgraphsI
       )
where

import HGraph.Directed
import HGraph.Utils
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe
import Data.List

-- | Whether `d` contains `h` as a subgraph (the identity is used for the isomorphism).
contains :: t a -> t a -> Bool
contains t a
d t a
h = [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> [a] -> Bool
forall a b. (a -> b) -> a -> b
$ 
  [ a
v
  | a
v <- t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. DirectedGraph t => t a -> [a]
vertices t a
h
  , a
u <- t a -> a -> [a]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
outneighbors t a
h a
v
  , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ t a -> (a, a) -> Bool
forall a. t a -> (a, a) -> Bool
forall (t :: * -> *) a. Adjacency t => t a -> (a, a) -> Bool
arcExists t a
d (a
v,a
u)
  ] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++
  (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> a -> Bool
forall a. t a -> a -> Bool
forall (t :: * -> *) a. DirectedGraph t => t a -> a -> Bool
isVertex t a
d) (t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. DirectedGraph t => t a -> [a]
vertices t a
h)
  

-- | Whether `h` is isomorphic to some subgraph of `d`.
isSubgraphOf :: t k2 -> t a -> Bool
isSubgraphOf t k2
h t a
d = Maybe (Map k2 a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Map k2 a) -> Bool) -> Maybe (Map k2 a) -> Bool
forall a b. (a -> b) -> a -> b
$ t a -> t k2 -> Maybe (Map k2 a)
forall {t :: * -> *} {t :: * -> *} {k2} {a}.
(Adjacency t, Adjacency t, Ord k2, Ord a, DirectedGraph t,
 DirectedGraph t) =>
t a -> t k2 -> Maybe (Map k2 a)
subgraphIsomorphism t a
d t k2
h

-- | Find an isomorphism from `h` to some subgraph of `d`, if it exists.
subgraphIsomorphism :: t a -> t k2 -> Maybe (Map k2 a)
subgraphIsomorphism t a
d t k2
h = (Map Int a -> Map k2 a) -> Maybe (Map Int a) -> Maybe (Map k2 a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> k2) -> Map Int a -> Map k2 a
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (Map Int k2
iToV Map Int k2 -> Int -> k2
forall k a. Ord k => Map k a -> k -> a
M.!)) (Maybe (Map Int a) -> Maybe (Map k2 a))
-> Maybe (Map Int a) -> Maybe (Map k2 a)
forall a b. (a -> b) -> a -> b
$ t a -> t Int -> Maybe (Map Int a)
forall {t :: * -> *} {t :: * -> *} {k2} {a}.
(Adjacency t, Adjacency t, Ord k2, Ord a, DirectedGraph t,
 DirectedGraph t) =>
t a -> t k2 -> Maybe (Map k2 a)
subgraphIsomorphismI t a
d t Int
hi
  where
    (t Int
hi, [(Int, k2)]
itova) = t k2 -> (t Int, [(Int, k2)])
forall a. t a -> (t Int, [(Int, a)])
forall (t :: * -> *) a.
DirectedGraph t =>
t a -> (t Int, [(Int, a)])
linearizeVertices t k2
h
    iToV :: Map Int k2
iToV = [(Int, k2)] -> Map Int k2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Int, k2)]
itova

subgraphIsomorphismI :: t a -> t k -> Maybe (Map k a)
subgraphIsomorphismI t a
d t k
hi = [k] -> Map k a -> Map k (Set a) -> Maybe (Map k a)
findIso (t k -> [k]
forall a. t a -> [a]
forall (t :: * -> *) a. DirectedGraph t => t a -> [a]
vertices t k
hi) Map k a
forall k a. Map k a
M.empty Map k (Set a)
candidates0
  where
    candidates0 :: Map k (Set a)
candidates0 = [(k, Set a)] -> Map k (Set a)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                  [ (k
v, [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList [a]
us)
                  | k
v <- t k -> [k]
forall a. t a -> [a]
forall (t :: * -> *) a. DirectedGraph t => t a -> [a]
vertices t k
hi
                  , let ov :: Integer
ov = t k -> k -> Integer
forall b a. Integral b => t a -> a -> b
forall (t :: * -> *) b a.
(Adjacency t, Integral b) =>
t a -> a -> b
outdegree t k
hi k
v
                  , let iv :: Integer
iv = t k -> k -> Integer
forall b a. Integral b => t a -> a -> b
forall (t :: * -> *) b a.
(Adjacency t, Integral b) =>
t a -> a -> b
indegree t k
hi k
v
                  , let us :: [a]
us = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\a
u -> t a -> a -> Integer
forall b a. Integral b => t a -> a -> b
forall (t :: * -> *) b a.
(Adjacency t, Integral b) =>
t a -> a -> b
outdegree t a
d a
u Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
ov Bool -> Bool -> Bool
&& t a -> a -> Integer
forall b a. Integral b => t a -> a -> b
forall (t :: * -> *) b a.
(Adjacency t, Integral b) =>
t a -> a -> b
indegree t a
d a
u Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
iv) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. DirectedGraph t => t a -> [a]
vertices t a
d
                  ]
    findIso :: [k] -> Map k a -> Map k (Set a) -> Maybe (Map k a)
findIso [] Map k a
phi Map k (Set a)
_ = Map k a -> Maybe (Map k a)
forall a. a -> Maybe a
Just Map k a
phi
    findIso (k
v:[k]
vs) Map k a
phi Map k (Set a)
candidates = [Map k a] -> Maybe (Map k a)
forall {a}. [a] -> Maybe a
mhead ([Map k a] -> Maybe (Map k a)) -> [Map k a] -> Maybe (Map k a)
forall a b. (a -> b) -> a -> b
$ (Maybe (Map k a) -> Map k a) -> [Maybe (Map k a)] -> [Map k a]
forall a b. (a -> b) -> [a] -> [b]
map Maybe (Map k a) -> Map k a
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe (Map k a)] -> [Map k a]) -> [Maybe (Map k a)] -> [Map k a]
forall a b. (a -> b) -> a -> b
$ (Maybe (Map k a) -> Bool) -> [Maybe (Map k a)] -> [Maybe (Map k a)]
forall a. (a -> Bool) -> [a] -> [a]
filter Maybe (Map k a) -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe (Map k a)] -> [Maybe (Map k a)])
-> [Maybe (Map k a)] -> [Maybe (Map k a)]
forall a b. (a -> b) -> a -> b
$ do      
      a
u <- Set a -> [a]
forall a. Set a -> [a]
S.toList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ Map k (Set a)
candidates Map k (Set a) -> k -> Set a
forall k a. Ord k => Map k a -> k -> a
M.! k
v
      let phi' :: Map k a
phi' = k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
v a
u Map k a
phi
      let candidates' :: Map k (Set a)
candidates' = (Set a -> Set a) -> Map k (Set a) -> Map k (Set a)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.delete a
u) (Map k (Set a) -> Map k (Set a)) -> Map k (Set a) -> Map k (Set a)
forall a b. (a -> b) -> a -> b
$ k -> Map k (Set a) -> Map k (Set a)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete k
v (Map k (Set a) -> Map k (Set a)) -> Map k (Set a) -> Map k (Set a)
forall a b. (a -> b) -> a -> b
$ 
              ((k, Set a) -> Map k (Set a) -> Map k (Set a))
-> Map k (Set a) -> [(k, Set a)] -> Map k (Set a)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((k -> Set a -> Map k (Set a) -> Map k (Set a))
-> (k, Set a) -> Map k (Set a) -> Map k (Set a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((k -> Set a -> Map k (Set a) -> Map k (Set a))
 -> (k, Set a) -> Map k (Set a) -> Map k (Set a))
-> (k -> Set a -> Map k (Set a) -> Map k (Set a))
-> (k, Set a)
-> Map k (Set a)
-> Map k (Set a)
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a -> Set a)
-> k -> Set a -> Map k (Set a) -> Map k (Set a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\Set a
n Set a
o -> Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set a
n Set a
o) )
                    Map k (Set a)
candidates ([(k, Set a)] -> Map k (Set a)) -> [(k, Set a)] -> Map k (Set a)
forall a b. (a -> b) -> a -> b
$
                    [ (k
w, [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ t a -> a -> [a]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
outneighbors t a
d a
u)
                    | k
w <- t k -> k -> [k]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
outneighbors t k
hi k
v
                    ] [(k, Set a)] -> [(k, Set a)] -> [(k, Set a)]
forall a. [a] -> [a] -> [a]
++
                    [ (k
w, [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ t a -> a -> [a]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
inneighbors t a
d a
u)
                    | k
w <- t k -> k -> [k]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
inneighbors t k
hi k
v
                    ]
      if Map k (Set a) -> Bool
forall a. Map k a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map k (Set a) -> Bool) -> Map k (Set a) -> Bool
forall a b. (a -> b) -> a -> b
$ (Set a -> Bool) -> Map k (Set a) -> Map k (Set a)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter Set a -> Bool
forall a. Set a -> Bool
S.null Map k (Set a)
candidates' then
        Maybe (Map k a) -> [Maybe (Map k a)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Map k a) -> [Maybe (Map k a)])
-> Maybe (Map k a) -> [Maybe (Map k a)]
forall a b. (a -> b) -> a -> b
$ [k] -> Map k a -> Map k (Set a) -> Maybe (Map k a)
findIso [k]
vs Map k a
phi' Map k (Set a)
candidates'
      else
        []

-- | Enumerate all subgraphs of `d` which are isomorphic to `h`
enumerateSubgraphs ::  (DirectedGraph t, Adjacency t, Mutable t) => t a -> t b -> [t a]
enumerateSubgraphs :: forall (t :: * -> *) a b.
(DirectedGraph t, Adjacency t, Mutable t) =>
t a -> t b -> [t a]
enumerateSubgraphs t a
d t b
h = (t Int -> t a) -> [t Int] -> [t a]
forall a b. (a -> b) -> [a] -> [b]
map (Map Int a -> t a -> t Int -> t a
forall (t :: * -> *) a b.
(DirectedGraph t, Mutable t, Ord a) =>
Map a b -> t b -> t a -> t b
renameVertices Map Int a
iToV (t a -> t a
forall a. t a -> t a
forall (t :: * -> *) a. DirectedGraph t => t a -> t a
empty t a
d)) ([t Int] -> [t a]) -> [t Int] -> [t a]
forall a b. (a -> b) -> a -> b
$ t Int -> t Int -> [t Int]
forall {t :: * -> *} {a} {t :: * -> *}.
(Mutable t, Ord a, DirectedGraph t, DirectedGraph t, Adjacency t,
 Adjacency t) =>
t a -> t Int -> [t a]
enumerateSubgraphsI t Int
di t Int
hi
  where
    (t Int
hi, [(Int, b)]
itovh) = t b -> (t Int, [(Int, b)])
forall a. t a -> (t Int, [(Int, a)])
forall (t :: * -> *) a.
DirectedGraph t =>
t a -> (t Int, [(Int, a)])
linearizeVertices t b
h
    (t Int
di, [(Int, a)]
itovd) = t a -> (t Int, [(Int, a)])
forall a. t a -> (t Int, [(Int, a)])
forall (t :: * -> *) a.
DirectedGraph t =>
t a -> (t Int, [(Int, a)])
linearizeVertices t a
d
    iToV :: Map Int a
iToV = [(Int, a)] -> Map Int a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Int, a)]
itovd

enumerateSubgraphsI :: t a -> t Int -> [t a]
enumerateSubgraphsI t a
d t Int
hi = 
  do
    a
u0 <- Set a -> [a]
forall a. Set a -> [a]
S.toList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ Map Int (Set a)
candidates0 Map Int (Set a) -> Int -> Set a
forall k a. Ord k => Map k a -> k -> a
M.! Int
v0
    t a
-> Map Int a
-> Set a
-> Map Int (Set a)
-> [Int]
-> Set Int
-> Int
-> a
-> [t a]
forall (t :: * -> *) a.
(DirectedGraph t, Adjacency t, Mutable t, Ord a) =>
t a
-> Map Int a
-> Set a
-> Map Int (Set a)
-> [Int]
-> Set Int
-> Int
-> a
-> [t a]
embed t a
d Map Int a
forall k a. Map k a
M.empty Set a
forall a. Set a
S.empty Map Int (Set a)
candidates0 ((t Int -> Int -> [Int]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
inneighbors t Int
hi Int
v0) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (t Int -> Int -> [Int]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
outneighbors t Int
hi Int
v0)) ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList ([Int] -> Set Int) -> [Int] -> Set Int
forall a b. (a -> b) -> a -> b
$ t Int -> [Int]
forall a. t a -> [a]
forall (t :: * -> *) a. DirectedGraph t => t a -> [a]
vertices t Int
hi) Int
v0 a
u0
  where
    (Int
v0, Integer
deg0) = ((Int, Integer) -> (Int, Integer) -> Ordering)
-> [(Int, Integer)] -> (Int, Integer)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (\(Int, Integer)
v (Int, Integer)
u -> Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Int, Integer) -> Integer
forall a b. (a, b) -> b
snd (Int, Integer)
v) ((Int, Integer) -> Integer
forall a b. (a, b) -> b
snd (Int, Integer)
u)) [(Int
v, t Int -> Int -> Integer
forall b a. Integral b => t a -> a -> b
forall (t :: * -> *) b a.
(Adjacency t, Integral b) =>
t a -> a -> b
indegree t Int
hi Int
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ t Int -> Int -> Integer
forall b a. Integral b => t a -> a -> b
forall (t :: * -> *) b a.
(Adjacency t, Integral b) =>
t a -> a -> b
outdegree t Int
hi Int
v) | Int
v <- t Int -> [Int]
forall a. t a -> [a]
forall (t :: * -> *) a. DirectedGraph t => t a -> [a]
vertices t Int
hi]
    candidates0 :: Map Int (Set a)
candidates0 = [(Int, Set a)] -> Map Int (Set a)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                  [ (Int
v, [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList [a]
us)
                  | Int
v <- t Int -> [Int]
forall a. t a -> [a]
forall (t :: * -> *) a. DirectedGraph t => t a -> [a]
vertices t Int
hi
                  , let ov :: Integer
ov = t Int -> Int -> Integer
forall b a. Integral b => t a -> a -> b
forall (t :: * -> *) b a.
(Adjacency t, Integral b) =>
t a -> a -> b
outdegree t Int
hi Int
v
                  , let iv :: Integer
iv = t Int -> Int -> Integer
forall b a. Integral b => t a -> a -> b
forall (t :: * -> *) b a.
(Adjacency t, Integral b) =>
t a -> a -> b
indegree t Int
hi Int
v
                  , let us :: [a]
us = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\a
u -> t a -> a -> Integer
forall b a. Integral b => t a -> a -> b
forall (t :: * -> *) b a.
(Adjacency t, Integral b) =>
t a -> a -> b
outdegree t a
d a
u Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
ov Bool -> Bool -> Bool
&& t a -> a -> Integer
forall b a. Integral b => t a -> a -> b
forall (t :: * -> *) b a.
(Adjacency t, Integral b) =>
t a -> a -> b
indegree t a
d a
u Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
iv) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. DirectedGraph t => t a -> [a]
vertices t a
d
                  ]
    embed :: (DirectedGraph t, Adjacency t, Mutable t, Ord a) =>
             t a -> M.Map Int a -> S.Set a -> M.Map Int (S.Set a) -> [Int] -> (S.Set Int) -> Int -> a -> [t a]
    embed :: forall (t :: * -> *) a.
(DirectedGraph t, Adjacency t, Mutable t, Ord a) =>
t a
-> Map Int a
-> Set a
-> Map Int (Set a)
-> [Int]
-> Set Int
-> Int
-> a
-> [t a]
embed t a
d Map Int a
phi Set a
blocked Map Int (Set a)
candidates [Int]
queue Set Int
missing Int
v a
u
      | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
v' -> Set a -> Bool
forall a. Set a -> Bool
S.null (Set a -> Bool) -> Set a -> Bool
forall a b. (a -> b) -> a -> b
$ Map Int (Set a)
candidates' Map Int (Set a) -> Int -> Set a
forall k a. Ord k => Map k a -> k -> a
M.! Int
v' ) [Int]
vN = []
      | Bool
otherwise = t a
-> Map Int a
-> Set a
-> Map Int (Set a)
-> [Int]
-> Set Int
-> [t a]
forall (t :: * -> *) a.
(DirectedGraph t, Adjacency t, Mutable t, Ord a) =>
t a
-> Map Int a
-> Set a
-> Map Int (Set a)
-> [Int]
-> Set Int
-> [t a]
embeddings t a
d (Int -> a -> Map Int a -> Map Int a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
v a
u Map Int a
phi) (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
u Set a
blocked) Map Int (Set a)
candidates' [Int]
queue Set Int
missing
      where
        vN :: [Int]
vN = (Int -> Bool) -> [Int] -> [Int]
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
. (Int -> Map Int a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map Int a
phi)) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ t Int -> Int -> [Int]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
outneighbors t Int
hi Int
v [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ t Int -> Int -> [Int]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
inneighbors t Int
hi Int
v
        candidates' :: Map Int (Set a)
candidates' = (((Int, Set a) -> Map Int (Set a) -> Map Int (Set a))
-> Map Int (Set a) -> [(Int, Set a)] -> Map Int (Set a)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
v', Set a
n) Map Int (Set a)
c -> (Set a -> Set a -> Set a)
-> Int -> Set a -> Map Int (Set a) -> Map Int (Set a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Int
v' Set a
n Map Int (Set a)
c) Map Int (Set a)
candidates ([(Int, Set a)] -> Map Int (Set a))
-> [(Int, Set a)] -> Map Int (Set a)
forall a b. (a -> b) -> a -> b
$ 
                                             [ (Int
v', [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
blocked)) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$
                                                                         t a -> a -> [a]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
outneighbors t a
d a
u) 
                                             | Int
v' <- t Int -> Int -> [Int]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
outneighbors t Int
hi Int
v ] [(Int, Set a)] -> [(Int, Set a)] -> [(Int, Set a)]
forall a. [a] -> [a] -> [a]
++
                                             [ (Int
v', [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
blocked)) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$
                                                                         t a -> a -> [a]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
inneighbors t a
d a
u)
                                             | Int
v' <-  t Int -> Int -> [Int]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
inneighbors t Int
hi Int
v ]
                                   )
    embeddings :: (DirectedGraph t, Adjacency t, Mutable t, Ord a) =>
                  t a -> M.Map Int a -> S.Set a -> M.Map Int (S.Set a) -> [Int] -> (S.Set Int) -> [t a]
    embeddings :: forall (t :: * -> *) a.
(DirectedGraph t, Adjacency t, Mutable t, Ord a) =>
t a
-> Map Int a
-> Set a
-> Map Int (Set a)
-> [Int]
-> Set Int
-> [t a]
embeddings t a
d Map Int a
phi Set a
blocked Map Int (Set a)
candidates [] Set Int
missing
      | Set Int -> Bool
forall a. Set a -> Bool
S.null Set Int
missing = t a -> [t a]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (t a -> [t a]) -> t a -> [t a]
forall a b. (a -> b) -> a -> b
$ t a -> Map Int a -> t a
forall (t :: * -> *) a.
(DirectedGraph t, Adjacency t, Mutable t, Ord a) =>
t a -> Map Int a -> t a
toSubgraph t a
d Map Int a
phi
      | Bool
otherwise = 
        let v :: Int
v = [Int] -> Int
forall a. HasCallStack => [a] -> a
head ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Set Int -> [Int]
forall a. Set a -> [a]
S.toList Set Int
missing
        in t a
-> Map Int a
-> Set a
-> Map Int (Set a)
-> [Int]
-> Set Int
-> [t a]
forall (t :: * -> *) a.
(DirectedGraph t, Adjacency t, Mutable t, Ord a) =>
t a
-> Map Int a
-> Set a
-> Map Int (Set a)
-> [Int]
-> Set Int
-> [t a]
embeddings t a
d Map Int a
phi Set a
blocked Map Int (Set a)
candidates [Int
v] (Int -> Set Int -> Set Int
forall a. Ord a => a -> Set a -> Set a
S.delete Int
v Set Int
missing)
    embeddings t a
d Map Int a
phi Set a
blocked Map Int (Set a)
candidates (Int
v:[Int]
vs) Set Int
missing
      | Int
v Int -> Map Int a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map Int a
phi = t a
-> Map Int a
-> Set a
-> Map Int (Set a)
-> [Int]
-> Set Int
-> [t a]
forall (t :: * -> *) a.
(DirectedGraph t, Adjacency t, Mutable t, Ord a) =>
t a
-> Map Int a
-> Set a
-> Map Int (Set a)
-> [Int]
-> Set Int
-> [t a]
embeddings t a
d Map Int a
phi Set a
blocked Map Int (Set a)
candidates [Int]
vs Set Int
missing
      | Bool
otherwise = do
          a
u <- Set a -> [a]
forall a. Set a -> [a]
S.toList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ Map Int (Set a)
candidates Map Int (Set a) -> Int -> Set a
forall k a. Ord k => Map k a -> k -> a
M.! Int
v
          t a
-> Map Int a
-> Set a
-> Map Int (Set a)
-> [Int]
-> Set Int
-> Int
-> a
-> [t a]
forall (t :: * -> *) a.
(DirectedGraph t, Adjacency t, Mutable t, Ord a) =>
t a
-> Map Int a
-> Set a
-> Map Int (Set a)
-> [Int]
-> Set Int
-> Int
-> a
-> [t a]
embed t a
d Map Int a
phi Set a
blocked Map Int (Set a)
candidates ((t Int -> Int -> [Int]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
inneighbors t Int
hi Int
v) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (t Int -> Int -> [Int]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
outneighbors t Int
hi Int
v) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
vs) (Int -> Set Int -> Set Int
forall a. Ord a => a -> Set a -> Set a
S.delete Int
v Set Int
missing) Int
v a
u
    toSubgraph :: (DirectedGraph t, Adjacency t, Mutable t, Ord a) => t a -> M.Map Int a -> t a
    toSubgraph :: forall (t :: * -> *) a.
(DirectedGraph t, Adjacency t, Mutable t, Ord a) =>
t a -> Map Int a -> t a
toSubgraph t a
d Map Int a
phi = 
      ((a, a) -> t a -> t a) -> t a -> [(a, a)] -> t a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a, a) -> t a -> t a
forall a. (a, a) -> t a -> t a
forall (t :: * -> *) a. Mutable t => (a, a) -> t a -> t a
addArc ((a -> t a -> t a) -> t a -> [a] -> t a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> t a -> t a
forall a. a -> t a -> t a
forall (t :: * -> *) a. Mutable t => a -> t a -> t a
addVertex (t a -> t a
forall a. t a -> t a
forall (t :: * -> *) a. DirectedGraph t => t a -> t a
empty t a
d) ([a] -> t a) -> [a] -> t a
forall a b. (a -> b) -> a -> b
$ Map Int a -> [a]
forall k a. Map k a -> [a]
M.elems Map Int a
phi) [(Map Int a
phi Map Int a -> Int -> a
forall k a. Ord k => Map k a -> k -> a
M.! Int
v, Map Int a
phi Map Int a -> Int -> a
forall k a. Ord k => Map k a -> k -> a
M.! Int
u) | (Int
v,Int
u) <- t Int -> [(Int, Int)]
forall a. t a -> [(a, a)]
forall (t :: * -> *) a. DirectedGraph t => t a -> [(a, a)]
arcs t Int
hi]

-- | Whether `phi` is a subgraph isomorphism from `h` to some subgraph of `d`.
isSubgraphIsomorphism :: t a -> t a -> Map a a -> Bool
isSubgraphIsomorphism t a
d t a
h Map a a
phi = [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
  [ a
v
  | a
v <- t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. DirectedGraph t => t a -> [a]
vertices t a
h
  , a
u <- t a -> a -> [a]
forall a. t a -> a -> [a]
forall (t :: * -> *) a. Adjacency t => t a -> a -> [a]
outneighbors t a
h a
v
  , Maybe () -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ do
      a
dv <- a -> Map a a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
v Map a a
phi
      a
du <- a -> Map a a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
u Map a a
phi
      if t a -> (a, a) -> Bool
forall a. t a -> (a, a) -> Bool
forall (t :: * -> *) a. Adjacency t => t a -> (a, a) -> Bool
arcExists t a
d (a
dv,a
du) then
        () -> Maybe ()
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      else
        Maybe ()
forall a. Maybe a
Nothing
  ]