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

    -- |A module defining various strongly regular graphs, including the Clebsch, Hoffman-Singleton, Higman-Sims, and McLaughlin graphs.

    --

    -- A strongly regular graph with parameters (n,k,lambda,mu) is a (simple) graph with n vertices,

    -- in which the number of common neighbours of x and y is k, lambda or mu according as whether

    -- x and y are equal, adjacent, or non-adjacent. (In particular, it is a k-regular graph.)

    --

    -- Strongly regular graphs are highly symmetric, and have large automorphism groups.

    module Math.Combinatorics.StronglyRegularGraph where

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

    import Math.Common.ListSet
    import Math.Core.Utils (combinationsOf)
    import Math.Algebra.Group.PermutationGroup hiding (P)
    import Math.Algebra.Group.SchreierSims as SS
    import Math.Combinatorics.Graph as G hiding (G)
    import Math.Combinatorics.GraphAuts
    import Math.Combinatorics.Design as D
    import Math.Algebra.LinearAlgebra -- hiding (t)

    import Math.Algebra.Field.Base -- for F2

    import Math.Combinatorics.FiniteGeometry

    -- Sources

    -- Godsil & Royle, Algebraic Graph Theory

    -- Cameron & van Lint, Designs, Graphs, Codes and their Links

    -- van Lint & Wilson, A Course in Combinatorics, 2nd ed

    -- STRONGLY REGULAR GRAPHS

    -- strongly regular graphs

    srgParams :: Graph a -> Maybe (Int, Int, Int, Int)
    srgParams g :: Graph a
    g
        | [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[a]]
    es = [Char] -> Maybe (Int, Int, Int, Int)
    forall a. HasCallStack => [Char] -> a
    error "srgParams: not defined for null graph"
        | [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[a]]
    es' = [Char] -> Maybe (Int, Int, Int, Int)
    forall a. HasCallStack => [Char] -> a
    error "srgParams: not defined for complete graph"
        | Bool
    otherwise =
            if (Int -> Bool) -> [Int] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    k) [Int]
    ks Bool -> Bool -> Bool
    && (Int -> Bool) -> [Int] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    lambda) [Int]
    ls Bool -> Bool -> Bool
    && (Int -> Bool) -> [Int] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    mu) [Int]
    ms
            then (Int, Int, Int, Int) -> Maybe (Int, Int, Int, Int)
    forall a. a -> Maybe a
    Just (Int
    n,Int
    k,Int
    lambda,Int
    mu)
            else Maybe (Int, Int, Int, Int)
    forall a. Maybe a
    Nothing
        where vs :: [a]
    vs = Graph a -> [a]
    forall a. Graph a -> [a]
    vertices Graph a
    g
              n :: Int
    n = [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    vs
              es :: [[a]]
    es = Graph a -> [[a]]
    forall a. Graph a -> [[a]]
    edges Graph a
    g
              es' :: [[a]]
    es' = Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 2 [a]
    vs [[a]] -> [[a]] -> [[a]]
    forall a. Ord a => [a] -> [a] -> [a]
    \\ [[a]]
    es -- the non-edges

              k :: Int
    k:ks :: [Int]
    ks = (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
              lambda :: Int
    lambda:ls :: [Int]
    ls = ([a] -> Int) -> [[a]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ([a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([a] -> Int) -> ([a] -> [a]) -> [a] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [a]
    commonNbrs) [[a]]
    es  -- common neighbours of adjacent vertices

              mu :: Int
    mu:ms :: [Int]
    ms = ([a] -> Int) -> [[a]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ([a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([a] -> Int) -> ([a] -> [a]) -> [a] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [a]
    commonNbrs) [[a]]
    es' -- common neighbours of non-adjacent vertices

              commonNbrs :: [a] -> [a]
    commonNbrs [v1 :: a
    v1,v2 :: a
    v2] = (Map a [a]
    nbrs_g Map a [a] -> a -> [a]
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    v1) [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    `intersect` (Map a [a]
    nbrs_g Map a [a] -> a -> [a]
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    v2)
              nbrs_g :: Map a [a]
    nbrs_g = [(a, [a])] -> Map a [a]
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [ (a
    v, Graph a -> a -> [a]
    forall a. Eq a => Graph a -> a -> [a]
    nbrs Graph a
    g a
    v) | a
    v <- [a]
    vs ]

    isSRG :: Graph a -> Bool
    isSRG g :: Graph a
    g = Maybe (Int, Int, Int, Int) -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe (Int, Int, Int, Int) -> Bool)
    -> Maybe (Int, Int, Int, Int) -> Bool
    forall a b. (a -> b) -> a -> b
    $ Graph a -> Maybe (Int, Int, Int, Int)
    forall a. Ord a => Graph a -> Maybe (Int, Int, Int, Int)
    srgParams Graph a
    g

    -- SIMPLE EXAMPLES

    -- Triangular graph - van Lint & Wilson p262

    -- http://mathworld.wolfram.com/TriangularGraph.html

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

    t :: a -> Graph [a]
    t m :: a
    m | a
    m a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 4 = ([[a]], [[[a]]]) -> Graph [a]
    forall t. Ord t => ([t], [[t]]) -> Graph t
    graph ([[a]]
    vs,[[[a]]]
    es) where
        vs :: [[a]]
    vs = Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 2 [1..a
    m]
        es :: [[[a]]]
    es = [ [[a]
    v,[a]
    v'] | [a]
    v <- [[a]]
    vs, [a]
    v' <- ([a] -> Bool) -> [[a]] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile ([a] -> [a] -> Bool
    forall a. Ord a => a -> a -> Bool
    <= [a]
    v) [[a]]
    vs, Bool -> Bool
    not ([a] -> [a] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    disjoint [a]
    v [a]
    v')]
    -- This is just lineGraph (k m), by another name

    -- Lattice graph - van Lint & Wilson p262

    -- http://mathworld.wolfram.com/LatticeGraph.html

    l2' :: b -> Graph t
    l2' m :: b
    m = Graph (b, b) -> Graph t
    forall t a. (Ord t, Num t, Enum t, Ord a) => Graph a -> Graph t
    G.to1n (Graph (b, b) -> Graph t) -> Graph (b, b) -> Graph t
    forall a b. (a -> b) -> a -> b
    $ b -> Graph (b, b)
    forall b. (Num b, Enum b, Ord b) => b -> Graph (b, b)
    l2 b
    m

    l2 :: b -> Graph (b, b)
    l2 m :: b
    m | b
    m b -> b -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 2 = ([(b, b)], [[(b, b)]]) -> Graph (b, b)
    forall t. Ord t => ([t], [[t]]) -> Graph t
    graph ([(b, b)]
    vs,[[(b, b)]]
    es) where
        vs :: [(b, b)]
    vs = [ (b
    i,b
    j) | b
    i <- [1..b
    m], b
    j <- [1..b
    m] ]
        es :: [[(b, b)]]
    es = [ [(b, b)
    v,(b, b)
    v'] | v :: (b, b)
    v@(i :: b
    i,j :: b
    j) <- [(b, b)]
    vs, v' :: (b, b)
    v'@(i' :: b
    i',j' :: b
    j') <- ((b, b) -> Bool) -> [(b, b)] -> [(b, b)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile ((b, b) -> (b, b) -> Bool
    forall a. Ord a => a -> a -> Bool
    <= (b, b)
    v) [(b, b)]
    vs, b
    i b -> b -> Bool
    forall a. Eq a => a -> a -> Bool
    == b
    i' Bool -> Bool -> Bool
    || b
    j b -> b -> Bool
    forall a. Eq a => a -> a -> Bool
    == b
    j']
    -- This is lineGraph (kb m m)

    -- Automorphism group is Sm * Sm * C2

    -- via i -> ig, j -> jg, i <-> j

    paleyGraph :: [t] -> Graph t
    paleyGraph fq :: [t]
    fq | [t] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [t]
    fq Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` 4 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 = ([t], [[t]]) -> Graph t
    forall t. Ord t => ([t], [[t]]) -> Graph t
    graph ([t]
    vs,[[t]]
    es) where
        vs :: [t]
    vs = [t]
    fq
        qs :: [t]
    qs = [t] -> [t]
    forall b. Ord b => [b] -> [b]
    set [t
    xt -> Integer -> t
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2 | t
    x <- [t]
    vs] [t] -> [t] -> [t]
    forall a. Ord a => [a] -> [a] -> [a]
    \\ [0] -- the non-zero squares in Fq

        es :: [[t]]
    es = [ [t
    x,t
    y] | t
    x <- [t]
    vs, t
    y <- [t]
    vs, t
    x t -> t -> Bool
    forall a. Ord a => a -> a -> Bool
    < t
    y, (t
    xt -> t -> t
    forall a. Num a => a -> a -> a
    -t
    y) t -> [t] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [t]
    qs]

    -- CLEBSCH GRAPH

    -- van Lint & Wilson, p263

    clebsch' :: Graph Integer
    clebsch' = Graph [Integer] -> Graph Integer
    forall t a. (Ord t, Num t, Enum t, Ord a) => Graph a -> Graph t
    G.to1n Graph [Integer]
    clebsch

    clebsch :: Graph [Integer]
    clebsch = ([[Integer]], [[[Integer]]]) -> Graph [Integer]
    forall t. Ord t => ([t], [[t]]) -> Graph t
    graph ([[Integer]]
    vs,[[[Integer]]]
    es) where
        vs :: [[Integer]]
    vs = [[Integer]] -> [[Integer]]
    forall b. Ord b => [b] -> [b]
    L.sort ([[Integer]] -> [[Integer]]) -> [[Integer]] -> [[Integer]]
    forall a b. (a -> b) -> a -> b
    $ ([Integer] -> Bool) -> [[Integer]] -> [[Integer]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Int -> Bool
    forall a. Integral a => a -> Bool
    even (Int -> Bool) -> ([Integer] -> Int) -> [Integer] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Integer] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length) ([[Integer]] -> [[Integer]]) -> [[Integer]] -> [[Integer]]
    forall a b. (a -> b) -> a -> b
    $ [Integer] -> [[Integer]]
    forall a. [a] -> [[a]]
    powerset [1..5]
        es :: [[[Integer]]]
    es = [ [[Integer]
    v,[Integer]
    v'] | [Integer]
    v <- [[Integer]]
    vs, [Integer]
    v' <- ([Integer] -> Bool) -> [[Integer]] -> [[Integer]]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile ([Integer] -> [Integer] -> Bool
    forall a. Ord a => a -> a -> Bool
    <= [Integer]
    v) [[Integer]]
    vs, [Integer] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Integer] -> [Integer] -> [Integer]
    forall a. Ord a => [a] -> [a] -> [a]
    symDiff [Integer]
    v [Integer]
    v') Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 4]

    -- Alternative construction from Cameron & van Lint p106

    clebsch2 :: Graph DesignVertex
    clebsch2 = ([DesignVertex], [[DesignVertex]]) -> Graph DesignVertex
    forall t. Ord t => ([t], [[t]]) -> Graph t
    graph ([DesignVertex]
    vs,[[DesignVertex]]
    es) where
        D xs :: [Integer]
    xs bs :: [[Integer]]
    bs = Integer -> Design Integer
    forall a. Integral a => a -> Design a
    pairDesign 5
        vs :: [DesignVertex]
    vs = [DesignVertex
    C] [DesignVertex] -> [DesignVertex] -> [DesignVertex]
    forall a. [a] -> [a] -> [a]
    ++ [Integer -> DesignVertex
    P Integer
    x | Integer
    x <- [Integer]
    xs] [DesignVertex] -> [DesignVertex] -> [DesignVertex]
    forall a. [a] -> [a] -> [a]
    ++ [[Integer] -> DesignVertex
    B [Integer]
    b | [Integer]
    b <- [[Integer]]
    bs]
        es :: [[DesignVertex]]
    es = [[DesignVertex]] -> [[DesignVertex]]
    forall b. Ord b => [b] -> [b]
    L.sort ([[DesignVertex]] -> [[DesignVertex]])
    -> [[DesignVertex]] -> [[DesignVertex]]
    forall a b. (a -> b) -> a -> b
    $ [ [[Integer] -> DesignVertex
    B [Integer]
    a, [Integer] -> DesignVertex
    B [Integer]
    b]  | [Integer]
    a <- [[Integer]]
    bs, [Integer]
    b <- ([Integer] -> Bool) -> [[Integer]] -> [[Integer]]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile ([Integer] -> [Integer] -> Bool
    forall a. Ord a => a -> a -> Bool
    <=[Integer]
    a) [[Integer]]
    bs, [Integer] -> [Integer] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    disjoint [Integer]
    a [Integer]
    b]
                   [[DesignVertex]] -> [[DesignVertex]] -> [[DesignVertex]]
    forall a. [a] -> [a] -> [a]
    ++ [ [Integer -> DesignVertex
    P Integer
    p, [Integer] -> DesignVertex
    B [Integer]
    b] | [Integer]
    b <- [[Integer]]
    bs, Integer
    p <- [Integer]
    b]
                   [[DesignVertex]] -> [[DesignVertex]] -> [[DesignVertex]]
    forall a. [a] -> [a] -> [a]
    ++ [ [DesignVertex
    C, Integer -> DesignVertex
    P Integer
    p]   | Integer
    p <- [Integer]
    xs ]

    -- HOFFMAN-SINGLETON GRAPH

    -- Cameron, Permutation Groups, p79ff

    -- Godsil & Royle, p92ff

    -- Aut group is U3(5).2 (Atlas p34)

    triples :: [[Integer]]
    triples = Int -> [Integer] -> [[Integer]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 3 [1..7]

    heptads :: [[[Integer]]]
    heptads = [ [[Integer]
    a,[Integer]
    b,[Integer]
    c,[Integer]
    d,[Integer]
    e,[Integer]
    f,[Integer]
    g] | [Integer]
    a <- [[Integer]]
    triples,
                                  [Integer]
    b <- [[Integer]]
    triples, [Integer]
    a [Integer] -> [Integer] -> Bool
    forall a. Ord a => a -> a -> Bool
    < [Integer]
    b, [Integer] -> [Integer] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    meetOne [Integer]
    b [Integer]
    a,
                                  [Integer]
    c <- [[Integer]]
    triples, [Integer]
    b [Integer] -> [Integer] -> Bool
    forall a. Ord a => a -> a -> Bool
    < [Integer]
    c, ([Integer] -> Bool) -> [[Integer]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([Integer] -> [Integer] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    meetOne [Integer]
    c) [[Integer]
    a,[Integer]
    b],
                                  [Integer]
    d <- [[Integer]]
    triples, [Integer]
    c [Integer] -> [Integer] -> Bool
    forall a. Ord a => a -> a -> Bool
    < [Integer]
    d, ([Integer] -> Bool) -> [[Integer]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([Integer] -> [Integer] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    meetOne [Integer]
    d) [[Integer]
    a,[Integer]
    b,[Integer]
    c],
                                  [Integer]
    e <- [[Integer]]
    triples, [Integer]
    d [Integer] -> [Integer] -> Bool
    forall a. Ord a => a -> a -> Bool
    < [Integer]
    e, ([Integer] -> Bool) -> [[Integer]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([Integer] -> [Integer] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    meetOne [Integer]
    e) [[Integer]
    a,[Integer]
    b,[Integer]
    c,[Integer]
    d],
                                  [Integer]
    f <- [[Integer]]
    triples, [Integer]
    e [Integer] -> [Integer] -> Bool
    forall a. Ord a => a -> a -> Bool
    < [Integer]
    f, ([Integer] -> Bool) -> [[Integer]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([Integer] -> [Integer] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    meetOne [Integer]
    f) [[Integer]
    a,[Integer]
    b,[Integer]
    c,[Integer]
    d,[Integer]
    e],
                                  [Integer]
    g <- [[Integer]]
    triples, [Integer]
    f [Integer] -> [Integer] -> Bool
    forall a. Ord a => a -> a -> Bool
    < [Integer]
    g, ([Integer] -> Bool) -> [[Integer]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([Integer] -> [Integer] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    meetOne [Integer]
    g) [[Integer]
    a,[Integer]
    b,[Integer]
    c,[Integer]
    d,[Integer]
    e,[Integer]
    f],
                                  ([Integer] -> [Integer] -> [Integer])
    -> [Integer] -> [[Integer]] -> [Integer]
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl [Integer] -> [Integer] -> [Integer]
    forall a. Ord a => [a] -> [a] -> [a]
    intersect [1..7] [[Integer]
    a,[Integer]
    b,[Integer]
    c,[Integer]
    d,[Integer]
    e,[Integer]
    f,[Integer]
    g] [Integer] -> [Integer] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [] ]
        where meetOne :: [a] -> [a] -> Bool
    meetOne x :: [a]
    x y :: [a]
    y = [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    intersect [a]
    x [a]
    y) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1
        -- each pair of triples meet in exactly one point, and there is no point in all of them - Godsil & Royle p69

        -- (so these are the projective planes over 7 points)

    plane :: [[a]]
    plane +^ :: [[a]] -> Permutation a -> [[a]]
    +^ g :: Permutation a
    g = [[a]] -> [[a]]
    forall b. Ord b => [b] -> [b]
    L.sort [[a]
    line [a] -> Permutation a -> [a]
    forall a. Ord a => [a] -> Permutation a -> [a]
    -^ Permutation a
    g | [a]
    line <- [[a]]
    plane]

    plane :: [[a]]
    plane +^^ :: [[a]] -> [Permutation a] -> [[[a]]]
    +^^ gs :: [Permutation a]
    gs = ([[a]] -> Permutation a -> [[a]])
    -> [[a]] -> [Permutation a] -> [[[a]]]
    forall t1 t2. Ord t1 => (t1 -> t2 -> t1) -> t1 -> [t2] -> [t1]
    orbit [[a]] -> Permutation a -> [[a]]
    forall a. Ord a => [[a]] -> Permutation a -> [[a]]
    (+^) [[a]]
    plane [Permutation a]
    gs
    -- plane +^^ gs = closure [plane] [ +^ g | g <- gs ]

    hoffmanSingleton' :: Graph Integer
    hoffmanSingleton' = Graph (Either [[Integer]] [Integer]) -> Graph Integer
    forall t a. (Ord t, Num t, Enum t, Ord a) => Graph a -> Graph t
    G.to1n Graph (Either [[Integer]] [Integer])
    hoffmanSingleton

    hoffmanSingleton :: Graph (Either [[Integer]] [Integer])
    hoffmanSingleton = ([Either [[Integer]] [Integer]], [[Either [[Integer]] [Integer]]])
    -> Graph (Either [[Integer]] [Integer])
    forall t. Ord t => ([t], [[t]]) -> Graph t
    graph ([Either [[Integer]] [Integer]]
    vs,[[Either [[Integer]] [Integer]]]
    es) where
        h :: [[Integer]]
    h = [[[Integer]]] -> [[Integer]]
    forall a. [a] -> a
    head [[[Integer]]]
    heptads
        hs :: [[[Integer]]]
    hs = [[Integer]]
    h [[Integer]] -> [Permutation Integer] -> [[[Integer]]]
    forall a. Ord a => [[a]] -> [Permutation a] -> [[[a]]]
    +^^ Integer -> [Permutation Integer]
    forall a. Integral a => a -> [Permutation a]
    _A 7 -- an A7 orbit of a heptad

        vs :: [Either [[Integer]] [Integer]]
    vs = ([[Integer]] -> Either [[Integer]] [Integer])
    -> [[[Integer]]] -> [Either [[Integer]] [Integer]]
    forall a b. (a -> b) -> [a] -> [b]
    map [[Integer]] -> Either [[Integer]] [Integer]
    forall a b. a -> Either a b
    Left [[[Integer]]]
    hs [Either [[Integer]] [Integer]]
    -> [Either [[Integer]] [Integer]] -> [Either [[Integer]] [Integer]]
    forall a. [a] -> [a] -> [a]
    ++ ([Integer] -> Either [[Integer]] [Integer])
    -> [[Integer]] -> [Either [[Integer]] [Integer]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Integer] -> Either [[Integer]] [Integer]
    forall a b. b -> Either a b
    Right [[Integer]]
    triples
        es :: [[Either [[Integer]] [Integer]]]
    es = [ [[[Integer]] -> Either [[Integer]] [Integer]
    forall a b. a -> Either a b
    Left [[Integer]]
    h, [Integer] -> Either [[Integer]] [Integer]
    forall a b. b -> Either a b
    Right [Integer]
    t] | [[Integer]]
    h <- [[[Integer]]]
    hs, [Integer]
    t <- [[Integer]]
    triples, [Integer]
    t [Integer] -> [[Integer]] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Integer]]
    h]
          [[Either [[Integer]] [Integer]]]
    -> [[Either [[Integer]] [Integer]]]
    -> [[Either [[Integer]] [Integer]]]
    forall a. [a] -> [a] -> [a]
    ++ [ [[Integer] -> Either [[Integer]] [Integer]
    forall a b. b -> Either a b
    Right [Integer]
    t, [Integer] -> Either [[Integer]] [Integer]
    forall a b. b -> Either a b
    Right [Integer]
    t'] | [Integer]
    t <- [[Integer]]
    triples, [Integer]
    t' <- ([Integer] -> Bool) -> [[Integer]] -> [[Integer]]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile ([Integer] -> [Integer] -> Bool
    forall a. Ord a => a -> a -> Bool
    <= [Integer]
    t) [[Integer]]
    triples, [Integer]
    t [Integer] -> [Integer] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    `disjoint` [Integer]
    t']

    -- induced action of A7 on Hoffman-Singleton graph

    inducedA7 :: Permutation Integer -> Permutation (Either [[Integer]] [Integer])
    inducedA7 g :: Permutation Integer
    g = [(Either [[Integer]] [Integer], Either [[Integer]] [Integer])]
    -> Permutation (Either [[Integer]] [Integer])
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [(Either [[Integer]] [Integer]
    v, Either [[Integer]] [Integer]
    v Either [[Integer]] [Integer]
    -> Permutation Integer -> Either [[Integer]] [Integer]
    forall a.
    Ord a =>
    Either [[a]] [a] -> Permutation a -> Either [[a]] [a]
    ~^ Permutation Integer
    g) | Either [[Integer]] [Integer]
    v <- [Either [[Integer]] [Integer]]
    vs] where
        vs :: [Either [[Integer]] [Integer]]
    vs = Graph (Either [[Integer]] [Integer])
    -> [Either [[Integer]] [Integer]]
    forall a. Graph a -> [a]
    vertices Graph (Either [[Integer]] [Integer])
    hoffmanSingleton
        (Left h :: [[a]]
    h) ~^ :: Either [[a]] [a] -> Permutation a -> Either [[a]] [a]
    ~^ g :: Permutation a
    g = [[a]] -> Either [[a]] [a]
    forall a b. a -> Either a b
    Left ([[a]]
    h [[a]] -> Permutation a -> [[a]]
    forall a. Ord a => [[a]] -> Permutation a -> [[a]]
    +^ Permutation a
    g)
        (Right t :: [a]
    t) ~^ g :: Permutation a
    g = [a] -> Either [[a]] [a]
    forall a b. b -> Either a b
    Right ([a]
    t [a] -> Permutation a -> [a]
    forall a. Ord a => [a] -> Permutation a -> [a]
    -^ Permutation a
    g)

    hsA7 :: [Permutation Integer]
    hsA7 = [Permutation (Either [[Integer]] [Integer])]
    -> [Permutation Integer]
    forall a1 a2.
    (Ord a1, Num a1, Enum a1, Ord a2) =>
    [Permutation a2] -> [Permutation a1]
    toSn ([Permutation (Either [[Integer]] [Integer])]
     -> [Permutation Integer])
    -> [Permutation (Either [[Integer]] [Integer])]
    -> [Permutation Integer]
    forall a b. (a -> b) -> a -> b
    $ (Permutation Integer -> Permutation (Either [[Integer]] [Integer]))
    -> [Permutation Integer]
    -> [Permutation (Either [[Integer]] [Integer])]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation Integer -> Permutation (Either [[Integer]] [Integer])
    inducedA7 ([Permutation Integer]
     -> [Permutation (Either [[Integer]] [Integer])])
    -> [Permutation Integer]
    -> [Permutation (Either [[Integer]] [Integer])]
    forall a b. (a -> b) -> a -> b
    $ Integer -> [Permutation Integer]
    forall a. Integral a => a -> [Permutation a]
    _A 7

    -- GEWIRTZ GRAPH

    -- van Lint & Wilson p266-7

    -- (also called Sims-Gewirtz graph)

    gewirtz' :: Graph Integer
    gewirtz' = Graph [Integer] -> Graph Integer
    forall t a. (Ord t, Num t, Enum t, Ord a) => Graph a -> Graph t
    G.to1n Graph [Integer]
    gewirtz

    gewirtz :: Graph [Integer]
    gewirtz = ([[Integer]], [[[Integer]]]) -> Graph [Integer]
    forall t. Ord t => ([t], [[t]]) -> Graph t
    graph ([[Integer]]
    vs,[[[Integer]]]
    es) where
        vs :: [[Integer]]
    vs = [[Integer]
    xs | [Integer]
    xs <- Design Integer -> [[Integer]]
    forall a. Design a -> [[a]]
    blocks Design Integer
    s_3_6_22, 22 Integer -> [Integer] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Integer]
    xs]
        -- The 21 blocks of S(3,6,22) which contain 22 are the lines of PG(2,4) (projective plane over F4)

        -- The 56 blocks which don't are hyperovals in this plane. They form a 2-(21,6,4) design.

        es :: [[[Integer]]]
    es = [ [[Integer]
    v,[Integer]
    v'] | [Integer]
    v <- [[Integer]]
    vs, [Integer]
    v' <- ([Integer] -> Bool) -> [[Integer]] -> [[Integer]]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile ([Integer] -> [Integer] -> Bool
    forall a. Ord a => a -> a -> Bool
    <= [Integer]
    v) [[Integer]]
    vs, [Integer] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Integer]
    v [Integer] -> [Integer] -> [Integer]
    forall a. Ord a => [a] -> [a] -> [a]
    `intersect` [Integer]
    v') Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0]

    -- HIGMAN-SIMS GRAPH

    -- Aut group is HS.2, where HS is the Higman-Sims sporadic simple group

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

    higmanSimsGraph' :: Graph Integer
    higmanSimsGraph' = Graph DesignVertex -> Graph Integer
    forall t a. (Ord t, Num t, Enum t, Ord a) => Graph a -> Graph t
    G.to1n Graph DesignVertex
    higmanSimsGraph

    -- Cameron & van Lint, p107

    higmanSimsGraph :: Graph DesignVertex
    higmanSimsGraph = ([DesignVertex], [[DesignVertex]]) -> Graph DesignVertex
    forall t. Ord t => ([t], [[t]]) -> Graph t
    graph ([DesignVertex]
    vs,[[DesignVertex]]
    es) where
        D xs :: [Integer]
    xs bs :: [[Integer]]
    bs = Design Integer
    s_3_6_22
        vs :: [DesignVertex]
    vs = [DesignVertex
    C] [DesignVertex] -> [DesignVertex] -> [DesignVertex]
    forall a. [a] -> [a] -> [a]
    ++ [Integer -> DesignVertex
    P Integer
    x | Integer
    x <- [Integer]
    xs] [DesignVertex] -> [DesignVertex] -> [DesignVertex]
    forall a. [a] -> [a] -> [a]
    ++ [[Integer] -> DesignVertex
    B [Integer]
    b | [Integer]
    b <- [[Integer]]
    bs]
        es :: [[DesignVertex]]
    es = [[DesignVertex]] -> [[DesignVertex]]
    forall b. Ord b => [b] -> [b]
    L.sort ([[DesignVertex]] -> [[DesignVertex]])
    -> [[DesignVertex]] -> [[DesignVertex]]
    forall a b. (a -> b) -> a -> b
    $ [ [[Integer] -> DesignVertex
    B [Integer]
    a, [Integer] -> DesignVertex
    B [Integer]
    b]  | [Integer]
    a <- [[Integer]]
    bs, [Integer]
    b <- ([Integer] -> Bool) -> [[Integer]] -> [[Integer]]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile ([Integer] -> [Integer] -> Bool
    forall a. Ord a => a -> a -> Bool
    <=[Integer]
    a) [[Integer]]
    bs, [Integer] -> [Integer] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    disjoint [Integer]
    a [Integer]
    b]
                   [[DesignVertex]] -> [[DesignVertex]] -> [[DesignVertex]]
    forall a. [a] -> [a] -> [a]
    ++ [ [Integer -> DesignVertex
    P Integer
    p, [Integer] -> DesignVertex
    B [Integer]
    b] | [Integer]
    b <- [[Integer]]
    bs, Integer
    p <- [Integer]
    b]
                   [[DesignVertex]] -> [[DesignVertex]] -> [[DesignVertex]]
    forall a. [a] -> [a] -> [a]
    ++ [ [DesignVertex
    C, Integer -> DesignVertex
    P Integer
    p]   | Integer
    p <- [Integer]
    xs ]
        -- s_3_6_22' = blocks s_3_6_22

    -- There is an induced action of M22 on Higman Sims graph

    -- induced action of M22 on Higman-Sims graph

    inducedM22 :: Permutation Integer -> Permutation DesignVertex
    inducedM22 g :: Permutation Integer
    g = [(DesignVertex, DesignVertex)] -> Permutation DesignVertex
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [(DesignVertex
    v, DesignVertex
    v DesignVertex -> Permutation Integer -> DesignVertex
    ~^ Permutation Integer
    g) | DesignVertex
    v <- [DesignVertex]
    vs] where
        -- G vs _ = higmanSimsGraph'

        vs :: [DesignVertex]
    vs = Graph DesignVertex -> [DesignVertex]
    forall a. Graph a -> [a]
    vertices Graph DesignVertex
    higmanSimsGraph
        (B b :: [Integer]
    b) ~^ :: DesignVertex -> Permutation Integer -> DesignVertex
    ~^ g :: Permutation Integer
    g = [Integer] -> DesignVertex
    B ([Integer]
    b [Integer] -> Permutation Integer -> [Integer]
    forall a. Ord a => [a] -> Permutation a -> [a]
    -^ Permutation Integer
    g)
        (P p :: Integer
    p) ~^ g :: Permutation Integer
    g = Integer -> DesignVertex
    P (Integer
    p Integer -> Permutation Integer -> Integer
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation Integer
    g)
        C ~^ _ = DesignVertex
    C

    higmanSimsM22 :: [Permutation Integer]
    higmanSimsM22 = [Permutation DesignVertex] -> [Permutation Integer]
    forall a1 a2.
    (Ord a1, Num a1, Enum a1, Ord a2) =>
    [Permutation a2] -> [Permutation a1]
    toSn ([Permutation DesignVertex] -> [Permutation Integer])
    -> [Permutation DesignVertex] -> [Permutation Integer]
    forall a b. (a -> b) -> a -> b
    $ (Permutation Integer -> Permutation DesignVertex)
    -> [Permutation Integer] -> [Permutation DesignVertex]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation Integer -> Permutation DesignVertex
    inducedM22 ([Permutation Integer] -> [Permutation DesignVertex])
    -> [Permutation Integer] -> [Permutation DesignVertex]
    forall a b. (a -> b) -> a -> b
    $ [Permutation Integer]
    m22sgs
    -- all (isGraphAut higmanSimsGraph) higmanSimsM22

    -- M22 is one point stabilizer (of C)

    -- HS.2, where HS is Higman-Sims sporadic group

    _HS2 :: [Permutation DesignVertex]
    _HS2 = [Permutation DesignVertex] -> [Permutation DesignVertex]
    forall a. Ord a => [Permutation a] -> [Permutation a]
    SS.reduceGens ([Permutation DesignVertex] -> [Permutation DesignVertex])
    -> [Permutation DesignVertex] -> [Permutation DesignVertex]
    forall a b. (a -> b) -> a -> b
    $ Graph DesignVertex -> [Permutation DesignVertex]
    forall a. Ord a => Graph a -> [Permutation a]
    graphAuts Graph DesignVertex
    higmanSimsGraph
    -- (It will actually find 11 strong generators, but the first 4 are sufficient to generate the group)

    _HS :: [Permutation DesignVertex]
    _HS = [Permutation DesignVertex] -> [Permutation DesignVertex]
    forall a. Ord a => [Permutation a] -> [Permutation a]
    SS.derivedSubgp [Permutation DesignVertex]
    _HS2

    -- SYMPLECTIC GRAPHS

    -- Godsil & Royle p242

    sp2 :: Int -> Graph [F2]
    sp2 r :: Int
    r = ([[F2]], [[[F2]]]) -> Graph [F2]
    forall t. Ord t => ([t], [[t]]) -> Graph t
    graph ([[F2]]
    vs,[[[F2]]]
    es) where
        vs :: [[F2]]
    vs = [[F2]] -> [[F2]]
    forall a. [a] -> [a]
    tail ([[F2]] -> [[F2]]) -> [[F2]] -> [[F2]]
    forall a b. (a -> b) -> a -> b
    $ Int -> [F2] -> [[F2]]
    forall a. Int -> [a] -> [[a]]
    ptsAG (2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    r) [F2]
    f2 -- all non-zero pts in F2^2r

        es :: [[[F2]]]
    es = [ [[F2]
    u,[F2]
    v] | [u :: [F2]
    u,v :: [F2]
    v] <- Int -> [[F2]] -> [[[F2]]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 2 [[F2]]
    vs, [F2]
    u [F2] -> [[F2]] -> [F2]
    forall a. Num a => [a] -> [[a]] -> [a]
    <*>> [[F2]]
    n [F2] -> [F2] -> F2
    forall a. Num a => [a] -> [a] -> a
    <.> [F2]
    v F2 -> F2 -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1] -- uT N v == 1, ie vectors adjacent if non-orthogonal

        n :: [[F2]]
    n = Int -> (Int -> Int -> F2) -> [[F2]]
    forall t a. (Num t, Enum t) => t -> (t -> t -> a) -> [[a]]
    fMatrix (2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    r) (\i :: Int
    i j :: Int
    j -> if Int -> Int
    forall a. Num a => a -> a
    abs (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    j) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 Bool -> Bool -> Bool
    && Int -> Bool
    forall a. Integral a => a -> Bool
    even (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    i Int
    j) then 1 else 0) -- matrix defining a symplectic form

    sp :: Int -> Graph [F2]
    sp n :: Int
    n | Int -> Bool
    forall a. Integral a => a -> Bool
    even Int
    n = Int -> Graph [F2]
    sp2 (Int
    n Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` 2)

    -- TWO GRAPHS AND SWITCHING

    -- SCHLAFLI GRAPH

    -- An srg(27,16,10,8)

    -- Has geometric interpretation in terms of 27 lines on general cubic surface in projective 3-space

    -- Aut group is G.2 where G = U4(2) = S4(3) (Atlas p26)

    -- (G.2 is also the Weyl group of E6 - don't know if there's any connection)

    -- Godsil & Royle p254ff

    switch :: Graph t -> [t] -> Graph t
    switch g :: Graph t
    g us :: [t]
    us | [t]
    us [t] -> [t] -> Bool
    forall (t1 :: * -> *) (t2 :: * -> *) a.
    (Foldable t1, Foldable t2, Eq a) =>
    t1 a -> t2 a -> Bool
    `D.isSubset` [t]
    vs = ([t], [[t]]) -> Graph t
    forall t. Ord t => ([t], [[t]]) -> Graph t
    graph ([t]
    vs, [[t]] -> [[t]]
    forall b. Ord b => [b] -> [b]
    L.sort [[t]]
    switchedes) where
        vs :: [t]
    vs = Graph t -> [t]
    forall a. Graph a -> [a]
    vertices Graph t
    g
        us' :: [t]
    us' = [t]
    vs [t] -> [t] -> [t]
    forall a. Eq a => [a] -> [a] -> [a]
    L.\\ [t]
    us -- complement of us in vs

        es :: [[t]]
    es = Graph t -> [[t]]
    forall a. Graph a -> [[a]]
    edges Graph t
    g
        es' :: Set [t]
    es' = [[t]] -> Set [t]
    forall a. Ord a => [a] -> Set a
    S.fromList [[t]]
    es
        switchedes :: [[t]]
    switchedes = [[t]
    e | e :: [t]
    e@[v1 :: t
    v1,v2 :: t
    v2] <- [[t]]
    es, (t
    v1 t -> [t] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [t]
    us) Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == (t
    v2 t -> [t] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [t]
    us)]
                     -- edges within us or its complement are unchanged

                  [[t]] -> [[t]] -> [[t]]
    forall a. [a] -> [a] -> [a]
    ++ [ [t] -> [t]
    forall b. Ord b => [b] -> [b]
    L.sort [t
    v1,t
    v2] | t
    v1 <- [t]
    us, t
    v2 <- [t]
    us', [t] -> [t]
    forall b. Ord b => [b] -> [b]
    L.sort [t
    v1,t
    v2] [t] -> Set [t] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.notMember` Set [t]
    es']
                     -- edges between us and its complement are switched

    -- Godsil & Royle p259

    schlafli' :: Graph Integer
    schlafli' = Graph Integer -> Graph Integer
    forall t a. (Ord t, Num t, Enum t, Ord a) => Graph a -> Graph t
    G.to1n Graph Integer
    schlafli

    schlafli :: Graph Integer
    schlafli = ([Integer], [[Integer]]) -> Graph Integer
    forall t. Ord t => ([t], [[t]]) -> Graph t
    graph ([Integer]
    vs,[[Integer]]
    es') where
        g :: Graph Integer
    g = Graph Integer -> Graph Integer
    forall t a. (Num t, Enum t, Ord t, Ord a) => Graph a -> Graph t
    lineGraph (Graph Integer -> Graph Integer) -> Graph Integer -> Graph Integer
    forall a b. (a -> b) -> a -> b
    $ Integer -> Graph Integer
    forall t. Integral t => t -> Graph t
    k 8
        v :: Integer
    v:vs :: [Integer]
    vs = Graph Integer -> [Integer]
    forall a. Graph a -> [a]
    vertices Graph Integer
    g
        es :: [[Integer]]
    es = Graph Integer -> [[Integer]]
    forall a. Graph a -> [[a]]
    edges Graph Integer
    g
        gswitched :: Graph Integer
    gswitched = Graph Integer -> [Integer] -> Graph Integer
    forall t. Ord t => Graph t -> [t] -> Graph t
    switch Graph Integer
    g (Graph Integer -> Integer -> [Integer]
    forall a. Eq a => Graph a -> a -> [a]
    nbrs Graph Integer
    g Integer
    v) -- switch off the vertex v

        es' :: [[Integer]]
    es' = Graph Integer -> [[Integer]]
    forall a. Graph a -> [[a]]
    edges Graph Integer
    gswitched

    -- MCLAUGHLIN GRAPH

    -- Aut group is McL.2, where McL is the McLaughlin sporadic simple group

    -- http://people.csse.uwa.edu.au/gordon/constructions/mclaughlin/

    -- http://mathworld.wolfram.com/McLaughlinGraph.html

    mcLaughlin' :: Graph Integer
    mcLaughlin' = Graph DesignVertex -> Graph Integer
    forall t a. (Ord t, Num t, Enum t, Ord a) => Graph a -> Graph t
    G.to1n Graph DesignVertex
    mcLaughlin

    mcLaughlin :: Graph DesignVertex
    mcLaughlin = ([DesignVertex], [[DesignVertex]]) -> Graph DesignVertex
    forall t. Ord t => ([t], [[t]]) -> Graph t
    graph ([DesignVertex]
    vs',[[DesignVertex]]
    es') where
        D xs :: [Integer]
    xs bs :: [[Integer]]
    bs = Design Integer
    s_4_7_23
        vs :: [DesignVertex]
    vs = (Integer -> DesignVertex) -> [Integer] -> [DesignVertex]
    forall a b. (a -> b) -> [a] -> [b]
    map Integer -> DesignVertex
    P [Integer]
    xs [DesignVertex] -> [DesignVertex] -> [DesignVertex]
    forall a. [a] -> [a] -> [a]
    ++ ([Integer] -> DesignVertex) -> [[Integer]] -> [DesignVertex]
    forall a b. (a -> b) -> [a] -> [b]
    map [Integer] -> DesignVertex
    B [[Integer]]
    bs
        es :: [[DesignVertex]]
    es = [ [Integer -> DesignVertex
    P Integer
    x, [Integer] -> DesignVertex
    B [Integer]
    b] | Integer
    x <- [Integer]
    xs, [Integer]
    b <- [[Integer]]
    bs, Integer
    x Integer -> [Integer] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Integer]
    b]
          [[DesignVertex]] -> [[DesignVertex]] -> [[DesignVertex]]
    forall a. [a] -> [a] -> [a]
    ++ [ [[Integer] -> DesignVertex
    B [Integer]
    b1, [Integer] -> DesignVertex
    B [Integer]
    b2] | [Integer]
    b1 <- [[Integer]]
    bs, [Integer]
    b2 <- [[Integer]]
    bs, [Integer]
    b1 [Integer] -> [Integer] -> Bool
    forall a. Ord a => a -> a -> Bool
    < [Integer]
    b2, [Integer] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Integer]
    b1 [Integer] -> [Integer] -> [Integer]
    forall a. Ord a => [a] -> [a] -> [a]
    `intersect` [Integer]
    b2) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1]
        g276 :: Graph DesignVertex
    g276 = ([DesignVertex], [[DesignVertex]]) -> Graph DesignVertex
    forall t. Ord t => ([t], [[t]]) -> Graph t
    graph ([DesignVertex]
    vs,[[DesignVertex]]
    es)
        g276switched :: Graph DesignVertex
    g276switched = Graph DesignVertex -> [DesignVertex] -> Graph DesignVertex
    forall t. Ord t => Graph t -> [t] -> Graph t
    switch Graph DesignVertex
    g276 (Graph DesignVertex -> DesignVertex -> [DesignVertex]
    forall a. Eq a => Graph a -> a -> [a]
    nbrs Graph DesignVertex
    g276 (Integer -> DesignVertex
    P 0))
        P 0 : vs' :: [DesignVertex]
    vs' = [DesignVertex]
    vs -- drop P 0 as it's now not connected

        es' :: [[DesignVertex]]
    es' = Graph DesignVertex -> [[DesignVertex]]
    forall a. Graph a -> [[a]]
    edges Graph DesignVertex
    g276switched

    _McL2 :: [Permutation DesignVertex]
    _McL2 = [Permutation DesignVertex] -> [Permutation DesignVertex]
    forall a. Ord a => [Permutation a] -> [Permutation a]
    SS.reduceGens ([Permutation DesignVertex] -> [Permutation DesignVertex])
    -> [Permutation DesignVertex] -> [Permutation DesignVertex]
    forall a b. (a -> b) -> a -> b
    $ Graph DesignVertex -> [Permutation DesignVertex]
    forall a. Ord a => Graph a -> [Permutation a]
    graphAuts Graph DesignVertex
    mcLaughlin
    -- finds 14 auts - but takes half an hour (interpreted) to do so

    -- in fact just the first 2 are sufficient to generate the group

    _McL :: [Permutation DesignVertex]
    _McL = [Permutation DesignVertex] -> [Permutation DesignVertex]
    forall a. Ord a => [Permutation a] -> [Permutation a]
    SS.derivedSubgp ([Permutation DesignVertex] -> [Permutation DesignVertex])
    -> [Permutation DesignVertex] -> [Permutation DesignVertex]
    forall a b. (a -> b) -> a -> b
    $ [Permutation DesignVertex]
    _McL2

    {-
    -- TWO GRAPH ON 276 VERTICES
    -- Has Conway's .3 as automorphism group

    -- Godsil & Royle p260ff

    twoGraph276 =
        let nt = D.incidenceMatrix s_4_7_23
            n = L.transpose nt -- Godsil & Royle do incidence matrix the other way round to us
            s = L.transpose $
                (j 23 23 <<->> i 23)      +|+ (j 23 253 <<->> 2 *>> n)
                                          ++
                (j 253 23 <<->> 2 *>> nt) +|+ (nt <<*>> n <<->> 5 *>> i 253 <<->> 2 *>> j 253 253)
            a = (map . map) (`div` 2) (j 276 276 <<->> i 276 <<->> s)
        in fromAdjacencyMatrix a
        where j r c = replicate r (replicate c 1)
              i = idMx
              (+|+) = zipWith (++)

    -- Its automorphism group *as a two-graph* is .3 (Co3)
    -- But its aut group as a graph is only M23

    twoGraph276' = graph (vs,es) where
        D xs bs = s_4_7_23
        vs = map P xs ++ map B bs
        es = [ [P x, B b] | x <- xs, b <- bs, x `notElem` b]
          ++ [ [B b1, B b2] | b1 <- bs, b2 <- bs, b1 < b2, length (b1 `intersect` b2) == 1]
    -- !! This isn't isomorphic to twoGraph276
    -- (Perhaps it is in the same switching class though)
    -- We can obtain McLaughlin graph from this by switching in neighbourhood of P 0
    -}