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