-- Copyright (c) 2008-2011, David Amos. All rights reserved.


-- |A module defining a polymorphic data type for (simple, undirected) graphs,

-- together with constructions of some common families of graphs,

-- new from old constructions, and calculation of simple properties of graphs.

module Math.Combinatorics.Graph where

import qualified Data.List as L
import Data.Maybe (isJust)
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Arrow ( (&&&) )

import Math.Common.ListSet as LS
import Math.Core.Utils
import Math.Algebra.Group.PermutationGroup hiding (fromDigits, fromBinary)
import qualified Math.Algebra.Group.SchreierSims as SS

-- Main source: Godsil & Royle, Algebraic Graph Theory



-- COMBINATORICS

-- Some functions we'll use


set :: [b] -> [b]
set xs :: [b]
xs = ([b] -> b) -> [[b]] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map [b] -> b
forall a. [a] -> a
head ([[b]] -> [b]) -> [[b]] -> [b]
forall a b. (a -> b) -> a -> b
$ [b] -> [[b]]
forall a. Eq a => [a] -> [[a]]
L.group ([b] -> [[b]]) -> [b] -> [[b]]
forall a b. (a -> b) -> a -> b
$ [b] -> [b]
forall a. Ord a => [a] -> [a]
L.sort [b]
xs

-- subsets of a set (returned in "binary" order)

powerset :: [a] -> [[a]]
powerset [] = [[]]
powerset (x :: a
x:xs :: [a]
xs) = let p :: [[a]]
p = [a] -> [[a]]
powerset [a]
xs in [[a]]
p [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) [[a]]
p

-- GRAPH


-- |Datatype for graphs, represented as a list of vertices and a list of edges.

-- For most purposes, graphs are required to be in normal form.

-- A graph G vs es is in normal form if (i) vs is in ascending order without duplicates,

-- (ii) es is in ascending order without duplicates, (iii) each e in es is a 2-element list [x,y], x<y

data Graph a = G [a] [[a]] deriving (Graph a -> Graph a -> Bool
(Graph a -> Graph a -> Bool)
-> (Graph a -> Graph a -> Bool) -> Eq (Graph a)
forall a. Eq a => Graph a -> Graph a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Graph a -> Graph a -> Bool
$c/= :: forall a. Eq a => Graph a -> Graph a -> Bool
== :: Graph a -> Graph a -> Bool
$c== :: forall a. Eq a => Graph a -> Graph a -> Bool
Eq,Eq (Graph a)
Eq (Graph a) =>
(Graph a -> Graph a -> Ordering)
-> (Graph a -> Graph a -> Bool)
-> (Graph a -> Graph a -> Bool)
-> (Graph a -> Graph a -> Bool)
-> (Graph a -> Graph a -> Bool)
-> (Graph a -> Graph a -> Graph a)
-> (Graph a -> Graph a -> Graph a)
-> Ord (Graph a)
Graph a -> Graph a -> Bool
Graph a -> Graph a -> Ordering
Graph a -> Graph a -> Graph 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 (Graph a)
forall a. Ord a => Graph a -> Graph a -> Bool
forall a. Ord a => Graph a -> Graph a -> Ordering
forall a. Ord a => Graph a -> Graph a -> Graph a
min :: Graph a -> Graph a -> Graph a
$cmin :: forall a. Ord a => Graph a -> Graph a -> Graph a
max :: Graph a -> Graph a -> Graph a
$cmax :: forall a. Ord a => Graph a -> Graph a -> Graph a
>= :: Graph a -> Graph a -> Bool
$c>= :: forall a. Ord a => Graph a -> Graph a -> Bool
> :: Graph a -> Graph a -> Bool
$c> :: forall a. Ord a => Graph a -> Graph a -> Bool
<= :: Graph a -> Graph a -> Bool
$c<= :: forall a. Ord a => Graph a -> Graph a -> Bool
< :: Graph a -> Graph a -> Bool
$c< :: forall a. Ord a => Graph a -> Graph a -> Bool
compare :: Graph a -> Graph a -> Ordering
$ccompare :: forall a. Ord a => Graph a -> Graph a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Graph a)
Ord,Int -> Graph a -> ShowS
[Graph a] -> ShowS
Graph a -> String
(Int -> Graph a -> ShowS)
-> (Graph a -> String) -> ([Graph a] -> ShowS) -> Show (Graph a)
forall a. Show a => Int -> Graph a -> ShowS
forall a. Show a => [Graph a] -> ShowS
forall a. Show a => Graph a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Graph a] -> ShowS
$cshowList :: forall a. Show a => [Graph a] -> ShowS
show :: Graph a -> String
$cshow :: forall a. Show a => Graph a -> String
showsPrec :: Int -> Graph a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Graph a -> ShowS
Show)

instance Functor Graph where
    -- |If f is not order-preserving, then you should call nf afterwards

    fmap :: (a -> b) -> Graph a -> Graph b
fmap f :: a -> b
f (G vs :: [a]
vs es :: [[a]]
es) = [b] -> [[b]] -> Graph b
forall a. [a] -> [[a]] -> Graph a
G ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
vs) (([a] -> [b]) -> [[a]] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f) [[a]]
es)
-- could use DeriveFunctor to derive this Functor instance


-- |Convert a graph to normal form. The input is assumed to be a valid graph apart from order

nf :: Ord a => Graph a -> Graph a
nf :: Graph a -> Graph a
nf (G vs :: [a]
vs es :: [[a]]
es) = [a] -> [[a]] -> Graph a
forall a. [a] -> [[a]] -> Graph a
G [a]
vs' [[a]]
es' where
    vs' :: [a]
vs' = [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a]
vs
    es' :: [[a]]
