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

    -- |A module for constructing and working with combinatorial designs.

    --

    -- Given integers t \< k \< v and lambda > 0, a t-design or t-(v,k,lambda) design is an incidence structure of points X and blocks B,

    -- where X is a set of v points, B is a collection of k-subsets of X, with the property that any t points are contained

    -- in exactly lambda blocks. If lambda = 1 and t >= 2, then a t-design is also called a Steiner system S(t,k,v).

    --

    -- Many designs are highly symmetric structures, having large automorphism groups. In particular, the Mathieu groups,

    -- which were the first discovered sporadic finite simple groups, turn up as the automorphism groups of the Witt designs.

    module Math.Combinatorics.Design where

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

    import Math.Common.ListSet (intersect, symDiff)
    import Math.Core.Utils (combinationsOf)

    import Math.Algebra.Field.Base
    import Math.Algebra.Field.Extension
    import Math.Algebra.Group.PermutationGroup hiding (elts, order, isMember)
    import Math.Algebra.Group.SchreierSims as SS
    import Math.Combinatorics.Graph as G hiding (to1n, incidenceMatrix)
    import Math.Combinatorics.GraphAuts (graphAuts, incidenceAuts) -- , removeGens)

    import Math.Combinatorics.FiniteGeometry

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

    {-
    set xs = map head $ group $ sort xs
    -}
    isSubset :: t a -> t a -> Bool
    isSubset xs :: t a
    xs ys :: t a
    ys = (a -> Bool) -> t a -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (a -> t a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` t a
    ys) t a
    xs

    -- DESIGNS

    data Design a = D [a] [[a]] deriving (Design a -> Design a -> Bool
    (Design a -> Design a -> Bool)
    -> (Design a -> Design a -> Bool) -> Eq (Design a)
    forall a. Eq a => Design a -> Design a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Design a -> Design a -> Bool
    $c/= :: forall a. Eq a => Design a -> Design a -> Bool
    == :: Design a -> Design a -> Bool
    $c== :: forall a. Eq a => Design a -> Design a -> Bool
    Eq,Eq (Design a)
    Eq (Design a) =>
    (Design a -> Design a -> Ordering)
    -> (Design a -> Design a -> Bool)
    -> (Design a -> Design a -> Bool)
    -> (Design a -> Design a -> Bool)
    -> (Design a -> Design a -> Bool)
    -> (Design a -> Design a -> Design a)
    -> (Design a -> Design a -> Design a)
    -> Ord (Design a)
    Design a -> Design a -> Bool
    Design a -> Design a -> Ordering
    Design a -> Design a -> Design a
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall a. Ord a => Eq (Design a)
    forall a. Ord a => Design a -> Design a -> Bool
    forall a. Ord a => Design a -> Design a -> Ordering
    forall a. Ord a => Design a -> Design a -> Design a
    min :: Design a -> Design a -> Design a
    $cmin :: forall a. Ord a => Design a -> Design a -> Design a
    max :: Design a -> Design a -> Design a
    $cmax :: forall a. Ord a => Design a -> Design a -> Design a
    >= :: Design a -> Design a -> Bool
    $c>= :: forall a. Ord a => Design a -> Design a -> Bool
    > :: Design a -> Design a -> Bool
    $c> :: forall a. Ord a => Design a -> Design a -> Bool
    <= :: Design a -> Design a -> Bool
    $c<= :: forall a. Ord a => Design a -> Design a -> Bool
    < :: Design a -> Design a -> Bool
    $c< :: forall a. Ord a => Design a -> Design a -> Bool
    compare :: Design a -> Design a -> Ordering
    $ccompare :: forall a. Ord a => Design a -> Design a -> Ordering
    $cp1Ord :: forall a. Ord a => Eq (Design a)
    Ord,Int -> Design a -> ShowS
    [Design a] -> ShowS
    Design a -> String
    (Int -> Design a -> ShowS)
    -> (Design a -> String) -> ([Design a] -> ShowS) -> Show (Design a)
    forall a. Show a => Int -> Design a -> ShowS
    forall a. Show a => [Design a] -> ShowS
    forall a. Show a => Design a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Design a] -> ShowS
    $cshowList :: forall a. Show a => [Design a] -> ShowS
    show :: Design a -> String
    $cshow :: forall a. Show a => Design a -> String
    showsPrec :: Int -> Design a -> ShowS
    $cshowsPrec :: forall a. Show a => Int -> Design a -> ShowS
    Show)
    -- Do we or should we insist on ordering of the xs or bs?

    design :: ([a], [[a]]) -> Design a
    design (xs :: [a]
    xs,bs :: [[a]]
    bs) | Design a -> Bool
    forall a. Ord a => Design a -> Bool
    isValid Design a
    d = Design a
    d where d :: Design a
    d = [a] -> [[a]] -> Design a
    forall a. [a] -> [[a]] -> Design a
    D [a]
    xs [[a]]
    bs

    toDesign :: ([a], [[a]]) -> Design a
    toDesign (xs :: [a]
    xs,bs :: [[a]]
    bs) = [a] -> [[a]] -> Design a
    forall a. [a] -> [[a]] -> Design a
    D [a]
    xs' [[a]]
    bs' where
        xs' :: [a]
    xs' = [a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a]
    xs
        bs' :: [[a]]
    bs' = [[a]] -> [[a]]
    forall a. Ord a => [a] -> [a]
    L.sort ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ ([a] -> [a]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [[a]]
    bs -- in fact don't require that the blocks are in order

    isValid :: Design a -> Bool
    isValid (D xs :: [a]
    xs bs :: [[a]]
    bs) = ([a]
    xs [a] -> [a] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a]
    xs Bool -> Bool -> Bool
    || String -> Bool
    forall a. HasCallStack => String -> a
    error "design: points are not in order")
                     Bool -> Bool -> Bool
    && (([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\b :: [a]
    b -> [a]
    b [a] -> [a] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a]
    b) [[a]]
    bs Bool -> Bool -> Bool
    || String -> Bool
    forall a. HasCallStack => String -> a
    error "design: blocks do not have points in order")
    -- could also check that each block is a subset of xs, etc

    points :: Design a -> [a]
    points (D xs :: [a]
    xs bs :: [[a]]
    bs) = [a]
    xs

    blocks :: Design a -> [[a]]
    blocks (D xs :: [a]
    xs bs :: [[a]]
    bs) = [[a]]
    bs

    -- FINDING DESIGN PARAMETERS

    noRepeatedBlocks :: Design a -> Bool
    noRepeatedBlocks (D xs :: [a]
    xs bs :: [[a]]
    bs) = ([[a]] -> Bool) -> [[[a]]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ( (Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==1) (Int -> Bool) -> ([[a]] -> Int) -> [[a]] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[a]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ) ([[[a]]] -> Bool) -> [[[a]]] -> Bool
    forall a b. (a -> b) -> a -> b
    $ [[a]] -> [[[a]]]
    forall a. Eq a => [a] -> [[a]]
    L.group ([[a]] -> [[[a]]]) -> [[a]] -> [[[a]]]
    forall a b. (a -> b) -> a -> b
    $ [[a]] -> [[a]]
    forall a. Ord a => [a] -> [a]
    L.sort [[a]]
    bs

    -- Note that the design parameters functions don't check no repeated blocks, so they're also valid for t-structures

    -- given t and a t-(v,k,lambda) design, return (v,k,lambda)

    tDesignParams :: Int -> Design a -> Maybe (Int, Int, Int)
    tDesignParams t :: Int
    t d :: Design a
    d =
        case Design a -> Maybe (Int, Int)
    forall a. Design a -> Maybe (Int, Int)
    findvk Design a
    d of
        Nothing -> Maybe (Int, Int, Int)
    forall a. Maybe a
    Nothing
        Just (v :: Int
    v,k :: Int
    k) ->
            case Int -> Design a -> Maybe Int
    forall a. Eq a => Int -> Design a -> Maybe Int
    findlambda Int
    t Design a
    d of
            Nothing -> Maybe (Int, Int, Int)
    forall a. Maybe a
    Nothing
            Just lambda :: Int
    lambda -> (Int, Int, Int) -> Maybe (Int, Int, Int)
    forall a. a -> Maybe a
    Just (Int
    v,Int
    k,Int
    lambda)

    findvk :: Design a -> Maybe (Int, Int)
    findvk (D xs :: [a]
    xs bs :: [[a]]
    bs) =
        let k :: Int
    k: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]]
    bs
        in 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]
    ls then (Int, Int) -> Maybe (Int, Int)
    forall a. a -> Maybe a
    Just (Int
    v,Int
    k) else Maybe (Int, Int)
    forall a. Maybe a
    Nothing
        where v :: Int
    v = [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs

    findlambda :: Int -> Design a -> Maybe Int
    findlambda t :: Int
    t (D xs :: [a]
    xs bs :: [[a]]
    bs) =
        let lambda :: Int
    lambda:ls :: [Int]
    ls = [[[a]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[a]
    b | [a]
    b <- [[a]]
    bs, [a]
    ts [a] -> [a] -> Bool
    forall (t :: * -> *) (t :: * -> *) a.
    (Foldable t, Foldable t, Eq a) =>
    t a -> t a -> Bool
    `isSubset` [a]
    b] | [a]
    ts <- Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf Int
    t [a]
    xs]
        in 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
    lambda) [Int]
    ls then Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    lambda else Maybe Int
    forall a. Maybe a
    Nothing

    -- given (xs,bs), return design parameters t-(v,k,lambda) with t maximal

    designParams :: Design a -> Maybe (Int, (Int, Int, Int))
    designParams d :: Design a
    d =
        case Design a -> Maybe (Int, Int)
    forall a. Design a -> Maybe (Int, Int)
    findvk Design a
    d of
        Nothing -> Maybe (Int, (Int, Int, Int))
    forall a. Maybe a
    Nothing
        Just (v :: Int
    v,k :: Int
    k) ->
            case [(Int, Maybe Int)] -> [(Int, Maybe Int)]
    forall a. [a] -> [a]
    reverse (((Int, Maybe Int) -> Bool)
    -> [(Int, Maybe Int)] -> [(Int, Maybe Int)]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Maybe Int -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe Int -> Bool)
    -> ((Int, Maybe Int) -> Maybe Int) -> (Int, Maybe Int) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, Maybe Int) -> Maybe Int
    forall a b. (a, b) -> b
    snd) [(Int
    t, Int -> Design a -> Maybe Int
    forall a. Eq a => Int -> Design a -> Maybe Int
    findlambda Int
    t Design a
    d) | Int
    t <- [0..Int
    k] ]) of
            [] -> Maybe (Int, (Int, Int, Int))
    forall a. Maybe a
    Nothing
            (t :: Int
    t,Just lambda :: Int
    lambda):_ -> (Int, (Int, Int, Int)) -> Maybe (Int, (Int, Int, Int))
    forall a. a -> Maybe a
    Just (Int
    t,(Int
    v,Int
    k,Int
    lambda))
    -- Note that a 0-(v,k,lambda) design just means that there are lambda blocks, all of size k, with no other regularity

    isStructure :: Int -> Design a -> Bool
    isStructure t :: Int
    t d :: Design a
    d = Maybe (Int, Int, Int) -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe (Int, Int, Int) -> Bool) -> Maybe (Int, Int, Int) -> Bool
    forall a b. (a -> b) -> a -> b
    $ Int -> Design a -> Maybe (Int, Int, Int)
    forall a. Eq a => Int -> Design a -> Maybe (Int, Int, Int)
    tDesignParams Int
    t Design a
    d

    isDesign :: Int -> Design a -> Bool
    isDesign t :: Int
    t d :: Design a
    d = Design a -> Bool
    forall a. Ord a => Design a -> Bool
    noRepeatedBlocks Design a
    d Bool -> Bool -> Bool
    && Int -> Design a -> Bool
    forall a. Eq a => Int -> Design a -> Bool
    isStructure Int
    t Design a
    d

    is2Design :: Design a -> Bool
    is2Design d :: Design a
    d = Int -> Design a -> Bool
    forall a. Ord a => Int -> Design a -> Bool
    isDesign 2 Design a
    d

    -- square 2-design (more often called "symmetric" in the literature)

    isSquare :: Design a -> Bool
    isSquare d :: Design a
    d@(D xs :: [a]
    xs bs :: [[a]]
    bs) = Design a -> Bool
    forall a. Ord a => Design a -> Bool
    is2Design Design a
    d Bool -> Bool -> Bool
    && [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [[a]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[a]]
    bs

    -- (We follow Cameron & van Lint.)

    -- |The incidence matrix of a design, with rows indexed by blocks and columns by points.

    -- (Note that in the literature, the opposite convention is sometimes used instead.)

    incidenceMatrix :: (Eq t) => Design t -> [[Int]]
    incidenceMatrix :: Design t -> [[Int]]
    incidenceMatrix (D xs :: [t]
    xs bs :: [[t]]
    bs) = [ [if t
    x t -> [t] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [t]
    b then 1 else 0 | t
    x <- [t]
    xs] | [t]
    b <- [[t]]
    bs]

    -- SOME FAMILIES OF DESIGNS

    -- the following is trivially a k-(v,k,lambda) design

    subsetDesign :: a -> Int -> Design a
    subsetDesign v :: a
    v k :: Int
    k = ([a], [[a]]) -> Design a
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([a]
    xs,[[a]]
    bs) where
        xs :: [a]
    xs = [1..a
    v]
        bs :: [[a]]
    bs = Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf Int
    k [a]
    xs

    -- Cameron & van Lint, p30

    -- the pair design on n points is the complete graph on n points considered as a 2-(n,2,1) design

    pairDesign :: a -> Design a
    pairDesign n :: a
    n = [a] -> [[a]] -> Design a
    forall a. [a] -> [[a]] -> Design a
    D [a]
    vs [[a]]
    es where
        graph :: Graph a
    graph = a -> Graph a
    forall t. Integral t => t -> Graph t
    G.k a
    n
        vs :: [a]
    vs = Graph a -> [a]
    forall a. Graph a -> [a]
    vertices Graph a
    graph
        es :: [[a]]
    es = Graph a -> [[a]]
    forall a. Graph a -> [[a]]
    edges Graph a
    graph

    -- |The affine plane AG(2,Fq), a 2-(q^2,q,1) design or Steiner system S(2,q,q^2).

    ag2 :: (FiniteField k, Ord k) => [k] -> Design [k]
    ag2 :: [k] -> Design [k]
    ag2 fq :: [k]
    fq = ([[k]], [[[k]]]) -> Design [k]
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([[k]]
    points, [[[k]]]
    lines) where
        points :: [[k]]
    points = Int -> [k] -> [[k]]
    forall a. Int -> [a] -> [[a]]
    ptsAG 2 [k]
    fq
        lines :: [[[k]]]
    lines = ([k] -> [[k]]) -> [[k]] -> [[[k]]]
    forall a b. (a -> b) -> [a] -> [b]
    map [k] -> [[k]]
    line ([[k]] -> [[[k]]]) -> [[k]] -> [[[k]]]
    forall a b. (a -> b) -> a -> b
    $ [[k]] -> [[k]]
    forall a. [a] -> [a]
    tail ([[k]] -> [[k]]) -> [[k]] -> [[k]]
    forall a b. (a -> b) -> a -> b
    $ Int -> [k] -> [[k]]
    forall a. Num a => Int -> [a] -> [[a]]
    ptsPG 2 [k]
    fq
        line :: [k] -> [[k]]
    line [a :: k
    a,b :: k
    b,c :: k
    c] = [ [k
    x,k
    y] | [x :: k
    x,y :: k
    y] <- [[k]]
    points, k
    ak -> k -> k
    forall a. Num a => a -> a -> a
    *k
    xk -> k -> k
    forall a. Num a => a -> a -> a
    +k
    bk -> k -> k
    forall a. Num a => a -> a -> a
    *k
    yk -> k -> k
    forall a. Num a => a -> a -> a
    +k
    ck -> k -> Bool
    forall a. Eq a => a -> a -> Bool
    ==0 ]

    -- |The projective plane PG(2,Fq), a square 2-(q^2+q+1,q+1,1) design or Steiner system S(2,q+1,q^2+q+1).

    -- For example, @pg2 f2@ is the Fano plane, a Steiner triple system S(2,3,7).

    pg2 :: (FiniteField k, Ord k) => [k] -> Design [k]
    pg2 :: [k] -> Design [k]
    pg2 fq :: [k]
    fq = ([[k]], [[[k]]]) -> Design [k]
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([[k]]
    points, [[[k]]]
    lines) where
        points :: [[k]]
    points = Int -> [k] -> [[k]]
    forall a. Num a => Int -> [a] -> [[a]]
    ptsPG 2 [k]
    fq
        lines :: [[[k]]]
    lines = [[[k]]] -> [[[k]]]
    forall a. Ord a => [a] -> [a]
    L.sort ([[[k]]] -> [[[k]]]) -> [[[k]]] -> [[[k]]]
    forall a b. (a -> b) -> a -> b
    $ ([k] -> [[k]]) -> [[k]] -> [[[k]]]
    forall a b. (a -> b) -> [a] -> [b]
    map [k] -> [[k]]
    line [[k]]
    points
        line :: [k] -> [[k]]
    line u :: [k]
    u = [[k]
    v | [k]
    v <- [[k]]
    points, [k]
    u [k] -> [k] -> k
    forall a. Num a => [a] -> [a] -> a
    <.> [k]
    v k -> k -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0]
        u :: [a]
    u <.> :: [a] -> [a] -> a
    <.> v :: [a]
    v = [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ((a -> a -> a) -> [a] -> [a] -> [a]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith a -> a -> a
    forall a. Num a => a -> a -> a
    (*) [a]
    u [a]
    v)
    -- Remember that the points and lines of PG(2,Fp) are really the lines and planes of AG(3,Fp).

    -- A line in AG(3,Fp) defines a plane orthogonal to it.

    -- The points and i-flats of PG(n,fq), 1<=i<=n-1, form a 2-design

    -- For i==1, this is a 2-((q^(n+1)-1)/(q-1),q+1,1) design

    -- For i==n-1, this is a 2-((q^(n+1)-1)/(q-1),(q^n-1)/(q-1),(q^(n-1)-1)/(q-1)) design

    -- Cameron & van Lint, p8

    flatsDesignPG :: Int -> [a] -> Int -> Design [a]
    flatsDesignPG n :: Int
    n fq :: [a]
    fq k :: Int
    k = ([[a]], [[[a]]]) -> Design [a]
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([[a]]
    points, [[[a]]]
    blocks) where
        points :: [[a]]
    points = Int -> [a] -> [[a]]
    forall a. Num a => Int -> [a] -> [[a]]
    ptsPG Int
    n [a]
    fq
        blocks :: [[[a]]]
    blocks = ([[a]] -> [[a]]) -> [[[a]]] -> [[[a]]]
    forall a b. (a -> b) -> [a] -> [b]
    map [[a]] -> [[a]]
    forall a. (Num a, Ord a, FinSet a) => [[a]] -> [[a]]
    closurePG ([[[a]]] -> [[[a]]]) -> [[[a]]] -> [[[a]]]
    forall a b. (a -> b) -> a -> b
    $ Int -> [a] -> Int -> [[[a]]]
    forall a. (Eq a, Num a) => Int -> [a] -> Int -> [[[a]]]
    flatsPG Int
    n [a]
    fq Int
    k -- the closurePG replaces the generators of the flat by the list of points of the flat

    -- The projective point-hyperplane design is also denoted PG(n,q)

    pg :: Int -> [a] -> Design [a]
    pg n :: Int
    n fq :: [a]
    fq = Int -> [a] -> Int -> Design [a]
    forall a.
    (Ord a, FinSet a, Num a) =>
    Int -> [a] -> Int -> Design [a]
    flatsDesignPG Int
    n [a]
    fq (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1)

    -- (Cameron & van Lint don't actually state that this is a design except when k == n-1)

    flatsDesignAG :: Int -> [a] -> Int -> Design [a]
    flatsDesignAG n :: Int
    n fq :: [a]
    fq k :: Int
    k = ([[a]], [[[a]]]) -> Design [a]
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([[a]]
    points, [[[a]]]
    blocks) where
        points :: [[a]]
    points = Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    ptsAG Int
    n [a]
    fq
        blocks :: [[[a]]]
    blocks = ([[a]] -> [[a]]) -> [[[a]]] -> [[[a]]]
    forall a b. (a -> b) -> [a] -> [b]
    map [[a]] -> [[a]]
    forall a. (Num a, Ord a, FinSet a) => [[a]] -> [[a]]
    closureAG ([[[a]]] -> [[[a]]]) -> [[[a]]] -> [[[a]]]
    forall a b. (a -> b) -> a -> b
    $ Int -> [a] -> Int -> [[[a]]]
    forall a. (Eq a, Num a) => Int -> [a] -> Int -> [[[a]]]
    flatsAG Int
    n [a]
    fq Int
    k -- the closureAG replaces the generators of the flat by the list of points of the flat

    -- The affine point-hyperplane design is also denoted AG(n,q)

    -- It a 2-(q^n,q^(n-1),(q^(n-1)-1)/(q-1)) design

    -- Cameron & van Lint, p17

    ag :: Int -> [a] -> Design [a]
    ag n :: Int
    n fq :: [a]
    fq = Int -> [a] -> Int -> Design [a]
    forall a.
    (Num a, Ord a, FinSet a) =>
    Int -> [a] -> Int -> Design [a]
    flatsDesignAG Int
    n [a]
    fq (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1)

    -- convert a design to be defined over the set [1..n]

    to1n :: Design a -> Design a
    to1n (D xs :: [a]
    xs bs :: [[a]]
    bs) = ([a] -> [[a]] -> Design a
    forall a. [a] -> [[a]] -> Design a
    D [a]
    xs' [[a]]
    bs') where
        mapping :: Map a a
    mapping = [(a, a)] -> Map a a
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(a, a)] -> Map a a) -> [(a, a)] -> Map a a
    forall a b. (a -> b) -> a -> b
    $ [a] -> [a] -> [(a, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [a]
    xs [1..] -- the mapping from vs to [1..n]

        xs' :: [a]
    xs' = Map a a -> [a]
    forall k a. Map k a -> [a]
    M.elems Map a a
    mapping
        bs' :: [[a]]
    bs' = [(a -> a) -> [a] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (Map a a
    mapping Map a a -> a -> a
    forall k a. Ord k => Map k a -> k -> a
    M.!) [a]
    b | [a]
    b <- [[a]]
    bs] -- the blocks will already be sorted correctly by construction

    -- Cameron & van Lint p10

    paleyDesign :: [a] -> Design a
    paleyDesign fq :: [a]
    fq | [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    fq Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` 4 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 3 = ([a], [[a]]) -> Design a
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([a]
    xs,[[a]]
    bs) where
        xs :: [a]
    xs = [a]
    fq
        qs :: [a]
    qs = [a] -> [a]
    forall a. Ord a => [a] -> [a]
    set [a
    xa -> Integer -> a
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2 | a
    x <- [a]
    xs] [a] -> [a] -> [a]
    forall a. Eq a => [a] -> [a] -> [a]
    L.\\ [0] -- the non-zero squares in Fq

        bs :: [[a]]
    bs = [[a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort ((a -> a) -> [a] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (a
    xa -> a -> a
    forall a. Num a => a -> a -> a
    +) [a]
    qs) | a
    x <- [a]
    xs]

    fanoPlane :: Design F7
    fanoPlane = [F7] -> Design F7
    forall a. (Ord a, Num a) => [a] -> Design a
    paleyDesign [F7]
    f7
    -- isomorphic to PG(2,F2)

    -- NEW DESIGNS FROM OLD

    -- Dual of a design. Cameron & van Lint p11

    -- |The dual of a design

    dual :: (Ord t) => Design t -> Design [t]
    dual :: Design t -> Design [t]
    dual (D xs :: [t]
    xs bs :: [[t]]
    bs) = ([[t]], [[[t]]]) -> Design [t]
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([[t]]
    bs, (t -> [[t]]) -> [t] -> [[[t]]]
    forall a b. (a -> b) -> [a] -> [b]
    map t -> [[t]]
    beta [t]
    xs) where
        beta :: t -> [[t]]
    beta x :: t
    x = ([t] -> Bool) -> [[t]] -> [[t]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (t
    x t -> [t] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem`) [[t]]
    bs

    -- Derived design relative to a point. Cameron & van Lint p11

    -- Derived design of a t-(v,k,lambda) is a t-1-(v-1,k-1,lambda) design.

    derivedDesign :: (Ord t) => Design t -> t -> Design t
    derivedDesign :: Design t -> t -> Design t
    derivedDesign (D xs :: [t]
    xs bs :: [[t]]
    bs) p :: t
    p = ([t], [[t]]) -> Design t
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([t]
    xs [t] -> [t] -> [t]
    forall a. Eq a => [a] -> [a] -> [a]
    L.\\ [t
    p], [[t]
    b [t] -> [t] -> [t]
    forall a. Eq a => [a] -> [a] -> [a]
    L.\\ [t
    p] | [t]
    b <- [[t]]
    bs, t
    p t -> [t] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [t]
    b])

    -- Residual design relative to a point. Cameron & van Lint p13

    -- Point-residual of a t-(v,k,lambda) is a t-1-(v-1,k,mu).

    pointResidual :: (Ord t) => Design t -> t -> Design t
    pointResidual :: Design t -> t -> Design t
    pointResidual (D xs :: [t]
    xs bs :: [[t]]
    bs) p :: t
    p = ([t], [[t]]) -> Design t
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([t]
    xs [t] -> [t] -> [t]
    forall a. Eq a => [a] -> [a] -> [a]
    L.\\ [t
    p], [[t]
    b | [t]
    b <- [[t]]
    bs, t
    p t -> [t] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [t]
    b])

    -- Complementary design. Cameron & van Lint p13

    -- Complement of a t-(v,k,lambda) is a t-(v,v-k,mu).

    complementaryDesign :: Design a -> Design a
    complementaryDesign (D xs :: [a]
    xs bs :: [[a]]
    bs) = ([a], [[a]]) -> Design a
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([a]
    xs, [[a]
    xs [a] -> [a] -> [a]
    forall a. Eq a => [a] -> [a] -> [a]
    L.\\ [a]
    b | [a]
    b <- [[a]]
    bs])

    -- Residual design relative to a block. Cameron & van Lint p13

    -- This is only a design if (xs,bs) is a square design

    -- It may have repeated blocks - but if so, residuals of the complement will not

    -- Block-residual of a 2-(v,k,lambda) is a 2-(v-k,k-lambda,lambda).

    blockResidual :: (Ord t) => Design t -> [t] -> Design t
    blockResidual :: Design t -> [t] -> Design t
    blockResidual d :: Design t
    d@(D xs :: [t]
    xs bs :: [[t]]
    bs) b :: [t]
    b | Design t -> Bool
    forall a. Ord a => Design a -> Bool
    isSquare Design t
    d = ([t], [[t]]) -> Design t
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([t]
    xs [t] -> [t] -> [t]
    forall a. Eq a => [a] -> [a] -> [a]
    L.\\ [t]
    b, [[t]
    b' [t] -> [t] -> [t]
    forall a. Eq a => [a] -> [a] -> [a]
    L.\\ [t]
    b | [t]
    b' <- [[t]]
    bs, [t]
    b' [t] -> [t] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [t]
    b])

    -- DESIGN AUTOMORPHISMS

    isDesignAut :: Design a -> Permutation a -> Bool
    isDesignAut (D xs :: [a]
    xs bs :: [[a]]
    bs) g :: Permutation a
    g | Permutation a -> [a]
    forall a. Permutation a -> [a]
    supp Permutation a
    g [a] -> [a] -> Bool
    forall (t :: * -> *) (t :: * -> *) a.
    (Foldable t, Foldable t, Eq a) =>
    t a -> t a -> Bool
    `isSubset` [a]
    xs = ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([a] -> Set [a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [a]
    bs') [[a]
    b [a] -> Permutation a -> [a]
    forall a. Ord a => [a] -> Permutation a -> [a]
    -^ Permutation a
    g | [a]
    b <- [[a]]
    bs]
        where bs' :: Set [a]
    bs' = [[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList [[a]]
    bs

    -- |The incidence graph of a design

    incidenceGraph :: (Ord a) => Design a -> Graph (Either a [a])
    incidenceGraph :: Design a -> Graph (Either a [a])
    incidenceGraph (D xs :: [a]
    xs bs :: [[a]]
    bs) = [Either a [a]] -> [[Either a [a]]] -> Graph (Either a [a])
    forall a. [a] -> [[a]] -> Graph a
    G [Either a [a]]
    vs [[Either a [a]]]
    es where -- graph (vs,es) where

        vs :: [Either a [a]]
    vs = [Either a [a]] -> [Either a [a]]
    forall a. Ord a => [a] -> [a]
    L.sort ([Either a [a]] -> [Either a [a]])
    -> [Either a [a]] -> [Either a [a]]
    forall a b. (a -> b) -> a -> b
    $ (a -> Either a [a]) -> [a] -> [Either a [a]]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Either a [a]
    forall a b. a -> Either a b
    Left [a]
    xs [Either a [a]] -> [Either a [a]] -> [Either a [a]]
    forall a. [a] -> [a] -> [a]
    ++ ([a] -> Either a [a]) -> [[a]] -> [Either a [a]]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> Either a [a]
    forall a b. b -> Either a b
    Right [[a]]
    bs
        es :: [[Either a [a]]]
    es = [[Either a [a]]] -> [[Either a [a]]]
    forall a. Ord a => [a] -> [a]
    L.sort [ [a -> Either a [a]
    forall a b. a -> Either a b
    Left a
    x, [a] -> Either a [a]
    forall a b. b -> Either a b
    Right [a]
    b] | a
    x <- [a]
    xs, [a]
    b <- [[a]]
    bs, a
    x a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [a]
    b ]

    -- |Find a strong generating set for the automorphism group of a design

    designAuts :: (Ord t) => Design t -> [Permutation t]
    designAuts :: Design t -> [Permutation t]
    designAuts d :: Design t
    d = Graph (Either t [t]) -> [Permutation t]
    forall p b. (Ord p, Ord b) => Graph (Either p b) -> [Permutation p]
    incidenceAuts (Graph (Either t [t]) -> [Permutation t])
    -> Graph (Either t [t]) -> [Permutation t]
    forall a b. (a -> b) -> a -> b
    $ Design t -> Graph (Either t [t])
    forall a. Ord a => Design a -> Graph (Either a [a])
    incidenceGraph Design t
    d

    -- We find design auts by finding graph auts of the incidence graph of the design

    -- In a square design, we need to watch out for graph auts which are mapping points <-> blocks

    designAuts1 :: Design a -> [Permutation a]
    designAuts1 d :: Design a
    d = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Permutation a -> Permutation a -> Bool
    forall a. Eq a => a -> a -> Bool
    /=1) ([Permutation a] -> [Permutation a])
    -> [Permutation a] -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ (Permutation (Either a [a]) -> Permutation a)
    -> [Permutation (Either a [a])] -> [Permutation a]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation (Either a [a]) -> Permutation a
    forall a b. Ord a => Permutation (Either a b) -> Permutation a
    points ([Permutation (Either a [a])] -> [Permutation a])
    -> [Permutation (Either a [a])] -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ Graph (Either a [a]) -> [Permutation (Either a [a])]
    forall a. Ord a => Graph a -> [Permutation a]
    graphAuts (Graph (Either a [a]) -> [Permutation (Either a [a])])
    -> Graph (Either a [a]) -> [Permutation (Either a [a])]
    forall a b. (a -> b) -> a -> b
    $ Design a -> Graph (Either a [a])
    forall a. Ord a => Design a -> Graph (Either a [a])
    incidenceGraph Design a
    d where
        points :: Permutation (Either a b) -> Permutation a
    points h :: Permutation (Either a b)
    h = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [(a
    x,a
    y) | (Left x :: a
    x, Left y :: a
    y) <- Permutation (Either a b) -> [(Either a b, Either a b)]
    forall a. Permutation a -> [(a, a)]
    toPairs Permutation (Either a b)
    h]
         -- This implicitly filters out (Right x, Right y) action on blocks,

         -- and also (Left x, Right y) auts taking points to blocks.

         -- The filter (/=1) is to remove points <-> blocks auts

    -- The incidence graph is a bipartite graph, so the distance function naturally partitions points from blocks

    -- MATHIEU GROUPS AND WITT DESIGNS

    alphaL2_23 :: Permutation Integer
    alphaL2_23 = [[Integer]] -> Permutation Integer
    forall a. Ord a => [[a]] -> Permutation a
    p [[-1],[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22]]                      -- t -> t+1

    betaL2_23 :: Permutation Integer
    betaL2_23  = [[Integer]] -> Permutation Integer
    forall a. Ord a => [[a]] -> Permutation a
    p [[-1],[0],[1,2,4,8,16,9,18,13,3,6,12],[5,10,20,17,11,22,21,19,15,7,14]]                  -- t -> 2*t

    gammaL2_23 :: Permutation Integer
    gammaL2_23 = [[Integer]] -> Permutation Integer
    forall a. Ord a => [[a]] -> Permutation a
    p [[-1,0],[1,22],[2,11],[3,15],[4,17],[5,9],[6,19],[7,13],[8,20],[10,16],[12,21],[14,18]]  -- t -> -1/t

    l2_23 :: [Permutation Integer]
    l2_23 = [Permutation Integer
    alphaL2_23, Permutation Integer
    betaL2_23, Permutation Integer
    gammaL2_23]

    -- Mathieu group M24

    -- Conway and Sloane p274ff

    -- This is the automorphism group of the extended binary Golay code G24

    -- or alternatively of the unique Steiner system S(5,8,24) (which consists of the weight 8 codewords of the above)

    deltaM24 :: Permutation Integer
    deltaM24 = [[Integer]] -> Permutation Integer
    forall a. Ord a => [[a]] -> Permutation a
    p [[-1],[0],[1,18,4,2,6],[3],[5,21,20,10,7],[8,16,13,9,12],[11,19,22,14,17],[15]]
    -- this is t -> t^3 / 9 (for t a quadratic residue), t -> 9 t^3 (t a non-residue)

    -- |Generators for the Mathieu group M24, a finite simple group of order 244823040

    m24 :: [Permutation Integer]
    m24 :: [Permutation Integer]
    m24 = [Permutation Integer
    alphaL2_23, Permutation Integer
    betaL2_23, Permutation Integer
    gammaL2_23, Permutation Integer
    deltaM24]

    -- |A strong generating set for the Mathieu group M24, a finite simple group of order 244823040

    m24sgs :: [Permutation Integer]
    m24sgs :: [Permutation Integer]
    m24sgs = [Permutation Integer] -> [Permutation Integer]
    forall a. (Ord a, Show a) => [Permutation a] -> [Permutation a]
    sgs [Permutation Integer]
    m24

    -- |A strong generating set for the Mathieu group M23, a finite simple group of order 10200960

    m23sgs :: [Permutation Integer]
    m23sgs :: [Permutation Integer]
    m23sgs = (Permutation Integer -> Bool)
    -> [Permutation Integer] -> [Permutation Integer]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\g :: Permutation Integer
    g -> (-1)Integer -> Permutation Integer -> Integer
    forall a. Ord a => a -> Permutation a -> a
    .^Permutation Integer
    g Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == -1) [Permutation Integer]
    m24sgs

    -- |A strong generating set for the Mathieu group M22, a finite simple group of order 443520

    m22sgs :: [Permutation Integer]
    m22sgs :: [Permutation Integer]
    m22sgs = (Permutation Integer -> Bool)
    -> [Permutation Integer] -> [Permutation Integer]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\g :: Permutation Integer
    g -> 0Integer -> Permutation Integer -> Integer
    forall a. Ord a => a -> Permutation a -> a
    .^Permutation Integer
    g Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0) [Permutation Integer]
    m23sgs

    -- sgs uses the base implied by the Ord instance, which will be [-1,0,..]

    -- Steiner system S(5,8,24)

    octad :: [Integer]
    octad = [0,1,2,3,4,7,10,12]
    -- Conway&Sloane p276 - this is a weight 8 codeword from Golay code G24

    -- |The Steiner system S(5,8,24), with 759 blocks, whose automorphism group is M24

    s_5_8_24 :: Design Integer
    s_5_8_24 :: Design Integer
    s_5_8_24 = ([Integer], [[Integer]]) -> Design Integer
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([-1..22], [Integer]
    octad [Integer] -> [Permutation Integer] -> [[Integer]]
    forall a. Ord a => [a] -> [Permutation a] -> [[a]]
    -^^ [Permutation Integer]
    l2_23)
    -- S(5,8,24) constructed as the image of a single octad under the action of PSL(2,23)

    -- 759 blocks ( (24 `choose` 5) `div` (8 `choose` 5) )

    -- Automorphism group is M24

    -- |The Steiner system S(4,7,23), with 253 blocks, whose automorphism group is M23

    s_4_7_23 :: Design Integer
    s_4_7_23 :: Design Integer
    s_4_7_23 = Design Integer -> Integer -> Design Integer
    forall t. Ord t => Design t -> t -> Design t
    derivedDesign Design Integer
    s_5_8_24 (-1)
    -- 253 blocks ( (23 `choose` 4) `div` (7 `choose` 4) )

    -- Automorphism group is M23

    -- |The Steiner system S(3,6,22), with 77 blocks, whose automorphism group is M22

    s_3_6_22 :: Design Integer
    s_3_6_22 :: Design Integer
    s_3_6_22 = Design Integer -> Integer -> Design Integer
    forall t. Ord t => Design t -> t -> Design t
    derivedDesign Design Integer
    s_4_7_23 0
    -- 77 blocks

    -- Automorphism group is M22

    -- Derived design of s_3_6_22 is PG(2,F4)

    -- An alternative construction

    s_5_8_24' :: Design Integer
    s_5_8_24' = [Integer] -> [[Integer]] -> Design Integer
    forall a. [a] -> [[a]] -> Design a
    D [Integer]
    xs [[Integer]]
    bs where
        xs :: [Integer]
    xs = [1..24]
        bs :: [[Integer]]
    bs = [[Integer]] -> [[Integer]] -> [[Integer]]
    forall a. Ord a => [[a]] -> [[a]] -> [[a]]
    sift [] (Int -> [Integer] -> [[Integer]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 8 [Integer]
    xs)
        sift :: [[a]] -> [[a]] -> [[a]]
    sift ls :: [[a]]
    ls (r :: [a]
    r:rs :: [[a]]
    rs) = if ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ((Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <=4) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length) [[a]
    r [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    `intersect` [a]
    l | [a]
    l <- [[a]]
    ls]
                         then [a]
    r [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [[a]] -> [[a]] -> [[a]]
    sift ([a]
    r[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    ls) [[a]]
    rs
                         else [[a]] -> [[a]] -> [[a]]
    sift [[a]]
    ls [[a]]
    rs
        sift ls :: [[a]]
    ls [] = []

    -- Could test that m22sgs are all designAuts of s_3_6_22

    -- S(5,6,12) and M12

    alphaL2_11 :: Permutation Integer
    alphaL2_11 = [[Integer]] -> Permutation Integer
    forall a. Ord a => [[a]] -> Permutation a
    p [[-1],[0,1,2,3,4,5,6,7,8,9,10]]          -- t -> t+1

    betaL2_11 :: Permutation Integer
    betaL2_11  = [[Integer]] -> Permutation Integer
    forall a. Ord a => [[a]] -> Permutation a
    p [[-1],[0],[1,3,9,5,4],[2,6,7,10,8]]      -- t -> 3*t

    gammaL2_11 :: Permutation Integer
    gammaL2_11 = [[Integer]] -> Permutation Integer
    forall a. Ord a => [[a]] -> Permutation a
    p [[-1,0],[1,10],[2,5],[3,7],[4,8],[6,9]]  -- t -> -1/t

    l2_11 :: [Permutation Integer]
    l2_11 = [Permutation Integer
    alphaL2_11, Permutation Integer
    betaL2_11, Permutation Integer
    gammaL2_11]

    deltaM12 :: Permutation Integer
    deltaM12 = [[Integer]] -> Permutation Integer
    forall a. Ord a => [[a]] -> Permutation a
    p [[-1],[0],[1],[2,10],[3,4],[5,9],[6,7],[8]]
    -- Conway&Sloane p271, 327

    hexad :: [Integer]
    hexad = [0,1,3,4,5,9]
    -- the squares (quadratic residues) in F11

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

    -- |The Steiner system S(5,6,12), with 132 blocks, whose automorphism group is M12

    s_5_6_12 :: Design Integer
    s_5_6_12 :: Design Integer
    s_5_6_12 = ([Integer], [[Integer]]) -> Design Integer
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([-1..10], [Integer]
    hexad [Integer] -> [Permutation Integer] -> [[Integer]]
    forall a. Ord a => [a] -> [Permutation a] -> [[a]]
    -^^ [Permutation Integer]
    l2_11)
    -- S(5,6,12) constructed as the image of a single hexad under the action of PSL(2,11)

    -- 132 blocks ( (12 `choose` 5) `div` (6 `choose` 5) )

    -- Automorphism group is M12

    -- |The Steiner system S(4,5,11), with 66 blocks, whose automorphism group is M11

    s_4_5_11 :: Design Integer
    s_4_5_11 :: Design Integer
    s_4_5_11 = Design Integer -> Integer -> Design Integer
    forall t. Ord t => Design t -> t -> Design t
    derivedDesign Design Integer
    s_5_6_12 (-1)
    -- 66 blocks

    -- Automorphism group is M11

    -- |Generators for the Mathieu group M12, a finite simple group of order 95040

    m12 :: [Permutation Integer]
    m12 :: [Permutation Integer]
    m12 = [Permutation Integer
    alphaL2_11, Permutation Integer
    betaL2_11, Permutation Integer
    gammaL2_11, Permutation Integer
    deltaM12]

    -- |A strong generating set for the Mathieu group M12, a finite simple group of order 95040

    m12sgs :: [Permutation Integer]
    m12sgs :: [Permutation Integer]
    m12sgs = [Permutation Integer] -> [Permutation Integer]
    forall a. (Ord a, Show a) => [Permutation a] -> [Permutation a]
    sgs [Permutation Integer]
    m12
    -- order 95040

    -- |A strong generating set for the Mathieu group M11, a finite simple group of order 7920

    m11sgs :: [Permutation Integer]
    m11sgs :: [Permutation Integer]
    m11sgs = (Permutation Integer -> Bool)
    -> [Permutation Integer] -> [Permutation Integer]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\g :: Permutation Integer
    g -> (-1)Integer -> Permutation Integer -> Integer
    forall a. Ord a => a -> Permutation a -> a
    .^Permutation Integer
    g Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == -1) [Permutation Integer]
    m12sgs
    -- order 7920

    {-
    -- WITT DESIGNS
    -- S(5,8,24) AND S(5,6,12)

    -- Let D be a square 2-design.
    -- An n-arc is a set of n points of D, no three of which are contained in a block
    arcs n (D xs bs) = map reverse $ dfs n [] xs where
        dfs 0 ys _ = [ys]
        dfs i ys xs = concat [dfs (i-1) (x:ys) (dropWhile (<=x) xs) | x <- xs, isCompatible (x:ys)]
        isCompatible ys = all ((<=2) . length) [ys `L.intersect` b | b <- bs]

    tangents (D xs bs) arc = [b | b <- bs, length (arc `L.intersect` b) == 1]

    -- !! NOT QUITE AS EXPECTED
    -- Cameron van Lint implies that ovals should have n = 1+(k-1)/lambda, whereas I'm finding that they're one bigger than that
    -- eg length $ ovals $ ag2 f3 should be 54
    -- But ag2 f3 isn't a *square* design
    ovals d =
        let Just (_,k,lambda) = tDesignParams 2 d
            (q,r) = (k-1) `quotRem` lambda
            n = 2+q -- == 1+(k-1)/lambda
        in if r == 0
           then [arc | arc <- arcs n d, arc == L.sort (concat $ map (L.intersect arc) $ tangents d arc)] -- each point has a unique tangent
           else []

    hyperovals d =
        let Just (_,k,lambda) = tDesignParams 2 d
            (q,r) = k `quotRem` lambda
            n = 1+q -- == 1+k/lambda
        in if r == 0
           then filter (null . tangents d) $ arcs n d
           else []

    -- Cameron & van Lint, p22
    -- s_5_8_24 = [length (intersect (head h) (head s)) | h <- [h1,h2,h3], s <- [s1,s2,s3]] where
    s_5_8_24 = design (points,lines) where
        points = map Left xs ++ map Right [1,2,3]
        lines = [map Left b ++ map Right [1,2,3] | b <- bs] ++ -- line plus three points at infinity
                [map Left h ++ map Right [2,3] | h <- h1] ++ -- hyperoval plus two points at infinity
                [map Left h ++ map Right [1,3] | h <- h2] ++
                [map Left h ++ map Right [1,2] | h <- h3] ++
                [map Left s ++ map Right [1] | s <- s1] ++ -- Baer subplanes plus one point at infinity
                [map Left s ++ map Right [2] | s <- s2] ++
                [map Left s ++ map Right [3] | s <- s3] ++
                [map Left (l1 `symDiff` l2) | l1 <- bs, l2 <- bs, l1 < l2]
        d@(D xs bs) = pg2 f4
        hs = hyperovals d
        [h1,h2,h3] = evenClasses hs
        [s2,s1,s3] = oddClasses baerSubplanes -- we have to number the ss so that if h <- hi, s <- sj, then |h intersect s| is even <=> i == j
        evenClasses (h:hs) = let (ys,ns) = partition (even . length . L.intersect h) hs in (h:ys) : evenClasses ns
        evenClasses [] = []
        oddClasses (h:hs) = let (ys,ns) = partition (odd . length . L.intersect h) hs in (h:ys) : oddClasses ns
        oddClasses [] = []
        baerSubplanes = [s | s <- baerSubplanes', and [length (L.intersect s b) `elem` [1,3] | b <- bs] ]
        baerSubplanes' = map reverse $ dfs 7 [] xs where
            dfs 0 ys _ = [ys]
            dfs i ys xs = concat [dfs (i-1) (x:ys) (dropWhile (<=x) xs) | x <- xs, isCompatible (x:ys)]
            isCompatible ys = all ((<=3) . length) [ys `L.intersect` b | b <- bs]
    -}