{-# LANGUAGE NoMonomorphismRestriction, TupleSections, DeriveFunctor #-}
module Math.Combinatorics.GraphAuts (isVertexTransitive, isEdgeTransitive,
isArcTransitive, is2ArcTransitive, is3ArcTransitive, is4ArcTransitive, isnArcTransitive,
isDistanceTransitive,
graphAuts, incidenceAuts, graphAuts7, graphAuts8, incidenceAuts2,
isGraphAut, isIncidenceAut,
graphIsos, incidenceIsos,
isGraphIso, isIncidenceIso) where
import Data.Either (lefts, rights, partitionEithers)
import qualified Data.List as L
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Data.Maybe
import Data.Ord (comparing)
import qualified Data.Foldable as Foldable
import qualified Data.Sequence as Seq
import Math.Common.ListSet
import Math.Core.Utils (combinationsOf, intersectAsc, pairs, picks, (^-))
import Math.Combinatorics.Graph
import Math.Algebra.Group.PermutationGroup
import Math.Algebra.Group.SchreierSims as SS
isVertexTransitive :: (Ord t) => Graph t -> Bool
(G [] []) = Bool
True
isVertexTransitive g :: Graph t
g@(G (v :: t
v:vs :: [t]
vs) es :: [[t]]
es) = [Permutation t] -> t -> [t]
forall t. Ord t => [Permutation t] -> t -> [t]
orbitV [Permutation t]
auts t
v [t] -> [t] -> Bool
forall a. Eq a => a -> a -> Bool
== t
vt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
vs where
auts :: [Permutation t]
auts = Graph t -> [Permutation t]
forall a. Ord a => Graph a -> [Permutation a]
graphAuts Graph t
g
isEdgeTransitive :: (Ord t) => Graph t -> Bool
isEdgeTransitive :: Graph t -> Bool
isEdgeTransitive (G _ []) = Bool
True
isEdgeTransitive g :: Graph t
g@(G vs :: [t]
vs (e :: [t]
e:es :: [[t]]
es)) = [Permutation t] -> [t] -> [[t]]
forall a. Ord a => [Permutation a] -> [a] -> [[a]]
orbitE [Permutation t]
auts [t]
e [[t]] -> [[t]] -> Bool
forall a. Eq a => a -> a -> Bool
== [t]
e[t] -> [[t]] -> [[t]]
forall a. a -> [a] -> [a]
:[[t]]
es where
auts :: [Permutation t]
auts = Graph t -> [Permutation t]
forall a. Ord a => Graph a -> [Permutation a]
graphAuts Graph t
g
arc :: [b]
arc ->^ :: [b] -> Permutation b -> [b]
->^ g :: Permutation b
g = (b -> b) -> [b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b -> Permutation b -> b
forall a. Ord a => a -> Permutation a -> a
.^ Permutation b
g) [b]
arc
isArcTransitive :: (Ord t) => Graph t -> Bool
isArcTransitive :: Graph t -> Bool
isArcTransitive (G _ []) = Bool
True
isArcTransitive g :: Graph t
g@(G vs :: [t]
vs es :: [[t]]
es) = ([t] -> Permutation t -> [t]) -> [t] -> [Permutation t] -> [[t]]
forall t1 t2. Ord t1 => (t1 -> t2 -> t1) -> t1 -> [t2] -> [t1]
orbit [t] -> Permutation t -> [t]
forall b. Ord b => [b] -> Permutation b -> [b]
(->^) [t]
a [Permutation t]
auts [[t]] -> [[t]] -> Bool
forall a. Eq a => a -> a -> Bool
== [t]
a[t] -> [[t]] -> [[t]]
forall a. a -> [a] -> [a]
:[[t]]
as where
a :: [t]
a:as :: [[t]]
as = [[t]] -> [[t]]
forall a. Ord a => [a] -> [a]
L.sort ([[t]] -> [[t]]) -> [[t]] -> [[t]]
forall a b. (a -> b) -> a -> b
$ [[t]]
es [[t]] -> [[t]] -> [[t]]
forall a. [a] -> [a] -> [a]
++ ([t] -> [t]) -> [[t]] -> [[t]]
forall a b. (a -> b) -> [a] -> [b]
map [t] -> [t]
forall a. [a] -> [a]
reverse [[t]]
es
auts :: [Permutation t]
auts = Graph t -> [Permutation t]
forall a. Ord a => Graph a -> [Permutation a]
graphAuts Graph t
g
isArcTransitive' :: Graph a -> Bool
isArcTransitive' g :: Graph a
g@(G (v :: a
v:vs :: [a]
vs) es :: [[a]]
es) =
[Permutation a] -> a -> [a]
forall t. Ord t => [Permutation t] -> t -> [t]
orbitP [Permutation a]
auts a
v [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== a
va -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
vs Bool -> Bool -> Bool
&&
[Permutation a] -> a -> [a]
forall t. Ord t => [Permutation t] -> t -> [t]
orbitP [Permutation a]
stab a
n [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ns
where auts :: [Permutation a]
auts = Graph a -> [Permutation a]
forall a. Ord a => Graph a -> [Permutation a]
graphAuts Graph a
g
stab :: [Permutation a]
stab = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\p :: Permutation a
p -> a
v a -> Permutation a -> a
forall a. Ord a => a -> Permutation a -> a
.^ Permutation a
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v) [Permutation a]
auts
n :: a
n:ns :: [a]
ns = Graph a -> a -> [a]
forall a. Eq a => Graph a -> a -> [a]
nbrs Graph a
g a
v
findArcs :: Graph a -> a -> b -> [[a]]
findArcs g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) x :: a
x l :: b
l = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [([a], b)] -> [[a]]
dfs [ ([a
x],0) ] where
dfs :: [([a], b)] -> [[a]]
dfs ( (z1 :: a
z1:z2 :: a
z2:zs :: [a]
zs,l' :: b
l') : nodes :: [([a], b)]
nodes)
| b
l b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
l' = (a
z1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
z2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [([a], b)] -> [[a]]
dfs [([a], b)]
nodes
| Bool
otherwise = [([a], b)] -> [[a]]
dfs ([([a], b)] -> [[a]]) -> [([a], b)] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [(a
wa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
z1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
z2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs,b
l'b -> b -> b
forall a. Num a => a -> a -> a
+1) | a
w <- Graph a -> a -> [a]
forall a. Eq a => Graph a -> a -> [a]
nbrs Graph a
g a
z1, a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
z2] [([a], b)] -> [([a], b)] -> [([a], b)]
forall a. [a] -> [a] -> [a]
++ [([a], b)]
nodes
dfs ( ([z :: a
z],l' :: b
l') : nodes :: [([a], b)]
nodes)
| b
l b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
l' = [a
z] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [([a], b)] -> [[a]]
dfs [([a], b)]
nodes
| Bool
otherwise = [([a], b)] -> [[a]]
dfs ([([a], b)] -> [[a]]) -> [([a], b)] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [([a
w,a
z],b
l'b -> b -> b
forall a. Num a => a -> a -> a
+1) | a
w <- Graph a -> a -> [a]
forall a. Eq a => Graph a -> a -> [a]
nbrs Graph a
g a
z] [([a], b)] -> [([a], b)] -> [([a], b)]
forall a. [a] -> [a] -> [a]
++ [([a], b)]
nodes
dfs [] = []
isnArcTransitive :: (Ord t) => Int -> Graph t -> Bool
isnArcTransitive :: Int -> Graph t -> Bool
isnArcTransitive _ (G [] []) = Bool
True
isnArcTransitive n :: Int
n g :: Graph t
g@(G (v :: t
v:vs :: [t]
vs) es :: [[t]]
es) =
[Permutation t] -> t -> [t]
forall t. Ord t => [Permutation t] -> t -> [t]
orbitP [Permutation t]
auts t
v [t] -> [t] -> Bool
forall a. Eq a => a -> a -> Bool
== t
vt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
vs Bool -> Bool -> Bool
&&
([t] -> Permutation t -> [t]) -> [t] -> [Permutation t] -> [[t]]
forall t1 t2. Ord t1 => (t1 -> t2 -> t1) -> t1 -> [t2] -> [t1]
orbit [t] -> Permutation t -> [t]
forall b. Ord b => [b] -> Permutation b -> [b]
(->^) [t]
a [Permutation t]
stab [[t]] -> [[t]] -> Bool
forall a. Eq a => a -> a -> Bool
== [t]
a[t] -> [[t]] -> [[t]]
forall a. a -> [a] -> [a]
:[[t]]
as
where auts :: [Permutation t]
auts = Graph t -> [Permutation t]
forall a. Ord a => Graph a -> [Permutation a]
graphAuts Graph t
g
stab :: [Permutation t]
stab = (Permutation t -> Bool) -> [Permutation t] -> [Permutation t]
forall a. (a -> Bool) -> [a] -> [a]
filter (\p :: Permutation t
p -> t
v t -> Permutation t -> t
forall a. Ord a => a -> Permutation a -> a
.^ Permutation t
p t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
v) [Permutation t]
auts
a :: [t]
a:as :: [[t]]
as = Graph t -> t -> Int -> [[t]]
forall b a. (Eq b, Eq a, Num b) => Graph a -> a -> b -> [[a]]
findArcs Graph t
g t
v Int
n
is2ArcTransitive :: (Ord t) => Graph t -> Bool
is2ArcTransitive :: Graph t -> Bool
is2ArcTransitive g :: Graph t
g = Int -> Graph t -> Bool
forall t. Ord t => Int -> Graph t -> Bool
isnArcTransitive 2 Graph t
g
is3ArcTransitive :: (Ord t) => Graph t -> Bool
is3ArcTransitive :: Graph t -> Bool
is3ArcTransitive g :: Graph t
g = Int -> Graph t -> Bool
forall t. Ord t => Int -> Graph t -> Bool
isnArcTransitive 3 Graph t
g
is4ArcTransitive :: (Ord t) => Graph t -> Bool
is4ArcTransitive :: Graph t -> Bool
is4ArcTransitive g :: Graph t
g = Int -> Graph t -> Bool
forall t. Ord t => Int -> Graph t -> Bool
isnArcTransitive 4 Graph t
g
isDistanceTransitive :: (Ord t) => Graph t -> Bool
isDistanceTransitive :: Graph t -> Bool
isDistanceTransitive (G [] []) = Bool
True
isDistanceTransitive g :: Graph t
g@(G (v :: t
v:vs :: [t]
vs) es :: [[t]]
es)
| Graph t -> Bool
forall t. Ord t => Graph t -> Bool
isConnected Graph t
g =
[Permutation t] -> t -> [t]
forall t. Ord t => [Permutation t] -> t -> [t]
orbitP [Permutation t]
auts t
v [t] -> [t] -> Bool
forall a. Eq a => a -> a -> Bool
== t
vt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
vs Bool -> Bool -> Bool
&&
[[t]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[t]]
stabOrbits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Graph t -> Int
forall t. Ord t => Graph t -> Int
diameter Graph t
g Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
| Bool
otherwise = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error "isDistanceTransitive: only implemented for connected graphs"
where auts :: [Permutation t]
auts = Graph t -> [Permutation t]
forall a. Ord a => Graph a -> [Permutation a]
graphAuts Graph t
g
stab :: [Permutation t]
stab = (Permutation t -> Bool) -> [Permutation t] -> [Permutation t]
forall a. (a -> Bool) -> [a] -> [a]
filter (\p :: Permutation t
p -> t
v t -> Permutation t -> t
forall a. Ord a => a -> Permutation a -> a
.^ Permutation t
p t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
v) [Permutation t]
auts
stabOrbits :: [[t]]
stabOrbits = let os :: [[t]]
os = [Permutation t] -> [[t]]
forall a. Ord a => [Permutation a] -> [[a]]
orbits [Permutation t]
stab in [[t]]
os [[t]] -> [[t]] -> [[t]]
forall a. [a] -> [a] -> [a]
++ (t -> [t]) -> [t] -> [[t]]
forall a b. (a -> b) -> [a] -> [b]
map (t -> [t] -> [t]
forall a. a -> [a] -> [a]
:[]) ((t
vt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
vs) [t] -> [t] -> [t]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [[t]] -> [t]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[t]]
os)
isGraphAut :: Ord t => Graph t -> Permutation t -> Bool
isGraphAut :: Graph t -> Permutation t -> Bool
isGraphAut (G vs :: [t]
vs es :: [[t]]
es) h :: Permutation t
h = ([t] -> Bool) -> [[t]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([t] -> Set [t] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [t]
es') [[t]
e [t] -> Permutation t -> [t]
forall b. Ord b => [b] -> Permutation b -> [b]
-^ Permutation t
h | [t]
e <- [[t]]
es]
where es' :: Set [t]
es' = [[t]] -> Set [t]
forall a. Ord a => [a] -> Set a
S.fromList [[t]]
es
isIncidenceAut :: (Ord p, Ord b) => Graph (Either p b) -> Permutation (Either p b) -> Bool
isIncidenceAut :: Graph (Either p b) -> Permutation (Either p b) -> Bool
isIncidenceAut (G vs :: [Either p b]
vs es :: [[Either p b]]
es) h :: Permutation (Either p b)
h = ([Either p b] -> Bool) -> [[Either p b]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Either p b] -> Set [Either p b] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [Either p b]
es') [[Either p b]
e [Either p b] -> Permutation (Either p b) -> [Either p b]
forall b. Ord b => [b] -> Permutation b -> [b]
->^ Permutation (Either p b)
h | [Either p b]
e <- [[Either p b]]
es]
where es' :: Set [Either p b]
es' = [[Either p b]] -> Set [Either p b]
forall a. Ord a => [a] -> Set a
S.fromList [[Either p b]]
es
adjLists :: Graph a -> Map a [a]
adjLists (G vs :: [a]
vs es :: [[a]]
es) = Map a [a] -> [[a]] -> Map a [a]
forall a. Ord a => Map a [a] -> [[a]] -> Map a [a]
adjLists' Map a [a]
forall k a. Map k a
M.empty [[a]]
es
where adjLists' :: Map a [a] -> [[a]] -> Map a [a]
adjLists' nbrs :: Map a [a]
nbrs ([u :: a
u,v :: a
v]:es :: [[a]]
es) =
Map a [a] -> [[a]] -> Map a [a]
adjLists' (([a] -> [a] -> [a]) -> a -> [a] -> Map a [a] -> Map a [a]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (([a] -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)) a
v [a
u] (Map a [a] -> Map a [a]) -> Map a [a] -> Map a [a]
forall a b. (a -> b) -> a -> b
$ ([a] -> [a] -> [a]) -> a -> [a] -> Map a [a] -> Map a [a]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (([a] -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)) a
u [a
v] Map a [a]
nbrs) [[a]]
es
adjLists' nbrs :: Map a [a]
nbrs [] = Map a [a]
nbrs
data SearchTree a = T Bool a [SearchTree a] deriving (SearchTree a -> SearchTree a -> Bool
(SearchTree a -> SearchTree a -> Bool)
-> (SearchTree a -> SearchTree a -> Bool) -> Eq (SearchTree a)
forall a. Eq a => SearchTree a -> SearchTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchTree a -> SearchTree a -> Bool
$c/= :: forall a. Eq a => SearchTree a -> SearchTree a -> Bool
== :: SearchTree a -> SearchTree a -> Bool
$c== :: forall a. Eq a => SearchTree a -> SearchTree a -> Bool
Eq, Eq (SearchTree a)
Eq (SearchTree a) =>
(SearchTree a -> SearchTree a -> Ordering)
-> (SearchTree a -> SearchTree a -> Bool)
-> (SearchTree a -> SearchTree a -> Bool)
-> (SearchTree a -> SearchTree a -> Bool)
-> (SearchTree a -> SearchTree a -> Bool)
-> (SearchTree a -> SearchTree a -> SearchTree a)
-> (SearchTree a -> SearchTree a -> SearchTree a)
-> Ord (SearchTree a)
SearchTree a -> SearchTree a -> Bool
SearchTree a -> SearchTree a -> Ordering
SearchTree a -> SearchTree a -> SearchTree a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (SearchTree a)
forall a. Ord a => SearchTree a -> SearchTree a -> Bool
forall a. Ord a => SearchTree a -> SearchTree a -> Ordering
forall a. Ord a => SearchTree a -> SearchTree a -> SearchTree a
min :: SearchTree a -> SearchTree a -> SearchTree a
$cmin :: forall a. Ord a => SearchTree a -> SearchTree a -> SearchTree a
max :: SearchTree a -> SearchTree a -> SearchTree a
$cmax :: forall a. Ord a => SearchTree a -> SearchTree a -> SearchTree a
>= :: SearchTree a -> SearchTree a -> Bool
$c>= :: forall a. Ord a => SearchTree a -> SearchTree a -> Bool
> :: SearchTree a -> SearchTree a -> Bool
$c> :: forall a. Ord a => SearchTree a -> SearchTree a -> Bool
<= :: SearchTree a -> SearchTree a -> Bool
$c<= :: forall a. Ord a => SearchTree a -> SearchTree a -> Bool
< :: SearchTree a -> SearchTree a -> Bool
$c< :: forall a. Ord a => SearchTree a -> SearchTree a -> Bool
compare :: SearchTree a -> SearchTree a -> Ordering
$ccompare :: forall a. Ord a => SearchTree a -> SearchTree a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (SearchTree a)
Ord, Int -> SearchTree a -> ShowS
[SearchTree a] -> ShowS
SearchTree a -> [Char]
(Int -> SearchTree a -> ShowS)
-> (SearchTree a -> [Char])
-> ([SearchTree a] -> ShowS)
-> Show (SearchTree a)
forall a. Show a => Int -> SearchTree a -> ShowS
forall a. Show a => [SearchTree a] -> ShowS
forall a. Show a => SearchTree a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SearchTree a] -> ShowS
$cshowList :: forall a. Show a => [SearchTree a] -> ShowS
show :: SearchTree a -> [Char]
$cshow :: forall a. Show a => SearchTree a -> [Char]
showsPrec :: Int -> SearchTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SearchTree a -> ShowS
Show, a -> SearchTree b -> SearchTree a
(a -> b) -> SearchTree a -> SearchTree b
(forall a b. (a -> b) -> SearchTree a -> SearchTree b)
-> (forall a b. a -> SearchTree b -> SearchTree a)
-> Functor SearchTree
forall a b. a -> SearchTree b -> SearchTree a
forall a b. (a -> b) -> SearchTree a -> SearchTree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SearchTree b -> SearchTree a
$c<$ :: forall a b. a -> SearchTree b -> SearchTree a
fmap :: (a -> b) -> SearchTree a -> SearchTree b
$cfmap :: forall a b. (a -> b) -> SearchTree a -> SearchTree b
Functor)
leftDepth :: SearchTree a -> p
leftDepth (T _ _ []) = 1
leftDepth (T _ _ (t :: SearchTree a
t:ts :: [SearchTree a]
ts)) = 1 p -> p -> p
forall a. Num a => a -> a -> a
+ SearchTree a -> p
leftDepth SearchTree a
t
leftWidths :: SearchTree a -> [Int]
leftWidths (T _ _ []) = []
leftWidths (T _ _ ts :: [SearchTree a]
ts@(t :: SearchTree a
t:_)) = [SearchTree a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SearchTree a]
ts Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: SearchTree a -> [Int]
leftWidths SearchTree a
t
graphAutsEdgeSearchTree :: Graph a -> SearchTree [(a, a)]
graphAutsEdgeSearchTree (G vs :: [a]
vs es :: [[a]]
es) = [(a, a)] -> [a] -> [a] -> SearchTree [(a, a)]
dfs [] [a]
vs [a]
vs where
dfs :: [(a, a)] -> [a] -> [a] -> SearchTree [(a, a)]
dfs xys :: [(a, a)]
xys (x :: a
x:xs :: [a]
xs) yys :: [a]
yys = Bool -> [(a, a)] -> [SearchTree [(a, a)]] -> SearchTree [(a, a)]
forall a. Bool -> a -> [SearchTree a] -> SearchTree a
T Bool
False [(a, a)]
xys [[(a, a)] -> [a] -> [a] -> SearchTree [(a, a)]
dfs ((a
x,a
y)(a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:[(a, a)]
xys) [a]
xs [a]
ys | (y :: a
y,ys :: [a]
ys) <- [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
picks [a]
yys, [(a, a)] -> (a, a) -> Bool
isCompatible [(a, a)]
xys (a
x,a
y)]
dfs xys :: [(a, a)]
xys [] [] = Bool -> [(a, a)] -> [SearchTree [(a, a)]] -> SearchTree [(a, a)]
forall a. Bool -> a -> [SearchTree a] -> SearchTree a
T Bool
True [(a, a)]
xys []
isCompatible :: [(a, a)] -> (a, a) -> Bool
isCompatible xys :: [(a, a)]
xys (x' :: a
x',y' :: a
y') = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [([a
x,a
x'] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
es') Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ([a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a
y,a
y'] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
es') | (x :: a
x,y :: a
y) <- [(a, a)]
xys]
es' :: Set [a]
es' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es
graphAuts1 :: Graph a -> [Permutation a]
graphAuts1 = ([(a, a)] -> Permutation a) -> [[(a, a)]] -> [Permutation a]
forall a b. (a -> b) -> [a] -> [b]
map [(a, a)] -> Permutation a
forall a. Ord a => [(a, a)] -> Permutation a
fromPairs ([[(a, a)]] -> [Permutation a])
-> (Graph a -> [[(a, a)]]) -> Graph a -> [Permutation a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchTree [(a, a)] -> [[(a, a)]]
forall b. SearchTree b -> [b]
terminals (SearchTree [(a, a)] -> [[(a, a)]])
-> (Graph a -> SearchTree [(a, a)]) -> Graph a -> [[(a, a)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> SearchTree [(a, a)]
forall a. Ord a => Graph a -> SearchTree [(a, a)]
graphAutsEdgeSearchTree
terminals :: SearchTree b -> [b]
terminals (T False _ ts :: [SearchTree b]
ts) = (SearchTree b -> [b]) -> [SearchTree b] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SearchTree b -> [b]
terminals [SearchTree b]
ts
terminals (T True xys :: b
xys _) = [b
xys]
transversalTerminals :: SearchTree a -> [a]
transversalTerminals (T False _ (t :: SearchTree a
t:ts :: [SearchTree a]
ts)) = (SearchTree a -> [a]) -> [SearchTree a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take 1 ([a] -> [a]) -> (SearchTree a -> [a]) -> SearchTree a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchTree a -> [a]
transversalTerminals) [SearchTree a]
ts [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ SearchTree a -> [a]
transversalTerminals SearchTree a
t
transversalTerminals (T True xys :: a
xys _) = [a
xys]
transversalTerminals _ = []
graphAuts2 :: Graph a -> [Permutation a]
graphAuts2 = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Permutation a -> Permutation a -> Bool
forall a. Eq a => a -> a -> Bool
/=1) ([Permutation a] -> [Permutation a])
-> (Graph a -> [Permutation a]) -> Graph a -> [Permutation a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, a)] -> Permutation a) -> [[(a, a)]] -> [Permutation a]
forall a b. (a -> b) -> [a] -> [b]
map [(a, a)] -> Permutation a
forall a. Ord a => [(a, a)] -> Permutation a
fromPairs ([[(a, a)]] -> [Permutation a])
-> (Graph a -> [[(a, a)]]) -> Graph a -> [Permutation a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchTree [(a, a)] -> [[(a, a)]]
forall b. SearchTree b -> [b]
transversalTerminals (SearchTree [(a, a)] -> [[(a, a)]])
-> (Graph a -> SearchTree [(a, a)]) -> Graph a -> [[(a, a)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> SearchTree [(a, a)]
forall a. Ord a => Graph a -> SearchTree [(a, a)]
graphAutsEdgeSearchTree
isSingleton :: [a] -> Bool
isSingleton [_] = Bool
True
isSingleton _ = Bool
False
intersectCells :: [[a]] -> [[a]] -> [[a]]
intersectCells p1 :: [[a]]
p1 p2 :: [[a]]
p2 = [[[a]]] -> [[a]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [[a]
c1 [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
`intersectAsc` [a]
c2 | [a]
c2 <- [[a]]
p2] | [a]
c1 <- [[a]]
p1]
graphAutsDistancePartitionSearchTree :: Graph a -> SearchTree [(a, a)]
graphAutsDistancePartitionSearchTree g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) = [(a, a)] -> ([[a]], [[a]]) -> SearchTree [(a, a)]
dfs [] ([[a]
vs],[[a]
vs]) where
dfs :: [(a, a)] -> ([[a]], [[a]]) -> SearchTree [(a, a)]
dfs xys :: [(a, a)]
xys (srcPart :: [[a]]
srcPart,trgPart :: [[a]]
trgPart)
| ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [a] -> Bool
forall a. [a] -> Bool
isSingleton [[a]]
srcPart =
let xys' :: [(a, a)]
xys' = [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
srcPart) ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
trgPart)
in Bool -> [(a, a)] -> [SearchTree [(a, a)]] -> SearchTree [(a, a)]
forall a. Bool -> a -> [SearchTree a] -> SearchTree a
T ([(a, a)] -> Bool
isCompatible [(a, a)]
xys') ([(a, a)]
xys[(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++[(a, a)]
xys') []
| Bool
otherwise = let (x :: a
x:xs :: [a]
xs):srcCells :: [[a]]
srcCells = [[a]]
srcPart
yys :: [a]
yys :trgCells :: [[a]]
trgCells = [[a]]
trgPart
srcPart' :: [[a]]
srcPart' = [[a]] -> [[a]] -> [[a]]
forall a. Ord a => [[a]] -> [[a]] -> [[a]]
intersectCells ([a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
srcCells) (Map a [[a]]
dps Map a [[a]] -> a -> [[a]]
forall k a. Ord k => Map k a -> k -> a
M.! a
x)
in Bool -> [(a, a)] -> [SearchTree [(a, a)]] -> SearchTree [(a, a)]
forall a. Bool -> a -> [SearchTree a] -> SearchTree a
T Bool
False [(a, a)]
xys
[[(a, a)] -> ([[a]], [[a]]) -> SearchTree [(a, a)]
dfs ((a
x,a
y)(a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:[(a, a)]
xys) (([([a], [a])] -> ([[a]], [[a]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([a], [a])] -> ([[a]], [[a]]))
-> ([([a], [a])] -> [([a], [a])]) -> [([a], [a])] -> ([[a]], [[a]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([a], [a])] -> [([a], [a])]
forall a. Ord a => [a] -> [a]
L.sort) ([[a]] -> [[a]] -> [([a], [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip (([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] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[a]]
srcPart') (([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] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[a]]
trgPart')))
| (y :: a
y,ys :: [a]
ys) <- [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
picks [a]
yys,
let trgPart' :: [[a]]
trgPart' = [[a]] -> [[a]] -> [[a]]
forall a. Ord a => [[a]] -> [[a]] -> [[a]]
intersectCells ([a]
ys [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
trgCells) (Map a [[a]]
dps Map a [[a]] -> a -> [[a]]
forall k a. Ord k => Map k a -> k -> a
M.! a
y),
([a] -> Int) -> [[a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
srcPart' [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== ([a] -> Int) -> [[a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
trgPart']
isCompatible :: [(a, a)] -> Bool
isCompatible xys :: [(a, a)]
xys = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [([a
x,a
x'] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
es') Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ([a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a
y,a
y'] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
es') | (x :: a
x,y :: a
y) <- [(a, a)]
xys, (x' :: a
x',y' :: a
y') <- [(a, a)]
xys, a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x']
es' :: Set [a]
es' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es
dps :: Map a [[a]]
dps = [(a, [[a]])] -> Map a [[a]]
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList [(a
v, [a] -> Set [a] -> a -> [[a]]
forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
distancePartitionS [a]
vs Set [a]
es' a
v) | a
v <- [a]
vs]
graphAuts3 :: Graph a -> [Permutation a]
graphAuts3 = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Permutation a -> Permutation a -> Bool
forall a. Eq a => a -> a -> Bool
/=1) ([Permutation a] -> [Permutation a])
-> (Graph a -> [Permutation a]) -> Graph a -> [Permutation a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, a)] -> Permutation a) -> [[(a, a)]] -> [Permutation a]
forall a b. (a -> b) -> [a] -> [b]
map [(a, a)] -> Permutation a
forall a. Ord a => [(a, a)] -> Permutation a
fromPairs ([[(a, a)]] -> [Permutation a])
-> (Graph a -> [[(a, a)]]) -> Graph a -> [Permutation a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchTree [(a, a)] -> [[(a, a)]]
forall b. SearchTree b -> [b]
transversalTerminals (SearchTree [(a, a)] -> [[(a, a)]])
-> (Graph a -> SearchTree [(a, a)]) -> Graph a -> [[(a, a)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> SearchTree [(a, a)]
forall a. Ord a => Graph a -> SearchTree [(a, a)]
graphAutsDistancePartitionSearchTree
strongTerminals :: SearchTree [(a, a)] -> [Permutation a]
strongTerminals = [Permutation a] -> SearchTree [(a, a)] -> [Permutation a]
forall a.
Ord a =>
[Permutation a] -> SearchTree [(a, a)] -> [Permutation a]
strongTerminals' [] where
strongTerminals' :: [Permutation a] -> SearchTree [(a, a)] -> [Permutation a]
strongTerminals' gs :: [Permutation a]
gs (T False xys :: [(a, a)]
xys ts :: [SearchTree [(a, a)]]
ts) =
case [(a, a)] -> Maybe (a, a)
forall a. [a] -> Maybe a
listToMaybe ([(a, a)] -> Maybe (a, a)) -> [(a, a)] -> Maybe (a, a)
forall a b. (a -> b) -> a -> b
$ [(a, a)] -> [(a, a)]
forall a. [a] -> [a]
reverse ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ ((a, a) -> Bool) -> [(a, a)] -> [(a, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(x :: a
x,y :: a
y) -> a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y) [(a, a)]
xys of
Nothing -> ([Permutation a] -> SearchTree [(a, a)] -> [Permutation a])
-> [Permutation a] -> [SearchTree [(a, a)]] -> [Permutation a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (\hs :: [Permutation a]
hs t :: SearchTree [(a, a)]
t -> [Permutation a] -> SearchTree [(a, a)] -> [Permutation a]
strongTerminals' [Permutation a]
hs SearchTree [(a, a)]
t) [Permutation a]
gs [SearchTree [(a, a)]]
ts
Just (x :: a
x,y :: a
y) -> if a
y a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (a
x a -> [Permutation a] -> [a]
forall a. Ord a => a -> [Permutation a] -> [a]
.^^ [Permutation a]
gs)
then [Permutation a]
gs
else [Permutation a] -> [SearchTree [(a, a)]] -> [Permutation a]
find1New [Permutation a]
gs [SearchTree [(a, a)]]
ts
strongTerminals' gs :: [Permutation a]
gs (T True xys :: [(a, a)]
xys []) = [(a, a)] -> Permutation a
forall a. Ord a => [(a, a)] -> Permutation a
fromPairs [(a, a)]
xys Permutation a -> [Permutation a] -> [Permutation a]
forall a. a -> [a] -> [a]
: [Permutation a]
gs
find1New :: [Permutation a] -> [SearchTree [(a, a)]] -> [Permutation a]
find1New gs :: [Permutation a]
gs (t :: SearchTree [(a, a)]
t:ts :: [SearchTree [(a, a)]]
ts) = let hs :: [Permutation a]
hs = [Permutation a] -> SearchTree [(a, a)] -> [Permutation a]
strongTerminals' [Permutation a]
gs SearchTree [(a, a)]
t
in if Int -> [Permutation a] -> [Permutation a]
forall a. Int -> [a] -> [a]
take 1 [Permutation a]
gs [Permutation a] -> [Permutation a] -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> [Permutation a] -> [Permutation a]
forall a. Int -> [a] -> [a]
take 1 [Permutation a]
hs
then [Permutation a]
hs
else [Permutation a] -> [SearchTree [(a, a)]] -> [Permutation a]
find1New [Permutation a]
gs [SearchTree [(a, a)]]
ts
find1New gs :: [Permutation a]
gs [] = [Permutation a]
gs
graphAuts :: (Ord a) => Graph a -> [Permutation a]
graphAuts :: Graph a -> [Permutation a]
graphAuts = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Permutation a -> Permutation a -> Bool
forall a. Eq a => a -> a -> Bool
/=1) ([Permutation a] -> [Permutation a])
-> (Graph a -> [Permutation a]) -> Graph a -> [Permutation a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchTree [(a, a)] -> [Permutation a]
forall a. Ord a => SearchTree [(a, a)] -> [Permutation a]
strongTerminals (SearchTree [(a, a)] -> [Permutation a])
-> (Graph a -> SearchTree [(a, a)]) -> Graph a -> [Permutation a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> SearchTree [(a, a)]
forall a. Ord a => Graph a -> SearchTree [(a, a)]
graphAutsDistancePartitionSearchTree
graphAutsDistanceColouringSearchTree :: Graph a -> SearchTree [(a, a)]
graphAutsDistanceColouringSearchTree g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) = [(a, a)]
-> (Map a [Integer], Map [Integer] [a])
-> (Map a [Integer], Map [Integer] [a])
-> SearchTree [(a, a)]
forall a.
(Num a, Enum a, Ord a) =>
[(a, a)]
-> (Map a [a], Map [a] [a])
-> (Map a [a], Map [a] [a])
-> SearchTree [(a, a)]
dfs [] (Map a [Integer], Map [Integer] [a])
forall a a. (Map a [a], Map [a] [a])
unitCol (Map a [Integer], Map [Integer] [a])
forall a a. (Map a [a], Map [a] [a])
unitCol where
unitCol :: (Map a [a], Map [a] [a])
unitCol = ([(a, [a])] -> Map a [a]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, [a])] -> Map a [a]) -> [(a, [a])] -> Map a [a]
forall a b. (a -> b) -> a -> b
$ (a -> (a, [a])) -> [a] -> [(a, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (,[]) [a]
vs, [a] -> [a] -> Map [a] [a]
forall k a. k -> a -> Map k a
M.singleton [] [a]
vs)
dfs :: [(a, a)]
-> (Map a [a], Map [a] [a])
-> (Map a [a], Map [a] [a])
-> SearchTree [(a, a)]
dfs xys :: [(a, a)]
xys srcColouring :: (Map a [a], Map [a] [a])
srcColouring@(srcVmap :: Map a [a]
srcVmap,srcCmap :: Map [a] [a]
srcCmap) trgColouring :: (Map a [a], Map [a] [a])
trgColouring@(trgVmap :: Map a [a]
trgVmap,trgCmap :: Map [a] [a]
trgCmap)
| ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [a] -> Bool
forall a. [a] -> Bool
isSingleton (Map [a] [a] -> [[a]]
forall k a. Map k a -> [a]
M.elems Map [a] [a]
srcCmap) =
let xys' :: [(a, a)]
xys' = [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Map [a] [a] -> [[a]]
forall k a. Map k a -> [a]
M.elems Map [a] [a]
srcCmap) ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Map [a] [a] -> [[a]]
forall k a. Map k a -> [a]
M.elems Map [a] [a]
trgCmap)
in Bool -> [(a, a)] -> [SearchTree [(a, a)]] -> SearchTree [(a, a)]
forall a. Bool -> a -> [SearchTree a] -> SearchTree a
T ([(a, a)] -> Bool
isCompatible [(a, a)]
xys') ([(a, a)] -> [(a, a)]
forall a. [a] -> [a]
reverse [(a, a)]
xys'[(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++[(a, a)]
xys) []
| Bool
otherwise = let (x :: a
x,c :: [a]
c) = Map a [a] -> (a, [a])
forall k a. Map k a -> (k, a)
M.findMin Map a [a]
srcVmap
(xVmap :: Map a [a]
xVmap,xCmap :: Map [a] [a]
xCmap) = Map a (Map a [a], Map [a] [a])
forall a a.
(Ord a, Num a, Num a, Enum a, Enum a) =>
Map a (Map a [a], Map [a] [a])
dcs Map a (Map a [a], Map [a] [a]) -> a -> (Map a [a], Map [a] [a])
forall k a. Ord k => Map k a -> k -> a
M.! a
x
ys :: [a]
ys = Map [a] [a]
trgCmap Map [a] [a] -> [a] -> [a]
forall k a. Ord k => Map k a -> k -> a
M.! [a]
c
srcVmap' :: Map a [a]
srcVmap' = a -> Map a [a] -> Map a [a]
forall k a. Ord k => k -> Map k a -> Map k a
M.delete a
x (Map a [a] -> Map a [a] -> Map a [a]
forall k a. Ord k => Map k [a] -> Map k [a] -> Map k [a]
intersectColouring Map a [a]
srcVmap Map a [a]
forall a. (Num a, Enum a) => Map a [a]
xVmap)
srcCmap' :: Map [a] [a]
srcCmap' = Map a [a] -> Map [a] [a]
forall k a. Ord k => Map a k -> Map k [a]
colourPartition Map a [a]
srcVmap'
in Bool -> [(a, a)] -> [SearchTree [(a, a)]] -> SearchTree [(a, a)]
forall a. Bool -> a -> [SearchTree a] -> SearchTree a
T Bool
False [(a, a)]
xys
[[(a, a)]
-> (Map a [a], Map [a] [a])
-> (Map a [a], Map [a] [a])
-> SearchTree [(a, a)]
dfs ((a
x,a
y)(a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:[(a, a)]
xys) (Map a [a]
srcVmap',Map [a] [a]
srcCmap') (Map a [a]
trgVmap',Map [a] [a]
trgCmap')
| a
y <- [a]
ys,
let (yVmap :: Map a [a]
yVmap,yCmap :: Map [a] [a]
yCmap) = Map a (Map a [a], Map [a] [a])
forall a a.
(Ord a, Num a, Num a, Enum a, Enum a) =>
Map a (Map a [a], Map [a] [a])
dcs Map a (Map a [a], Map [a] [a]) -> a -> (Map a [a], Map [a] [a])
forall k a. Ord k => Map k a -> k -> a
M.! a
y,
let trgVmap' :: Map a [a]
trgVmap' = a -> Map a [a] -> Map a [a]
forall k a. Ord k => k -> Map k a -> Map k a
M.delete a
y (Map a [a] -> Map a [a] -> Map a [a]
forall k a. Ord k => Map k [a] -> Map k [a] -> Map k [a]
intersectColouring Map a [a]
trgVmap Map a [a]
forall a. (Num a, Enum a) => Map a [a]
yVmap),
let trgCmap' :: Map [a] [a]
trgCmap' = Map a [a] -> Map [a] [a]
forall k a. Ord k => Map a k -> Map k [a]
colourPartition Map a [a]
trgVmap',
([a] -> Int) -> Map [a] [a] -> Map [a] Int
forall a b k. (a -> b) -> Map k a -> Map k b
M.map [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map [a] [a]
srcCmap' Map [a] Int -> Map [a] Int -> Bool
forall a. Eq a => a -> a -> Bool
== ([a] -> Int) -> Map [a] [a] -> Map [a] Int
forall a b k. (a -> b) -> Map k a -> Map k b
M.map [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map [a] [a]
trgCmap' ]
isCompatible :: [(a, a)] -> Bool
isCompatible xys :: [(a, a)]
xys = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [([a
x,a
x'] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
es') Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ([a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a
y,a
y'] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
es') | (x :: a
x,y :: a
y) <- [(a, a)]
xys, (x' :: a
x',y' :: a
y') <- [(a, a)]
xys, a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x']
es' :: Set [a]
es' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es
dcs :: Map a (Map a [a], Map [a] [a])
dcs = [(a, (Map a [a], Map [a] [a]))] -> Map a (Map a [a], Map [a] [a])
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList [(a
v, a -> (Map a [a], Map [a] [a])
forall a a.
(Ord a, Num a, Num a, Enum a, Enum a) =>
a -> (Map a [a], Map [a] [a])
distanceColouring a
v) | a
v <- [a]
vs]
distanceColouring :: a -> (Map a [a], Map [a] [a])
distanceColouring u :: a
u = let dp :: [[a]]
dp = [a] -> Set [a] -> a -> [[a]]
forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
distancePartitionS [a]
vs Set [a]
es' a
u
vmap :: Map a [a]
vmap = [(a, [a])] -> Map a [a]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(a
v,[a
c]) | (cell :: [a]
cell,c :: a
c) <- [[a]] -> [a] -> [([a], a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[a]]
dp [0..], a
v <- [a]
cell]
cmap :: Map [a] [a]
cmap = [([a], [a])] -> Map [a] [a]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([([a], [a])] -> Map [a] [a]) -> [([a], [a])] -> Map [a] [a]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[a]] -> [([a], [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip ((a -> [a]) -> [a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[]) [0..]) [[a]]
dp
in (Map a [a]
forall a. (Num a, Enum a) => Map a [a]
vmap, Map [a] [a]
forall a. (Ord a, Num a, Enum a) => Map [a] [a]
cmap)
distanceColouring :: Graph k -> k -> Map k [a]
distanceColouring (G vs :: [k]
vs es :: [[k]]
es) u :: k
u = [(k, [a])] -> Map k [a]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k
v,[a
c]) | (cell :: [k]
cell,c :: a
c) <- [[k]] -> [a] -> [([k], a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([k] -> Set [k] -> k -> [[k]]
forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
distancePartitionS [k]
vs Set [k]
es' k
u) [0..], k
v <- [k]
cell]
where es' :: Set [k]
es' = [[k]] -> Set [k]
forall a. Ord a => [a] -> Set a
S.fromList [[k]]
es
intersectColouring :: Map k [a] -> Map k [a] -> Map k [a]
intersectColouring c1 :: Map k [a]
c1 c2 :: Map k [a]
c2 = ([a] -> [a] -> [a]) -> Map k [a] -> Map k [a] -> Map k [a]
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) Map k [a]
c1 Map k [a]
c2
colourPartition :: Map a k -> Map k [a]
colourPartition c :: Map a k
c = ((a, k) -> Map k [a] -> Map k [a])
-> Map k [a] -> [(a, k)] -> Map k [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr (\(k :: a
k,v :: k
v) m :: Map k [a]
m -> ([a] -> [a] -> [a]) -> k -> [a] -> Map k [a] -> Map k [a]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) k
v [a
k] Map k [a]
m) Map k [a]
forall k a. Map k a
M.empty (Map a k -> [(a, k)]
forall k a. Map k a -> [(k, a)]
M.assocs Map a k
c)
equitableRefinement :: Graph a -> [[a]] -> [[a]]
equitableRefinement g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) p :: [[a]]
p = Set [a] -> [[a]] -> [[a]]
forall a. Ord a => Set [a] -> [[a]] -> [[a]]
equitableRefinement' ([[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es) [[a]]
p
equitableRefinement' :: Set [a] -> [[a]] -> [[a]]
equitableRefinement' edgeset :: Set [a]
edgeset partition :: [[a]]
partition = [[a]] -> [[a]]
go [[a]]
partition where
go :: [[a]] -> [[a]]
go cells :: [[a]]
cells = let splits :: [([[a]], [[a]])]
splits = [[[a]]] -> [[[a]]] -> [([[a]], [[a]])]
forall a b. [a] -> [b] -> [(a, b)]
L.zip ([[a]] -> [[[a]]]
forall a. [a] -> [[a]]
L.inits [[a]]
cells) ([[a]] -> [[[a]]]
forall a. [a] -> [[a]]
L.tails [[a]]
cells)
shatterPairs :: [([(a, Int)], [[a]], [[a]])]
shatterPairs = [([a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [a]
ci [Int]
counts,[[a]]
ls,[[a]]
rs) | (ls :: [[a]]
ls,ci :: [a]
ci:rs :: [[a]]
rs) <- [([[a]], [[a]])]
splits, [a]
cj <- [[a]]
cells,
let counts :: [Int]
counts = (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([a] -> a -> Int
nbrCount [a]
cj) [a]
ci, [Int] -> Bool
forall a. Eq a => [a] -> Bool
isShatter [Int]
counts]
in case [([(a, Int)], [[a]], [[a]])]
shatterPairs of
[] -> [[a]]
cells
(vcs :: [(a, Int)]
vcs,ls :: [[a]]
ls,rs :: [[a]]
rs):_ -> let fragments :: [[a]]
fragments = [(a, Int)] -> [[a]]
forall b b. Ord b => [(b, b)] -> [[b]]
shatter [(a, Int)]
vcs
in [[a]] -> [[a]]
go ([[a]]
ls [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
fragments [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
rs)
isShatter :: [a] -> Bool
isShatter (c :: a
c:cs :: [a]
cs) = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
c) [a]
cs
shatter :: [(b, b)] -> [[b]]
shatter vcs :: [(b, b)]
vcs = ([(b, b)] -> [b]) -> [[(b, b)]] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map (((b, b) -> b) -> [(b, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b, b) -> b
forall a b. (a, b) -> a
fst) ([[(b, b)]] -> [[b]]) -> [[(b, b)]] -> [[b]]
forall a b. (a -> b) -> a -> b
$ ((b, b) -> (b, b) -> Bool) -> [(b, b)] -> [[(b, b)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (\x :: (b, b)
x y :: (b, b)
y -> (b, b) -> b
forall a b. (a, b) -> b
snd (b, b)
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== (b, b) -> b
forall a b. (a, b) -> b
snd (b, b)
y) ([(b, b)] -> [[(b, b)]]) -> [(b, b)] -> [[(b, b)]]
forall a b. (a -> b) -> a -> b
$ ((b, b) -> (b, b) -> Ordering) -> [(b, b)] -> [(b, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (((b, b) -> b) -> (b, b) -> (b, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (b, b) -> b
forall a b. (a, b) -> b
snd) ([(b, b)] -> [(b, b)]) -> [(b, b)] -> [(b, b)]
forall a b. (a -> b) -> a -> b
$ [(b, b)]
vcs
nbrCount :: [a] -> a -> Int
nbrCount cell :: [a]
cell vertex :: a
vertex = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
isEdge a
vertex) [a]
cell)
isEdge :: a -> a -> Bool
isEdge u :: a
u v :: a
v = [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a
u,a
v] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
edgeset
equitablePartitionSearchTree :: Graph a -> [[a]] -> SearchTree ([[a]], [a])
equitablePartitionSearchTree g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) p :: [[a]]
p = [a] -> [[a]] -> SearchTree ([[a]], [a])
dfs [] [[a]]
p where
dfs :: [a] -> [[a]] -> SearchTree ([[a]], [a])
dfs bs :: [a]
bs p :: [[a]]
p = let p' :: [[a]]
p' = Set [a] -> [[a]] -> [[a]]
forall a. Ord a => Set [a] -> [[a]] -> [[a]]
equitableRefinement' Set [a]
es' [[a]]
p in
if ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [a] -> Bool
forall a. [a] -> Bool
isSingleton [[a]]
p'
then Bool
-> ([[a]], [a])
-> [SearchTree ([[a]], [a])]
-> SearchTree ([[a]], [a])
forall a. Bool -> a -> [SearchTree a] -> SearchTree a
T Bool
True ([[a]]
p',[a]
bs) []
else Bool
-> ([[a]], [a])
-> [SearchTree ([[a]], [a])]
-> SearchTree ([[a]], [a])
forall a. Bool -> a -> [SearchTree a] -> SearchTree a
T Bool
False ([[a]]
p',[a]
bs) [[a] -> [[a]] -> SearchTree ([[a]], [a])
dfs (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bs) [[a]]
p'' | (b :: a
b,p'' :: [[a]]
p'') <- [[a]] -> [[a]] -> [(a, [[a]])]
forall a. [[a]] -> [[a]] -> [(a, [[a]])]
splits [] [[a]]
p']
splits :: [[a]] -> [[a]] -> [(a, [[a]])]
splits ls :: [[a]]
ls (r :: [a]
r:rs :: [[a]]
rs) | [a] -> Bool
forall a. [a] -> Bool
isSingleton [a]
r = [[a]] -> [[a]] -> [(a, [[a]])]
splits ([a]
r[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ls) [[a]]
rs
| Bool
otherwise = let ls' :: [[a]]
ls' = [[a]] -> [[a]]
forall a. [a] -> [a]
reverse [[a]]
ls in [(a
x, [[a]]
ls' [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [a
x][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[a]
xs[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
rs) | (x :: a
x,xs :: [a]
xs) <- [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
picks [a]
r]
es' :: Set [a]
es' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es
equitablePartitionSearchTree2 :: Graph a -> [[a]] -> SearchTree ([[a]], [a])
equitablePartitionSearchTree2 g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) p :: [[a]]
p = [a] -> ([[a]], [[a]]) -> SearchTree ([[a]], [a])
dfs [] ([],[[a]]
p) where
dfs :: [a] -> ([[a]], [[a]]) -> SearchTree ([[a]], [a])
dfs bs :: [a]
bs (ss :: [[a]]
ss,cs :: [[a]]
cs) = let (ss' :: [[a]]
ss',cs' :: [[a]]
cs') = ([a] -> Bool) -> [[a]] -> ([[a]], [[a]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition [a] -> Bool
forall a. [a] -> Bool
isSingleton ([[a]] -> ([[a]], [[a]])) -> [[a]] -> ([[a]], [[a]])
forall a b. (a -> b) -> a -> b
$ Set [a] -> [[a]] -> [[a]]
forall a. Ord a => Set [a] -> [[a]] -> [[a]]
equitableRefinement' Set [a]
es' [[a]]
cs
ss'' :: [[a]]
ss'' = [[a]]
ss[[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++[[a]]
ss'
in case [[a]]
cs' of
[] -> Bool
-> ([[a]], [a])
-> [SearchTree ([[a]], [a])]
-> SearchTree ([[a]], [a])
forall a. Bool -> a -> [SearchTree a] -> SearchTree a
T Bool
True ([[a]]
ss'',[a]
bs) []
c :: [a]
c:cs'' :: [[a]]
cs'' -> Bool
-> ([[a]], [a])
-> [SearchTree ([[a]], [a])]
-> SearchTree ([[a]], [a])
forall a. Bool -> a -> [SearchTree a] -> SearchTree a
T Bool
False ([[a]]
cs'[[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++[[a]]
ss'',[a]
bs) [[a] -> ([[a]], [[a]]) -> SearchTree ([[a]], [a])
dfs (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bs) ([[a]]
ss'',[a
x][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[a]
xs[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
cs'') | (x :: a
x,xs :: [a]
xs) <- [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
picks [a]
c]
es' :: Set [a]
es' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es
equitableDistancePartitionSearchTree :: Graph a -> [[a]] -> SearchTree ([[a]], [a])
equitableDistancePartitionSearchTree g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) p :: [[a]]
p = [a] -> [[a]] -> SearchTree ([[a]], [a])
dfs [] [[a]]
p where
dfs :: [a] -> [[a]] -> SearchTree ([[a]], [a])
dfs bs :: [a]
bs p :: [[a]]
p = let p' :: [[a]]
p' = Set [a] -> [[a]] -> [[a]]
forall a. Ord a => Set [a] -> [[a]] -> [[a]]
equitableRefinement' Set [a]
es' [[a]]
p in
if ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [a] -> Bool
forall a. [a] -> Bool
isSingleton [[a]]
p'
then Bool
-> ([[a]], [a])
-> [SearchTree ([[a]], [a])]
-> SearchTree ([[a]], [a])
forall a. Bool -> a -> [SearchTree a] -> SearchTree a
T Bool
True ([[a]]
p',[a]
bs) []
else Bool
-> ([[a]], [a])
-> [SearchTree ([[a]], [a])]
-> SearchTree ([[a]], [a])
forall a. Bool -> a -> [SearchTree a] -> SearchTree a
T Bool
False ([[a]]
p',[a]
bs) [[a] -> [[a]] -> SearchTree ([[a]], [a])
dfs (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bs) [[a]]
p'' | (b :: a
b,p'' :: [[a]]
p'') <- [[a]] -> [[a]] -> [(a, [[a]])]
splits [] [[a]]
p']
splits :: [[a]] -> [[a]] -> [(a, [[a]])]
splits ls :: [[a]]
ls (r :: [a]
r:rs :: [[a]]
rs) | [a] -> Bool
forall a. [a] -> Bool
isSingleton [a]
r = [[a]] -> [[a]] -> [(a, [[a]])]
splits ([a]
r[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ls) [[a]]
rs
| Bool
otherwise = [(a
x, [[a]]
p'') | let ls' :: [[a]]
ls' = [[a]] -> [[a]]
forall a. [a] -> [a]
reverse [[a]]
ls,
(x :: a
x,xs :: [a]
xs) <- [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
picks [a]
r,
let p' :: [[a]]
p' = [[a]]
ls' [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [a
x][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[a]
xs[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
rs,
let p'' :: [[a]]
p'' = ([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] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[a]] -> [[a]] -> [[a]]
forall a. Ord a => [[a]] -> [[a]] -> [[a]]
intersectCells [[a]]
p' (Map a [[a]]
dps Map a [[a]] -> a -> [[a]]
forall k a. Ord k => Map k a -> k -> a
M.! a
x))]
es' :: Set [a]
es' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es
dps :: Map a [[a]]
dps = [(a, [[a]])] -> Map a [[a]]
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList [(a
v, [a] -> Set [a] -> a -> [[a]]
forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
distancePartitionS [a]
vs Set [a]
es' a
v) | a
v <- [a]
vs]
trace1 :: [t a] -> [(Int, Int)]
trace1 p :: [t a]
p = ([Int] -> (Int, Int)) -> [[Int]] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\xs :: [Int]
xs@(x :: Int
x:_) -> (Int
x, [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs)) ([[Int]] -> [(Int, Int)]) -> [[Int]] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
L.group ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
L.sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (t a -> Int) -> [t a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [t a]
p
equitablePartitionGraphSearchTree :: Graph a -> SearchTree ([[a]], [a])
equitablePartitionGraphSearchTree g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) = Graph a -> [[a]] -> SearchTree ([[a]], [a])
forall a. Ord a => Graph a -> [[a]] -> SearchTree ([[a]], [a])
equitablePartitionSearchTree Graph a
g [[a]]
unitPartition
where unitPartition :: [[a]]
unitPartition = [[a]
vs]
equitablePartitionIncidenceSearchTree :: Graph (Either a b) -> SearchTree ([[Either a b]], [Either a b])
equitablePartitionIncidenceSearchTree g :: Graph (Either a b)
g@(G vs :: [Either a b]
vs es :: [[Either a b]]
es) = Graph (Either a b)
-> [[Either a b]] -> SearchTree ([[Either a b]], [Either a b])
forall a. Ord a => Graph a -> [[a]] -> SearchTree ([[a]], [a])
equitablePartitionSearchTree Graph (Either a b)
g [[Either a b]]
lrPartition
where (lefts :: [a]
lefts, rights :: [b]
rights) = [Either a b] -> ([a], [b])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either a b]
vs
lrPartition :: [[Either a b]]
lrPartition = [(a -> Either a b) -> [a] -> [Either a b]
forall a b. (a -> b) -> [a] -> [b]
map a -> Either a b
forall a b. a -> Either a b
Left [a]
lefts, (b -> Either a b) -> [b] -> [Either a b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Either a b
forall a b. b -> Either a b
Right [b]
rights]
leftLeaf :: SearchTree (t [a], [a]) -> ([a], [a])
leftLeaf (T False _ (t :: SearchTree (t [a], [a])
t:ts :: [SearchTree (t [a], [a])]
ts)) = SearchTree (t [a], [a]) -> ([a], [a])
leftLeaf SearchTree (t [a], [a])
t
leftLeaf (T True (p :: t [a]
p,bs :: [a]
bs) []) = (t [a] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [a]
p, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
bs)
allLeaves :: SearchTree (t [a], [a]) -> [([a], [a])]
allLeaves (T False _ ts :: [SearchTree (t [a], [a])]
ts) = (SearchTree (t [a], [a]) -> [([a], [a])])
-> [SearchTree (t [a], [a])] -> [([a], [a])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SearchTree (t [a], [a]) -> [([a], [a])]
allLeaves [SearchTree (t [a], [a])]
ts
allLeaves (T True (p :: t [a]
p,bs :: [a]
bs) []) = [(t [a] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [a]
p, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
bs)]
partitionBSGS0 :: Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
partitionBSGS0 g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) t :: SearchTree ([[a]], [a])
t = ([a]
bs, SearchTree ([[a]], [a]) -> [Permutation a]
forall b. SearchTree ([[a]], b) -> [Permutation a]
findLevels SearchTree ([[a]], [a])
t) where
(p1 :: [a]
p1,bs :: [a]
bs) = SearchTree ([[a]], [a]) -> ([a], [a])
forall (t :: * -> *) a a.
Foldable t =>
SearchTree (t [a], [a]) -> ([a], [a])
leftLeaf SearchTree ([[a]], [a])
t
g1 :: Permutation a
g1 = [(a, a)] -> Permutation a
forall a. Ord a => [(a, a)] -> Permutation a
fromPairs ([(a, a)] -> Permutation a) -> [(a, a)] -> Permutation a
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
p1 [a]
vs
g1' :: Permutation a
g1' = Permutation a
g1Permutation a -> Integer -> Permutation a
forall a b. (Num a, HasInverses a, Integral b) => a -> b -> a
^-1
es1 :: Set [a]
es1 = [[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
$ Graph a -> [[a]]
forall a. Graph a -> [[a]]
edges (Graph a -> [[a]]) -> Graph a -> [[a]]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> Graph a -> Graph a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Permutation a -> a
forall a. Ord a => a -> Permutation a -> a
.^ Permutation a
g1) Graph a
g
findLevels :: SearchTree ([[a]], b) -> [Permutation a]
findLevels (T True (partition :: [[a]]
partition,_) []) = []
findLevels (T False (partition :: [[a]]
partition,_) (t :: SearchTree ([[a]], b)
t:ts :: [SearchTree ([[a]], b)]
ts)) =
let hs :: [Permutation a]
hs = SearchTree ([[a]], b) -> [Permutation a]
findLevels SearchTree ([[a]], b)
t
cell :: [a]
cell@(v :: a
v:vs :: [a]
vs) = [[a]] -> [a]
forall a. [a] -> a
head ([[a]] -> [a]) -> [[a]] -> [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] -> Bool
forall a. [a] -> Bool
isSingleton) [[a]]
partition
in a
-> [Permutation a]
-> [(a, SearchTree ([[a]], b))]
-> [Permutation a]
forall (t :: * -> *) b.
Foldable t =>
a
-> [Permutation a]
-> [(a, SearchTree (t [a], b))]
-> [Permutation a]
findLevel a
v [Permutation a]
hs ([a] -> [SearchTree ([[a]], b)] -> [(a, SearchTree ([[a]], b))]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
vs [SearchTree ([[a]], b)]
ts)
findLevel :: a
-> [Permutation a]
-> [(a, SearchTree (t [a], b))]
-> [Permutation a]
findLevel v :: a
v hs :: [Permutation a]
hs ((v' :: a
v',t' :: SearchTree (t [a], b)
t'):vts :: [(a, SearchTree (t [a], b))]
vts) = if a
v' a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` a
v a -> [Permutation a] -> [a]
forall a. Ord a => a -> [Permutation a] -> [a]
.^^ [Permutation a]
hs
then a
-> [Permutation a]
-> [(a, SearchTree (t [a], b))]
-> [Permutation a]
findLevel a
v [Permutation a]
hs [(a, SearchTree (t [a], b))]
vts
else let h :: [Permutation a]
h = SearchTree (t [a], b) -> [Permutation a]
forall (t :: * -> *) b.
Foldable t =>
SearchTree (t [a], b) -> [Permutation a]
find1New SearchTree (t [a], b)
t' in a
-> [Permutation a]
-> [(a, SearchTree (t [a], b))]
-> [Permutation a]
findLevel a
v ([Permutation a]
h[Permutation a] -> [Permutation a] -> [Permutation a]
forall a. [a] -> [a] -> [a]
++[Permutation a]
hs) [(a, SearchTree (t [a], b))]
vts
findLevel _ hs :: [Permutation a]
hs [] = [Permutation a]
hs
find1New :: SearchTree (t [a], b) -> [Permutation a]
find1New (T False _ ts :: [SearchTree (t [a], b)]
ts) = Int -> [Permutation a] -> [Permutation a]
forall a. Int -> [a] -> [a]
take 1 ([Permutation a] -> [Permutation a])
-> [Permutation a] -> [Permutation a]
forall a b. (a -> b) -> a -> b
$ (SearchTree (t [a], b) -> [Permutation a])
-> [SearchTree (t [a], b)] -> [Permutation a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SearchTree (t [a], b) -> [Permutation a]
find1New [SearchTree (t [a], b)]
ts
find1New (T True (partition :: t [a]
partition,_) []) = let h :: Permutation a
h = [(a, a)] -> Permutation a
forall a. Ord a => [(a, a)] -> Permutation a
fromPairs ([(a, a)] -> Permutation a) -> [(a, a)] -> Permutation a
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (t [a] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [a]
partition) [a]
vs
g' :: Graph a
g' = (a -> a) -> Graph a -> Graph a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Permutation a -> a
forall a. Ord a => a -> Permutation a -> a
.^ Permutation a
h) Graph a
g
in if ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
es1) (Graph a -> [[a]]
forall a. Graph a -> [[a]]
edges Graph a
g') then [Permutation a
hPermutation a -> Permutation a -> Permutation a
forall a. Num a => a -> a -> a
*Permutation a
g1'] else []
partitionBSGS :: Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
partitionBSGS g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) t :: SearchTree ([[a]], [a])
t = ([a]
bs, SearchTree ([[a]], [a]) -> [Permutation a]
forall b. SearchTree ([[a]], b) -> [Permutation a]
findLevels SearchTree ([[a]], [a])
t) where
(canonical :: [a]
canonical,bs :: [a]
bs) = SearchTree ([[a]], [a]) -> ([a], [a])
forall (t :: * -> *) a a.
Foldable t =>
SearchTree (t [a], [a]) -> ([a], [a])
leftLeaf SearchTree ([[a]], [a])
t
findLevels :: SearchTree ([[a]], b) -> [Permutation a]
findLevels (T True (partition :: [[a]]
partition,_) []) = []
findLevels (T False (partition :: [[a]]
partition,_) (t :: SearchTree ([[a]], b)
t:ts :: [SearchTree ([[a]], b)]
ts)) =
let hs :: [Permutation a]
hs = SearchTree ([[a]], b) -> [Permutation a]
findLevels SearchTree ([[a]], b)
t
cell :: [a]
cell@(v :: a
v:vs :: [a]
vs) = [[a]] -> [a]
forall a. [a] -> a
head ([[a]] -> [a]) -> [[a]] -> [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] -> Bool
forall a. [a] -> Bool
isSingleton) [[a]]
partition
in a
-> [Permutation a]
-> [(a, SearchTree ([[a]], b))]
-> [Permutation a]
forall (t :: * -> *) b.
Foldable t =>
a
-> [Permutation a]
-> [(a, SearchTree (t [a], b))]
-> [Permutation a]
findLevel a
v [Permutation a]
hs ([a] -> [SearchTree ([[a]], b)] -> [(a, SearchTree ([[a]], b))]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
vs [SearchTree ([[a]], b)]
ts)
findLevel :: a
-> [Permutation a]
-> [(a, SearchTree (t [a], b))]
-> [Permutation a]
findLevel v :: a
v hs :: [Permutation a]
hs ((v' :: a
v',t' :: SearchTree (t [a], b)
t'):vts :: [(a, SearchTree (t [a], b))]
vts) = if a
v' a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` a
v a -> [Permutation a] -> [a]
forall a. Ord a => a -> [Permutation a] -> [a]
.^^ [Permutation a]
hs
then a
-> [Permutation a]
-> [(a, SearchTree (t [a], b))]
-> [Permutation a]
findLevel a
v [Permutation a]
hs [(a, SearchTree (t [a], b))]
vts
else let h :: [Permutation a]
h = SearchTree (t [a], b) -> [Permutation a]
forall (t :: * -> *) b.
Foldable t =>
SearchTree (t [a], b) -> [Permutation a]
find1New SearchTree (t [a], b)
t' in a
-> [Permutation a]
-> [(a, SearchTree (t [a], b))]
-> [Permutation a]
findLevel a
v ([Permutation a]
h[Permutation a] -> [Permutation a] -> [Permutation a]
forall a. [a] -> [a] -> [a]
++[Permutation a]
hs) [(a, SearchTree (t [a], b))]
vts
findLevel _ hs :: [Permutation a]
hs [] = [Permutation a]
hs
find1New :: SearchTree (t [a], b) -> [Permutation a]
find1New (T False _ ts :: [SearchTree (t [a], b)]
ts) = Int -> [Permutation a] -> [Permutation a]
forall a. Int -> [a] -> [a]
take 1 ([Permutation a] -> [Permutation a])
-> [Permutation a] -> [Permutation a]
forall a b. (a -> b) -> a -> b
$ (SearchTree (t [a], b) -> [Permutation a])
-> [SearchTree (t [a], b)] -> [Permutation a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SearchTree (t [a], b) -> [Permutation a]
find1New [SearchTree (t [a], b)]
ts
find1New (T True (partition :: t [a]
partition,_) []) = let h :: Permutation a
h = [(a, a)] -> Permutation a
forall a. Ord a => [(a, a)] -> Permutation a
fromPairs ([(a, a)] -> Permutation a) -> [(a, a)] -> Permutation a
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
canonical (t [a] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [a]
partition)
in (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
forall a. (a -> Bool) -> [a] -> [a]
filter Permutation a -> Bool
isAut [Permutation a
h]
isAut :: Permutation a -> Bool
isAut h :: Permutation a
h = ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
es') [[a]
e [a] -> Permutation a -> [a]
forall b. Ord b => [b] -> Permutation b -> [b]
-^ Permutation a
h | [a]
e <- [[a]]
es]
es' :: Set [a]
es' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es
partitionBSGS3 :: Graph a
-> SearchTree ([[a]], [a])
-> ([a], [Either (Permutation a) (Permutation a)])
partitionBSGS3 g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) t :: SearchTree ([[a]], [a])
t = ([a]
bs, SearchTree ([[a]], [a]) -> [Either (Permutation a) (Permutation a)]
forall b.
SearchTree ([[a]], b) -> [Either (Permutation a) (Permutation a)]
findLevels SearchTree ([[a]], [a])
t) where
(p1 :: [a]
p1,bs :: [a]
bs) = SearchTree ([[a]], [a]) -> ([a], [a])
forall (t :: * -> *) a a.
Foldable t =>
SearchTree (t [a], [a]) -> ([a], [a])
leftLeaf SearchTree ([[a]], [a])
t
findLevels :: SearchTree ([[a]], b) -> [Either (Permutation a) (Permutation a)]
findLevels (T True (partition :: [[a]]
partition,_) []) = []
findLevels (T False (partition :: [[a]]
partition,_) (t :: SearchTree ([[a]], b)
t:ts :: [SearchTree ([[a]], b)]
ts)) =
let hs :: [Either (Permutation a) (Permutation a)]
hs = SearchTree ([[a]], b) -> [Either (Permutation a) (Permutation a)]
findLevels SearchTree ([[a]], b)
t
cell :: [a]
cell@(v :: a
v:vs :: [a]
vs) = [[a]] -> [a]
forall a. [a] -> a
head ([[a]] -> [a]) -> [[a]] -> [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] -> Bool
forall a. [a] -> Bool
isSingleton) [[a]]
partition
in a
-> [Either (Permutation a) (Permutation a)]
-> [(a, SearchTree ([[a]], b))]
-> [Either (Permutation a) (Permutation a)]
forall (t :: * -> *) b.
Foldable t =>
a
-> [Either (Permutation a) (Permutation a)]
-> [(a, SearchTree (t [a], b))]
-> [Either (Permutation a) (Permutation a)]
findLevel a
v [Either (Permutation a) (Permutation a)]
hs ([a] -> [SearchTree ([[a]], b)] -> [(a, SearchTree ([[a]], b))]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
vs [SearchTree ([[a]], b)]
ts)
findLevel :: a
-> [Either (Permutation a) (Permutation a)]
-> [(a, SearchTree (t [a], b))]
-> [Either (Permutation a) (Permutation a)]
findLevel v :: a
v hs :: [Either (Permutation a) (Permutation a)]
hs ((v' :: a
v',t' :: SearchTree (t [a], b)
t'):vts :: [(a, SearchTree (t [a], b))]
vts) = if a
v' a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` a
v a -> [Permutation a] -> [a]
forall a. Ord a => a -> [Permutation a] -> [a]
.^^ [Either (Permutation a) (Permutation a)] -> [Permutation a]
forall a b. [Either a b] -> [b]
rights [Either (Permutation a) (Permutation a)]
hs
then a
-> [Either (Permutation a) (Permutation a)]
-> [(a, SearchTree (t [a], b))]
-> [Either (Permutation a) (Permutation a)]
findLevel a
v [Either (Permutation a) (Permutation a)]
hs [(a, SearchTree (t [a], b))]
vts
else let h :: [Either (Permutation a) (Permutation a)]
h = SearchTree (t [a], b) -> [Either (Permutation a) (Permutation a)]
forall (t :: * -> *) b.
Foldable t =>
SearchTree (t [a], b) -> [Either (Permutation a) (Permutation a)]
find1New SearchTree (t [a], b)
t' in a
-> [Either (Permutation a) (Permutation a)]
-> [(a, SearchTree (t [a], b))]
-> [Either (Permutation a) (Permutation a)]
findLevel a
v ([Either (Permutation a) (Permutation a)]
h[Either (Permutation a) (Permutation a)]
-> [Either (Permutation a) (Permutation a)]
-> [Either (Permutation a) (Permutation a)]
forall a. [a] -> [a] -> [a]
++[Either (Permutation a) (Permutation a)]
hs) [(a, SearchTree (t [a], b))]
vts
findLevel _ hs :: [Either (Permutation a) (Permutation a)]
hs [] = [Either (Permutation a) (Permutation a)]
hs
find1New :: SearchTree (t [a], b) -> [Either (Permutation a) (Permutation a)]
find1New (T False _ ts :: [SearchTree (t [a], b)]
ts) = Int
-> [Either (Permutation a) (Permutation a)]
-> [Either (Permutation a) (Permutation a)]
forall a. Int -> [a] -> [a]
take 1 ([Either (Permutation a) (Permutation a)]
-> [Either (Permutation a) (Permutation a)])
-> [Either (Permutation a) (Permutation a)]
-> [Either (Permutation a) (Permutation a)]
forall a b. (a -> b) -> a -> b
$ (SearchTree (t [a], b) -> [Either (Permutation a) (Permutation a)])
-> [SearchTree (t [a], b)]
-> [Either (Permutation a) (Permutation a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SearchTree (t [a], b) -> [Either (Permutation a) (Permutation a)]
find1New [SearchTree (t [a], b)]
ts
find1New (T True (partition :: t [a]
partition,_) []) = let h :: Permutation a
h = [(a, a)] -> Permutation a
forall a. Ord a => [(a, a)] -> Permutation a
fromPairs ([(a, a)] -> Permutation a) -> [(a, a)] -> Permutation a
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
p1 (t [a] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [a]
partition)
in if Permutation a -> Bool
isAut Permutation a
h then [Permutation a -> Either (Permutation a) (Permutation a)
forall a b. b -> Either a b
Right Permutation a
h] else [Permutation a -> Either (Permutation a) (Permutation a)
forall a b. a -> Either a b
Left Permutation a
h]
isAut :: Permutation a -> Bool
isAut h :: Permutation a
h = ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
es') [[a]
e [a] -> Permutation a -> [a]
forall b. Ord b => [b] -> Permutation b -> [b]
-^ Permutation a
h | [a]
e <- [[a]]
es]
es' :: Set [a]
es' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es
partitionBSGS2 :: Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
partitionBSGS2 g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) t :: SearchTree ([[a]], [a])
t = ([a]
bs, SearchTree ([[a]], [a], Int) -> [Permutation a]
forall c b. Eq c => SearchTree ([[a]], b, c) -> [Permutation a]
findLevels SearchTree ([[a]], [a], Int)
t') where
t' :: SearchTree ([[a]], [a], Int)
t' = (([[a]], [a]) -> ([[a]], [a], Int))
-> SearchTree ([[a]], [a]) -> SearchTree ([[a]], [a], Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(p :: [[a]]
p,bs :: [a]
bs) -> ([[a]]
p,[a]
bs,[[a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
trace1 [[a]]
p)) SearchTree ([[a]], [a])
t
trace1 :: t a -> Int
trace1 = t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
(canonical :: [a]
canonical,bs :: [a]
bs) = SearchTree ([[a]], [a]) -> ([a], [a])
forall (t :: * -> *) a a.
Foldable t =>
SearchTree (t [a], [a]) -> ([a], [a])
leftLeaf SearchTree ([[a]], [a])
t
findLevels :: SearchTree ([[a]], b, c) -> [Permutation a]
findLevels (T True (partition :: [[a]]
partition,_,_) []) = []
findLevels (T False (partition :: [[a]]
partition,_,_) (t :: SearchTree ([[a]], b, c)
t:ts :: [SearchTree ([[a]], b, c)]
ts)) =
let (T _ (_,_,trace :: c
trace) _) = SearchTree ([[a]], b, c)
t
hs :: [Permutation a]
hs = SearchTree ([[a]], b, c) -> [Permutation a]
findLevels SearchTree ([[a]], b, c)
t
cell :: [a]
cell@(v :: a
v:vs :: [a]
vs) = [[a]] -> [a]
forall a. [a] -> a
head ([[a]] -> [a]) -> [[a]] -> [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] -> Bool
forall a. [a] -> Bool
isSingleton) [[a]]
partition
vts :: [(a, SearchTree ([[a]], b, c))]
vts = ((a, SearchTree ([[a]], b, c)) -> Bool)
-> [(a, SearchTree ([[a]], b, c))]
-> [(a, SearchTree ([[a]], b, c))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(_,T _ (_,_,trace' :: c
trace') _) -> c
trace c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
trace') ([(a, SearchTree ([[a]], b, c))]
-> [(a, SearchTree ([[a]], b, c))])
-> [(a, SearchTree ([[a]], b, c))]
-> [(a, SearchTree ([[a]], b, c))]
forall a b. (a -> b) -> a -> b
$ [a]
-> [SearchTree ([[a]], b, c)] -> [(a, SearchTree ([[a]], b, c))]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
vs [SearchTree ([[a]], b, c)]
ts
in a
-> [Permutation a]
-> [(a, SearchTree ([[a]], b, c))]
-> [Permutation a]
forall (t :: * -> *) b c.
Foldable t =>
a
-> [Permutation a]
-> [(a, SearchTree (t [a], b, c))]
-> [Permutation a]
findLevel a
v [Permutation a]
hs [(a, SearchTree ([[a]], b, c))]
vts
findLevel :: a
-> [Permutation a]
-> [(a, SearchTree (t [a], b, c))]
-> [Permutation a]
findLevel v :: a
v hs :: [Permutation a]
hs ((v' :: a
v',t' :: SearchTree (t [a], b, c)
t'):vts :: [(a, SearchTree (t [a], b, c))]
vts) = if a
v' a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` a
v a -> [Permutation a] -> [a]
forall a. Ord a => a -> [Permutation a] -> [a]
.^^ [Permutation a]
hs
then a
-> [Permutation a]
-> [(a, SearchTree (t [a], b, c))]
-> [Permutation a]
findLevel a
v [Permutation a]
hs [(a, SearchTree (t [a], b, c))]
vts
else let h :: [Permutation a]
h = SearchTree (t [a], b, c) -> [Permutation a]
forall (t :: * -> *) b c.
Foldable t =>
SearchTree (t [a], b, c) -> [Permutation a]
find1New SearchTree (t [a], b, c)
t' in a
-> [Permutation a]
-> [(a, SearchTree (t [a], b, c))]
-> [Permutation a]
findLevel a
v ([Permutation a]
h[Permutation a] -> [Permutation a] -> [Permutation a]
forall a. [a] -> [a] -> [a]
++[Permutation a]
hs) [(a, SearchTree (t [a], b, c))]
vts
findLevel _ hs :: [Permutation a]
hs [] = [Permutation a]
hs
find1New :: SearchTree (t [a], b, c) -> [Permutation a]
find1New (T False _ ts :: [SearchTree (t [a], b, c)]
ts) = Int -> [Permutation a] -> [Permutation a]
forall a. Int -> [a] -> [a]
take 1 ([Permutation a] -> [Permutation a])
-> [Permutation a] -> [Permutation a]
forall a b. (a -> b) -> a -> b
$ (SearchTree (t [a], b, c) -> [Permutation a])
-> [SearchTree (t [a], b, c)] -> [Permutation a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SearchTree (t [a], b, c) -> [Permutation a]
find1New [SearchTree (t [a], b, c)]
ts
find1New (T True (partition :: t [a]
partition,_,_) []) = let h :: Permutation a
h = [(a, a)] -> Permutation a
forall a. Ord a => [(a, a)] -> Permutation a
fromPairs ([(a, a)] -> Permutation a) -> [(a, a)] -> Permutation a
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
canonical (t [a] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [a]
partition)
in (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
forall a. (a -> Bool) -> [a] -> [a]
filter Permutation a -> Bool
isAut [Permutation a
h]
isAut :: Permutation a -> Bool
isAut h :: Permutation a
h = ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
es') [[a]
e [a] -> Permutation a -> [a]
forall b. Ord b => [b] -> Permutation b -> [b]
-^ Permutation a
h | [a]
e <- [[a]]
es]
es' :: Set [a]
es' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es
graphAuts7 :: Graph a -> ([a], [Permutation a])
graphAuts7 g :: Graph a
g = (Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
forall a a.
Ord a =>
Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
partitionBSGS Graph a
g) (Graph a -> SearchTree ([[a]], [a])
forall a. Ord a => Graph a -> SearchTree ([[a]], [a])
equitablePartitionGraphSearchTree Graph a
g)
graphAuts8 :: Graph a -> ([a], [Permutation a])
graphAuts8 g :: Graph a
g = (Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
forall a a.
Ord a =>
Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
partitionBSGS Graph a
g) (Graph a -> [[a]] -> SearchTree ([[a]], [a])
forall a. Ord a => Graph a -> [[a]] -> SearchTree ([[a]], [a])
equitableDistancePartitionSearchTree Graph a
g [Graph a -> [a]
forall a. Graph a -> [a]
vertices Graph a
g])
g1 :: Graph a
g1 = [a] -> [[a]] -> Graph a
forall a. [a] -> [[a]] -> Graph a
G [1..10] [[1,2],[1,3],[1,9],[2,4],[2,10],[3,4],[3,9],[4,10],[5,6],[5,8],[5,9],[6,7],[6,10],[7,8],[7,9],[8,10]]
g1' :: Graph a
g1' = Graph a -> Graph a
forall a. Ord a => Graph a -> Graph a
nf (Graph a -> Graph a) -> Graph a -> Graph a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> Graph a -> Graph a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: a
x -> if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 4 then a
xa -> a -> a
forall a. Num a => a -> a -> a
+4 else if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 8 then a
xa -> a -> a
forall a. Num a => a -> a -> a
-4 else a
x) Graph a
forall a. (Num a, Enum a) => Graph a
g1
g2 :: Graph a
g2 = [a] -> [[a]] -> Graph a
forall a. [a] -> [[a]] -> Graph a
G [1..12] [[1,2],[1,4],[1,11],[2,3],[2,12],[3,4],[3,11],[4,12],[5,6],[5,8],[5,11],[6,9],[6,12],[7,8],[7,10],[7,11],[8,12],[9,10],[9,11],[10,12]]
maybeGraphIso :: Graph k -> Graph a -> Maybe (Map k a)
maybeGraphIso g1 :: Graph k
g1 g2 :: Graph a
g2 = let (vs1 :: [k]
vs1,_) = (SearchTree ([[k]], [k]) -> ([k], [k])
forall (t :: * -> *) a a.
Foldable t =>
SearchTree (t [a], [a]) -> ([a], [a])
leftLeaf (SearchTree ([[k]], [k]) -> ([k], [k]))
-> (Graph k -> SearchTree ([[k]], [k])) -> Graph k -> ([k], [k])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph k -> SearchTree ([[k]], [k])
forall a. Ord a => Graph a -> SearchTree ([[a]], [a])
equitablePartitionGraphSearchTree) Graph k
g1
(vs2 :: [a]
vs2,_) = (SearchTree ([[a]], [a]) -> ([a], [a])
forall (t :: * -> *) a a.
Foldable t =>
SearchTree (t [a], [a]) -> ([a], [a])
leftLeaf (SearchTree ([[a]], [a]) -> ([a], [a]))
-> (Graph a -> SearchTree ([[a]], [a])) -> Graph a -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> SearchTree ([[a]], [a])
forall a. Ord a => Graph a -> SearchTree ([[a]], [a])
equitablePartitionGraphSearchTree) Graph a
g2
f :: Map k a
f = [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([k] -> [a] -> [(k, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [k]
vs1 [a]
vs2)
in if [k] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [k]
vs1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vs2 Bool -> Bool -> Bool
&& (Graph a -> Graph a
forall a. Ord a => Graph a -> Graph a
nf (Graph a -> Graph a) -> (Graph k -> Graph a) -> Graph k -> Graph a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> a) -> Graph k -> Graph a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map k a
f Map k a -> k -> a
forall k a. Ord k => Map k a -> k -> a
M.!)) Graph k
g1 Graph a -> Graph a -> Bool
forall a. Eq a => a -> a -> Bool
== Graph a
g2 then Map k a -> Maybe (Map k a)
forall a. a -> Maybe a
Just Map k a
f else Maybe (Map k a)
forall a. Maybe a
Nothing
incidenceAutsDistancePartitionSearchTree :: Graph (Either b b) -> SearchTree [(b, b)]
incidenceAutsDistancePartitionSearchTree g :: Graph (Either b b)
g@(G vs :: [Either b b]
vs es :: [[Either b b]]
es) = [(Either b b, Either b b)]
-> ([[Either b b]], [[Either b b]]) -> SearchTree [(b, b)]
dfs [] ([[Either b b]]
lrPart, [[Either b b]]
lrPart) where
dfs :: [(Either b b, Either b b)]
-> ([[Either b b]], [[Either b b]]) -> SearchTree [(b, b)]
dfs xys :: [(Either b b, Either b b)]
xys (srcPart :: [[Either b b]]
srcPart,trgPart :: [[Either b b]]
trgPart)
| ([Either b b] -> Bool) -> [[Either b b]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Either b b] -> Bool
forall a. [a] -> Bool
isSingleton [[Either b b]]
srcPart =
let xys' :: [(Either b b, Either b b)]
xys' = [Either b b] -> [Either b b] -> [(Either b b, Either b b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[Either b b]] -> [Either b b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Either b b]]
srcPart) ([[Either b b]] -> [Either b b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Either b b]]
trgPart)
in Bool -> [(b, b)] -> [SearchTree [(b, b)]] -> SearchTree [(b, b)]
forall a. Bool -> a -> [SearchTree a] -> SearchTree a
T ([(Either b b, Either b b)] -> Bool
isCompatible [(Either b b, Either b b)]
xys') ([(Either b b, Either b b)] -> [(b, b)]
forall a b b b. [(Either a b, Either b b)] -> [(a, b)]
unLeft ([(Either b b, Either b b)] -> [(b, b)])
-> [(Either b b, Either b b)] -> [(b, b)]
forall a b. (a -> b) -> a -> b
$ [(Either b b, Either b b)]
xys[(Either b b, Either b b)]
-> [(Either b b, Either b b)] -> [(Either b b, Either b b)]
forall a. [a] -> [a] -> [a]
++[(Either b b, Either b b)]
xys') []
| Bool
otherwise = let (x :: Either b b
x:xs :: [Either b b]
xs):srcCells :: [[Either b b]]
srcCells = [[Either b b]]
srcPart
yys :: [Either b b]
yys :trgCells :: [[Either b b]]
trgCells = [[Either b b]]
trgPart
srcPart' :: [[Either b b]]
srcPart' = [[Either b b]] -> [[Either b b]] -> [[Either b b]]
forall a. Ord a => [[a]] -> [[a]] -> [[a]]
intersectCells ([Either b b]
xs [Either b b] -> [[Either b b]] -> [[Either b b]]
forall a. a -> [a] -> [a]
: [[Either b b]]
srcCells) (Map (Either b b) [[Either b b]]
dps Map (Either b b) [[Either b b]] -> Either b b -> [[Either b b]]
forall k a. Ord k => Map k a -> k -> a
M.! Either b b
x)
in Bool -> [(b, b)] -> [SearchTree [(b, b)]] -> SearchTree [(b, b)]
forall a. Bool -> a -> [SearchTree a] -> SearchTree a
T Bool
False ([(Either b b, Either b b)] -> [(b, b)]
forall a b b b. [(Either a b, Either b b)] -> [(a, b)]
unLeft [(Either b b, Either b b)]
xys)
[[(Either b b, Either b b)]
-> ([[Either b b]], [[Either b b]]) -> SearchTree [(b, b)]
dfs ((Either b b
x,Either b b
y)(Either b b, Either b b)
-> [(Either b b, Either b b)] -> [(Either b b, Either b b)]
forall a. a -> [a] -> [a]
:[(Either b b, Either b b)]
xys) (([([Either b b], [Either b b])] -> ([[Either b b]], [[Either b b]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([Either b b], [Either b b])]
-> ([[Either b b]], [[Either b b]]))
-> ([([Either b b], [Either b b])]
-> [([Either b b], [Either b b])])
-> [([Either b b], [Either b b])]
-> ([[Either b b]], [[Either b b]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Either b b], [Either b b])] -> [([Either b b], [Either b b])]
forall a. Ord a => [a] -> [a]
L.sort) ([[Either b b]] -> [[Either b b]] -> [([Either b b], [Either b b])]
forall a b. [a] -> [b] -> [(a, b)]
zip (([Either b b] -> Bool) -> [[Either b b]] -> [[Either b b]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Either b b] -> Bool) -> [Either b b] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either b b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Either b b]]
srcPart') (([Either b b] -> Bool) -> [[Either b b]] -> [[Either b b]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Either b b] -> Bool) -> [Either b b] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either b b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Either b b]]
trgPart')))
| (y :: Either b b
y,ys :: [Either b b]
ys) <- [Either b b] -> [(Either b b, [Either b b])]
forall a. [a] -> [(a, [a])]
picks [Either b b]
yys,
let trgPart' :: [[Either b b]]
trgPart' = [[Either b b]] -> [[Either b b]] -> [[Either b b]]
forall a. Ord a => [[a]] -> [[a]] -> [[a]]
intersectCells ([Either b b]
ys [Either b b] -> [[Either b b]] -> [[Either b b]]
forall a. a -> [a] -> [a]
: [[Either b b]]
trgCells) (Map (Either b b) [[Either b b]]
dps Map (Either b b) [[Either b b]] -> Either b b -> [[Either b b]]
forall k a. Ord k => Map k a -> k -> a
M.! Either b b
y),
([Either b b] -> Int) -> [[Either b b]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Either b b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Either b b]]
srcPart' [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== ([Either b b] -> Int) -> [[Either b b]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Either b b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Either b b]]
trgPart']
isCompatible :: [(Either b b, Either b b)] -> Bool
isCompatible xys :: [(Either b b, Either b b)]
xys = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [([Either b b
x,Either b b
x'] [Either b b] -> Set [Either b b] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [Either b b]
es') Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ([Either b b] -> [Either b b]
forall a. Ord a => [a] -> [a]
L.sort [Either b b
y,Either b b
y'] [Either b b] -> Set [Either b b] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [Either b b]
es') | (x :: Either b b
x,y :: Either b b
y) <- [(Either b b, Either b b)]
xys, (x' :: Either b b
x',y' :: Either b b
y') <- [(Either b b, Either b b)]
xys, Either b b
x Either b b -> Either b b -> Bool
forall a. Ord a => a -> a -> Bool
< Either b b
x']
(lefts :: [b]
lefts, rights :: [b]
rights) = [Either b b] -> ([b], [b])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either b b]
vs
lrPart :: [[Either b b]]
lrPart = [(b -> Either b b) -> [b] -> [Either b b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Either b b
forall a b. a -> Either a b
Left [b]
lefts, (b -> Either b b) -> [b] -> [Either b b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Either b b
forall a b. b -> Either a b
Right [b]
rights]
unLeft :: [(Either a b, Either b b)] -> [(a, b)]
unLeft xys :: [(Either a b, Either b b)]
xys = [(a
x,b
y) | (Left x :: a
x, Left y :: b
y) <- [(Either a b, Either b b)]
xys]
es' :: Set [Either b b]
es' = [[Either b b]] -> Set [Either b b]
forall a. Ord a => [a] -> Set a
S.fromList [[Either b b]]
es
dps :: Map (Either b b) [[Either b b]]
dps = [(Either b b, [[Either b b]])] -> Map (Either b b) [[Either b b]]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Either b b
v, [Either b b] -> Set [Either b b] -> Either b b -> [[Either b b]]
forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
distancePartitionS [Either b b]
vs Set [Either b b]
es' Either b b
v) | Either b b
v <- [Either b b]
vs]
incidenceAuts :: (Ord p, Ord b) => Graph (Either p b) -> [Permutation p]
incidenceAuts :: Graph (Either p b) -> [Permutation p]
incidenceAuts = (Permutation p -> Bool) -> [Permutation p] -> [Permutation p]
forall a. (a -> Bool) -> [a] -> [a]
filter (Permutation p -> Permutation p -> Bool
forall a. Eq a => a -> a -> Bool
/= [[p]] -> Permutation p
forall a. Ord a => [[a]] -> Permutation a
p []) ([Permutation p] -> [Permutation p])
-> (Graph (Either p b) -> [Permutation p])
-> Graph (Either p b)
-> [Permutation p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchTree [(p, p)] -> [Permutation p]
forall a. Ord a => SearchTree [(a, a)] -> [Permutation a]
strongTerminals (SearchTree [(p, p)] -> [Permutation p])
-> (Graph (Either p b) -> SearchTree [(p, p)])
-> Graph (Either p b)
-> [Permutation p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph (Either p b) -> SearchTree [(p, p)]
forall b b.
(Ord b, Ord b) =>
Graph (Either b b) -> SearchTree [(b, b)]
incidenceAutsDistancePartitionSearchTree
incidenceAuts2 :: Graph (Either a b) -> ([Either a b], [Permutation (Either a b)])
incidenceAuts2 g :: Graph (Either a b)
g = (Graph (Either a b)
-> SearchTree ([[Either a b]], [Either a b])
-> ([Either a b], [Permutation (Either a b)])
forall a a.
Ord a =>
Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
partitionBSGS Graph (Either a b)
g) (Graph (Either a b) -> SearchTree ([[Either a b]], [Either a b])
forall a b.
(Ord a, Ord b) =>
Graph (Either a b) -> SearchTree ([[Either a b]], [Either a b])
equitablePartitionIncidenceSearchTree Graph (Either a b)
g)
where unLeft :: Either a b -> a
unLeft (Left x :: a
x) = a
x
graphIsos :: Graph a -> Graph a -> [[(a, a)]]
graphIsos g1 :: Graph a
g1 g2 :: Graph a
g2
| [Graph a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Graph a]
cs1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Graph a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Graph a]
cs2 = []
| Bool
otherwise = [Graph a] -> [Graph a] -> [[(a, a)]]
forall a a. (Ord a, Ord a) => [Graph a] -> [Graph a] -> [[(a, a)]]
graphIsos' [Graph a]
cs1 [Graph a]
cs2
where cs1 :: [Graph a]
cs1 = ([a] -> Graph a) -> [[a]] -> [Graph a]
forall a b. (a -> b) -> [a] -> [b]
map (Graph a -> [a] -> Graph a
forall a. Eq a => Graph a -> [a] -> Graph a
inducedSubgraph Graph a
g1) (Graph a -> [[a]]
forall a. Ord a => Graph a -> [[a]]
components Graph a
g1)
cs2 :: [Graph a]
cs2 = ([a] -> Graph a) -> [[a]] -> [Graph a]
forall a b. (a -> b) -> [a] -> [b]
map (Graph a -> [a] -> Graph a
forall a. Eq a => Graph a -> [a] -> Graph a
inducedSubgraph Graph a
g2) (Graph a -> [[a]]
forall a. Ord a => Graph a -> [[a]]
components Graph a
g2)
graphIsos' :: [Graph a] -> [Graph a] -> [[(a, a)]]
graphIsos' (ci :: Graph a
ci:cis :: [Graph a]
cis) cjs :: [Graph a]
cjs =
[[(a, a)]
iso [(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++ [(a, a)]
iso' | (cj :: Graph a
cj,cjs' :: [Graph a]
cjs') <- [Graph a] -> [(Graph a, [Graph a])]
forall a. [a] -> [(a, [a])]
picks [Graph a]
cjs,
[(a, a)]
iso <- Graph a -> Graph a -> [[(a, a)]]
forall a a. (Ord a, Ord a) => Graph a -> Graph a -> [[(a, a)]]
graphIsosCon Graph a
ci Graph a
cj,
[(a, a)]
iso' <- [Graph a] -> [Graph a] -> [[(a, a)]]
graphIsos' [Graph a]
cis [Graph a]
cjs']
graphIsos' [] [] = [[]]
graphIsosCon :: Graph a -> Graph a -> [[(a, a)]]
graphIsosCon g1 :: Graph a
g1 g2 :: Graph a
g2
| Graph a -> Bool
forall t. Ord t => Graph t -> Bool
isConnected Graph a
g1 Bool -> Bool -> Bool
&& Graph a -> Bool
forall t. Ord t => Graph t -> Bool
isConnected Graph a
g2
= [[[(a, a)]]] -> [[(a, a)]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(a, a)] -> [[a]] -> [[a]] -> [[(a, a)]]
dfs [] (Graph a -> a -> [[a]]
forall a. Ord a => Graph a -> a -> [[a]]
distancePartition Graph a
g1 a
v1) (Graph a -> a -> [[a]]
forall a. Ord a => Graph a -> a -> [[a]]
distancePartition Graph a
g2 a
v2)
| a
v1 <- Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take 1 (Graph a -> [a]
forall a. Graph a -> [a]
vertices Graph a
g1), a
v2 <- Graph a -> [a]
forall a. Graph a -> [a]
vertices Graph a
g2]
| Bool
otherwise = [Char] -> [[(a, a)]]
forall a. HasCallStack => [Char] -> a
error "graphIsosCon: either or both graphs are not connected"
where dfs :: [(a, a)] -> [[a]] -> [[a]] -> [[(a, a)]]
dfs xys :: [(a, a)]
xys p1 :: [[a]]
p1 p2 :: [[a]]
p2
| ([a] -> Int) -> [[a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
p1 [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
/= ([a] -> Int) -> [[a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
p2 = []
| Bool
otherwise =
let p1' :: [[a]]
p1' = ([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] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[a]]
p1
p2' :: [[a]]
p2' = ([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] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[a]]
p2
in if ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [a] -> Bool
forall a. [a] -> Bool
isSingleton [[a]]
p1'
then let xys' :: [(a, a)]
xys' = [(a, a)]
xys [(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
p1') ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
p2')
in if [(a, a)] -> Bool
isCompatible [(a, a)]
xys' then [[(a, a)]
xys'] else []
else let (x :: a
x:xs :: [a]
xs):p1'' :: [[a]]
p1'' = [[a]]
p1'
ys :: [a]
ys:p2'' :: [[a]]
p2'' = [[a]]
p2'
in [[[(a, a)]]] -> [[(a, a)]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(a, a)] -> [[a]] -> [[a]] -> [[(a, a)]]
dfs ((a
x,a
y)(a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:[(a, a)]
xys)
([[a]] -> [[a]] -> [[a]]
forall a. Ord a => [[a]] -> [[a]] -> [[a]]
intersectCells ([a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
p1'') (Map a [[a]]
dps1 Map a [[a]] -> a -> [[a]]
forall k a. Ord k => Map k a -> k -> a
M.! a
x))
([[a]] -> [[a]] -> [[a]]
forall a. Ord a => [[a]] -> [[a]] -> [[a]]
intersectCells ([a]
ys'[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
p2'') (Map a [[a]]
dps2 Map a [[a]] -> a -> [[a]]
forall k a. Ord k => Map k a -> k -> a
M.! a
y))
| (y :: a
y,ys' :: [a]
ys') <- [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
picks [a]
ys]
isCompatible :: [(a, a)] -> Bool
isCompatible xys :: [(a, a)]
xys = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [([a
x,a
x'] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
es1) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ([a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a
y,a
y'] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
es2) | (x :: a
x,y :: a
y) <- [(a, a)]
xys, (x' :: a
x',y' :: a
y') <- [(a, a)]
xys, a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x']
dps1 :: Map a [[a]]
dps1 = [(a, [[a]])] -> Map a [[a]]
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList [(a
v, [a] -> Set [a] -> a -> [[a]]
forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
distancePartitionS [a]
vs1 Set [a]
es1 a
v) | a
v <- [a]
vs1]
dps2 :: Map a [[a]]
dps2 = [(a, [[a]])] -> Map a [[a]]
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList [(a
v, [a] -> Set [a] -> a -> [[a]]
forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
distancePartitionS [a]
vs2 Set [a]
es2 a
v) | a
v <- [a]
vs2]
vs1 :: [a]
vs1 = Graph a -> [a]
forall a. Graph a -> [a]
vertices Graph a
g1
vs2 :: [a]
vs2 = Graph a -> [a]
forall a. Graph a -> [a]
vertices Graph a
g2
es1 :: Set [a]
es1 = [[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
$ Graph a -> [[a]]
forall a. Graph a -> [[a]]
edges Graph a
g1
es2 :: Set [a]
es2 = [[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
$ Graph a -> [[a]]
forall a. Graph a -> [[a]]
edges Graph a
g2
isGraphIso :: (Ord a, Ord b) => Graph a -> Graph b -> Bool
isGraphIso :: Graph a -> Graph b -> Bool
isGraphIso g1 :: Graph a
g1 g2 :: Graph b
g2 = (Bool -> Bool
not (Bool -> Bool) -> ([[(a, b)]] -> Bool) -> [[(a, b)]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(a, b)]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Graph a -> Graph b -> [[(a, b)]]
forall a a. (Ord a, Ord a) => Graph a -> Graph a -> [[(a, a)]]
graphIsos Graph a
g1 Graph b
g2)
incidenceIsos :: Graph (Either a b) -> Graph (Either b b) -> [[(a, b)]]
incidenceIsos g1 :: Graph (Either a b)
g1 g2 :: Graph (Either b b)
g2
| [Graph (Either a b)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Graph (Either a b)]
cs1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Graph (Either b b)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Graph (Either b b)]
cs2 = []
| Bool
otherwise = [Graph (Either a b)] -> [Graph (Either b b)] -> [[(a, b)]]
forall a b b b.
(Ord a, Ord b, Ord b, Ord b) =>
[Graph (Either a b)] -> [Graph (Either b b)] -> [[(a, b)]]
incidenceIsos' [Graph (Either a b)]
cs1 [Graph (Either b b)]
cs2
where cs1 :: [Graph (Either a b)]
cs1 = ([Either a b] -> Graph (Either a b))
-> [[Either a b]] -> [Graph (Either a b)]
forall a b. (a -> b) -> [a] -> [b]
map (Graph (Either a b) -> [Either a b] -> Graph (Either a b)
forall a. Eq a => Graph a -> [a] -> Graph a
inducedSubgraph Graph (Either a b)
g1) (([Either a b] -> Bool) -> [[Either a b]] -> [[Either a b]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Either a b] -> Bool) -> [Either a b] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> ([Either a b] -> [a]) -> [Either a b] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either a b] -> [a]
forall a b. [Either a b] -> [a]
lefts) ([[Either a b]] -> [[Either a b]])
-> [[Either a b]] -> [[Either a b]]
forall a b. (a -> b) -> a -> b
$ Graph (Either a b) -> [[Either a b]]
forall a. Ord a => Graph a -> [[a]]
components Graph (Either a b)
g1)
cs2 :: [Graph (Either b b)]
cs2 = ([Either b b] -> Graph (Either b b))
-> [[Either b b]] -> [Graph (Either b b)]
forall a b. (a -> b) -> [a] -> [b]
map (Graph (Either b b) -> [Either b b] -> Graph (Either b b)
forall a. Eq a => Graph a -> [a] -> Graph a
inducedSubgraph Graph (Either b b)
g2) (([Either b b] -> Bool) -> [[Either b b]] -> [[Either b b]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Either b b] -> Bool) -> [Either b b] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([b] -> Bool) -> ([Either b b] -> [b]) -> [Either b b] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either b b] -> [b]
forall a b. [Either a b] -> [a]
lefts) ([[Either b b]] -> [[Either b b]])
-> [[Either b b]] -> [[Either b b]]
forall a b. (a -> b) -> a -> b
$ Graph (Either b b) -> [[Either b b]]
forall a. Ord a => Graph a -> [[a]]
components Graph (Either b b)
g2)
incidenceIsos' :: [Graph (Either a b)] -> [Graph (Either b b)] -> [[(a, b)]]
incidenceIsos' (ci :: Graph (Either a b)
ci:cis :: [Graph (Either a b)]
cis) cjs :: [Graph (Either b b)]
cjs =
[[(a, b)]
iso [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ [(a, b)]
iso' | (cj :: Graph (Either b b)
cj,cjs' :: [Graph (Either b b)]
cjs') <- [Graph (Either b b)]
-> [(Graph (Either b b), [Graph (Either b b)])]
forall a. [a] -> [(a, [a])]
picks [Graph (Either b b)]
cjs,
[(a, b)]
iso <- Graph (Either a b) -> Graph (Either b b) -> [[(a, b)]]
forall a b b b.
(Ord a, Ord b, Ord b, Ord b) =>
Graph (Either a b) -> Graph (Either b b) -> [[(a, b)]]
incidenceIsosCon Graph (Either a b)
ci Graph (Either b b)
cj,
[(a, b)]
iso' <- [Graph (Either a b)] -> [Graph (Either b b)] -> [[(a, b)]]
incidenceIsos' [Graph (Either a b)]
cis [Graph (Either b b)]
cjs']
incidenceIsos' [] [] = [[]]
incidenceIsosCon :: Graph (Either a b) -> Graph (Either b b) -> [[(a, b)]]
incidenceIsosCon g1 :: Graph (Either a b)
g1 g2 :: Graph (Either b b)
g2
| Graph (Either a b) -> Bool
forall t. Ord t => Graph t -> Bool
isConnected Graph (Either a b)
g1 Bool -> Bool -> Bool
&& Graph (Either b b) -> Bool
forall t. Ord t => Graph t -> Bool
isConnected Graph (Either b b)
g2
= [[[(a, b)]]] -> [[(a, b)]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Either a b, Either b b)]
-> [[Either a b]] -> [[Either b b]] -> [[(a, b)]]
dfs [] (Graph (Either a b) -> Either a b -> [[Either a b]]
forall a. Ord a => Graph a -> a -> [[a]]
distancePartition Graph (Either a b)
g1 Either a b
v1) (Graph (Either b b) -> Either b b -> [[Either b b]]
forall a. Ord a => Graph a -> a -> [[a]]
distancePartition Graph (Either b b)
g2 Either b b
v2)
| v1 :: Either a b
v1@(Left _) <- Int -> [Either a b] -> [Either a b]
forall a. Int -> [a] -> [a]
take 1 (Graph (Either a b) -> [Either a b]
forall a. Graph a -> [a]
vertices Graph (Either a b)
g1), v2 :: Either b b
v2@(Left _) <- Graph (Either b b) -> [Either b b]
forall a. Graph a -> [a]
vertices Graph (Either b b)
g2]
| Bool
otherwise = [Char] -> [[(a, b)]]
forall a. HasCallStack => [Char] -> a
error "incidenceIsos: one or both graphs not connected"
where dfs :: [(Either a b, Either b b)]
-> [[Either a b]] -> [[Either b b]] -> [[(a, b)]]
dfs xys :: [(Either a b, Either b b)]
xys p1 :: [[Either a b]]
p1 p2 :: [[Either b b]]
p2
| ([Either a b] -> Int) -> [[Either a b]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Either a b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Either a b]]
p1 [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
/= ([Either b b] -> Int) -> [[Either b b]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Either b b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Either b b]]
p2 = []
| Bool
otherwise =
let p1' :: [[Either a b]]
p1' = ([Either a b] -> Bool) -> [[Either a b]] -> [[Either a b]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Either a b] -> Bool) -> [Either a b] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either a b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Either a b]]
p1
p2' :: [[Either b b]]
p2' = ([Either b b] -> Bool) -> [[Either b b]] -> [[Either b b]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Either b b] -> Bool) -> [Either b b] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either b b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Either b b]]
p2
in if ([Either a b] -> Bool) -> [[Either a b]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Either a b] -> Bool
forall a. [a] -> Bool
isSingleton [[Either a b]]
p1'
then let xys' :: [(Either a b, Either b b)]
xys' = [(Either a b, Either b b)]
xys [(Either a b, Either b b)]
-> [(Either a b, Either b b)] -> [(Either a b, Either b b)]
forall a. [a] -> [a] -> [a]
++ [Either a b] -> [Either b b] -> [(Either a b, Either b b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[Either a b]] -> [Either a b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Either a b]]
p1') ([[Either b b]] -> [Either b b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Either b b]]
p2')
in if [(Either a b, Either b b)] -> Bool
isCompatible [(Either a b, Either b b)]
xys' then [[(a
x,b
y) | (Left x, Left y) <- [(Either a b, Either b b)]
xys']] else []
else let (x :: Either a b
x:xs :: [Either a b]
xs):p1'' :: [[Either a b]]
p1'' = [[Either a b]]
p1'
ys :: [Either b b]
ys:p2'' :: [[Either b b]]
p2'' = [[Either b b]]
p2'
in [[[(a, b)]]] -> [[(a, b)]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Either a b, Either b b)]
-> [[Either a b]] -> [[Either b b]] -> [[(a, b)]]
dfs ((Either a b
x,Either b b
y)(Either a b, Either b b)
-> [(Either a b, Either b b)] -> [(Either a b, Either b b)]
forall a. a -> [a] -> [a]
:[(Either a b, Either b b)]
xys)
([[Either a b]] -> [[Either a b]] -> [[Either a b]]
forall a. Ord a => [[a]] -> [[a]] -> [[a]]
intersectCells ([Either a b]
xs [Either a b] -> [[Either a b]] -> [[Either a b]]
forall a. a -> [a] -> [a]
: [[Either a b]]
p1'') (Map (Either a b) [[Either a b]]
dps1 Map (Either a b) [[Either a b]] -> Either a b -> [[Either a b]]
forall k a. Ord k => Map k a -> k -> a
M.! Either a b
x))
([[Either b b]] -> [[Either b b]] -> [[Either b b]]
forall a. Ord a => [[a]] -> [[a]] -> [[a]]
intersectCells ([Either b b]
ys'[Either b b] -> [[Either b b]] -> [[Either b b]]
forall a. a -> [a] -> [a]
: [[Either b b]]
p2'') (Map (Either b b) [[Either b b]]
dps2 Map (Either b b) [[Either b b]] -> Either b b -> [[Either b b]]
forall k a. Ord k => Map k a -> k -> a
M.! Either b b
y))
| (y :: Either b b
y,ys' :: [Either b b]
ys') <- [Either b b] -> [(Either b b, [Either b b])]
forall a. [a] -> [(a, [a])]
picks [Either b b]
ys]
isCompatible :: [(Either a b, Either b b)] -> Bool
isCompatible xys :: [(Either a b, Either b b)]
xys = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [([Either a b
x,Either a b
x'] [Either a b] -> Set [Either a b] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [Either a b]
es1) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ([Either b b] -> [Either b b]
forall a. Ord a => [a] -> [a]
L.sort [Either b b
y,Either b b
y'] [Either b b] -> Set [Either b b] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [Either b b]
es2) | (x :: Either a b
x,y :: Either b b
y) <- [(Either a b, Either b b)]
xys, (x' :: Either a b
x',y' :: Either b b
y') <- [(Either a b, Either b b)]
xys, Either a b
x Either a b -> Either a b -> Bool
forall a. Ord a => a -> a -> Bool
< Either a b
x']
dps1 :: Map (Either a b) [[Either a b]]
dps1 = [(Either a b, [[Either a b]])] -> Map (Either a b) [[Either a b]]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Either a b
v, Graph (Either a b) -> Either a b -> [[Either a b]]
forall a. Ord a => Graph a -> a -> [[a]]
distancePartition Graph (Either a b)
g1 Either a b
v) | Either a b
v <- Graph (Either a b) -> [Either a b]
forall a. Graph a -> [a]
vertices Graph (Either a b)
g1]
dps2 :: Map (Either b b) [[Either b b]]
dps2 = [(Either b b, [[Either b b]])] -> Map (Either b b) [[Either b b]]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Either b b
v, Graph (Either b b) -> Either b b -> [[Either b b]]
forall a. Ord a => Graph a -> a -> [[a]]
distancePartition Graph (Either b b)
g2 Either b b
v) | Either b b
v <- Graph (Either b b) -> [Either b b]
forall a. Graph a -> [a]
vertices Graph (Either b b)
g2]
es1 :: Set [Either a b]
es1 = [[Either a b]] -> Set [Either a b]
forall a. Ord a => [a] -> Set a
S.fromList ([[Either a b]] -> Set [Either a b])
-> [[Either a b]] -> Set [Either a b]
forall a b. (a -> b) -> a -> b
$ Graph (Either a b) -> [[Either a b]]
forall a. Graph a -> [[a]]
edges Graph (Either a b)
g1
es2 :: Set [Either b b]
es2 = [[Either b b]] -> Set [Either b b]
forall a. Ord a => [a] -> Set a
S.fromList ([[Either b b]] -> Set [Either b b])
-> [[Either b b]] -> Set [Either b b]
forall a b. (a -> b) -> a -> b
$ Graph (Either b b) -> [[Either b b]]
forall a. Graph a -> [[a]]
edges Graph (Either b b)
g2
isIncidenceIso :: (Ord p1, Ord b1, Ord p2, Ord b2) =>
Graph (Either p1 b1) -> Graph (Either p2 b2) -> Bool
isIncidenceIso :: Graph (Either p1 b1) -> Graph (Either p2 b2) -> Bool
isIncidenceIso g1 :: Graph (Either p1 b1)
g1 g2 :: Graph (Either p2 b2)
g2 = (Bool -> Bool
not (Bool -> Bool) -> ([[(p1, p2)]] -> Bool) -> [[(p1, p2)]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(p1, p2)]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Graph (Either p1 b1) -> Graph (Either p2 b2) -> [[(p1, p2)]]
forall a b b b.
(Ord b, Ord b, Ord a, Ord b) =>
Graph (Either a b) -> Graph (Either b b) -> [[(a, b)]]
incidenceIsos Graph (Either p1 b1)
g1 Graph (Either p2 b2)
g2)