es' = [[a]] -> [[a]]
forall a. Ord a => [a] -> [a]
L.sort (([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [[a]]
es)

-- we require that vs, es, and each individual e are sorted

isSetSystem :: [a] -> [[a]] -> Bool
isSetSystem xs :: [a]
xs bs :: [[a]]
bs = [a] -> Bool
forall a. Ord a => [a] -> Bool
isListSet [a]
xs Bool -> Bool -> Bool
&& [[a]] -> Bool
forall a. Ord a => [a] -> Bool
isListSet [[a]]
bs Bool -> Bool -> Bool
&& ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [a] -> Bool
forall a. Ord a => [a] -> Bool
isListSet [[a]]
bs Bool -> Bool -> Bool
&& ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`isSubset` [a]
xs) [[a]]
bs

isGraph :: [a] -> [[a]] -> Bool
isGraph vs :: [a]
vs es :: [[a]]
es = [a] -> [[a]] -> Bool
forall a. Ord a => [a] -> [[a]] -> Bool
isSetSystem [a]
vs [[a]]
es Bool -> Bool -> Bool
&& ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ( (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==2) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[a]]
es

-- |Safe constructor for graph from lists of vertices and edges.

-- graph (vs,es) checks that vs and es are valid before returning the graph.

graph :: (Ord t) => ([t], [[t]]) -> Graph t
graph :: ([t], [[t]]) -> Graph t
graph (vs :: [t]
vs,es :: [[t]]
es) | [t] -> [[t]] -> Bool
forall a. Ord a => [a] -> [[a]] -> Bool
isGraph [t]
vs [[t]]
es = [t] -> [[t]] -> Graph t
forall a. [a] -> [[a]] -> Graph a
G [t]
vs [[t]]
es
--              | otherwise = error ( "graph " ++ show (vs,es) )

-- isValid g = g where g = G vs es


toGraph :: ([a], [[a]]) -> Graph a
toGraph (vs :: [a]
vs,es :: [[a]]
es) | [a] -> [[a]] -> Bool
forall a. Ord a => [a] -> [[a]] -> Bool
isGraph [a]
vs' [[a]]
es' = [a] -> [[a]] -> Graph a
forall a. [a] -> [[a]] -> Graph a
G [a]
vs' [[a]]
es' where
    vs' :: [a]
vs' = [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a]
vs
    es' :: [[a]]
es' = [[a]] -> [[a]]
forall a. Ord a => [a] -> [a]
L.sort ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [[a]]
es
-- note that calling isListSet on a sorted list still checks that there are no duplicates


vertices :: Graph a -> [a]
vertices (G vs :: [a]
vs _) = [a]
vs

edges :: Graph a -> [[a]]
edges (G _ es :: [[a]]
es) = [[a]]
es


-- OTHER REPRESENTATIONS


-- incidence matrix of a graph

-- (rows and columns indexed by edges and vertices respectively)

-- (warning: in the literature it is often the other way round)

incidenceMatrix :: Graph a -> [[a]]
incidenceMatrix (G vs :: [a]
vs es :: [[a]]
es) = [ [if a
v a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
e then 1 else 0 | a
v <- [a]
vs] | [a]
e <- [[a]]
es]

fromIncidenceMatrix :: [[a]] -> Graph t
fromIncidenceMatrix m :: [[a]]
m = ([t], [[t]]) -> Graph t
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([t]
vs,[[t]]
es) where
    n :: t
n = [a] -> t
forall i a. Num i => [a] -> i
L.genericLength ([a] -> t) -> [a] -> t
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall a. [a] -> a
head [[a]]
m
    vs :: [t]
vs = [1..t
n]
    es :: [[t]]
es = [[t]] -> [[t]]
forall a. Ord a => [a] -> [a]
L.sort ([[t]] -> [[t]]) -> [[t]] -> [[t]]
forall a b. (a -> b) -> a -> b
$ ([a] -> [t]) -> [[a]] -> [[t]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [t]
forall a. (Eq a, Num a) => [a] -> [t]
edge [[a]]
m
    edge :: [a] -> [t]
edge row :: [a]
row = [t
v | (1,v :: t
v) <- [a] -> [t] -> [(a, t)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
row [t]
vs]

adjacencyMatrix :: Graph a -> [[a]]
adjacencyMatrix (G vs :: [a]
vs es :: [[a]]
es) =
    [ [if [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a
i,a
j] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
es' then 1 else 0 | a
j <- [a]
vs] | a
i <- [a]
vs]
    where es' :: Set [a]
es' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es

fromAdjacencyMatrix :: [[a]] -> Graph Int
fromAdjacencyMatrix m :: [[a]]
m = ([Int], [[Int]]) -> Graph Int
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([Int]
vs,[[Int]]
es) where
    n :: Int
n = [[a]] -> Int
forall i a. Num i => [a] -> i
L.genericLength [[a]]
m
    vs :: [Int]
vs = [1..Int
n]
    es :: [[Int]]
es = Int -> [[a]] -> [[Int]]
forall a. (Eq a, Num a) => Int -> [[a]] -> [[Int]]
es' 1 [[a]]
m
    es' :: Int -> [[a]] -> [[Int]]
es' i :: Int
i (r :: [a]
r:rs :: [[a]]
rs) = [ [Int
i,Int
j] | (j :: Int
j,1) <- Int -> [(Int, a)] -> [(Int, a)]
forall a. Int -> [a] -> [a]
drop Int
i ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
vs [a]
r)] [[Int]] -> [[Int]] -> [[Int]]
forall a. [a] -> [a] -> [a]
++ Int -> [[a]] -> [[Int]]
es' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [[a]]
rs
    es' _ [] = []

-- SOME SIMPLE FAMILIES OF GRAPHS


-- |The null graph on n vertices is the graph with no edges

nullGraph :: (Integral t) => t -> Graph t
nullGraph :: t -> Graph t
nullGraph n :: t
n = [t] -> [[t]] -> Graph t
forall a. [a] -> [[a]] -> Graph a
G [1..t
n] []

-- |The null graph, with no vertices or edges

nullGraph' :: Graph Int -- type signature needed

nullGraph' :: Graph Int
nullGraph' = [Int] -> [[Int]] -> Graph Int
forall a. [a] -> [[a]] -> Graph a
G [] []

-- |c n is the cyclic graph on n vertices

c :: (Integral t) => t -> Graph t
c :: t -> Graph t
c n :: t
n | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= 3 = ([t], [[t]]) -> Graph t
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([t]
vs,[[t]]
es) where
    vs :: [t]
vs = [1..t
n]
    es :: [[t]]
es = [t] -> [[t]] -> [[t]]
forall a. Ord a => a -> [a] -> [a]
L.insert [1,t
n] [[t
i,t
it -> t -> t
forall a. Num a => a -> a -> a
+1] | t
i <- [1..t
nt -> t -> t
forall a. Num a => a -> a -> a
-1]]
-- automorphism group is D2n


-- |k n is the complete graph on n vertices

k :: (Integral t) => t -> Graph t
k :: t -> Graph t
k n :: t
n = ([t], [[t]]) -> Graph t
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([t]
vs,[[t]]
es) where
    vs :: [t]
vs = [1..t
n]
    es :: [[t]]
es = [[t
i,t
j] | t
i <- [1..t
nt -> t -> t
forall a. Num a => a -> a -> a
-1], t
j <- [t
it -> t -> t
forall a. Num a => a -> a -> a
+1..t
n]] -- == combinationsOf 2 [1..n]

-- automorphism group is Sn


-- |kb m n is the complete bipartite graph on m and n vertices

kb :: (Integral t) => t -> t -> Graph t
kb :: t -> t -> Graph t
kb m :: t
m n :: t
n = Graph (Either t t) -> Graph t
forall t a. (Ord t, Num t, Enum t, Ord a) => Graph a -> Graph t
to1n (Graph (Either t t) -> Graph t) -> Graph (Either t t) -> Graph t
forall a b. (a -> b) -> a -> b
$ t -> t -> Graph (Either t t)
forall t. Integral t => t -> t -> Graph (Either t t)
kb' t
m t
n

-- |kb' m n is the complete bipartite graph on m left and n right vertices

kb' :: (Integral t) => t -> t -> Graph (Either t t)
kb' :: t -> t -> Graph (Either t t)
kb' m :: t
m n :: t
n = ([Either t t], [[Either t t]]) -> Graph (Either t t)
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([Either t t]
vs,[[Either t t]]
es) where
    vs :: [Either t t]
vs = (t -> Either t t) -> [t] -> [Either t t]
forall a b. (a -> b) -> [a] -> [b]
map t -> Either t t
forall a b. a -> Either a b
Left [1..t
m] [Either t t] -> [Either t t] -> [Either t t]
forall a. [a] -> [a] -> [a]
++ (t -> Either t t) -> [t] -> [Either t t]
forall a b. (a -> b) -> [a] -> [b]
map t -> Either t t
forall a b. b -> Either a b
Right [1..t
n]
    es :: [[Either t t]]
es = [ [t -> Either t t
forall a b. a -> Either a b
Left t
i, t -> Either t t
forall a b. b -> Either a b
Right t
j] | t
i <- [1..t
m], t
j <- [1..t
n] ]
-- automorphism group is Sm*Sn (plus a flip if m==n)


-- |q k is the graph of the k-cube

q :: (Integral t) => Int -> Graph t
q :: Int -> Graph t
q k :: Int
k = Graph [t] -> Graph t
forall a. Integral a => Graph [a] -> Graph a
fromBinary (Graph [t] -> Graph t) -> Graph [t] -> Graph t
forall a b. (a -> b) -> a -> b
$ Int -> Graph [t]
forall t. Integral t => Int -> Graph [t]
q' Int
k

q' :: (Integral t) => Int -> Graph [t]
q' :: Int -> Graph [t]
q' k :: Int
k = ([[t]], [[[t]]]) -> Graph [t]
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([[t]]
vs,[[[t]]]
es) where
    vs :: [[t]]
vs = [[t]] -> [[t]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([[t]] -> [[t]]) -> [[t]] -> [[t]]
forall a b. (a -> b) -> a -> b
$ Int -> [t] -> [[t]]
forall a. Int -> a -> [a]
replicate Int
k [0,1] -- ptsAn k f2

    es :: [[[t]]]
es = [ [[t]
u,[t]
v] | [u :: [t]
u,v :: [t]
v] <- Int -> [[t]] -> [[[t]]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [[t]]
vs, [t] -> [t] -> Int
forall a. Eq a => [a] -> [a] -> Int
hammingDistance [t]
u [t]
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 ]
    hammingDistance :: [a] -> [a] -> Int
hammingDistance as :: [a]
as bs :: [a]
bs = [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Bool] -> Int) -> [Bool] -> Int
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter Bool -> Bool
forall a. a -> a
id ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> [a] -> [a] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=) [a]
as [a]
bs
-- can probably type-coerce this to be Graph [F2] if required



tetrahedron :: Graph Integer
tetrahedron = Integer -> Graph Integer
forall t. Integral t => t -> Graph t
k 4

cube :: Graph Integer
cube = Int -> Graph Integer
forall t. Integral t => Int -> Graph t
q 3

octahedron :: Graph Integer
octahedron = ([Integer], [[Integer]]) -> Graph Integer
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([Integer]
vs,[[Integer]]
es) where
    vs :: [Integer]
vs = [1..6]
    es :: [[Integer]]
es = Int -> [Integer] -> [[Integer]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [Integer]
vs [[Integer]] -> [[Integer]] -> [[Integer]]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [[1,6],[2,5],[3,4]]

dodecahedron :: Graph Integer
dodecahedron = ([Integer], [[Integer]]) -> Graph Integer
forall t. Ord t => ([t], [[t]]) -> Graph t
toGraph ([Integer]
vs,[[Integer]]
es) where
    vs :: [Integer]
vs = [1..20]
    es :: [[Integer]]
es = [ [1,2],[2,3],[3,4],[4,5],[5,1],
           [6,7],[7,8],[8,9],[9,10],[10,11],[11,12],[12,13],[13,14],[14,15],[15,6],
           [16,17],[17,18],[18,19],[19,20],[20,16],
           [1,6],[2,8],[3,10],[4,12],[5,14],
           [7,16],[9,17],[11,18],[13,19],[15,20] ]

icosahedron :: Graph Integer
icosahedron = ([Integer], [[Integer]]) -> Graph Integer
forall t. Ord t => ([t], [[t]]) -> Graph t
toGraph ([Integer]
vs,[[Integer]]
es) where
    vs :: [Integer]
vs = [1..12]
    es :: [[Integer]]
es = [ [1,2],[1,3],[1,4],[1,5],[1,6],
           [2,3],[3,4],[4,5],[5,6],[6,2],
           [7,12],[8,12],[9,12],[10,12],[11,12],
           [7,8],[8,9],[9,10],[10,11],[11,7],
           [2,7],[7,3],[3,8],[8,4],[4,9],[9,5],[5,10],[10,6],[6,11],[11,2] ]


-- Prisms are regular, vertex-transitive, but not edge-transitive unless n == 1, 2, 4.

-- (prism 2 ~= q 2, prism 4 ~= q 3)

prism :: Int -> Graph (Int,Int)
prism :: Int -> Graph (Int, Int)
prism n :: Int
n = Int -> Graph Int
forall t. Integral t => t -> Graph t
k 2 Graph Int -> Graph Int -> Graph (Int, Int)
forall a a. (Ord a, Ord a) => Graph a -> Graph a -> Graph (a, a)
`cartProd` Int -> Graph Int
forall t. Integral t => t -> Graph t
c Int
n


-- convert a graph to have [1..n] as vertices

to1n :: Graph a -> Graph t
to1n (G vs :: [a]
vs es :: [[a]]
es) = ([t], [[t]]) -> Graph t
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([t]
vs',[[t]]
es') where
    mapping :: Map a t
mapping = [(a, t)] -> Map a t
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, t)] -> Map a t) -> [(a, t)] -> Map a t
forall a b. (a -> b) -> a -> b
$ [a] -> [t] -> [(a, t)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
vs [1..] -- the mapping from vs to [1..n]

    vs' :: [t]
vs' = Map a t -> [t]
forall k a. Map k a -> [a]
M.elems Map a t
mapping
    es' :: [[t]]
es' = [(a -> t) -> [a] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (Map a t
mapping Map a t -> a -> t
forall k a. Ord k => Map k a -> k -> a
M.!) [a]
e | [a]
e <- [[a]]
es] -- the edges will already be sorted correctly by construction


