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

    module Math.Algebra.Group.SchreierSims where

    import qualified Data.List as L
    import Data.Maybe (isNothing, isJust)
    import qualified Data.Set as S
    import qualified Data.Map as M
    import Math.Algebra.Group.PermutationGroup hiding (elts, order, orderBSGS, gens, isMember, isSubgp, isNormal, reduceGens, normalClosure, commutatorGp, derivedSubgp)
    import Math.Common.ListSet (toListSet)
    import Math.Core.Utils hiding (elts)

    -- COSET REPRESENTATIVES FOR STABILISER OF A POINT

    -- Given a group G = <gs>, and a point x, find (right) coset representatives for Gx (stabiliser of x) in G

    -- In other words, for each x' in the orbit of x under G, we find a g <- G taking x to x'

    -- The code is similar to the code for calculating orbits, but modified to keep track of the group elements that we used to get there

    cosetRepsGx :: [Permutation k] -> k -> Map k (Permutation k)
    cosetRepsGx gs :: [Permutation k]
    gs x :: k
    x = [Permutation k]
    -> Map k (Permutation k)
    -> Map k (Permutation k)
    -> Map k (Permutation k)
    forall k.
    Ord k =>
    [Permutation k]
    -> Map k (Permutation k)
    -> Map k (Permutation k)
    -> Map k (Permutation k)
    cosetRepsGx' [Permutation k]
    gs Map k (Permutation k)
    forall k a. Map k a
    M.empty (k -> Permutation k -> Map k (Permutation k)
    forall k a. k -> a -> Map k a
    M.singleton k
    x 1) where
        cosetRepsGx' :: [Permutation k]
    -> Map k (Permutation k)
    -> Map k (Permutation k)
    -> Map k (Permutation k)
    cosetRepsGx' gs :: [Permutation k]
    gs interior :: Map k (Permutation k)
    interior boundary :: Map k (Permutation k)
    boundary
            | Map k (Permutation k) -> Bool
    forall k a. Map k a -> Bool
    M.null Map k (Permutation k)
    boundary = Map k (Permutation k)
    interior
            | Bool
    otherwise =
                let interior' :: Map k (Permutation k)
    interior' = Map k (Permutation k)
    -> Map k (Permutation k) -> Map k (Permutation k)
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    M.union Map k (Permutation k)
    interior Map k (Permutation k)
    boundary
                    boundary' :: Map k (Permutation k)
    boundary' = [(k, Permutation k)] -> Map k (Permutation k)
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(k
    p k -> Permutation k -> k
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation k
    g, Permutation k
    hPermutation k -> Permutation k -> Permutation k
    forall a. Num a => a -> a -> a
    *Permutation k
    g) | Permutation k
    g <- [Permutation k]
    gs, (p :: k
    p,h :: Permutation k
    h) <- Map k (Permutation k) -> [(k, Permutation k)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map k (Permutation k)
    boundary] Map k (Permutation k)
    -> Map k (Permutation k) -> Map k (Permutation k)
    forall k a b. Ord k => Map k a -> Map k b -> Map k a
    M.\\ Map k (Permutation k)
    interior'
                in [Permutation k]
    -> Map k (Permutation k)
    -> Map k (Permutation k)
    -> Map k (Permutation k)
    cosetRepsGx' [Permutation k]
    gs Map k (Permutation k)
    interior' Map k (Permutation k)
    boundary'

    -- SCHREIER GENERATORS

    -- toSet xs = (map head . group . sort) xs

    -- Generators for Gx, the stabiliser of x, given that G is generated by gs, and rs is a set of coset representatives for Gx in G.

    -- Schreier's Lemma states that if H < G = <S>, and R is a set of coset reps for H in G

    -- then H is generated by { rs(rs)*^-1 | r <- R, s <- S } (where * means "the coset representative of")

    -- In particular, with H = Gx, this gives us a way of finding a set of generators for Gx

    schreierGeneratorsGx :: (a, Map a (Permutation a)) -> [Permutation a] -> [Permutation a]
    schreierGeneratorsGx (x :: a
    x,rs :: Map a (Permutation a)
    rs) gs :: [Permutation a]
    gs = [Permutation a] -> [Permutation a]
    forall a. Eq a => [a] -> [a]
    L.nub ([Permutation a] -> [Permutation a])
    -> [Permutation a] -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ (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
    schreierGenerator Permutation a
    r Permutation a
    g | Permutation a
    r <- Map a (Permutation a) -> [Permutation a]
    forall k a. Map k a -> [a]
    M.elems Map a (Permutation a)
    rs,  Permutation a
    g <- [Permutation a]
    gs]
        where schreierGenerator :: Permutation a -> Permutation a -> Permutation a
    schreierGenerator r :: Permutation a
    r g :: Permutation a
    g = let h :: Permutation a
    h = Permutation a
    r Permutation a -> Permutation a -> Permutation a
    forall a. Num a => a -> a -> a
    * Permutation a
    g
                                          h' :: Permutation a
    h' = Map a (Permutation a)
    rs Map a (Permutation a) -> a -> Permutation a
    forall k a. Ord k => Map k a -> k -> a
    M.! (a
    x a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    h)
                                      in Permutation a
    h Permutation a -> Permutation a -> Permutation a
    forall a. Num a => a -> a -> a
    * Permutation a -> Permutation a
    forall a. HasInverses a => a -> a
    inverse Permutation a
    h'

    -- SCHREIER-SIMS ALGORITHM

    -- Given a list of right transversals for a stabiliser chain, sift a group element through it

    -- Note, this version assumes the base is non-redundant

    sift :: [(k, Map k (Permutation k))]
    -> Permutation k -> Maybe (Permutation k)
    sift _ 1 = Maybe (Permutation k)
    forall a. Maybe a
    Nothing
    sift ((b :: k
    b,t :: Map k (Permutation k)
    t):bts :: [(k, Map k (Permutation k))]
    bts) g :: Permutation k
    g = case k -> Map k (Permutation k) -> Maybe (Permutation k)
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (k
    b k -> Permutation k -> k
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation k
    g) Map k (Permutation k)
    t of
                         Nothing -> Permutation k -> Maybe (Permutation k)
    forall a. a -> Maybe a
    Just Permutation k
    g
                         -- Nothing -> sift bts g -- if we allow redundant levels

                         Just h :: Permutation k
    h -> [(k, Map k (Permutation k))]
    -> Permutation k -> Maybe (Permutation k)
    sift [(k, Map k (Permutation k))]
    bts (Permutation k
    g Permutation k -> Permutation k -> Permutation k
    forall a. Num a => a -> a -> a
    * Permutation k -> Permutation k
    forall a. HasInverses a => a -> a
    inverse Permutation k
    h)
    sift [] g :: Permutation k
    g = Permutation k -> Maybe (Permutation k)
    forall a. a -> Maybe a
    Just Permutation k
    g -- g == 1 case already caught above

    -- findBase gs = minimum $ concatMap supp gs

    findBase :: [Permutation a] -> a
    findBase gs :: [Permutation a]
    gs = [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum ([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 c. Permutation c -> c
    minsupp [Permutation a]
    gs
    {-
    -- Find base and strong generating set using Schreier-Sims algorithm
    bsgs gs | all (/= 1) gs = map fst $ ss [newLevel gs] []

    newLevel s = let b = findBase s
                     t = cosetRepsGx s b
                 in ((b,t),s)

    ss (bad@((b,t),s):bads) goods =
        let bts = map fst goods
            sgs = schreierGeneratorsGx (b,t) s
            siftees = filter isJust $ map (sift bts) sgs
        in  if null siftees
            then ss bads (bad:goods)
            else let Just h = head siftees
                 in if null goods
                    then ss (newLevel [h] : bad : bads) []
                    else let ((b_,t_),s_) = head goods
                             s' = h:s_
                             t' = cosetRepsGx s' b_
                         in ss (((b_,t'),s') : bad : bads) (tail goods)
    ss [] goods = goods
    -}

    -- |Given generators for a permutation group, return a strong generating set.

    -- The result is calculated using Schreier-Sims algorithm, and is relative to the base implied by the Ord instance

    sgs :: (Ord a, Show a) => [Permutation a] -> [Permutation a]
    sgs :: [Permutation a] -> [Permutation a]
    sgs gs :: [Permutation a]
    gs = [Permutation a] -> [Permutation a]
    forall b. Ord b => [b] -> [b]
    toListSet ([Permutation a] -> [Permutation a])
    -> [Permutation a] -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ (((a, Map a (Permutation a)), [Permutation a]) -> [Permutation a])
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [Permutation a]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((a, Map a (Permutation a)), [Permutation a]) -> [Permutation a]
    forall a b. (a, b) -> b
    snd ([((a, Map a (Permutation a)), [Permutation a])]
     -> [Permutation a])
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ [a]
    -> [Permutation a]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    forall a.
    Ord a =>
    [a]
    -> [Permutation a]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    ss [a]
    bs [Permutation a]
    gs
        where bs :: [a]
    bs = [a] -> [a]
    forall b. Ord b => [b] -> [b]
    toListSet ([a] -> [a]) -> [a] -> [a]
    forall a b. (a -> b) -> a -> b
    $ (Permutation a -> [a]) -> [Permutation a] -> [a]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Permutation a -> [a]
    forall a. Permutation a -> [a]
    supp [Permutation a]
    gs

    -- Find base and strong generating set using Schreier-Sims algorithm

    -- !! This function is poorly named - it actually finds you a base and sets of transversals

    -- This version guarantees to use bases in order

    bsgs :: [Permutation a] -> [(a, Map a (Permutation a))]
    bsgs gs :: [Permutation a]
    gs = [a] -> [Permutation a] -> [(a, Map a (Permutation a))]
    forall a.
    Ord a =>
    [a] -> [Permutation a] -> [(a, Map a (Permutation a))]
    bsgs' [a]
    bs [Permutation a]
    gs
        where bs :: [a]
    bs = [a] -> [a]
    forall b. Ord b => [b] -> [b]
    toListSet ([a] -> [a]) -> [a] -> [a]
    forall a b. (a -> b) -> a -> b
    $ (Permutation a -> [a]) -> [Permutation a] -> [a]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Permutation a -> [a]
    forall a. Permutation a -> [a]
    supp [Permutation a]
    gs

    -- This version lets you pass in bases in the order you want them (or [], and it will find its own)

    bsgs' :: [a] -> [Permutation a] -> [(a, Map a (Permutation a))]
    bsgs' bs :: [a]
    bs gs :: [Permutation a]
    gs = (((a, Map a (Permutation a)), [Permutation a])
     -> (a, Map a (Permutation a)))
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [(a, Map a (Permutation a))]
    forall a b. (a -> b) -> [a] -> [b]
    map ((a, Map a (Permutation a)), [Permutation a])
    -> (a, Map a (Permutation a))
    forall a b. (a, b) -> a
    fst ([((a, Map a (Permutation a)), [Permutation a])]
     -> [(a, Map a (Permutation a))])
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [(a, Map a (Permutation a))]
    forall a b. (a -> b) -> a -> b
    $ [a]
    -> [Permutation a]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    forall a.
    Ord a =>
    [a]
    -> [Permutation a]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    ss [a]
    bs [Permutation a]
    gs

    -- For example, bsgs (_A 5) uses [1,2,3] as the bases, but bsgs' [] (_A 5) uses [1,3,2]

    newLevel :: [k]
    -> [Permutation k]
    -> ([k], ((k, Map k (Permutation k)), [Permutation k]))
    newLevel (b :: k
    b:bs :: [k]
    bs) s :: [Permutation k]
    s = ([k]
    bs, k
    -> [Permutation k] -> ((k, Map k (Permutation k)), [Permutation k])
    forall k.
    Ord k =>
    k
    -> [Permutation k] -> ((k, Map k (Permutation k)), [Permutation k])
    newLevel' k
    b [Permutation k]
    s)
    newLevel [] s :: [Permutation k]
    s = ([], k
    -> [Permutation k] -> ((k, Map k (Permutation k)), [Permutation k])
    forall k.
    Ord k =>
    k
    -> [Permutation k] -> ((k, Map k (Permutation k)), [Permutation k])
    newLevel' k
    b [Permutation k]
    s) where b :: k
    b = [Permutation k] -> k
    forall a. Ord a => [Permutation a] -> a
    findBase [Permutation k]
    s
    newLevel' :: k
    -> [Permutation k] -> ((k, Map k (Permutation k)), [Permutation k])
    newLevel' b :: k
    b s :: [Permutation k]
    s = ((k
    b,Map k (Permutation k)
    t),[Permutation k]
    s) where t :: Map k (Permutation k)
    t = [Permutation k] -> k -> Map k (Permutation k)
    forall k. Ord k => [Permutation k] -> k -> Map k (Permutation k)
    cosetRepsGx [Permutation k]
    s k
    b

    ss :: [a]
    -> [Permutation a]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    ss bs :: [a]
    bs gs :: [Permutation a]
    gs = [a]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    forall a.
    Ord a =>
    [a]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    ss' [a]
    bs' [((a, Map a (Permutation a)), [Permutation a])
    level] []
        where (bs' :: [a]
    bs',level :: ((a, Map a (Permutation a)), [Permutation a])
    level) = [a]
    -> [Permutation a]
    -> ([a], ((a, Map a (Permutation a)), [Permutation a]))
    forall k.
    Ord k =>
    [k]
    -> [Permutation k]
    -> ([k], ((k, Map k (Permutation k)), [Permutation k]))
    newLevel [a]
    bs ([Permutation a]
     -> ([a], ((a, Map a (Permutation a)), [Permutation a])))
    -> [Permutation a]
    -> ([a], ((a, Map a (Permutation a)), [Permutation a]))
    forall a b. (a -> b) -> a -> b
    $ (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]
    gs

    ss' :: [a]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    ss' bs :: [a]
    bs (bad :: ((a, Map a (Permutation a)), [Permutation a])
    bad@((b :: a
    b,t :: Map a (Permutation a)
    t),s :: [Permutation a]
    s):bads :: [((a, Map a (Permutation a)), [Permutation a])]
    bads) goods :: [((a, Map a (Permutation a)), [Permutation a])]
    goods =
        let bts :: [(a, Map a (Permutation a))]
    bts = (((a, Map a (Permutation a)), [Permutation a])
     -> (a, Map a (Permutation a)))
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [(a, Map a (Permutation a))]
    forall a b. (a -> b) -> [a] -> [b]
    map ((a, Map a (Permutation a)), [Permutation a])
    -> (a, Map a (Permutation a))
    forall a b. (a, b) -> a
    fst [((a, Map a (Permutation a)), [Permutation a])]
    goods
            sgs :: [Permutation a]
    sgs = (a, Map a (Permutation a)) -> [Permutation a] -> [Permutation a]
    forall a.
    Ord a =>
    (a, Map a (Permutation a)) -> [Permutation a] -> [Permutation a]
    schreierGeneratorsGx (a
    b,Map a (Permutation a)
    t) [Permutation a]
    s
            siftees :: [Maybe (Permutation a)]
    siftees = (Maybe (Permutation a) -> Bool)
    -> [Maybe (Permutation a)] -> [Maybe (Permutation a)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Maybe (Permutation a) -> Bool
    forall a. Maybe a -> Bool
    isJust ([Maybe (Permutation a)] -> [Maybe (Permutation a)])
    -> [Maybe (Permutation a)] -> [Maybe (Permutation a)]
    forall a b. (a -> b) -> a -> b
    $ (Permutation a -> Maybe (Permutation a))
    -> [Permutation a] -> [Maybe (Permutation a)]
    forall a b. (a -> b) -> [a] -> [b]
    map ([(a, Map a (Permutation a))]
    -> Permutation a -> Maybe (Permutation a)
    forall k.
    Ord k =>
    [(k, Map k (Permutation k))]
    -> Permutation k -> Maybe (Permutation k)
    sift [(a, Map a (Permutation a))]
    bts) [Permutation a]
    sgs
        in  if [Maybe (Permutation a)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Maybe (Permutation a)]
    siftees
            then [a]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    ss' [a]
    bs [((a, Map a (Permutation a)), [Permutation a])]
    bads (((a, Map a (Permutation a)), [Permutation a])
    bad((a, Map a (Permutation a)), [Permutation a])
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    forall a. a -> [a] -> [a]
    :[((a, Map a (Permutation a)), [Permutation a])]
    goods)
            else let Just h :: Permutation a
    h = [Maybe (Permutation a)] -> Maybe (Permutation a)
    forall a. [a] -> a
    head [Maybe (Permutation a)]
    siftees
                 in if [((a, Map a (Permutation a)), [Permutation a])] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [((a, Map a (Permutation a)), [Permutation a])]
    goods
                    then let (bs' :: [a]
    bs', level :: ((a, Map a (Permutation a)), [Permutation a])
    level) = [a]
    -> [Permutation a]
    -> ([a], ((a, Map a (Permutation a)), [Permutation a]))
    forall k.
    Ord k =>
    [k]
    -> [Permutation k]
    -> ([k], ((k, Map k (Permutation k)), [Permutation k]))
    newLevel [a]
    bs [Permutation a
    h]
                         in [a]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    ss' [a]
    bs' (((a, Map a (Permutation a)), [Permutation a])
    level ((a, Map a (Permutation a)), [Permutation a])
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    forall a. a -> [a] -> [a]
    : ((a, Map a (Permutation a)), [Permutation a])
    bad ((a, Map a (Permutation a)), [Permutation a])
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    forall a. a -> [a] -> [a]
    : [((a, Map a (Permutation a)), [Permutation a])]
    bads) []
                    else let ((b_ :: a
    b_,t_ :: Map a (Permutation a)
    t_),s_ :: [Permutation a]
    s_) = [((a, Map a (Permutation a)), [Permutation a])]
    -> ((a, Map a (Permutation a)), [Permutation a])
    forall a. [a] -> a
    head [((a, Map a (Permutation a)), [Permutation a])]
    goods
                             s' :: [Permutation a]
    s' = Permutation a
    hPermutation a -> [Permutation a] -> [Permutation a]
    forall a. a -> [a] -> [a]
    :[Permutation a]
    s_
                             t' :: Map a (Permutation a)
    t' = [Permutation a] -> a -> Map a (Permutation a)
    forall k. Ord k => [Permutation k] -> k -> Map k (Permutation k)
    cosetRepsGx [Permutation a]
    s' a
    b_
                         in [a]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    ss' [a]
    bs (((a
    b_,Map a (Permutation a)
    t'),[Permutation a]
    s') ((a, Map a (Permutation a)), [Permutation a])
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    forall a. a -> [a] -> [a]
    : ((a, Map a (Permutation a)), [Permutation a])
    bad ((a, Map a (Permutation a)), [Permutation a])
    -> [((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    forall a. a -> [a] -> [a]
    : [((a, Map a (Permutation a)), [Permutation a])]
    bads) ([((a, Map a (Permutation a)), [Permutation a])]
    -> [((a, Map a (Permutation a)), [Permutation a])]
    forall a. [a] -> [a]
    tail [((a, Map a (Permutation a)), [Permutation a])]
    goods)
    ss' _ [] goods :: [((a, Map a (Permutation a)), [Permutation a])]
    goods = [((a, Map a (Permutation a)), [Permutation a])]
    goods
    {-
    extendbsgs [] g = bsgs [g]
    extendbsgs (((b,t),s):bts) g = ss (((b,t),g:s):bts) []

    bsgs' gs = map fst $ foldl extendbsgs [] gs
    -}

    -- The above is written for simplicity.

    -- Its efficiency could be improved by incrementally updating the transversals,

    -- and keeping track of Schreier generators we have already tried.

    -- (Remember to add new Schreier generators every time the generating set or transversal is augmented.)

    -- USING THE SCHREIER-SIMS TRANSVERSALS

    isMemberBSGS :: [(k, Map k (Permutation k))] -> Permutation k -> Bool
    isMemberBSGS bts :: [(k, Map k (Permutation k))]
    bts g :: Permutation k
    g = Maybe (Permutation k) -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe (Permutation k) -> Bool) -> Maybe (Permutation k) -> Bool
    forall a b. (a -> b) -> a -> b
    $ [(k, Map k (Permutation k))]
    -> Permutation k -> Maybe (Permutation k)
    forall k.
    Ord k =>
    [(k, Map k (Permutation k))]
    -> Permutation k -> Maybe (Permutation k)
    sift [(k, Map k (Permutation k))]
    bts Permutation k
    g

    -- By Lagrange's thm, every g <- G can be written uniquely as g = r_m ... r_1 (Seress p56)

    -- Note that we have to reverse the list of coset representatives

    eltsBSGS :: [(a, Map k b)] -> [b]
    eltsBSGS bts :: [(a, Map k b)]
    bts = ([b] -> b) -> [[b]] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map ([b] -> b
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    product ([b] -> b) -> ([b] -> [b]) -> [b] -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [b] -> [b]
    forall a. [a] -> [a]
    reverse) ([[b]] -> [[b]]
    forall a. [[a]] -> [[a]]
    cartProd [[b]]
    ts)
    	where ts :: [[b]]
    ts = ((a, Map k b) -> [b]) -> [(a, Map k b)] -> [[b]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Map k b -> [b]
    forall k a. Map k a -> [a]
    M.elems (Map k b -> [b])
    -> ((a, Map k b) -> Map k b) -> (a, Map k b) -> [b]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, Map k b) -> Map k b
    forall a b. (a, b) -> b
    snd) [(a, Map k b)]
    bts

    cartProd :: [[a]] -> [[a]]
    cartProd (set :: [a]
    set:sets :: [[a]]
    sets) = [a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    xs | a
    x <- [a]
    set, [a]
    xs <- [[a]] -> [[a]]
    cartProd [[a]]
    sets]
    cartProd [] = [[]]

    orderBSGS :: [(a, Map k a)] -> Integer
    orderBSGS bts :: [(a, Map k a)]
    bts = [Integer] -> Integer
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    product (((a, Map k a) -> Integer) -> [(a, Map k a)] -> [Integer]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Integer)
    -> ((a, Map k a) -> Int) -> (a, Map k a) -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map k a -> Int
    forall k a. Map k a -> Int
    M.size (Map k a -> Int)
    -> ((a, Map k a) -> Map k a) -> (a, Map k a) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, Map k a) -> Map k a
    forall a b. (a, b) -> b
    snd) [(a, Map k a)]
    bts)

    -- |Given generators for a group, determine whether a permutation is a member of the group, using Schreier-Sims algorithm

    isMember :: (Ord t, Show t) => [Permutation t] -> Permutation t -> Bool
    isMember :: [Permutation t] -> Permutation t -> Bool
    isMember gs :: [Permutation t]
    gs h :: Permutation t
    h = [(t, Map t (Permutation t))] -> Permutation t -> Bool
    forall k.
    Ord k =>
    [(k, Map k (Permutation k))] -> Permutation k -> Bool
    isMemberBSGS ([Permutation t] -> [(t, Map t (Permutation t))]
    forall a. Ord a => [Permutation a] -> [(a, Map a (Permutation a))]
    bsgs [Permutation t]
    gs) Permutation t
    h

    -- |Given generators for a group, return a (sorted) list of all elements of the group, using Schreier-Sims algorithm

    elts :: (Ord t, Show t) => [Permutation t] -> [Permutation t]
    elts :: [Permutation t] -> [Permutation t]
    elts [] = [1]
    elts gs :: [Permutation t]
    gs = [(t, Map t (Permutation t))] -> [Permutation t]
    forall b a k. Num b => [(a, Map k b)] -> [b]
    eltsBSGS ([(t, Map t (Permutation t))] -> [Permutation t])
    -> [(t, Map t (Permutation t))] -> [Permutation t]
    forall a b. (a -> b) -> a -> b
    $ [Permutation t] -> [(t, Map t (Permutation t))]
    forall a. Ord a => [Permutation a] -> [(a, Map a (Permutation a))]
    bsgs [Permutation t]
    gs

    -- |Given generators for a group, return the order of the group (the number of elements), using Schreier-Sims algorithm

    order :: (Ord t, Show t) => [Permutation t] -> Integer
    order :: [Permutation t] -> Integer
    order [] = 1
    order gs :: [Permutation t]
    gs = [(t, Map t (Permutation t))] -> Integer
    forall a k a. [(a, Map k a)] -> Integer
    orderBSGS ([(t, Map t (Permutation t))] -> Integer)
    -> [(t, Map t (Permutation t))] -> Integer
    forall a b. (a -> b) -> a -> b
    $ [Permutation t] -> [(t, Map t (Permutation t))]
    forall a. Ord a => [Permutation a] -> [(a, Map a (Permutation a))]
    bsgs [Permutation t]
    gs

    isSubgp :: t (Permutation k) -> [Permutation k] -> Bool
    isSubgp hs :: t (Permutation k)
    hs gs :: [Permutation k]
    gs = (Permutation k -> Bool) -> t (Permutation k) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([(k, Map k (Permutation k))] -> Permutation k -> Bool
    forall k.
    Ord k =>
    [(k, Map k (Permutation k))] -> Permutation k -> Bool
    isMemberBSGS [(k, Map k (Permutation k))]
    gs') t (Permutation k)
    hs
        where gs' :: [(k, Map k (Permutation k))]
    gs' = [Permutation k] -> [(k, Map k (Permutation k))]
    forall a. Ord a => [Permutation a] -> [(a, Map a (Permutation a))]
    bsgs [Permutation k]
    gs

    isNormal :: [Permutation k] -> [Permutation k] -> Bool
    isNormal hs :: [Permutation k]
    hs gs :: [Permutation k]
    gs = [Permutation k]
    hs [Permutation k] -> [Permutation k] -> Bool
    forall (t :: * -> *) k.
    (Foldable t, Ord k) =>
    t (Permutation k) -> [Permutation k] -> Bool
    `isSubgp` [Permutation k]
    gs
                  Bool -> Bool -> Bool
    && (Permutation k -> Bool) -> [Permutation k] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([(k, Map k (Permutation k))] -> Permutation k -> Bool
    forall k.
    Ord k =>
    [(k, Map k (Permutation k))] -> Permutation k -> Bool
    isMemberBSGS [(k, Map k (Permutation k))]
    hs') [Permutation k
    hPermutation k -> Permutation k -> Permutation k
    forall a. Ord a => Permutation a -> Permutation a -> Permutation a
    ~^Permutation k
    g | Permutation k
    h <- [Permutation k]
    hs, Permutation k
    g <- [Permutation k]
    gs]
        where hs' :: [(k, Map k (Permutation k))]
    hs' = [Permutation k] -> [(k, Map k (Permutation k))]
    forall a. Ord a => [Permutation a] -> [(a, Map a (Permutation a))]
    bsgs [Permutation k]
    hs

    index :: [Permutation t] -> [Permutation t] -> Integer
    index gs :: [Permutation t]
    gs hs :: [Permutation t]
    hs = [Permutation t] -> Integer
    forall t. (Ord t, Show t) => [Permutation t] -> Integer
    order [Permutation t]
    gs Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `div` [Permutation t] -> Integer
    forall t. (Ord t, Show t) => [Permutation t] -> Integer
    order [Permutation t]
    hs

    -- given list of generators, try to find a shorter list

    reduceGens :: [Permutation a] -> [Permutation a]
    reduceGens gs :: [Permutation a]
    gs = ([Permutation a], [(a, Map a (Permutation a))]) -> [Permutation a]
    forall a b. (a, b) -> a
    fst (([Permutation a], [(a, Map a (Permutation a))])
     -> [Permutation a])
    -> ([Permutation a], [(a, Map a (Permutation a))])
    -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ [Permutation a] -> ([Permutation a], [(a, Map a (Permutation a))])
    forall a.
    Ord a =>
    [Permutation a] -> ([Permutation a], [(a, Map a (Permutation a))])
    reduceGensBSGS ((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]
    gs)

    reduceGensBSGS :: [Permutation a] -> ([Permutation a], [(a, Map a (Permutation a))])
    reduceGensBSGS (g :: Permutation a
    g:gs :: [Permutation a]
    gs) = ([Permutation a], [(a, Map a (Permutation a))])
    -> [Permutation a]
    -> ([Permutation a], [(a, Map a (Permutation a))])
    forall a.
    Ord a =>
    ([Permutation a], [(a, Map a (Permutation a))])
    -> [Permutation a]
    -> ([Permutation a], [(a, Map a (Permutation a))])
    reduceGens' ([Permutation a
    g],[Permutation a] -> [(a, Map a (Permutation a))]
    forall a. Ord a => [Permutation a] -> [(a, Map a (Permutation a))]
    bsgs [Permutation a
    g]) [Permutation a]
    gs where
        reduceGens' :: ([Permutation a], [(a, Map a (Permutation a))])
    -> [Permutation a]
    -> ([Permutation a], [(a, Map a (Permutation a))])
    reduceGens' (gs :: [Permutation a]
    gs,bsgsgs :: [(a, Map a (Permutation a))]
    bsgsgs) (h :: Permutation a
    h:hs :: [Permutation a]
    hs) =
            if [(a, Map a (Permutation a))] -> Permutation a -> Bool
    forall k.
    Ord k =>
    [(k, Map k (Permutation k))] -> Permutation k -> Bool
    isMemberBSGS [(a, Map a (Permutation a))]
    bsgsgs Permutation a
    h
            then ([Permutation a], [(a, Map a (Permutation a))])
    -> [Permutation a]
    -> ([Permutation a], [(a, Map a (Permutation a))])
    reduceGens' ([Permutation a]
    gs,[(a, Map a (Permutation a))]
    bsgsgs) [Permutation a]
    hs
            else ([Permutation a], [(a, Map a (Permutation a))])
    -> [Permutation a]
    -> ([Permutation a], [(a, Map a (Permutation a))])
    reduceGens' (Permutation a
    hPermutation a -> [Permutation a] -> [Permutation a]
    forall a. a -> [a] -> [a]
    :[Permutation a]
    gs, [Permutation a] -> [(a, Map a (Permutation a))]
    forall a. Ord a => [Permutation a] -> [(a, Map a (Permutation a))]
    bsgs ([Permutation a] -> [(a, Map a (Permutation a))])
    -> [Permutation a] -> [(a, Map a (Permutation a))]
    forall a b. (a -> b) -> a -> b
    $ Permutation a
    hPermutation a -> [Permutation a] -> [Permutation a]
    forall a. a -> [a] -> [a]
    :[Permutation a]
    gs) [Permutation a]
    hs
        reduceGens' (gs :: [Permutation a]
    gs,bsgsgs :: [(a, Map a (Permutation a))]
    bsgsgs) [] = ([Permutation a] -> [Permutation a]
    forall a. [a] -> [a]
    reverse [Permutation a]
    gs,[(a, Map a (Permutation a))]
    bsgsgs)
    reduceGensBSGS [] = ([],[])

    -- normal closure of H in G

    -- for efficiency, should be called with gs and hs already reduced sets of generators

    normalClosure :: [Permutation a] -> [Permutation a] -> [Permutation a]
    normalClosure gs :: [Permutation a]
    gs hs :: [Permutation a]
    hs = [Permutation a] -> [Permutation a]
    forall a. Ord a => [Permutation a] -> [Permutation a]
    reduceGens ([Permutation a] -> [Permutation a])
    -> [Permutation a] -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ [Permutation a]
    hs [Permutation a] -> [Permutation a] -> [Permutation a]
    forall a. [a] -> [a] -> [a]
    ++ [Permutation a
    h Permutation a -> Permutation a -> Permutation a
    forall a. Ord a => Permutation a -> Permutation a -> Permutation a
    ~^ Permutation a
    g | Permutation a
    h <- [Permutation a]
    hs, Permutation a
    g <- [Permutation a]
    gs']
        where gs' :: [Permutation a]
    gs' = [Permutation a]
    gs [Permutation a] -> [Permutation a] -> [Permutation a]
    forall a. [a] -> [a] -> [a]
    ++ (Permutation a -> Permutation a)
    -> [Permutation a] -> [Permutation a]
    forall a b. (a -> b) -> [a] -> [b]
    map Permutation a -> Permutation a
    forall a. HasInverses a => a -> a
    inverse [Permutation a]
    gs

    -- commutator gp of H and K

    commutatorGp :: [Permutation a] -> [Permutation a] -> [Permutation a]
    commutatorGp hs :: [Permutation a]
    hs ks :: [Permutation a]
    ks = [Permutation a] -> [Permutation a] -> [Permutation a]
    forall a.
    Ord a =>
    [Permutation a] -> [Permutation a] -> [Permutation a]
    normalClosure ([Permutation a]
    hsks) [Permutation a
    hPermutation a -> Integer -> Permutation a
    forall a b. (Num a, HasInverses a, Integral b) => a -> b -> a
    ^-1 Permutation a -> Permutation a -> Permutation a
    forall a. Num a => a -> a -> a
    * Permutation a
    kPermutation a -> Integer -> Permutation a
    forall a b. (Num a, HasInverses a, Integral b) => a -> b -> a
    ^-1 Permutation a -> Permutation a -> Permutation a
    forall a. Num a => a -> a -> a
    * Permutation a
    h Permutation a -> Permutation a -> Permutation a
    forall a. Num a => a -> a -> a
    * Permutation a
    k | Permutation a
    h <- [Permutation a]
    hs', Permutation a
    k <- [Permutation a]
    ks']
        where hs' :: [Permutation a]
    hs' = [Permutation a] -> [Permutation a]
    forall a. Ord a => [Permutation a] -> [Permutation a]
    reduceGens [Permutation a]
    hs
              ks' :: [Permutation a]
    ks' = [Permutation a] -> [Permutation a]
    forall a. Ord a => [Permutation a] -> [Permutation a]
    reduceGens [Permutation a]
    ks
              hsks :: [Permutation a]
    hsks = [Permutation a] -> [Permutation a]
    forall a. Ord a => [Permutation a] -> [Permutation a]
    reduceGens ([Permutation a]
    hs' [Permutation a] -> [Permutation a] -> [Permutation a]
    forall a. [a] -> [a] -> [a]
    ++ [Permutation a]
    ks')
              -- no point processing more potential generators than we have to

    -- derived subgroup (or commutator subgroup)

    derivedSubgp :: [Permutation a] -> [Permutation a]
    derivedSubgp gs :: [Permutation a]
    gs = [Permutation a] -> [Permutation a] -> [Permutation a]
    forall a.
    Ord a =>
    [Permutation a] -> [Permutation a] -> [Permutation a]
    normalClosure [Permutation a]
    gs' [Permutation a
    gPermutation a -> Integer -> Permutation a
    forall a b. (Num a, HasInverses a, Integral b) => a -> b -> a
    ^-1 Permutation a -> Permutation a -> Permutation a
    forall a. Num a => a -> a -> a
    * Permutation a
    hPermutation a -> Integer -> Permutation a
    forall a b. (Num a, HasInverses a, Integral b) => a -> b -> a
    ^-1 Permutation a -> Permutation a -> Permutation a
    forall a. Num a => a -> a -> a
    * Permutation a
    g Permutation a -> Permutation a -> Permutation a
    forall a. Num a => a -> a -> a
    * Permutation a
    h | Permutation a
    g <- [Permutation a]
    gs', Permutation a
    h <- [Permutation a]
    gs']
        where gs' :: [Permutation a]
    gs' = [Permutation a] -> [Permutation a]
    forall a. Ord a => [Permutation a] -> [Permutation a]
    reduceGens [Permutation a]
    gs
        -- == commutatorGp gs gs

    {-
    isPerfect gs = order gs == order (derivedSubgp gs)
    -- We compare orders rather than the generators themselves, because derivedSubgp will usually find different generators

    derivedSeries gs = derivedSeries' (gs, order gs) where
        derivedSeries' ([],1) = [[]]
        derivedSeries' (hs, orderhs) =
            let hs' = derivedSubgp hs
                orderhs' = order hs'
            in if orderhs' == orderhs
               then [hs]
               else hs : derivedSeries' (hs',orderhs')

    lowerCentralSeries gs = lowerCentralSeries' (gs, order gs) where
        lowerCentralSeries' ([],1) = [[]]
        lowerCentralSeries' (hs, orderhs) =
            let hs' = commutatorGp gs hs
                orderhs' = order hs'
            in if orderhs' == orderhs
               then [hs]
               else hs : lowerCentralSeries' (hs',orderhs')
    -}