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

    {-# LANGUAGE NoMonomorphismRestriction #-}
    -- Because unRight defined point-free

    module Math.Algebra.Group.Subquotients where

    import qualified Data.List as L
    import qualified Data.Map as M

    import Math.Common.ListSet
    import Math.Algebra.Group.PermutationGroup hiding (ptStab, normalClosure)
    import Math.Algebra.Group.SchreierSims (cosetRepsGx)
    import Math.Algebra.Group.RandomSchreierSims

    -- Source: Seress, Permutation Group Algorithms

    isLeft :: Either a b -> Bool
    isLeft (Left _) = Bool
    True
    isLeft (Right _) = Bool
    False

    isRight :: Either a b -> Bool
    isRight (Right _) = Bool
    True
    isRight (Left _) = Bool
    False

    unRight :: Permutation (Either a a) -> Permutation a
    unRight = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(a, a)] -> Permutation a)
    -> (Permutation (Either a a) -> [(a, a)])
    -> Permutation (Either a a)
    -> Permutation a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Either a a, Either a a) -> (a, a))
    -> [(Either a a, Either a a)] -> [(a, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Right a :: a
    a, Right b :: a
    b) -> (a
    a,a
    b)) ([(Either a a, Either a a)] -> [(a, a)])
    -> (Permutation (Either a a) -> [(Either a a, Either a a)])
    -> Permutation (Either a a)
    -> [(a, a)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permutation (Either a a) -> [(Either a a, Either a a)]
    forall a. Permutation a -> [(a, a)]
    toPairs

    restrictLeft :: Permutation (Either a b) -> Permutation a
    restrictLeft g :: Permutation (Either a b)
    g = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [(a
    a,a
    b) | (Left a :: a
    a, Left b :: a
    b) <- Permutation (Either a b) -> [(Either a b, Either a b)]
    forall a. Permutation a -> [(a, a)]
    toPairs Permutation (Either a b)
    g]
    -- note that this is doing a filter - taking only the left part of the action - and a map, unLefting

    -- pointwise stabiliser of xs
    ptStab :: [Permutation a] -> t a -> [Permutation a]
    ptStab gs :: [Permutation a]
    gs delta :: t a
    delta = (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 a. Ord a => Permutation (Either a a) -> Permutation a
    unRight ([Permutation (Either a a)] -> [Permutation a])
    -> [Permutation (Either a a)] -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ (Permutation (Either a a) -> Bool)
    -> [Permutation (Either a a)] -> [Permutation (Either a a)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Either a a -> Bool
    forall a b. Either a b -> Bool
    isLeft (Either a a -> Bool)
    -> (Permutation (Either a a) -> Either a a)
    -> Permutation (Either a a)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permutation (Either a a) -> Either a a
    forall c. Permutation c -> c
    minsupp) ([Permutation (Either a a)] -> [Permutation (Either a a)])
    -> [Permutation (Either a a)] -> [Permutation (Either a a)]
    forall a b. (a -> b) -> a -> b
    $ [Permutation (Either a a)] -> [Permutation (Either a a)]
    forall a. (Ord a, Show a) => [Permutation a] -> [Permutation a]
    sgs [Permutation (Either a a)]
    gs' where
        gs' :: [Permutation (Either a a)]
    gs' = [ ([(Either a a, Either a a)] -> Permutation (Either a a)
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(Either a a, Either a a)] -> Permutation (Either a a))
    -> (Permutation a -> [(Either a a, Either a a)])
    -> Permutation a
    -> Permutation (Either a a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a, a) -> (Either a a, Either a a))
    -> [(a, a)] -> [(Either a a, Either a a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(a :: a
    a,b :: a
    b) -> (a -> Either a a
    lr a
    a, a -> Either a a
    lr a
    b)) ([(a, a)] -> [(Either a a, Either a a)])
    -> (Permutation a -> [(a, a)])
    -> Permutation a
    -> [(Either a a, Either a a)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permutation a -> [(a, a)]
    forall a. Permutation a -> [(a, a)]
    toPairs) Permutation a
    g | Permutation a
    g <- [Permutation a]
    gs]
        lr :: a -> Either a a
    lr x :: a
    x = if a
    x a -> t a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` t a
    delta then a -> Either a a
    forall a b. a -> Either a b
    Left a
    x else a -> Either a a
    forall a b. b -> Either a b
    Right a
    x

    {-
    -- !! NEXT TWO FUNCTIONS NOT TESTED
    -- Need some meaningful examples of homomorphisms
    -- eg Sn -> Sym(k-subsets of n)
    -- restrict to a transitive constituent
    -- blocks

    -- Given generators gs for a group G, and f : G -> H a homomorphism,
    -- return the "semi-diagonal" subgroup [(f g, g) | g <- gs] of f(G) * G
    homomorphismConstruction :: (Ord a, Ord b) => [Permutation a] -> (Permutation a -> Permutation b) -> [Permutation (Either b a)]
    homomorphismConstruction gs f = [lift g | g <- gs] where
        lift g = fromPairs $ [(Right x, Right y) | (x,y) <- toPairs g] ++ [(Left x', Left y') | (x',y') <- toPairs (f g)]

    ker gs f = ks where
        gbar = homomorphismConstruction gs f
        gs' = sgs gbar
        ks' = dropWhile (\h -> isLeft $ minsupp h) gs' -- !! should filter isRight - sgs might not be in order
        ks = map unRight ks'
        unRight = fromPairs . map (\(Right a, Right b) -> (a,b)) . toPairs
    -}

    isTransitive :: (Ord t) => [Permutation t] -> Bool
    isTransitive :: [Permutation t] -> Bool
    isTransitive gs :: [Permutation t]
    gs = [[t]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Permutation t] -> [[t]]
    forall a. Ord a => [Permutation a] -> [[a]]
    orbits [Permutation t]
    gs) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1

    -- TRANSITIVE CONSTITUENTS

    {-
    -- find largest composition factor of a group which is not transitive
    -- we do this by taking the smallest orbit delta,
    -- then constructing the homomorphism G -> Sym(delta)
    -- and returning the kernel and the image
    factorNotTransitive gs = transitiveConstituentHomomorphism' gs delta where
        delta = smallest $ orbits gs
        sizeSorted lists = map snd $ L.sort $ [(length l, l) | l <- lists]
        smallest = head . sizeSorted
    -}

    -- Seress p81
    -- |Given a group gs and a transitive constituent ys, return the kernel and image of the transitive constituent homomorphism.
    -- That is, suppose that gs acts on a set xs, and ys is a subset of xs on which gs acts transitively.
    -- Then the transitive constituent homomorphism is the restriction of the action of gs to an action on the ys.
    transitiveConstituentHomomorphism
      :: (Ord a, Show a) =>
         [Permutation a] -> [a] -> ([Permutation a], [Permutation a])
    transitiveConstituentHomomorphism :: [Permutation a] -> [a] -> ([Permutation a], [Permutation a])
    transitiveConstituentHomomorphism gs :: [Permutation a]
    gs delta :: [a]
    delta
        | [a]
    delta [a] -> [a] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [a] -> [a -> a] -> [a]
    forall a. Ord a => [a] -> [a -> a] -> [a]
    closure [a]
    delta [(a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    g) | Permutation a
    g <- [Permutation a]
    gs] -- delta is closed under action of gs, hence a union of orbits
            = [Permutation a] -> [a] -> ([Permutation a], [Permutation a])
    forall (t :: * -> *) b.
    (Foldable t, Show b, Ord b) =>
    [Permutation b] -> t b -> ([Permutation b], [Permutation b])
    transitiveConstituentHomomorphism' [Permutation a]
    gs [a]
    delta

    transitiveConstituentHomomorphism' :: [Permutation b] -> t b -> ([Permutation b], [Permutation b])
    transitiveConstituentHomomorphism' gs :: [Permutation b]
    gs delta :: t b
    delta = ([Permutation b]
    ker, [Permutation b]
    im) where
        gs' :: [Permutation (Either b b)]
    gs' = [Permutation (Either b b)] -> [Permutation (Either b b)]
    forall a. (Ord a, Show a) => [Permutation a] -> [Permutation a]
    sgs ([Permutation (Either b b)] -> [Permutation (Either b b)])
    -> [Permutation (Either b b)] -> [Permutation (Either b b)]
    forall a b. (a -> b) -> a -> b
    $ (Permutation b -> Permutation (Either b b))
    -> [Permutation b] -> [Permutation (Either b b)]
    forall a b. (a -> b) -> [a] -> [b]
    map ([(Either b b, Either b b)] -> Permutation (Either b b)
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(Either b b, Either b b)] -> Permutation (Either b b))
    -> (Permutation b -> [(Either b b, Either b b)])
    -> Permutation b
    -> Permutation (Either b b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((b, b) -> (Either b b, Either b b))
    -> [(b, b)] -> [(Either b b, Either b b)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(a :: b
    a,b :: b
    b) -> (b -> Either b b
    lr b
    a, b -> Either b b
    lr b
    b)) ([(b, b)] -> [(Either b b, Either b b)])
    -> (Permutation b -> [(b, b)])
    -> Permutation b
    -> [(Either b b, Either b b)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permutation b -> [(b, b)]
    forall a. Permutation a -> [(a, a)]
    toPairs) [Permutation b]
    gs
        -- as delta is a transitive constituent, we will always have a and b either both Left or both Right
        lr :: b -> Either b b
    lr x :: b
    x = if b
    x b -> t b -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` t b
    delta then b -> Either b b
    forall a b. a -> Either a b
    Left b
    x else b -> Either b b
    forall a b. b -> Either a b
    Right b
    x
        ker :: [Permutation b]
    ker = (Permutation (Either b b) -> Permutation b)
    -> [Permutation (Either b b)] -> [Permutation b]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation (Either b b) -> Permutation b
    forall a a. Ord a => Permutation (Either a a) -> Permutation a
    unRight ([Permutation (Either b b)] -> [Permutation b])
    -> [Permutation (Either b b)] -> [Permutation b]
    forall a b. (a -> b) -> a -> b
    $ (Permutation (Either b b) -> Bool)
    -> [Permutation (Either b b)] -> [Permutation (Either b b)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Either b b -> Bool
    forall a b. Either a b -> Bool
    isLeft (Either b b -> Bool)
    -> (Permutation (Either b b) -> Either b b)
    -> Permutation (Either b b)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permutation (Either b b) -> Either b b
    forall c. Permutation c -> c
    minsupp) [Permutation (Either b b)]
    gs' -- pointwise stabiliser of delta
        im :: [Permutation b]
    im = (Permutation (Either b b) -> Permutation b)
    -> [Permutation (Either b b)] -> [Permutation b]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation (Either b b) -> Permutation b
    forall a b. Ord a => Permutation (Either a b) -> Permutation a
    restrictLeft ([Permutation (Either b b)] -> [Permutation b])
    -> [Permutation (Either b b)] -> [Permutation b]
    forall a b. (a -> b) -> a -> b
    $ (Permutation (Either b b) -> Bool)
    -> [Permutation (Either b b)] -> [Permutation (Either b b)]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Either b b -> Bool
    forall a b. Either a b -> Bool
    isLeft (Either b b -> Bool)
    -> (Permutation (Either b b) -> Either b b)
    -> Permutation (Either b b)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permutation (Either b b) -> Either b b
    forall c. Permutation c -> c
    minsupp) [Permutation (Either b b)]
    gs' -- restriction of the action to delta

    -- BLOCKS OF IMPRIMITIVITY

    -- Holt p83ff (and also Seress p107ff)
    -- Find a minimal block containing ys. ys are assumed to be sorted.
    minimalBlock :: [Permutation a] -> [a] -> [[a]]
    minimalBlock gs :: [Permutation a]
    gs ys :: [a]
    ys@(y1 :: a
    y1:yt :: [a]
    yt) = Map a a -> [a] -> [Permutation a] -> [[a]]
    minimalBlock' Map a a
    p [a]
    yt [Permutation a]
    gs where
        xs :: [a]
    xs = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    union [] ([[a]] -> [a]) -> [[a]] -> [a]
    forall a b. (a -> b) -> a -> b
    $ (Permutation a -> [a]) -> [Permutation a] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation a -> [a]
    forall a. Permutation a -> [a]
    supp [Permutation a]
    gs
        p :: Map a a
    p = [(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
    yi,a
    y1) | a
    yi <- [a]
    ys] [(a, a)] -> [(a, a)] -> [(a, a)]
    forall a. [a] -> [a] -> [a]
    ++ [(a
    x,a
    x) | a
    x <- [a]
    xs [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    \\ [a]
    ys]
        minimalBlock' :: Map a a -> [a] -> [Permutation a] -> [[a]]
    minimalBlock' p :: Map a a
    p (q :: a
    q:qs :: [a]
    qs) (h :: Permutation a
    h:hs :: [Permutation a]
    hs) =
            let r :: a
    r = Map a a
    p Map a a -> a -> a
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    q         -- representative of class containing q
                k :: a
    k = Map a a
    p Map a a -> a -> a
    forall k a. Ord k => Map k a -> k -> a
    M.! (a
    q a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    h)  -- rep of class (q^h)
                l :: a
    l = Map a a
    p Map a a -> a -> a
    forall k a. Ord k => Map k a -> k -> a
    M.! (a
    r a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    h)  -- rep of class (r^h)
            in if a
    k a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    l -- then we need to merge the classes
               then let p' :: Map a a
    p' = (a -> a) -> Map a a -> Map a a
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map (\x :: a
    x -> if a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    l then a
    k else a
    x) Map a a
    p
                        qs' :: [a]
    qs' = [a]
    qs [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a
    l]
                    in Map a a -> [a] -> [Permutation a] -> [[a]]
    minimalBlock' Map a a
    p' (a
    qa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    qs') [Permutation a]
    hs
               else Map a a -> [a] -> [Permutation a] -> [[a]]
    minimalBlock' Map a a
    p (a
    qa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    qs) [Permutation a]
    hs
        minimalBlock' p :: Map a a
    p (q :: a
    q:qs :: [a]
    qs) [] = Map a a -> [a] -> [Permutation a] -> [[a]]
    minimalBlock' Map a a
    p [a]
    qs [Permutation a]
    gs
        minimalBlock' p :: Map a a
    p [] _ =
            let reps :: [a]
    reps = [a] -> [a]
    forall b. Ord b => [b] -> [b]
    toListSet ([a] -> [a]) -> [a] -> [a]
    forall a b. (a -> b) -> a -> b
    $ Map a a -> [a]
    forall k a. Map k a -> [a]
    M.elems Map a a
    p
            in [[a]] -> [[a]]
    forall b. Ord b => [b] -> [b]
    L.sort [ (a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\x :: a
    x -> Map a a
    p Map a a -> a -> a
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    r) [a]
    xs | a
    r <- [a]
    reps ]
    -- Because the support of the permutations is not constrained to be [1..n], we have to use a map instead of an array
    -- This probably affects the complexity, but isn't a problem in practice

    -- |Given a transitive group gs, find all non-trivial block systems. That is, if gs act on xs,
    -- find all the ways that the xs can be divided into blocks, such that the gs also have a permutation action on the blocks
    blockSystems :: (Ord t) => [Permutation t] -> [[[t]]]
    blockSystems :: [Permutation t] -> [[[t]]]
    blockSystems gs :: [Permutation t]
    gs
        | [Permutation t] -> Bool
    forall t. Ord t => [Permutation t] -> Bool
    isTransitive [Permutation t]
    gs = [[[t]]] -> [[[t]]]
    forall b. Ord b => [b] -> [b]
    toListSet ([[[t]]] -> [[[t]]]) -> [[[t]]] -> [[[t]]]
    forall a b. (a -> b) -> a -> b
    $ ([[t]] -> Bool) -> [[[t]]] -> [[[t]]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ([[t]] -> [[t]] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [t
    xt -> [t] -> [t]
    forall a. a -> [a] -> [a]
    :[t]
    xs]) ([[[t]]] -> [[[t]]]) -> [[[t]]] -> [[[t]]]
    forall a b. (a -> b) -> a -> b
    $ ([t] -> [[t]]) -> [[t]] -> [[[t]]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Permutation t] -> [t] -> [[t]]
    forall a. Ord a => [Permutation a] -> [a] -> [[a]]
    minimalBlock [Permutation t]
    gs) [ [t
    x,t
    x'] | t
    x' <- [t]
    xs ]
        | Bool
    otherwise = [Char] -> [[[t]]]
    forall a. HasCallStack => [Char] -> a
    error "blockSystems: not transitive"
        where x :: t
    x:xs :: [t]
    xs = ([t] -> [t] -> [t]) -> [t] -> [[t]] -> [t]
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl [t] -> [t] -> [t]
    forall a. Ord a => [a] -> [a] -> [a]
    union [] ([[t]] -> [t]) -> [[t]] -> [t]
    forall a b. (a -> b) -> a -> b
    $ (Permutation t -> [t]) -> [Permutation t] -> [[t]]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation t -> [t]
    forall a. Permutation a -> [a]
    supp [Permutation t]
    gs

    -- |A more efficient version of blockSystems, if we have an sgs
    blockSystemsSGS :: (Ord a) => [Permutation a] -> [[[a]]]
    blockSystemsSGS :: [Permutation a] -> [[[a]]]
    blockSystemsSGS gs :: [Permutation a]
    gs = [[[a]]] -> [[[a]]]
    forall b. Ord b => [b] -> [b]
    toListSet ([[[a]]] -> [[[a]]]) -> [[[a]]] -> [[[a]]]
    forall a b. (a -> b) -> a -> b
    $ ([[a]] -> Bool) -> [[[a]]] -> [[[a]]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ([[a]] -> [[a]] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    xs]) ([[[a]]] -> [[[a]]]) -> [[[a]]] -> [[[a]]]
    forall a b. (a -> b) -> a -> b
    $ ([a] -> [[a]]) -> [[a]] -> [[[a]]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Permutation a] -> [a] -> [[a]]
    forall a. Ord a => [Permutation a] -> [a] -> [[a]]
    minimalBlock [Permutation a]
    gs) [ [a
    x,a
    x'] | a
    x' <- [a]
    rs ]
        where x :: a
    x:xs :: [a]
    xs = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    union [] ([[a]] -> [a]) -> [[a]] -> [a]
    forall a b. (a -> b) -> a -> b
    $ (Permutation a -> [a]) -> [Permutation a] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation a -> [a]
    forall a. Permutation a -> [a]
    supp [Permutation a]
    gs
              hs :: [Permutation a]
    hs = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\g :: Permutation a
    g -> a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < Permutation a -> a
    forall c. Permutation c -> c
    minsupp Permutation a
    g) [Permutation a]
    gs -- sgs for stabiliser Gx
              os :: [[a]]
    os = [Permutation a] -> [[a]]
    forall a. Ord a => [Permutation a] -> [[a]]
    orbits [Permutation a]
    hs
              rs :: [a]
    rs = ([a] -> a) -> [[a]] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> a
    forall a. [a] -> a
    head [[a]]
    os [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ ([a]
    xs [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    \\ [a] -> [a]
    forall b. Ord b => [b] -> [b]
    L.sort ([[a]] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[a]]
    os)) -- orbit representatives, including singleton cycles
    -- Perhaps we could have a function which just returns orbit reps for stabiliser

    -- eg for D 10, the stabiliser of 1 is [[2,6],[3,5]] - we need to make sure we don't forget 4

    -- If we didn't have an SGS, we could try to randomly generate a few elts of stabiliser Gx, as that would still be better than nothing
    -- see Holt RandomStab function

    -- |A permutation group is primitive if it has no non-trivial block systems
    isPrimitive :: (Ord t) => [Permutation t] -> Bool
    isPrimitive :: [Permutation t] -> Bool
    isPrimitive gs :: [Permutation t]
    gs = [[[t]]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([Permutation t] -> [[[t]]]
    forall t. Ord t => [Permutation t] -> [[[t]]]
    blockSystems [Permutation t]
    gs)

    isPrimitiveSGS :: (Ord a) => [Permutation a] -> Bool
    isPrimitiveSGS :: [Permutation a] -> Bool
    isPrimitiveSGS gs :: [Permutation a]
    gs = [[[a]]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([Permutation a] -> [[[a]]]
    forall t. Ord t => [Permutation t] -> [[[t]]]
    blockSystemsSGS [Permutation a]
    gs)

    -- There are other optimisations we haven't done
    -- see Holt p86

    -- |Given a transitive group gs, and a block system for gs, return the kernel and image of the block homomorphism
    -- (the homomorphism onto the action of gs on the blocks)
    blockHomomorphism
      :: (Ord t, Show t) =>
         [Permutation t] -> [[t]] -> ([Permutation t], [Permutation [t]])
    blockHomomorphism :: [Permutation t] -> [[t]] -> ([Permutation t], [Permutation [t]])
    blockHomomorphism gs :: [Permutation t]
    gs bs :: [[t]]
    bs
        | [[t]]
    bs [[t]] -> [[t]] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [[t]] -> [[t] -> [t]] -> [[t]]
    forall a. Ord a => [a] -> [a -> a] -> [a]
    closure [[t]]
    bs [([t] -> Permutation t -> [t]
    forall a. Ord a => [a] -> Permutation a -> [a]
    -^ Permutation t
    g) | Permutation t
    g <- [Permutation t]
    gs] -- bs is closed under action of gs
            = [Permutation t] -> [[t]] -> ([Permutation t], [Permutation [t]])
    forall b.
    (Show b, Ord b) =>
    [Permutation b] -> [[b]] -> ([Permutation b], [Permutation [b]])
    blockHomomorphism' [Permutation t]
    gs [[t]]
    bs

    blockHomomorphism' :: [Permutation b] -> [[b]] -> ([Permutation b], [Permutation [b]])
    blockHomomorphism' gs :: [Permutation b]
    gs bs :: [[b]]
    bs = ([Permutation b]
    ker,[Permutation [b]]
    im) where
        gs' :: [Permutation (Either [b] b)]
    gs' = [Permutation (Either [b] b)] -> [Permutation (Either [b] b)]
    forall a. (Ord a, Show a) => [Permutation a] -> [Permutation a]
    sgs ([Permutation (Either [b] b)] -> [Permutation (Either [b] b)])
    -> [Permutation (Either [b] b)] -> [Permutation (Either [b] b)]
    forall a b. (a -> b) -> a -> b
    $ (Permutation b -> Permutation (Either [b] b))
    -> [Permutation b] -> [Permutation (Either [b] b)]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation b -> Permutation (Either [b] b)
    lr [Permutation b]
    gs
        lr :: Permutation b -> Permutation (Either [b] b)
    lr g :: Permutation b
    g = [(Either [b] b, Either [b] b)] -> Permutation (Either [b] b)
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(Either [b] b, Either [b] b)] -> Permutation (Either [b] b))
    -> [(Either [b] b, Either [b] b)] -> Permutation (Either [b] b)
    forall a b. (a -> b) -> a -> b
    $ [([b] -> Either [b] b
    forall a b. a -> Either a b
    Left [b]
    b, [b] -> Either [b] b
    forall a b. a -> Either a b
    Left ([b] -> Either [b] b) -> [b] -> Either [b] b
    forall a b. (a -> b) -> a -> b
    $ [b]
    b [b] -> Permutation b -> [b]
    forall a. Ord a => [a] -> Permutation a -> [a]
    -^ Permutation b
    g) | [b]
    b <- [[b]]
    bs] [(Either [b] b, Either [b] b)]
    -> [(Either [b] b, Either [b] b)] -> [(Either [b] b, Either [b] b)]
    forall a. [a] -> [a] -> [a]
    ++ [(b -> Either [b] b
    forall a b. b -> Either a b
    Right b
    x, b -> Either [b] b
    forall a b. b -> Either a b
    Right b
    y) | (x :: b
    x,y :: b
    y) <- Permutation b -> [(b, b)]
    forall a. Permutation a -> [(a, a)]
    toPairs Permutation b
    g]
        ker :: [Permutation b]
    ker = (Permutation (Either [b] b) -> Permutation b)
    -> [Permutation (Either [b] b)] -> [Permutation b]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation (Either [b] b) -> Permutation b
    forall a a. Ord a => Permutation (Either a a) -> Permutation a
    unRight ([Permutation (Either [b] b)] -> [Permutation b])
    -> [Permutation (Either [b] b)] -> [Permutation b]
    forall a b. (a -> b) -> a -> b
    $ (Permutation (Either [b] b) -> Bool)
    -> [Permutation (Either [b] b)] -> [Permutation (Either [b] b)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Either [b] b -> Bool
    forall a b. Either a b -> Bool
    isLeft (Either [b] b -> Bool)
    -> (Permutation (Either [b] b) -> Either [b] b)
    -> Permutation (Either [b] b)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permutation (Either [b] b) -> Either [b] b
    forall c. Permutation c -> c
    minsupp) [Permutation (Either [b] b)]
    gs' -- stabiliser of the blocks
        im :: [Permutation [b]]
    im = (Permutation (Either [b] b) -> Permutation [b])
    -> [Permutation (Either [b] b)] -> [Permutation [b]]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation (Either [b] b) -> Permutation [b]
    forall a b. Ord a => Permutation (Either a b) -> Permutation a
    restrictLeft ([Permutation (Either [b] b)] -> [Permutation [b]])
    -> [Permutation (Either [b] b)] -> [Permutation [b]]
    forall a b. (a -> b) -> a -> b
    $ (Permutation (Either [b] b) -> Bool)
    -> [Permutation (Either [b] b)] -> [Permutation (Either [b] b)]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Either [b] b -> Bool
    forall a b. Either a b -> Bool
    isLeft (Either [b] b -> Bool)
    -> (Permutation (Either [b] b) -> Either [b] b)
    -> Permutation (Either [b] b)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permutation (Either [b] b) -> Either [b] b
    forall c. Permutation c -> c
    minsupp) [Permutation (Either [b] b)]
    gs' -- restriction to the action on blocks

    -- Note that there is a slightly more efficient way to calculate block homomorphism,
    -- but requires change of base algorithm which we haven't implemented yet

    -- NORMAL CLOSURE

    -- Seress 115
    -- Given G, H < Sym(Omega) return <H^G> (the normal closure)
    normalClosure :: [Permutation a] -> [Permutation a] -> [Permutation a]
    normalClosure gs :: [Permutation a]
    gs hs :: [Permutation a]
    hs = (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 a. Ord a => Permutation (Either a a) -> Permutation a
    unRight ([Permutation (Either a a)] -> [Permutation a])
    -> [Permutation (Either a a)] -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ (Permutation (Either a a) -> Bool)
    -> [Permutation (Either a a)] -> [Permutation (Either a a)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Either a a -> Bool
    forall a b. Either a b -> Bool
    isLeft (Either a a -> Bool)
    -> (Permutation (Either a a) -> Either a a)
    -> Permutation (Either a a)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permutation (Either a a) -> Either a a
    forall c. Permutation c -> c
    minsupp) ([Permutation (Either a a)] -> [Permutation (Either a a)])
    -> [Permutation (Either a a)] -> [Permutation (Either a a)]
    forall a b. (a -> b) -> a -> b
    $ [Permutation (Either a a)] -> [Permutation (Either a a)]
    forall a. (Ord a, Show a) => [Permutation a] -> [Permutation a]
    sgs [Permutation (Either a a)]
    ks where
        xs :: [a]
    xs = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    union [] ([[a]] -> [a]) -> [[a]] -> [a]
    forall a b. (a -> b) -> a -> b
    $ (Permutation a -> [a]) -> [Permutation a] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation a -> [a]
    forall a. Permutation a -> [a]
    supp ([Permutation a] -> [[a]]) -> [Permutation a] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ [Permutation a]
    gs [Permutation a] -> [Permutation a] -> [Permutation a]
    forall a. [a] -> [a] -> [a]
    ++ [Permutation a]
    hs
        ds :: [Permutation (Either a a)]
    ds = (Permutation a -> Permutation (Either a a))
    -> [Permutation a] -> [Permutation (Either a a)]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation a -> Permutation (Either a a)
    forall b. Ord b => Permutation b -> Permutation (Either b b)
    diag [Permutation a]
    gs -- {(g,g) | g <- G}
        diag :: Permutation b -> Permutation (Either b b)
    diag g :: Permutation b
    g = [(Either b b, Either b b)] -> Permutation (Either b b)
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(Either b b, Either b b)] -> Permutation (Either b b))
    -> [(Either b b, Either b b)] -> Permutation (Either b b)
    forall a b. (a -> b) -> a -> b
    $ [[(Either b b, Either b b)]] -> [(Either b b, Either b b)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ [(b -> Either b b
    forall a b. a -> Either a b
    Left b
    x, b -> Either b b
    forall a b. a -> Either a b
    Left b
    y) , (b -> Either b b
    forall a b. b -> Either a b
    Right b
    x, b -> Either b b
    forall a b. b -> Either a b
    Right b
    y)] | (x :: b
    x,y :: b
    y) <- Permutation b -> [(b, b)]
    forall a. Permutation a -> [(a, a)]
    toPairs Permutation b
    g]
        hsR :: [Permutation (Either a a)]
    hsR = (Permutation a -> Permutation (Either a a))
    -> [Permutation a] -> [Permutation (Either a a)]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation a -> Permutation (Either a a)
    forall a b.
    (Ord a, Ord b) =>
    Permutation b -> Permutation (Either a b)
    inR [Permutation a]
    hs -- {(1,h) | h <- H}
        inR :: Permutation b -> Permutation (Either a b)
    inR h :: Permutation b
    h = [(Either a b, Either a b)] -> Permutation (Either a b)
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [(b -> Either a b
    forall a b. b -> Either a b
    Right b
    x, b -> Either a b
    forall a b. b -> Either a b
    Right b
    y) | (x :: b
    x,y :: b
    y) <- Permutation b -> [(b, b)]
    forall a. Permutation a -> [(a, a)]
    toPairs Permutation b
    h]
        ks :: [Permutation (Either a a)]
    ks = [Permutation (Either a a)]
    ds [Permutation (Either a a)]
    -> [Permutation (Either a a)] -> [Permutation (Either a a)]
    forall a. [a] -> [a] -> [a]
    ++ [Permutation (Either a a)]
    forall a. Ord a => [Permutation (Either a a)]
    hsR

    -- Seress 116
    -- Given G, H < Sym(Omega) return <H^G> `intersection` G
    intersectionNormalClosure :: [Permutation a] -> [Permutation a] -> [Permutation a]
    intersectionNormalClosure gs :: [Permutation a]
    gs hs :: [Permutation a]
    hs = (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 a. Ord a => Permutation (Either a a) -> Permutation a
    unRight ([Permutation (Either a a)] -> [Permutation a])
    -> [Permutation (Either a a)] -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ (Permutation (Either a a) -> Bool)
    -> [Permutation (Either a a)] -> [Permutation (Either a a)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Either a a -> Bool
    forall a b. Either a b -> Bool
    isLeft (Either a a -> Bool)
    -> (Permutation (Either a a) -> Either a a)
    -> Permutation (Either a a)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permutation (Either a a) -> Either a a
    forall c. Permutation c -> c
    minsupp) ([Permutation (Either a a)] -> [Permutation (Either a a)])
    -> [Permutation (Either a a)] -> [Permutation (Either a a)]
    forall a b. (a -> b) -> a -> b
    $ [Permutation (Either a a)] -> [Permutation (Either a a)]
    forall a. (Ord a, Show a) => [Permutation a] -> [Permutation a]
    sgs [Permutation (Either a a)]
    ks where
        xs :: [a]
    xs = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    union [] ([[a]] -> [a]) -> [[a]] -> [a]
    forall a b. (a -> b) -> a -> b
    $ (Permutation a -> [a]) -> [Permutation a] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation a -> [a]
    forall a. Permutation a -> [a]
    supp ([Permutation a] -> [[a]]) -> [Permutation a] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ [Permutation a]
    gs [Permutation a] -> [Permutation a] -> [Permutation a]
    forall a. [a] -> [a] -> [a]
    ++ [Permutation a]
    hs
        ds :: [Permutation (Either a a)]
    ds = (Permutation a -> Permutation (Either a a))
    -> [Permutation a] -> [Permutation (Either a a)]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation a -> Permutation (Either a a)
    forall b. Ord b => Permutation b -> Permutation (Either b b)
    diag [Permutation a]
    gs -- {(g,g) | g <- G}
        diag :: Permutation b -> Permutation (Either b b)
    diag g :: Permutation b
    g = [(Either b b, Either b b)] -> Permutation (Either b b)
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(Either b b, Either b b)] -> Permutation (Either b b))
    -> [(Either b b, Either b b)] -> Permutation (Either b b)
    forall a b. (a -> b) -> a -> b
    $ [[(Either b b, Either b b)]] -> [(Either b b, Either b b)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ [(b -> Either b b
    forall a b. a -> Either a b
    Left b
    x, b -> Either b b
    forall a b. a -> Either a b
    Left b
    y) , (b -> Either b b
    forall a b. b -> Either a b
    Right b
    x, b -> Either b b
    forall a b. b -> Either a b
    Right b
    y)] | (x :: b
    x,y :: b
    y) <- Permutation b -> [(b, b)]
    forall a. Permutation a -> [(a, a)]
    toPairs Permutation b
    g]
        hsL :: [Permutation (Either a b)]
    hsL = (Permutation a -> Permutation (Either a b))
    -> [Permutation a] -> [Permutation (Either a b)]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation a -> Permutation (Either a b)
    forall a b.
    (Ord a, Ord b) =>
    Permutation a -> Permutation (Either a b)
    inL [Permutation a]
    hs -- {(h,1) | h <- H}
        inL :: Permutation a -> Permutation (Either a b)
    inL h :: Permutation a
    h = [(Either a b, Either a b)] -> Permutation (Either a b)
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [(a -> Either a b
    forall a b. a -> Either a b
    Left a
    x, a -> Either a b
    forall a b. a -> Either a b
    Left a
    y) | (x :: a
    x,y :: a
    y) <- Permutation a -> [(a, a)]
    forall a. Permutation a -> [(a, a)]
    toPairs Permutation a
    h]
        ks :: [Permutation (Either a a)]
    ks = [Permutation (Either a a)]
    ds [Permutation (Either a a)]
    -> [Permutation (Either a a)] -> [Permutation (Either a a)]
    forall a. [a] -> [a] -> [a]
    ++ [Permutation (Either a a)]
    forall b. Ord b => [Permutation (Either a b)]
    hsL

    -- CENTRALISER IN THE SYMMETRIC GROUP

    -- Centralizer of G in Sym(X) - transitive case
    centralizerSymTrans :: [Permutation a] -> [Permutation a]
    centralizerSymTrans gs :: [Permutation a]
    gs = (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 a] -> [a] -> [Permutation a]
    centralizerSymTrans' [] [a]
    fix_g_a where
        xs :: [a]
    xs@(a :: a
    a:_) = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    union [] ([[a]] -> [a]) -> [[a]] -> [a]
    forall a b. (a -> b) -> a -> b
    $ (Permutation a -> [a]) -> [Permutation a] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation a -> [a]
    forall a. Permutation a -> [a]
    supp [Permutation a]
    gs
        ss :: [Permutation a]
    ss = [Permutation a] -> [Permutation a]
    forall a. (Ord a, Show a) => [Permutation a] -> [Permutation a]
    sgs [Permutation a]
    gs
        g_a :: [Permutation a]
    g_a = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile ( (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==a
    a) (a -> Bool) -> (Permutation a -> a) -> Permutation a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permutation a -> a
    forall c. Permutation c -> c
    minsupp ) [Permutation a]
    ss -- pt stabiliser of a
        fix_g_a :: [a]
    fix_g_a = [a]
    xs [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    \\ (([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    union [] ([[a]] -> [a]) -> [[a]] -> [a]
    forall a b. (a -> b) -> a -> b
    $ (Permutation a -> [a]) -> [Permutation a] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation a -> [a]
    forall a. Permutation a -> [a]
    supp [Permutation a]
    g_a) -- the pts fixed by stabiliser of a
        reps_a :: Map a (Permutation a)
    reps_a = [Permutation a] -> a -> Map a (Permutation a)
    forall k. Ord k => [Permutation k] -> k -> Map k (Permutation k)
    cosetRepsGx [Permutation a]
    gs a
    a
        -- xs = M.keys reps_a
        centralizingElt :: a -> Permutation a
    centralizingElt b :: a
    b = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [ let g :: Permutation a
    g = Map a (Permutation a)
    reps_a Map a (Permutation a) -> a -> Permutation a
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    x in (a
    x, a
    b a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    g) | a
    x <- [a]
    xs ]
        centralizerSymTrans' :: [Permutation a] -> [a] -> [Permutation a]
    centralizerSymTrans' ls :: [Permutation a]
    ls (r :: a
    r:rs :: [a]
    rs) =
            let c :: Permutation a
    c = a -> Permutation a
    centralizingElt a
    r
            in Permutation a
    c Permutation a -> [Permutation a] -> [Permutation a]
    forall a. a -> [a] -> [a]
    : [Permutation a] -> [a] -> [Permutation a]
    centralizerSymTrans' (Permutation a
    cPermutation a -> [Permutation a] -> [Permutation a]
    forall a. a -> [a] -> [a]
    :[Permutation a]
    ls) ([a]
    rs [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    \\ [Permutation a] -> a -> [a]
    forall t. Ord t => [Permutation t] -> t -> [t]
    orbitP (Permutation a
    cPermutation a -> [Permutation a] -> [Permutation a]
    forall a. a -> [a] -> [a]
    :[Permutation a]
    ls) a
    a)
        centralizerSymTrans' _ [] = []