-- |Given a graph with vertices which are lists of small integers, eg [1,2,3],

-- return a graph with vertices which are the numbers obtained by interpreting these as digits, eg 123.

-- The caller is responsible for ensuring that this makes sense (eg that the small integers are all < 10)

fromDigits :: Integral a => Graph [a] -> Graph a
fromDigits :: Graph [a] -> Graph a
fromDigits = ([a] -> a) -> Graph [a] -> Graph a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall p. Num p => [p] -> p
fromDigits'
{-
fromDigits (G vs es) = graph (vs',es') where
    vs' = map fromDigits' vs
    es' = (map . map) fromDigits' es
-}

-- |Given a graph with vertices which are lists of 0s and 1s,

-- return a graph with vertices which are the numbers obtained by interpreting these as binary digits.

-- For example, [1,1,0] -> 6.

fromBinary :: Integral a => Graph [a] -> Graph a
fromBinary :: Graph [a] -> Graph a
fromBinary = ([a] -> a) -> Graph [a] -> Graph a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall p. Num p => [p] -> p
fromBinary'
{-
fromBinary (G vs es) = graph (vs',es') where
    vs' = map fromBinary' vs
    es' = (map . map) fromBinary' es
-}

petersen :: Graph [Integer]
petersen :: Graph [Integer]
petersen = ([[Integer]], [[[Integer]]]) -> Graph [Integer]
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([[Integer]]
vs,[[[Integer]]]
es) where
    vs :: [[Integer]]
