    -- 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