{-# LANGUAGE DeriveGeneric #-}
module Algebra.Graph.Bipartite.Undirected.AdjacencyMap (
AdjacencyMap, leftAdjacencyMap, rightAdjacencyMap,
empty, leftVertex, rightVertex, vertex, edge, overlay, connect, vertices,
edges, overlays, connects, swap,
toBipartite, toBipartiteWith, fromBipartite, fromBipartiteWith,
isEmpty, hasLeftVertex, hasRightVertex, hasVertex, hasEdge, leftVertexCount,
rightVertexCount, vertexCount, edgeCount, leftVertexList, rightVertexList,
vertexList, edgeList, leftVertexSet, rightVertexSet, vertexSet, edgeSet,
circuit, biclique,
OddCycle, detectParts,
consistent
) where
import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Monad.State
import Data.Either
import Data.Foldable
import Data.List
import Data.Map.Strict (Map)
import Data.Maybe
import Data.Set (Set)
import GHC.Generics
import qualified Algebra.Graph.AdjacencyMap as AM
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Tuple
data AdjacencyMap a b = BAM {
AdjacencyMap a b -> Map a (Set b)
leftAdjacencyMap :: Map a (Set b),
AdjacencyMap a b -> Map b (Set a)
rightAdjacencyMap :: Map b (Set a)
} deriving (forall x. AdjacencyMap a b -> Rep (AdjacencyMap a b) x)
-> (forall x. Rep (AdjacencyMap a b) x -> AdjacencyMap a b)
-> Generic (AdjacencyMap a b)
forall x. Rep (AdjacencyMap a b) x -> AdjacencyMap a b
forall x. AdjacencyMap a b -> Rep (AdjacencyMap a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (AdjacencyMap a b) x -> AdjacencyMap a b
forall a b x. AdjacencyMap a b -> Rep (AdjacencyMap a b) x
$cto :: forall a b x. Rep (AdjacencyMap a b) x -> AdjacencyMap a b
$cfrom :: forall a b x. AdjacencyMap a b -> Rep (AdjacencyMap a b) x
Generic
instance (Ord a, Ord b, Num b) => Num (AdjacencyMap a b) where
fromInteger :: Integer -> AdjacencyMap a b
fromInteger = b -> AdjacencyMap a b
forall b a. b -> AdjacencyMap a b
rightVertex (b -> AdjacencyMap a b)
-> (Integer -> b) -> Integer -> AdjacencyMap a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> b
forall a. Num a => Integer -> a
fromInteger
+ :: AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
(+) = AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
forall a b.
(Ord a, Ord b) =>
AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
overlay
* :: AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
(*) = AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
forall a b.
(Ord a, Ord b) =>
AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
connect
signum :: AdjacencyMap a b -> AdjacencyMap a b
signum = AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
forall a b. a -> b -> a
const AdjacencyMap a b
forall a b. AdjacencyMap a b
empty
abs :: AdjacencyMap a b -> AdjacencyMap a b
abs = AdjacencyMap a b -> AdjacencyMap a b
forall a. a -> a
id
negate :: AdjacencyMap a b -> AdjacencyMap a b
negate = AdjacencyMap a b -> AdjacencyMap a b
forall a. a -> a
id
instance (Ord a, Ord b) => Eq (AdjacencyMap a b) where
BAM Map a (Set b)
lr1 Map b (Set a)
rl1 == :: AdjacencyMap a b -> AdjacencyMap a b -> Bool
== BAM Map a (Set b)
lr2 Map b (Set a)
rl2 = Map a (Set b)
lr1 Map a (Set b) -> Map a (Set b) -> Bool
forall a. Eq a => a -> a -> Bool
== Map a (Set b)
lr2 Bool -> Bool -> Bool
&& Map b (Set a) -> Set b
forall k a. Map k a -> Set k
Map.keysSet Map b (Set a)
rl1 Set b -> Set b -> Bool
forall a. Eq a => a -> a -> Bool
== Map b (Set a) -> Set b
forall k a. Map k a -> Set k
Map.keysSet Map b (Set a)
rl2
instance (Ord a, Ord b) => Ord (AdjacencyMap a b) where
compare :: AdjacencyMap a b -> AdjacencyMap a b -> Ordering
compare AdjacencyMap a b
x AdjacencyMap a b
y = [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat
[ Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyMap a b -> Int
forall a b. AdjacencyMap a b -> Int
vertexCount AdjacencyMap a b
x) (AdjacencyMap a b -> Int
forall a b. AdjacencyMap a b -> Int
vertexCount AdjacencyMap a b
y)
, Set (Either a b) -> Set (Either a b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyMap a b -> Set (Either a b)
forall a b. (Ord a, Ord b) => AdjacencyMap a b -> Set (Either a b)
vertexSet AdjacencyMap a b
x) (AdjacencyMap a b -> Set (Either a b)
forall a b. (Ord a, Ord b) => AdjacencyMap a b -> Set (Either a b)
vertexSet AdjacencyMap a b
y)
, Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyMap a b -> Int
forall a b. AdjacencyMap a b -> Int
edgeCount AdjacencyMap a b
x) (AdjacencyMap a b -> Int
forall a b. AdjacencyMap a b -> Int
edgeCount AdjacencyMap a b
y)
, Set (a, b) -> Set (a, b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AdjacencyMap a b -> Set (a, b)
forall a b. (Ord a, Ord b) => AdjacencyMap a b -> Set (a, b)
edgeSet AdjacencyMap a b
x) (AdjacencyMap a b -> Set (a, b)
forall a b. (Ord a, Ord b) => AdjacencyMap a b -> Set (a, b)
edgeSet AdjacencyMap a b
y) ]
instance (Ord a, Ord b, Show a, Show b) => Show (AdjacencyMap a b) where
showsPrec :: Int -> AdjacencyMap a b -> ShowS
showsPrec Int
p AdjacencyMap a b
bam
| [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
lvs Bool -> Bool -> Bool
&& [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [b]
rvs = String -> ShowS
showString String
"empty"
| [(a, b)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, b)]
es = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [a] -> [b] -> ShowS
forall a a. (Show a, Show a) => [a] -> [a] -> ShowS
vshow [a]
lvs [b]
rvs
| ([a]
lvs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
lused) Bool -> Bool -> Bool
&& ([b]
rvs [b] -> [b] -> Bool
forall a. Eq a => a -> a -> Bool
== [b]
rused) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [(a, b)] -> ShowS
forall a a. (Show a, Show a) => [(a, a)] -> ShowS
eshow [(a, b)]
es
| Bool
otherwise = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
(ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"overlay ("
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either a b] -> ShowS
forall a a. (Show a, Show a) => [Either a a] -> ShowS
veshow ([Either a b]
vs [Either a b] -> [Either a b] -> [Either a b]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Either a b]
used)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
") ("
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> ShowS
forall a a. (Show a, Show a) => [(a, a)] -> ShowS
eshow [(a, b)]
es
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
where
lvs :: [a]
lvs = AdjacencyMap a b -> [a]
forall a b. AdjacencyMap a b -> [a]
leftVertexList AdjacencyMap a b
bam
rvs :: [b]
rvs = AdjacencyMap a b -> [b]
forall a b. AdjacencyMap a b -> [b]
rightVertexList AdjacencyMap a b
bam
vs :: [Either a b]
vs = AdjacencyMap a b -> [Either a b]
forall a b. AdjacencyMap a b -> [Either a b]
vertexList AdjacencyMap a b
bam
es :: [(a, b)]
es = AdjacencyMap a b -> [(a, b)]
forall a b. AdjacencyMap a b -> [(a, b)]
edgeList AdjacencyMap a b
bam
vshow :: [a] -> [a] -> ShowS
vshow [a
x] [] = String -> ShowS
showString String
"leftVertex " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x
vshow [] [a
x] = String -> ShowS
showString String
"rightVertex " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x
vshow [a]
xs [a]
ys = String -> ShowS
showString String
"vertices " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [a]
xs
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [a]
ys
veshow :: [Either a a] -> ShowS
veshow [Either a a]
xs = [a] -> [a] -> ShowS
forall a a. (Show a, Show a) => [a] -> [a] -> ShowS
vshow ([Either a a] -> [a]
forall a b. [Either a b] -> [a]
lefts [Either a a]
xs) ([Either a a] -> [a]
forall a b. [Either a b] -> [b]
rights [Either a a]
xs)
eshow :: [(a, a)] -> ShowS
eshow [(a
x, a
y)] = String -> ShowS
showString String
"edge " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
y
eshow [(a, a)]
es = String -> ShowS
showString String
"edges " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(a, a)] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [(a, a)]
es
lused :: [a]
lused = Set a -> [a]
forall a. Set a -> [a]
Set.toAscList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> Set a
forall a. Eq a => [a] -> Set a
Set.fromAscList [ a
u | (a
u, b
_) <- AdjacencyMap a b -> [(a, b)]
forall a b. AdjacencyMap a b -> [(a, b)]
edgeList AdjacencyMap a b
bam ]
rused :: [b]
rused = Set b -> [b]
forall a. Set a -> [a]
Set.toAscList (Set b -> [b]) -> Set b -> [b]
forall a b. (a -> b) -> a -> b
$ [b] -> Set b
forall a. Ord a => [a] -> Set a
Set.fromList [ b
v | (a
_, b
v) <- AdjacencyMap a b -> [(a, b)]
forall a b. AdjacencyMap a b -> [(a, b)]
edgeList AdjacencyMap a b
bam ]
used :: [Either a b]
used = (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]
lused [Either a b] -> [Either a b] -> [Either a b]
forall a. [a] -> [a] -> [a]
++ (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]
rused
empty :: AdjacencyMap a b
empty :: AdjacencyMap a b
empty = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM Map a (Set b)
forall k a. Map k a
Map.empty Map b (Set a)
forall k a. Map k a
Map.empty
leftVertex :: a -> AdjacencyMap a b
leftVertex :: a -> AdjacencyMap a b
leftVertex a
x = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (a -> Set b -> Map a (Set b)
forall k a. k -> a -> Map k a
Map.singleton a
x Set b
forall a. Set a
Set.empty) Map b (Set a)
forall k a. Map k a
Map.empty
rightVertex :: b -> AdjacencyMap a b
rightVertex :: b -> AdjacencyMap a b
rightVertex b
y = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM Map a (Set b)
forall k a. Map k a
Map.empty (b -> Set a -> Map b (Set a)
forall k a. k -> a -> Map k a
Map.singleton b
y Set a
forall a. Set a
Set.empty)
vertex :: Either a b -> AdjacencyMap a b
vertex :: Either a b -> AdjacencyMap a b
vertex (Left a
x) = a -> AdjacencyMap a b
forall a b. a -> AdjacencyMap a b
leftVertex a
x
vertex (Right b
y) = b -> AdjacencyMap a b
forall b a. b -> AdjacencyMap a b
rightVertex b
y
edge :: a -> b -> AdjacencyMap a b
edge :: a -> b -> AdjacencyMap a b
edge a
x b
y =
Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM (a -> Set b -> Map a (Set b)
forall k a. k -> a -> Map k a
Map.singleton a
x (b -> Set b
forall a. a -> Set a
Set.singleton b
y)) (b -> Set a -> Map b (Set a)
forall k a. k -> a -> Map k a
Map.singleton b
y (a -> Set a
forall a. a -> Set a
Set.singleton a
x))
overlay :: (Ord a, Ord b) => AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
overlay :: AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
overlay (BAM Map a (Set b)
lr1 Map b (Set a)
rl1) (BAM Map a (Set b)
lr2 Map b (Set a)
rl2) =
Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM ((Set b -> Set b -> Set b)
-> Map a (Set b) -> Map a (Set b) -> Map a (Set b)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
Set.union Map a (Set b)
lr1 Map a (Set b)
lr2) ((Set a -> Set a -> Set a)
-> Map b (Set a) -> Map b (Set a) -> Map b (Set a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union Map b (Set a)
rl1 Map b (Set a)
rl2)
connect :: (Ord a, Ord b) => AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
connect :: AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
connect (BAM Map a (Set b)
lr1 Map b (Set a)
rl1) (BAM Map a (Set b)
lr2 Map b (Set a)
rl2) = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM Map a (Set b)
lr Map b (Set a)
rl
where
l1 :: Set a
l1 = Map a (Set b) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Set b)
lr1
l2 :: Set a
l2 = Map a (Set b) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Set b)
lr2
r1 :: Set b
r1 = Map b (Set a) -> Set b
forall k a. Map k a -> Set k
Map.keysSet Map b (Set a)
rl1
r2 :: Set b
r2 = Map b (Set a) -> Set b
forall k a. Map k a -> Set k
Map.keysSet Map b (Set a)
rl2
lr :: Map a (Set b)
lr = (Set b -> Set b -> Set b) -> [Map a (Set b)] -> Map a (Set b)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
Set.union
[ Map a (Set b)
lr1, Map a (Set b)
lr2, (a -> Set b) -> Set a -> Map a (Set b)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set b -> a -> Set b
forall a b. a -> b -> a
const Set b
r2) Set a
l1, (a -> Set b) -> Set a -> Map a (Set b)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set b -> a -> Set b
forall a b. a -> b -> a
const Set b
r1) Set a
l2 ]
rl :: Map b (Set a)
rl = (Set a -> Set a -> Set a) -> [Map b (Set a)] -> Map b (Set a)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union
[ Map b (Set a)
rl1, Map b (Set a)
rl2, (b -> Set a) -> Set b -> Map b (Set a)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set a -> b -> Set a
forall a b. a -> b -> a
const Set a
l2) Set b
r1, (b -> Set a) -> Set b -> Map b (Set a)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set a -> b -> Set a
forall a b. a -> b -> a
const Set a
l1) Set b
r2 ]
vertices :: (Ord a, Ord b) => [a] -> [b] -> AdjacencyMap a b
vertices :: [a] -> [b] -> AdjacencyMap a b
vertices [a]
ls [b]
rs = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM ([(a, Set b)] -> Map a (Set b)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (a
l, Set b
forall a. Set a
Set.empty) | a
l <- [a]
ls ])
([(b, Set a)] -> Map b (Set a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (b
r, Set a
forall a. Set a
Set.empty) | b
r <- [b]
rs ])
edges :: (Ord a, Ord b) => [(a, b)] -> AdjacencyMap a b
edges :: [(a, b)] -> AdjacencyMap a b
edges [(a, b)]
es = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM ((Set b -> Set b -> Set b) -> [(a, Set b)] -> Map a (Set b)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
Set.union [ (a
x, b -> Set b
forall a. a -> Set a
Set.singleton b
y) | (a
x, b
y) <- [(a, b)]
es ])
((Set a -> Set a -> Set a) -> [(b, Set a)] -> Map b (Set a)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union [ (b
y, a -> Set a
forall a. a -> Set a
Set.singleton a
x) | (a
x, b
y) <- [(a, b)]
es ])
overlays :: (Ord a, Ord b) => [AdjacencyMap a b] -> AdjacencyMap a b
overlays :: [AdjacencyMap a b] -> AdjacencyMap a b
overlays [AdjacencyMap a b]
ams = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM ((Set b -> Set b -> Set b) -> [Map a (Set b)] -> Map a (Set b)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
Set.union ((AdjacencyMap a b -> Map a (Set b))
-> [AdjacencyMap a b] -> [Map a (Set b)]
forall a b. (a -> b) -> [a] -> [b]
map AdjacencyMap a b -> Map a (Set b)
forall a b. AdjacencyMap a b -> Map a (Set b)
leftAdjacencyMap [AdjacencyMap a b]
ams))
((Set a -> Set a -> Set a) -> [Map b (Set a)] -> Map b (Set a)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union ((AdjacencyMap a b -> Map b (Set a))
-> [AdjacencyMap a b] -> [Map b (Set a)]
forall a b. (a -> b) -> [a] -> [b]
map AdjacencyMap a b -> Map b (Set a)
forall a b. AdjacencyMap a b -> Map b (Set a)
rightAdjacencyMap [AdjacencyMap a b]
ams))
connects :: (Ord a, Ord b) => [AdjacencyMap a b] -> AdjacencyMap a b
connects :: [AdjacencyMap a b] -> AdjacencyMap a b
connects = (AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b)
-> AdjacencyMap a b -> [AdjacencyMap a b] -> AdjacencyMap a b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
forall a b.
(Ord a, Ord b) =>
AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
connect AdjacencyMap a b
forall a b. AdjacencyMap a b
empty
swap :: AdjacencyMap a b -> AdjacencyMap b a
swap :: AdjacencyMap a b -> AdjacencyMap b a
swap (BAM Map a (Set b)
lr Map b (Set a)
rl) = Map b (Set a) -> Map a (Set b) -> AdjacencyMap b a
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM Map b (Set a)
rl Map a (Set b)
lr
toBipartite :: (Ord a, Ord b) => AM.AdjacencyMap (Either a b) -> AdjacencyMap a b
toBipartite :: AdjacencyMap (Either a b) -> AdjacencyMap a b
toBipartite AdjacencyMap (Either a b)
m = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM ([(a, Set b)] -> Map a (Set b)
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [ (a
x, Set (Either a b) -> Set b
forall a. Set (Either a b) -> Set b
setRights Set (Either a b)
ys) | (Left a
x, Set (Either a b)
ys) <- [(Either a b, Set (Either a b))]
symmetricList ])
([(b, Set a)] -> Map b (Set a)
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [ (b
x, Set (Either a b) -> Set a
forall b. Set (Either a b) -> Set a
setLefts Set (Either a b)
ys) | (Right b
x, Set (Either a b)
ys) <- [(Either a b, Set (Either a b))]
symmetricList ])
where
setRights :: Set (Either a b) -> Set b
setRights = [b] -> Set b
forall a. Eq a => [a] -> Set a
Set.fromAscList ([b] -> Set b)
-> (Set (Either a b) -> [b]) -> Set (Either a b) -> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either a b] -> [b]
forall a b. [Either a b] -> [b]
rights ([Either a b] -> [b])
-> (Set (Either a b) -> [Either a b]) -> Set (Either a b) -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Either a b) -> [Either a b]
forall a. Set a -> [a]
Set.toAscList
setLefts :: Set (Either a b) -> Set a
setLefts = [a] -> Set a
forall a. Eq a => [a] -> Set a
Set.fromAscList ([a] -> Set a)
-> (Set (Either a b) -> [a]) -> Set (Either a b) -> Set a
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] -> [a])
-> (Set (Either a b) -> [Either a b]) -> Set (Either a b) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Either a b) -> [Either a b]
forall a. Set a -> [a]
Set.toAscList
symmetricList :: [(Either a b, Set (Either a b))]
symmetricList = Map (Either a b) (Set (Either a b))
-> [(Either a b, Set (Either a b))]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map (Either a b) (Set (Either a b))
-> [(Either a b, Set (Either a b))])
-> Map (Either a b) (Set (Either a b))
-> [(Either a b, Set (Either a b))]
forall a b. (a -> b) -> a -> b
$ AdjacencyMap (Either a b) -> Map (Either a b) (Set (Either a b))
forall a. AdjacencyMap a -> Map a (Set a)
AM.adjacencyMap (AdjacencyMap (Either a b) -> Map (Either a b) (Set (Either a b)))
-> AdjacencyMap (Either a b) -> Map (Either a b) (Set (Either a b))
forall a b. (a -> b) -> a -> b
$ AdjacencyMap (Either a b) -> AdjacencyMap (Either a b)
forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
AM.symmetricClosure AdjacencyMap (Either a b)
m
toBipartiteWith :: (Ord a, Ord b, Ord c) => (a -> Either b c) -> AM.AdjacencyMap a -> AdjacencyMap b c
toBipartiteWith :: (a -> Either b c) -> AdjacencyMap a -> AdjacencyMap b c
toBipartiteWith a -> Either b c
f = AdjacencyMap (Either b c) -> AdjacencyMap b c
forall a b.
(Ord a, Ord b) =>
AdjacencyMap (Either a b) -> AdjacencyMap a b
toBipartite (AdjacencyMap (Either b c) -> AdjacencyMap b c)
-> (AdjacencyMap a -> AdjacencyMap (Either b c))
-> AdjacencyMap a
-> AdjacencyMap b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either b c) -> AdjacencyMap a -> AdjacencyMap (Either b c)
forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
AM.gmap a -> Either b c
f
fromBipartite :: (Ord a, Ord b) => AdjacencyMap a b -> AM.AdjacencyMap (Either a b)
fromBipartite :: AdjacencyMap a b -> AdjacencyMap (Either a b)
fromBipartite (BAM Map a (Set b)
lr Map b (Set a)
rl) = [(Either a b, Set (Either a b))] -> AdjacencyMap (Either a b)
forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
AM.fromAdjacencySets ([(Either a b, Set (Either a b))] -> AdjacencyMap (Either a b))
-> [(Either a b, Set (Either a b))] -> AdjacencyMap (Either a b)
forall a b. (a -> b) -> a -> b
$
[ (a -> Either a b
forall a b. a -> Either a b
Left a
x, (b -> Either a b) -> Set b -> Set (Either a b)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic b -> Either a b
forall a b. b -> Either a b
Right Set b
ys) | (a
x, Set b
ys) <- Map a (Set b) -> [(a, Set b)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set b)
lr ] [(Either a b, Set (Either a b))]
-> [(Either a b, Set (Either a b))]
-> [(Either a b, Set (Either a b))]
forall a. [a] -> [a] -> [a]
++
[ (b -> Either a b
forall a b. b -> Either a b
Right b
y, (a -> Either a b) -> Set a -> Set (Either a b)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic a -> Either a b
forall a b. a -> Either a b
Left Set a
xs) | (b
y, Set a
xs) <- Map b (Set a) -> [(b, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map b (Set a)
rl ]
fromBipartiteWith :: Ord c => (a -> c) -> (b -> c) -> AdjacencyMap a b -> AM.AdjacencyMap c
fromBipartiteWith :: (a -> c) -> (b -> c) -> AdjacencyMap a b -> AdjacencyMap c
fromBipartiteWith a -> c
f b -> c
g (BAM Map a (Set b)
lr Map b (Set a)
rl) = [(c, Set c)] -> AdjacencyMap c
forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
AM.fromAdjacencySets ([(c, Set c)] -> AdjacencyMap c) -> [(c, Set c)] -> AdjacencyMap c
forall a b. (a -> b) -> a -> b
$
[ (a -> c
f a
x, (b -> c) -> Set b -> Set c
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map b -> c
g Set b
ys) | (a
x, Set b
ys) <- Map a (Set b) -> [(a, Set b)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set b)
lr ] [(c, Set c)] -> [(c, Set c)] -> [(c, Set c)]
forall a. [a] -> [a] -> [a]
++
[ (b -> c
g b
y, (a -> c) -> Set a -> Set c
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> c
f Set a
xs) | (b
y, Set a
xs) <- Map b (Set a) -> [(b, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map b (Set a)
rl ]
isEmpty :: AdjacencyMap a b -> Bool
isEmpty :: AdjacencyMap a b -> Bool
isEmpty (BAM Map a (Set b)
lr Map b (Set a)
rl) = Map a (Set b) -> Bool
forall k a. Map k a -> Bool
Map.null Map a (Set b)
lr Bool -> Bool -> Bool
&& Map b (Set a) -> Bool
forall k a. Map k a -> Bool
Map.null Map b (Set a)
rl
hasLeftVertex :: Ord a => a -> AdjacencyMap a b -> Bool
hasLeftVertex :: a -> AdjacencyMap a b -> Bool
hasLeftVertex a
x (BAM Map a (Set b)
lr Map b (Set a)
_) = a -> Map a (Set b) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member a
x Map a (Set b)
lr
hasRightVertex :: Ord b => b -> AdjacencyMap a b -> Bool
hasRightVertex :: b -> AdjacencyMap a b -> Bool
hasRightVertex b
y (BAM Map a (Set b)
_ Map b (Set a)
rl) = b -> Map b (Set a) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member b
y Map b (Set a)
rl
hasVertex :: (Ord a, Ord b) => Either a b -> AdjacencyMap a b -> Bool
hasVertex :: Either a b -> AdjacencyMap a b -> Bool
hasVertex (Left a
x) = a -> AdjacencyMap a b -> Bool
forall a b. Ord a => a -> AdjacencyMap a b -> Bool
hasLeftVertex a
x
hasVertex (Right b
y) = b -> AdjacencyMap a b -> Bool
forall b a. Ord b => b -> AdjacencyMap a b -> Bool
hasRightVertex b
y
hasEdge :: (Ord a, Ord b) => a -> b -> AdjacencyMap a b -> Bool
hasEdge :: a -> b -> AdjacencyMap a b -> Bool
hasEdge a
x b
y (BAM Map a (Set b)
m Map b (Set a)
_) = (b -> Set b -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member b
y (Set b -> Bool) -> Maybe (Set b) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Map a (Set b) -> Maybe (Set b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
x Map a (Set b)
m) Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
leftVertexCount :: AdjacencyMap a b -> Int
leftVertexCount :: AdjacencyMap a b -> Int
leftVertexCount = Map a (Set b) -> Int
forall k a. Map k a -> Int
Map.size (Map a (Set b) -> Int)
-> (AdjacencyMap a b -> Map a (Set b)) -> AdjacencyMap a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> Map a (Set b)
forall a b. AdjacencyMap a b -> Map a (Set b)
leftAdjacencyMap
rightVertexCount :: AdjacencyMap a b -> Int
rightVertexCount :: AdjacencyMap a b -> Int
rightVertexCount = Map b (Set a) -> Int
forall k a. Map k a -> Int
Map.size (Map b (Set a) -> Int)
-> (AdjacencyMap a b -> Map b (Set a)) -> AdjacencyMap a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> Map b (Set a)
forall a b. AdjacencyMap a b -> Map b (Set a)
rightAdjacencyMap
vertexCount :: AdjacencyMap a b -> Int
vertexCount :: AdjacencyMap a b -> Int
vertexCount AdjacencyMap a b
g = AdjacencyMap a b -> Int
forall a b. AdjacencyMap a b -> Int
leftVertexCount AdjacencyMap a b
g Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AdjacencyMap a b -> Int
forall a b. AdjacencyMap a b -> Int
rightVertexCount AdjacencyMap a b
g
edgeCount :: AdjacencyMap a b -> Int
edgeCount :: AdjacencyMap a b -> Int
edgeCount = (Set b -> Int -> Int) -> Int -> Map a (Set b) -> Int
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> (Set b -> Int) -> Set b -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set b -> Int
forall a. Set a -> Int
Set.size) Int
0 (Map a (Set b) -> Int)
-> (AdjacencyMap a b -> Map a (Set b)) -> AdjacencyMap a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> Map a (Set b)
forall a b. AdjacencyMap a b -> Map a (Set b)
leftAdjacencyMap
leftVertexList :: AdjacencyMap a b -> [a]
leftVertexList :: AdjacencyMap a b -> [a]
leftVertexList = Map a (Set b) -> [a]
forall k a. Map k a -> [k]
Map.keys (Map a (Set b) -> [a])
-> (AdjacencyMap a b -> Map a (Set b)) -> AdjacencyMap a b -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> Map a (Set b)
forall a b. AdjacencyMap a b -> Map a (Set b)
leftAdjacencyMap
rightVertexList :: AdjacencyMap a b -> [b]
rightVertexList :: AdjacencyMap a b -> [b]
rightVertexList = Map b (Set a) -> [b]
forall k a. Map k a -> [k]
Map.keys (Map b (Set a) -> [b])
-> (AdjacencyMap a b -> Map b (Set a)) -> AdjacencyMap a b -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> Map b (Set a)
forall a b. AdjacencyMap a b -> Map b (Set a)
rightAdjacencyMap
vertexList :: AdjacencyMap a b -> [Either a b]
vertexList :: AdjacencyMap a b -> [Either a b]
vertexList AdjacencyMap a b
g = (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 (AdjacencyMap a b -> [a]
forall a b. AdjacencyMap a b -> [a]
leftVertexList AdjacencyMap a b
g) [Either a b] -> [Either a b] -> [Either a b]
forall a. [a] -> [a] -> [a]
++ (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 (AdjacencyMap a b -> [b]
forall a b. AdjacencyMap a b -> [b]
rightVertexList AdjacencyMap a b
g)
edgeList :: AdjacencyMap a b -> [(a, b)]
edgeList :: AdjacencyMap a b -> [(a, b)]
edgeList (BAM Map a (Set b)
lr Map b (Set a)
_) = [ (a
x, b
y) | (a
x, Set b
ys) <- Map a (Set b) -> [(a, Set b)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set b)
lr, b
y <- Set b -> [b]
forall a. Set a -> [a]
Set.toAscList Set b
ys ]
leftVertexSet :: AdjacencyMap a b -> Set a
leftVertexSet :: AdjacencyMap a b -> Set a
leftVertexSet = Map a (Set b) -> Set a
forall k a. Map k a -> Set k
Map.keysSet (Map a (Set b) -> Set a)
-> (AdjacencyMap a b -> Map a (Set b)) -> AdjacencyMap a b -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> Map a (Set b)
forall a b. AdjacencyMap a b -> Map a (Set b)
leftAdjacencyMap
rightVertexSet :: AdjacencyMap a b -> Set b
rightVertexSet :: AdjacencyMap a b -> Set b
rightVertexSet = Map b (Set a) -> Set b
forall k a. Map k a -> Set k
Map.keysSet (Map b (Set a) -> Set b)
-> (AdjacencyMap a b -> Map b (Set a)) -> AdjacencyMap a b -> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> Map b (Set a)
forall a b. AdjacencyMap a b -> Map b (Set a)
rightAdjacencyMap
vertexSet :: (Ord a, Ord b) => AdjacencyMap a b -> Set (Either a b)
vertexSet :: AdjacencyMap a b -> Set (Either a b)
vertexSet = [Either a b] -> Set (Either a b)
forall a. Eq a => [a] -> Set a
Set.fromAscList ([Either a b] -> Set (Either a b))
-> (AdjacencyMap a b -> [Either a b])
-> AdjacencyMap a b
-> Set (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> [Either a b]
forall a b. AdjacencyMap a b -> [Either a b]
vertexList
edgeSet :: (Ord a, Ord b) => AdjacencyMap a b -> Set (a, b)
edgeSet :: AdjacencyMap a b -> Set (a, b)
edgeSet = [(a, b)] -> Set (a, b)
forall a. Eq a => [a] -> Set a
Set.fromAscList ([(a, b)] -> Set (a, b))
-> (AdjacencyMap a b -> [(a, b)]) -> AdjacencyMap a b -> Set (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjacencyMap a b -> [(a, b)]
forall a b. AdjacencyMap a b -> [(a, b)]
edgeList
circuit :: (Ord a, Ord b) => [(a, b)] -> AdjacencyMap a b
circuit :: [(a, b)] -> AdjacencyMap a b
circuit [] = AdjacencyMap a b
forall a b. AdjacencyMap a b
empty
circuit [(a, b)]
xs = [(a, b)] -> AdjacencyMap a b
forall a b. (Ord a, Ord b) => [(a, b)] -> AdjacencyMap a b
edges ([(a, b)] -> AdjacencyMap a b) -> [(a, b)] -> AdjacencyMap a b
forall a b. (a -> b) -> a -> b
$ [(a, b)]
xs [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
cycle [a]
as) [b]
bs
where
([a]
as, [b]
bs) = [(a, b)] -> ([a], [b])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, b)]
xs
biclique :: (Ord a, Ord b) => [a] -> [b] -> AdjacencyMap a b
biclique :: [a] -> [b] -> AdjacencyMap a b
biclique [a]
xs [b]
ys = Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
forall a b. Map a (Set b) -> Map b (Set a) -> AdjacencyMap a b
BAM ((a -> Set b) -> Set a -> Map a (Set b)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set b -> a -> Set b
forall a b. a -> b -> a
const Set b
sys) Set a
sxs) ((b -> Set a) -> Set b -> Map b (Set a)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Set a -> b -> Set a
forall a b. a -> b -> a
const Set a
sxs) Set b
sys)
where
sxs :: Set a
sxs = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs
sys :: Set b
sys = [b] -> Set b
forall a. Ord a => [a] -> Set a
Set.fromList [b]
ys
data Part = LeftPart | RightPart deriving (Int -> Part -> ShowS
[Part] -> ShowS
Part -> String
(Int -> Part -> ShowS)
-> (Part -> String) -> ([Part] -> ShowS) -> Show Part
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Part] -> ShowS
$cshowList :: [Part] -> ShowS
show :: Part -> String
$cshow :: Part -> String
showsPrec :: Int -> Part -> ShowS
$cshowsPrec :: Int -> Part -> ShowS
Show, Part -> Part -> Bool
(Part -> Part -> Bool) -> (Part -> Part -> Bool) -> Eq Part
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Part -> Part -> Bool
$c/= :: Part -> Part -> Bool
== :: Part -> Part -> Bool
$c== :: Part -> Part -> Bool
Eq)
otherPart :: Part -> Part
otherPart :: Part -> Part
otherPart Part
LeftPart = Part
RightPart
otherPart Part
RightPart = Part
LeftPart
type OddCycle a = [a]
detectParts :: Ord a => AM.AdjacencyMap a -> Either (OddCycle a) (AdjacencyMap a a)
detectParts :: AdjacencyMap a -> Either (OddCycle a) (AdjacencyMap a a)
detectParts AdjacencyMap a
x = case State (Map a Part) (Maybe (OddCycle a))
-> Map a Part -> (Maybe (OddCycle a), Map a Part)
forall s a. State s a -> s -> (a, s)
runState (MaybeT (StateT (Map a Part) Identity) (OddCycle a)
-> State (Map a Part) (Maybe (OddCycle a))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT (StateT (Map a Part) Identity) (OddCycle a)
dfs) Map a Part
forall k a. Map k a
Map.empty of
(Maybe (OddCycle a)
Nothing, Map a Part
m) -> AdjacencyMap a a -> Either (OddCycle a) (AdjacencyMap a a)
forall a b. b -> Either a b
Right (AdjacencyMap a a -> Either (OddCycle a) (AdjacencyMap a a))
-> AdjacencyMap a a -> Either (OddCycle a) (AdjacencyMap a a)
forall a b. (a -> b) -> a -> b
$ (a -> Either a a) -> AdjacencyMap a -> AdjacencyMap a a
forall a b c.
(Ord a, Ord b, Ord c) =>
(a -> Either b c) -> AdjacencyMap a -> AdjacencyMap b c
toBipartiteWith (Map a Part -> a -> Either a a
forall b. Ord b => Map b Part -> b -> Either b b
toEither Map a Part
m) AdjacencyMap a
g
(Just OddCycle a
c, Map a Part
_) -> OddCycle a -> Either (OddCycle a) (AdjacencyMap a a)
forall a b. a -> Either a b
Left (OddCycle a -> Either (OddCycle a) (AdjacencyMap a a))
-> OddCycle a -> Either (OddCycle a) (AdjacencyMap a a)
forall a b. (a -> b) -> a -> b
$ OddCycle a -> OddCycle a
forall a. Eq a => [a] -> [a]
oddCycle OddCycle a
c
where
g :: AdjacencyMap a
g = AdjacencyMap a -> AdjacencyMap a
forall a. Ord a => AdjacencyMap a -> AdjacencyMap a
AM.symmetricClosure AdjacencyMap a
x
dfs :: MaybeT (StateT (Map a Part) Identity) (OddCycle a)
dfs = [MaybeT (StateT (Map a Part) Identity) (OddCycle a)]
-> MaybeT (StateT (Map a Part) Identity) (OddCycle a)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ a -> MaybeT (StateT (Map a Part) Identity) (OddCycle a)
processVertex a
v | a
v <- AdjacencyMap a -> OddCycle a
forall a. AdjacencyMap a -> [a]
AM.vertexList AdjacencyMap a
g ]
processVertex :: a -> MaybeT (StateT (Map a Part) Identity) (OddCycle a)
processVertex a
v = do Map a Part
m <- MaybeT (StateT (Map a Part) Identity) (Map a Part)
forall s (m :: * -> *). MonadState s m => m s
get
Bool -> MaybeT (StateT (Map a Part) Identity) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a -> Map a Part -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember a
v Map a Part
m)
Part -> a -> MaybeT (StateT (Map a Part) Identity) (OddCycle a)
inVertex Part
LeftPart a
v
inVertex :: Part -> a -> MaybeT (StateT (Map a Part) Identity) (OddCycle a)
inVertex Part
p a
v = ((:) a
v) (OddCycle a -> OddCycle a)
-> MaybeT (StateT (Map a Part) Identity) (OddCycle a)
-> MaybeT (StateT (Map a Part) Identity) (OddCycle a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do (Map a Part -> Map a Part)
-> MaybeT (StateT (Map a Part) Identity) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (a -> Part -> Map a Part -> Map a Part
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert a
v Part
p)
let q :: Part
q = Part -> Part
otherPart Part
p
[MaybeT (StateT (Map a Part) Identity) (OddCycle a)]
-> MaybeT (StateT (Map a Part) Identity) (OddCycle a)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ Part -> a -> MaybeT (StateT (Map a Part) Identity) (OddCycle a)
onEdge Part
q a
u | a
u <- Set a -> OddCycle a
forall a. Set a -> [a]
Set.toAscList (a -> AdjacencyMap a -> Set a
forall a. Ord a => a -> AdjacencyMap a -> Set a
AM.postSet a
v AdjacencyMap a
g) ]
{-# INLINE onEdge #-}
onEdge :: Part -> a -> MaybeT (StateT (Map a Part) Identity) (OddCycle a)
onEdge Part
p a
v = do Map a Part
m <- MaybeT (StateT (Map a Part) Identity) (Map a Part)
forall s (m :: * -> *). MonadState s m => m s
get
case a -> Map a Part -> Maybe Part
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
v Map a Part
m of
Maybe Part
Nothing -> Part -> a -> MaybeT (StateT (Map a Part) Identity) (OddCycle a)
inVertex Part
p a
v
Just Part
q -> do Bool -> MaybeT (StateT (Map a Part) Identity) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Part
p Part -> Part -> Bool
forall a. Eq a => a -> a -> Bool
/= Part
q)
OddCycle a -> MaybeT (StateT (Map a Part) Identity) (OddCycle a)
forall (m :: * -> *) a. Monad m => a -> m a
return [a
v]
toEither :: Map b Part -> b -> Either b b
toEither Map b Part
m b
v = case Maybe Part -> Part
forall a. HasCallStack => Maybe a -> a
fromJust (b -> Map b Part -> Maybe Part
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup b
v Map b Part
m) of
Part
LeftPart -> b -> Either b b
forall a b. a -> Either a b
Left b
v
Part
RightPart -> b -> Either b b
forall a b. b -> Either a b
Right b
v
oddCycle :: [a] -> [a]
oddCycle [a]
c = [a] -> [a]
forall a. [a] -> [a]
init ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= [a] -> a
forall a. [a] -> a
last [a]
c) [a]
c
consistent :: (Ord a, Ord b) => AdjacencyMap a b -> Bool
consistent :: AdjacencyMap a b -> Bool
consistent (BAM Map a (Set b)
lr Map b (Set a)
rl) = Map a (Set b) -> [(a, b)]
forall a b. Map a (Set b) -> [(a, b)]
edgeList Map a (Set b)
lr [(a, b)] -> [(a, b)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(a, b)] -> [(a, b)]
forall a. Ord a => [a] -> [a]
sort (((b, a) -> (a, b)) -> [(b, a)] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (b, a) -> (a, b)
forall a b. (a, b) -> (b, a)
Data.Tuple.swap ([(b, a)] -> [(a, b)]) -> [(b, a)] -> [(a, b)]
forall a b. (a -> b) -> a -> b
$ Map b (Set a) -> [(b, a)]
forall a b. Map a (Set b) -> [(a, b)]
edgeList Map b (Set a)
rl)
where
edgeList :: Map a (Set b) -> [(a, b)]
edgeList Map a (Set b)
lr = [ (a
u, b
v) | (a
u, Set b
vs) <- Map a (Set b) -> [(a, Set b)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set b)
lr, b
v <- Set b -> [b]
forall a. Set a -> [a]
Set.toAscList Set b
vs ]