vs = Int -> [Integer] -> [[Integer]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [1..5]
    es :: [[[Integer]]]
es = [ [[Integer]
v1,[Integer]
v2] | [v1 :: [Integer]
v1,v2 :: [Integer]
v2] <- Int -> [[Integer]] -> [[[Integer]]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [[Integer]]
vs, [Integer] -> [Integer] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
disjoint [Integer]
v1 [Integer]
v2]
-- == kneser 5 2 == j 5 2 0

-- == complement $ lineGraph' $ k 5

-- == complement $ t' 5



-- NEW GRAPHS FROM OLD


complement :: (Ord t) => Graph t -> Graph t
complement :: Graph t -> Graph t
complement (G vs :: [t]
vs es :: [[t]]
es) = ([t], [[t]]) -> Graph t
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([t]
vs,[[t]]
es') where es' :: [[t]]
es' = Int -> [t] -> [[t]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [t]
vs [[t]] -> [[t]] -> [[t]]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [[t]]
es
-- es' = [e | e <- combinationsOf 2 vs, e `notElem` es]


-- |The restriction of a graph to a subset of the vertices

restriction :: (Eq a) => Graph a -> [a] -> Graph a
restriction :: Graph a -> [a] -> Graph a
restriction g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) us :: [a]
us = [a] -> [[a]] -> Graph a
forall a. [a] -> [[a]] -> Graph a
G [a]
us ([[a]]
es [[a]] -> [a] -> [[a]]
forall (t :: * -> *) a. (Foldable t, Eq a) => [[a]] -> t a -> [[a]]
`restrict` [a]
us)
    where es :: [[a]]
es restrict :: [[a]] -> t a -> [[a]]
`restrict` us :: t a
us = [[a]
e | e :: [a]
e@[i :: a
i,j :: a
j] <- [[a]]
es, a
i a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
us, a
j a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
us]

inducedSubgraph :: (Eq a) => Graph a -> [a] -> Graph a
inducedSubgraph :: Graph a -> [a] -> Graph a
inducedSubgraph g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) us :: [a]
us = [a] -> [[a]] -> Graph a
forall a. [a] -> [[a]] -> Graph a
G [a]
us ([[a]]
es [[a]] -> [a] -> [[a]]
forall (t :: * -> *) a. (Foldable t, Eq a) => [[a]] -> t a -> [[a]]
`restrict` [a]
us)
    where es :: [[a]]
es restrict :: [[a]] -> t a -> [[a]]
`restrict` us :: t a
us = [[a]
e | e :: [a]
e@[i :: a
i,j :: a
j] <- [[a]]
es, a
i a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
us, a
j a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
us]

lineGraph :: Graph a -> Graph t
lineGraph g :: Graph a
g = Graph [a] -> Graph t
forall t a. (Ord t, Num t, Enum t, Ord a) => Graph a -> Graph t
to1n (Graph [a] -> Graph t) -> Graph [a] -> Graph t
forall a b. (a -> b) -> a -> b
$ Graph a -> Graph [a]
forall a. Ord a => Graph a -> Graph [a]
lineGraph' Graph a
g

lineGraph' :: Graph a -> Graph [a]
lineGraph' (G vs :: [a]
vs es :: [[a]]
es) = ([[a]], [[[a]]]) -> Graph [a]
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([[a]]
es, [ [[a]
ei,[a]
ej] | [a]
ei <- [[a]]
es, [a]
ej <- ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ([a] -> [a] -> Bool
forall a. Ord a => a -> a -> Bool
<= [a]
ei) [[a]]
es, [a]
ei [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
`intersect` [a]
ej [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] ])


-- For example cartProd (c m) (c n) is a wireframe for a torus

-- cartProd (q m) (q n) `isGraphIso` q (m+n)

-- Godsil and Royle p154

cartProd :: Graph a -> Graph a -> Graph (a, a)
cartProd (G vs :: [a]
vs es :: [[a]]
es) (G vs' :: [a]
vs' es' :: [[a]]
es') = [(a, a)] -> [[(a, a)]] -> Graph (a, a)
forall a. [a] -> [[a]] -> Graph a
G [(a, a)]
us [[(a, a)]
e | e :: [(a, a)]
e@[u :: (a, a)
u,u' :: (a, a)
u'] <- Int -> [(a, a)] -> [[(a, a)]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [(a, a)]
us, (a, a)
u (a, a) -> (a, a) -> Bool
`adj` (a, a)
u' ]
    where us :: [(a, a)]
us = [(a
v,a
v') | a
v <- [a]
vs, a
v' <- [a]
vs']
          eset :: Set [a]
eset = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es
          eset' :: Set [a]
eset' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es'
          adj :: (a, a) -> (a, a) -> Bool
adj (x1 :: a
x1,y1 :: a
y1) (x2 :: a
x2,y2 :: a
y2) = a
x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x2 Bool -> Bool -> Bool
&& [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a
y1,a
y2] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
eset'
                             Bool -> Bool -> Bool
|| a
y1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y2 Bool -> Bool -> Bool
&& [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a
x1,a
x2] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
eset


-- SIMPLE PROPERTIES OF GRAPHS


order :: Graph a -> Int
order = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> (Graph a -> [a]) -> Graph a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> [a]
forall a. Graph a -> [a]
vertices

size :: Graph a -> Int
size = [[a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[a]] -> Int) -> (Graph a -> [[a]]) -> Graph a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> [[a]]
forall a. Graph a -> [[a]]
edges

-- also called degree

valency :: Graph a -> a -> Int
valency (G vs :: [a]
vs es :: [[a]]
es) v :: a
v = [[a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[a]] -> Int) -> [[a]] -> Int
forall a b. (a -> b) -> a -> b
$ ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (a
v a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) [[a]]
es

valencies :: Graph a -> [(Int, Int)]
valencies g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) = ([Int] -> (Int, Int)) -> [[Int]] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> ([Int] -> Int) -> [Int] -> (Int, Int)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[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
$ (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Graph a -> a -> Int
forall a. Eq a => Graph a -> a -> Int
valency Graph a
g) [a]
vs

valencyPartition :: Graph b -> [[b]]
valencyPartition g :: Graph b
g@(G vs :: [b]
vs es :: [[b]]
es) = ([(Int, b)] -> [b]) -> [[(Int, b)]] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, b) -> b) -> [(Int, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Int, b) -> b
forall a b. (a, b) -> b
snd) ([[(Int, b)]] -> [[b]]) -> [[(Int, b)]] -> [[b]]
forall a b. (a -> b) -> a -> b
$ ((Int, b) -> (Int, b) -> Bool) -> [(Int, b)] -> [[(Int, b)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (\x :: (Int, b)
x y :: (Int, b)
y -> (Int, b) -> Int
forall a b. (a, b) -> a
fst (Int, b)
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, b) -> Int
forall a b. (a, b) -> a
fst (Int, b)
y) [(Graph b -> b -> Int
forall a. Eq a => Graph a -> a -> Int
valency Graph b
g b
v, b
v) | b
v <- [b]
vs]

regularParam :: Graph a -> Maybe Int
regularParam g :: Graph a
g =
    case Graph a -> [(Int, Int)]
forall a. Eq a => Graph a -> [(Int, Int)]
valencies Graph a
g of
    [(v :: Int
v,_)] -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
v
    _       -> Maybe Int
forall a. Maybe a
Nothing

-- |A graph is regular if all vertices have the same valency (degree)

isRegular :: (Eq t) => Graph t -> Bool
isRegular :: Graph t -> Bool
isRegular g :: Graph t
g = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ Graph t -> Maybe Int
forall a. Eq a => Graph a -> Maybe Int
regularParam Graph t
g

-- |A 3-regular graph is called a cubic graph

isCubic :: (Eq t) => Graph t -> Bool
isCubic :: Graph t -> Bool
isCubic g :: Graph t
g = Graph t -> Maybe Int
forall a. Eq a => Graph a -> Maybe Int
regularParam Graph t
g Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just 3


nbrs :: Graph a -> a -> [a]
nbrs (G vs :: [a]
vs es :: [[a]]
es) v :: a
v = [a
u | [u :: a
u,v' :: a
v'] <- [[a]]
es, a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v']
                [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
w | [v' :: a
v',w :: a
w] <- [[a]]
es, a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v']
-- if the graph is valid, then the neighbours will be returned in ascending order



-- find paths from x to y using bfs

-- by definition, a path is a subgraph isomorphic to a "line" - it can't have self-crossings

-- (a walk allows self-crossings, a trail allows self-crossings but no edge reuse)

findPaths :: Graph a -> a -> a -> [[a]]
findPaths g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) x :: a
x y :: a
y = ([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]] -> [[a]]
bfs [ [a
x] ] where
    bfs :: [[a]] -> [[a]]
bfs ((z :: a
z:zs :: [a]
zs) : nodes :: [[a]]
nodes)
        | a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y    = (a
za -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
bfs [[a]]
nodes
        | Bool
otherwise = [[a]] -> [[a]]
bfs ([[a]]
nodes [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [(a
wa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
za -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs) | a
w <- Graph a -> a -> [a]
forall a. Eq a => Graph a -> a -> [a]
nbrs Graph a
g a
z, a
w a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
zs])
    bfs [] = []

-- |Within a graph G, the distance d(u,v) between vertices u, v is length of the shortest path from u to v

distance :: (Eq a) => Graph a -> a -> a -> Int
distance :: Graph a -> a -> a -> Int
distance g :: Graph a
g x :: a
x y :: a
y =
    case Graph a -> a -> a -> [[a]]
forall a. Eq a => Graph a -> a -> a -> [[a]]
findPaths Graph a
g a
x a
y of
    [] -> -1 -- infinite

    p :: [a]
p:ps :: [[a]]
ps -> [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1

-- |The diameter of a graph is maximum distance between two distinct vertices

diameter :: (Ord t) => Graph t -> Int
diameter :: Graph t -> Int
diameter g :: Graph t
g@(G vs :: [t]
vs es :: [[t]]
es)
    | Graph t -> Bool
forall t. Ord t => Graph t -> Bool
isConnected Graph t
g = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (t -> Int) -> [t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map t -> Int
maxDistance [t]
vs
    | Bool
otherwise = -1
    where maxDistance :: t -> Int
maxDistance v :: t
v = [[t]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Graph t -> t -> [[t]]
forall a. Ord a => Graph a -> a -> [[a]]
distancePartition Graph t
g t
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1

-- find cycles starting at x

-- by definition, a cycle is a subgraph isomorphic to a cyclic graph - it can't have self-crossings

-- (a circuit allows self-crossings but not edge reuse)

findCycles :: Graph a -> a -> [[a]]
findCycles g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) x :: a
x = [[a] -> [a]
forall a. [a] -> [a]
reverse (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
za -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs) | z :: a
z:zs :: [a]
zs <- [[a]] -> [[a]]
bfs [ [a
x] ], a
z a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
nbrsx, [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
zs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1] where
    nbrsx :: [a]
nbrsx = Graph a -> a -> [a]
forall a. Eq a => Graph a -> a -> [a]
nbrs Graph a
g a
x
    bfs :: [[a]] -> [[a]]
bfs ((z :: a
z:zs :: [a]
zs) : nodes :: [[a]]
nodes) = (a
za -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
bfs ([[a]]
nodes [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [ a
wa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
za -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs | a
w <- Graph a -> a -> [a]
forall a. Eq a => Graph a -> a -> [a]
nbrs Graph a
g a
z, a
w a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
zs])
    bfs [] = []

-- |The girth of a graph is the size of the smallest cycle that it contains.

-- Note: If the graph contains no cycles, we return -1, representing infinity.

girth :: (Eq t) => Graph t -> Int
girth :: Graph t -> Int
girth g :: Graph t
g@(G vs :: [t]
vs es :: [[t]]
es) = [Int] -> Int
forall p. (Ord p, Num p) => [p] -> p
minimum' ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (t -> Int) -> [t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map t -> Int
minCycle [t]
vs where
    minimum' :: [p] -> p
minimum' xs :: [p]
xs = let (zs :: [p]
zs,nzs :: [p]
nzs) = (p -> Bool) -> [p] -> ([p], [p])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (p -> p -> Bool
forall a. Eq a => a -> a -> Bool
==0) [p]
xs in if [p] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [p]
nzs then -1 else [p] -> p
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [p]
nzs
    minCycle :: t -> Int
minCycle v :: t
v = case Graph t -> t -> [[t]]
forall a. Eq a => Graph a -> a -> [[a]]
findCycles Graph t
g t
v of
                 [] -> 0
                 c :: [t]
c:cs :: [[t]]
cs -> [t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [t]
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 -- because v occurs twice in c, as startpoint and endpoint


-- circumference = max cycle - Bollobas p104


-- Vertices that are not in the same component as the start vertex all go into a final cell

distancePartition :: Graph a -> a -> [[a]]
distancePartition g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) v :: a
v = [a] -> Set [a] -> a -> [[a]]
forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
distancePartitionS [a]
vs ([[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es) a
v

distancePartitionS :: [a] -> Set [a] -> a -> [[a]]
distancePartitionS vs :: [a]
vs eset :: Set [a]
eset v :: a
v = Set a -> Set a -> [[a]]
distancePartition' (a -> Set a
forall a. a -> Set a
S.singleton a
v) (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.delete a
v ([a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList [a]
vs)) where
    distancePartition' :: Set a -> Set a -> [[a]]
distancePartition' boundary :: Set a
boundary exterior :: Set a
exterior
        | Set a -> Bool
forall a. Set a -> Bool
S.null Set a
boundary = if Set a -> Bool
forall a. Set a -> Bool
S.null Set a
exterior then [] else [Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
exterior] -- graph may not have been connected

        | Bool
otherwise = let (boundary' :: Set a
boundary', exterior' :: Set a
exterior') = (a -> Bool) -> Set a -> (Set a, Set a)
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
S.partition (\v :: a
v -> ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
eset) [[a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a
u,a
v] | a
u <- Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
boundary]) Set a
exterior
                      in Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
boundary [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Set a -> Set a -> [[a]]
distancePartition' Set a
boundary' Set a
exterior'

-- the connected component to which v belongs

component :: Graph a -> a -> [a]
component g :: Graph a
g v :: a
v = Set a -> Set a -> [a]
component' Set a
forall a. Set a
S.empty (a -> Set a
forall a. a -> Set a
S.singleton a
v) where
    component' :: Set a -> Set a -> [a]
component' interior :: Set a
interior boundary :: Set a
boundary
        | Set a -> Bool
forall a. Set a -> Bool
S.null Set a
boundary = Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
interior
        | Bool
otherwise = let interior' :: Set a
interior' = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
interior Set a
boundary
                          boundary' :: Set a
boundary' = (Set a -> Set a -> Set a) -> Set a -> [Set a] -> Set a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
forall a. Set a
S.empty [[a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList (Graph a -> a -> [a]
forall a. Eq a => Graph a -> a -> [a]
nbrs Graph a
g a
x) | a
x <- Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
boundary] Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.\\ Set a
interior'
                      in Set a -> Set a -> [a]
component' Set a
interior' Set a
boundary'
-- TODO: This can almost certainly be made more efficient.

-- nbrs is O(n), and this calls it for each vertex in the component, so it is O(n^2)


-- |Is the graph connected?

isConnected :: (Ord t) => Graph t -> Bool
isConnected :: Graph t -> Bool
isConnected g :: Graph t
g@(G (v :: t
v:vs :: [t]
vs) es :: [[t]]
es) = [t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Graph t -> t -> [t]
forall a. Ord a => Graph a -> a -> [a]
component Graph t
g t
v) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (t
vt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
vs)
isConnected (G [] []) = Bool
True

components :: Graph a -> [[a]]
components g :: Graph a
g = [a] -> [[a]]
components' (Graph a -> [a]
forall a. Graph a -> [a]
vertices Graph a
g)
    where components' :: [a] -> [[a]]
components' [] = []
          components' (v :: a
v:vs :: [a]
vs) = let c :: [a]
c = Graph a -> a -> [a]
forall a. Ord a => Graph a -> a -> [a]
component Graph a
g a
v in [a]
c [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
components' ([a]
vs [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
c)


-- MORE GRAPHS


-- Generalized Johnson graph, Godsil & Royle p9

-- Also called generalised Kneser graph, http://en.wikipedia.org/wiki/Kneser_graph

j :: Int -> Int -> Int -> Graph [Int]
j v :: Int
v k :: Int
k i :: Int
i | Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i
    = ([[Int]], [[[Int]]]) -> Graph [Int]
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([[Int]]
vs,[[[Int]]]
es) where
        vs :: [[Int]]
vs = Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
k [1..Int
v]
        es :: [[[Int]]]
es = [ [[Int]
v1,[Int]
v2] | [v1 :: [Int]
v1,v2 :: [Int]
v2] <- Int -> [[Int]] -> [[[Int]]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [[Int]]
vs, [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int]
v1 [Int] -> [Int] -> [Int]
forall a. Ord a => [a] -> [a] -> [a]
`intersect` [Int]
v2) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i ]
-- j v k i is isomorphic to j v (v-k) (v-2k+i), so may as well have v >= 2k


-- kneser v k | v >= 2*k = j v k 0

-- |kneser n k returns the kneser graph KG n,k -

-- whose vertices are the k-element subsets of [1..n], with edges between disjoint subsets

kneser :: Int -> Int -> Graph [Int]
kneser :: Int -> Int -> Graph [Int]
kneser n :: Int
n k :: Int
k | 2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n = ([[Int]], [[[Int]]]) -> Graph [Int]
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([[Int]]
vs,[[[Int]]]
es) where
    vs :: [[Int]]
vs = Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
k [1..Int
n]
    es :: [[[Int]]]
es = [ [[Int]
v1,[Int]
v2] | [v1 :: [Int]
v1,v2 :: [Int]
v2] <- Int -> [[Int]] -> [[[Int]]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [[Int]]
vs, [Int] -> [Int] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
disjoint [Int]
v1 [Int]
v2]

johnson :: Int -> Int -> Graph [Int]
johnson v :: Int
v k :: Int
k | Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
k = Int -> Int -> Int -> Graph [Int]
j Int
v Int
k (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)


bipartiteKneser :: Int -> Int -> Graph (Either [Int] [Int])
bipartiteKneser n :: Int
n k :: Int
k | 2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = ([Either [Int] [Int]], [[Either [Int] [Int]]])
-> Graph (Either [Int] [Int])
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([Either [Int] [Int]]
vs,[[Either [Int] [Int]]]
es) where
    vs :: [Either [Int] [Int]]
vs = ([Int] -> Either [Int] [Int]) -> [[Int]] -> [Either [Int] [Int]]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Either [Int] [Int]
forall a b. a -> Either a b
Left (Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
k [1..Int
n])
      [Either [Int] [Int]]
-> [Either [Int] [Int]] -> [Either [Int] [Int]]
forall a. [a] -> [a] -> [a]
++ ([Int] -> Either [Int] [Int]) -> [[Int]] -> [Either [Int] [Int]]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Either [Int] [Int]
forall a b. b -> Either a b
Right (Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) [1..Int
n])
    es :: [[Either [Int] [Int]]]
es = [ [[Int] -> Either [Int] [Int]
forall a b. a -> Either a b
Left [Int]
u, [Int] -> Either [Int] [Int]
forall a b. b -> Either a b
Right [Int]
v] | [Int]
u <- Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
k [1..Int
n], [Int]
v <- Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) [1..Int
n], [Int]
u [Int] -> [Int] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`isSubset` [Int]
v]

desargues1 :: Graph (Either [Int] [Int])
desargues1 = Int -> Int -> Graph (Either [Int] [Int])
bipartiteKneser 5 2


-- Generalised Petersen graphs

-- http://en.wikipedia.org/wiki/Petersen_graph

gp :: b -> b -> Graph (Either b b)
gp n :: b
n k :: b
k | 2b -> b -> b
forall a. Num a => a -> a -> a
*b
k b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
n = ([Either b b], [[Either b b]]) -> Graph (Either b b)
forall t. Ord t => ([t], [[t]]) -> Graph t
toGraph ([Either b b]
vs,[[Either b b]]
es) where
    vs :: [Either b b]
vs = (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 [0..b
nb -> b -> b
forall a. Num a => a -> a -> a
-1] [Either b b] -> [Either b b] -> [Either b b]
forall a. [a] -> [a] -> [a]
++ (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 [0..b
nb -> b -> b
forall a. Num a => a -> a -> a
-1]
    es :: [[Either b b]]
es = (([b] -> [Either b b]) -> [[b]] -> [[Either b b]]
forall a b. (a -> b) -> [a] -> [b]
map (([b] -> [Either b b]) -> [[b]] -> [[Either b b]])
-> ((b -> Either b b) -> [b] -> [Either b b])
-> (b -> Either b b)
-> [[b]]
-> [[Either b b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
i, (b
ib -> b -> b
forall a. Num a => a -> a -> a
+1) b -> b -> b
forall a. Integral a => a -> a -> a
`mod` b
n] | b
i <- [0..b
nb -> b -> b
forall a. Num a => a -> a -> a
-1] ]
      [[Either b b]] -> [[Either b b]] -> [[Either b b]]
forall a. [a] -> [a] -> [a]
++ [ [b -> Either b b
forall a b. a -> Either a b
Left b
i, b -> Either b b
forall a b. b -> Either a b
Right b
i] | b
i <- [0..b
nb -> b -> b
forall a. Num a => a -> a -> a
-1] ]
      [[Either b b]] -> [[Either b b]] -> [[Either b b]]
forall a. [a] -> [a] -> [a]
++ (([b] -> [Either b b]) -> [[b]] -> [[Either b b]]
forall a b. (a -> b) -> [a] -> [b]
map (([b] -> [Either b b]) -> [[b]] -> [[Either b b]])
-> ((b -> Either b b) -> [b] -> [Either b b])
-> (b -> Either b b)
-> [[b]]
-> [[Either b b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
i, (b
ib -> b -> b
forall a. Num a => a -> a -> a
+b
k) b -> b -> b
forall a. Integral a => a -> a -> a
`mod` b
n] | b
i <- [0..b
nb -> b -> b
forall a. Num a => a -> a -> a
-1] ]

petersen2 :: Graph (Either Integer Integer)
petersen2 = Integer -> Integer -> Graph (Either Integer Integer)
forall t. Integral t => t -> t -> Graph (Either t t)
gp 5 2
prism' :: b -> Graph (Either b b)
prism' n :: b
n = b -> b -> Graph (Either b b)
forall t. Integral t => t -> t -> Graph (Either t t)
gp b
n 1
durer :: Graph (Either Integer Integer)
durer = Integer -> Integer -> Graph (Either Integer Integer)
forall t. Integral t => t -> t -> Graph (Either t t)
gp 6 2
mobiusKantor :: Graph (Either Integer Integer)
mobiusKantor = Integer -> Integer -> Graph (Either Integer Integer)
forall t. Integral t => t -> t -> Graph (Either t t)
gp 8 3
dodecahedron2 :: Graph (Either Integer Integer)
dodecahedron2 = Integer -> Integer -> Graph (Either Integer Integer)
forall t. Integral t => t -> t -> Graph (Either t t)
gp 10 2
desargues2 :: Graph (Either Integer Integer)
desargues2 = Integer -> Integer -> Graph (Either Integer Integer)
forall t. Integral t => t -> t -> Graph (Either t t)
gp 10 3