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
import Math.Algebra.Field.Base
import Math.Combinatorics.FiniteGeometry
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
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
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'
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
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')]
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']
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]
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 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]
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 ]
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
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
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
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']
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 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]
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]
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
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 ]
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
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
_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
_HS :: [Permutation DesignVertex]
_HS = [Permutation DesignVertex] -> [Permutation DesignVertex]
forall a. Ord a => [Permutation a] -> [Permutation a]
SS.derivedSubgp [Permutation DesignVertex]
_HS2
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
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]
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)
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)
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
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)]
[[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']
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)
es' :: [[Integer]]
es' = Graph Integer -> [[Integer]]
forall a. Graph a -> [[a]]
edges Graph Integer
gswitched
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
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
_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