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

    {-# LANGUAGE NoMonomorphismRestriction #-}

    -- |A module for doing arithmetic in permutation groups.

    --

    -- Group elements are represented as permutations of underlying sets, and are entered and displayed

    -- using a Haskell-friendly version of cycle notation. For example, the permutation (1 2 3)(4 5)

    -- would be entered as @p [[1,2,3],[4,5]]@, and displayed as [[1,2,3],[4,5]]. Permutations can be defined

    -- over arbitrary underlying sets (types), not just the integers.

    --

    -- If @g@ and @h@ are group elements, then the expressions @g*h@ and @g^-1@ calculate product and inverse respectively.

    module Math.Algebra.Group.PermutationGroup where

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

    import Math.Common.ListSet (toListSet, union, (\\) ) -- a version of union which assumes the arguments are ascending sets (no repeated elements)

    import Math.Core.Utils hiding (elts)
    import Math.Algebra.LinearAlgebra hiding (inverse) -- only needed for use in ghci

    infix 8 ~^

    rotateL :: [a] -> [a]
    rotateL (x :: a
    x:xs :: [a]
    xs) = [a]
    xs [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a
    x]

    -- PERMUTATIONS

    -- |A type for permutations, considered as functions or actions which can be performed on an underlying set.

    newtype Permutation a = P (M.Map a a) deriving (Permutation a -> Permutation a -> Bool
    (Permutation a -> Permutation a -> Bool)
    -> (Permutation a -> Permutation a -> Bool) -> Eq (Permutation a)
    forall a. Eq a => Permutation a -> Permutation a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Permutation a -> Permutation a -> Bool
    $c/= :: forall a. Eq a => Permutation a -> Permutation a -> Bool
    == :: Permutation a -> Permutation a -> Bool
    $c== :: forall a. Eq a => Permutation a -> Permutation a -> Bool
    Eq,Eq (Permutation a)
    Eq (Permutation a) =>
    (Permutation a -> Permutation a -> Ordering)
    -> (Permutation a -> Permutation a -> Bool)
    -> (Permutation a -> Permutation a -> Bool)
    -> (Permutation a -> Permutation a -> Bool)
    -> (Permutation a -> Permutation a -> Bool)
    -> (Permutation a -> Permutation a -> Permutation a)
    -> (Permutation a -> Permutation a -> Permutation a)
    -> Ord (Permutation a)
    Permutation a -> Permutation a -> Bool
    Permutation a -> Permutation a -> Ordering
    Permutation a -> Permutation a -> Permutation 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 (Permutation a)
    forall a. Ord a => Permutation a -> Permutation a -> Bool
    forall a. Ord a => Permutation a -> Permutation a -> Ordering
    forall a. Ord a => Permutation a -> Permutation a -> Permutation a
    min :: Permutation a -> Permutation a -> Permutation a
    $cmin :: forall a. Ord a => Permutation a -> Permutation a -> Permutation a
    max :: Permutation a -> Permutation a -> Permutation a
    $cmax :: forall a. Ord a => Permutation a -> Permutation a -> Permutation a
    >= :: Permutation a -> Permutation a -> Bool
    $c>= :: forall a. Ord a => Permutation a -> Permutation a -> Bool
    > :: Permutation a -> Permutation a -> Bool
    $c> :: forall a. Ord a => Permutation a -> Permutation a -> Bool
    <= :: Permutation a -> Permutation a -> Bool
    $c<= :: forall a. Ord a => Permutation a -> Permutation a -> Bool
    < :: Permutation a -> Permutation a -> Bool
    $c< :: forall a. Ord a => Permutation a -> Permutation a -> Bool
    compare :: Permutation a -> Permutation a -> Ordering
    $ccompare :: forall a. Ord a => Permutation a -> Permutation a -> Ordering
    $cp1Ord :: forall a. Ord a => Eq (Permutation a)
    Ord)

    -- Can't make a Functor instance because we need an Ord instance

    fmapP :: (t -> a) -> Permutation t -> Permutation a
    fmapP f :: t -> a
    f = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(a, a)] -> Permutation a)
    -> (Permutation t -> [(a, a)]) -> Permutation t -> Permutation a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((t, t) -> (a, a)) -> [(t, t)] -> [(a, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(x :: t
    x,y :: t
    y) -> (t -> a
    f t
    x, t -> a
    f t
    y)) ([(t, t)] -> [(a, a)])
    -> (Permutation t -> [(t, t)]) -> Permutation t -> [(a, a)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permutation t -> [(t, t)]
    forall a. Permutation a -> [(a, a)]
    toPairs

    -- |Construct a permutation from a list of cycles.

    -- For example, @p [[1,2,3],[4,5]]@ returns the permutation that sends 1 to 2, 2 to 3, 3 to 1, 4 to 5, 5 to 4.

    p :: (Ord a) => [[a]] -> Permutation a
    p :: [[a]] -> Permutation a
    p = [[a]] -> Permutation a
    forall a. Ord a => [[a]] -> Permutation a
    fromCycles

    fromPairs :: [(a, a)] -> Permutation a
    fromPairs xys :: [(a, a)]
    xys | Bool
    isValid   = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs' [(a, a)]
    xys
                  | Bool
    otherwise = [Char] -> Permutation a
    forall a. HasCallStack => [Char] -> a
    error "Not a permutation"
        where (xs :: [a]
    xs,ys :: [a]
    ys) = [(a, a)] -> ([a], [a])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(a, a)]
    xys
              (xs' :: [a]
    xs',ys' :: [a]
    ys') = ([a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a]
    xs, [a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a]
    ys)
              isValid :: Bool
    isValid = [a]
    xs' [a] -> [a] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [a]
    ys' Bool -> Bool -> Bool
    && ([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] -> [[a]]
    forall a. Eq a => [a] -> [[a]]
    L.group [a]
    xs') -- ie the domain and range are the same, and are *sets*

    fromPairs' :: [(a, a)] -> Permutation a
    fromPairs' xys :: [(a, a)]
    xys = Map a a -> Permutation a
    forall a. Map a a -> Permutation a
    P (Map a a -> Permutation a) -> Map a a -> Permutation a
    forall a b. (a -> b) -> a -> b
    $ [(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) -> Bool) -> [(a, a)] -> [(a, a)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((a -> a -> Bool) -> (a, a) -> Bool
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    (/=)) [(a, a)]
    xys
    -- we remove fixed points, so that the derived Eq instance works as expected

    toPairs :: Permutation a -> [(a, a)]
    toPairs (P g :: Map a a
    g) = Map a a -> [(a, a)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map a a
    g

    fromList :: [a] -> Permutation a
    fromList xs :: [a]
    xs = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(a, a)] -> Permutation a) -> [(a, a)] -> Permutation a
    forall a b. (a -> b) -> a -> b
    $ [a] -> [a] -> [(a, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [a]
    xs ([a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a]
    xs)
    -- for example, fromList [2,3,1] is [[1,3,2]] - because the 1 moved to the 3 position

    -- the support of a permutation is the points it moves (returned in ascending order)

    supp :: Permutation a -> [a]
    supp (P g :: Map a a
    g) = Map a a -> [a]
    forall k a. Map k a -> [k]
    M.keys Map a a
    g
    -- (This is guaranteed not to contain fixed points provided the permutations have been constructed using the supplied constructors)

    -- |x .^ g returns the image of a vertex or point x under the action of the permutation g.

    -- For example, @1 .^ p [[1,2,3]]@ returns 2.

    -- The dot is meant to be a mnemonic for point or vertex.

    (.^) :: (Ord a) => a -> Permutation a -> a
    x :: a
    x .^ :: a -> Permutation a -> a
    .^ P g :: Map a a
    g = case a -> Map a a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup a
    x Map a a
    g of
               Just y :: a
    y  -> a
    y
               Nothing -> a
    x -- if x `notElem` supp (P g), then x is not moved

    -- |b -^ g returns the image of an edge or block b under the action of the permutation g.

    -- For example, @[1,2] -^ p [[1,4],[2,3]]@ returns [3,4].

    -- The dash is meant to be a mnemonic for edge or line or block.

    (-^) :: (Ord a) => [a] -> Permutation a -> [a]
    xs :: [a]
    xs -^ :: [a] -> Permutation a -> [a]
    -^ g :: Permutation a
    g = [a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a
    x a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    g | a
    x <- [a]
    xs]

    -- construct a permutation from cycles

    -- fromCycles cs = fromPairs $ concatMap fromCycle cs

    fromCycles :: [[a]] -> Permutation a
    fromCycles cs :: [[a]]
    cs = [Permutation a] -> Permutation a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    product ([Permutation a] -> Permutation a)
    -> [Permutation a] -> Permutation a
    forall a b. (a -> b) -> a -> b
    $ ([a] -> Permutation a) -> [[a]] -> [Permutation a]
    forall a b. (a -> b) -> [a] -> [b]
    map ([(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(a, a)] -> Permutation a)
    -> ([a] -> [(a, a)]) -> [a] -> Permutation a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [(a, a)]
    forall b. [b] -> [(b, b)]
    fromCycle) [[a]]
    cs
        where fromCycle :: [b] -> [(b, b)]
    fromCycle xs :: [b]
    xs = [b] -> [b] -> [(b, b)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [b]
    xs ([b] -> [b]
    forall a. [a] -> [a]
    rotateL [b]
    xs)

    -- convert a permutation to cycles

    toCycles :: Permutation a -> [[a]]
    toCycles g :: Permutation a
    g = [a] -> [[a]]
    toCycles' ([a] -> [[a]]) -> [a] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ Permutation a -> [a]
    forall a. Permutation a -> [a]
    supp Permutation a
    g
        where toCycles' :: [a] -> [[a]]
    toCycles' ys :: [a]
    ys@(y :: a
    y:_) = let c :: [a]
    c = Permutation a -> a -> [a]
    forall t. Ord t => Permutation t -> t -> [t]
    cycleOf Permutation a
    g a
    y in [a]
    c [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [a] -> [[a]]
    toCycles' ([a]
    ys [a] -> [a] -> [a]
    forall a. Eq a => [a] -> [a] -> [a]
    L.\\ [a]
    c)
              toCycles' [] = []

    cycleOf :: Permutation t -> t -> [t]
    cycleOf g :: Permutation t
    g x :: t
    x = t -> [t] -> [t]
    cycleOf' t
    x [] where
        cycleOf' :: t -> [t] -> [t]
    cycleOf' y :: t
    y ys :: [t]
    ys = let y' :: t
    y' = t
    y t -> Permutation t -> t
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation t
    g in if t
    y' t -> t -> Bool
    forall a. Eq a => a -> a -> Bool
    == t
    x then [t] -> [t]
    forall a. [a] -> [a]
    reverse (t
    yt -> [t] -> [t]
    forall a. a -> [a] -> [a]
    :[t]
    ys) else t -> [t] -> [t]
    cycleOf' t
    y' (t
    yt -> [t] -> [t]
    forall a. a -> [a] -> [a]
    :[t]
    ys)

    instance (Ord a, Show a) => Show (Permutation a) where
        show :: Permutation a -> [Char]
    show g :: Permutation a
    g | Permutation a
    g Permutation a -> Permutation a -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 = "1"
               | Bool
    otherwise = [[a]] -> [Char]
    forall a. Show a => a -> [Char]
    show (Permutation a -> [[a]]
    forall a. Ord a => Permutation a -> [[a]]
    toCycles Permutation a
    g)

    parity :: Permutation a -> Int
    parity g :: Permutation a
    g = let cs :: [[a]]
    cs = Permutation a -> [[a]]
    forall a. Ord a => Permutation a -> [[a]]
    toCycles Permutation a
    g in ([a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([[a]] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[a]]
    cs) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [[a]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[a]]
    cs) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` 2
    -- parity' g = length (filter (even . length) $ toCycles g) `mod` 2

    sign :: Permutation a -> a
    sign g :: Permutation a
    g = (-1)a -> Int -> a
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Permutation a -> Int
    forall a. Ord a => Permutation a -> Int
    parity Permutation a
    g)

    orderElt :: Permutation a -> Int
    orderElt g :: Permutation a
    g = (Int -> Int -> Int) -> Int -> [Int] -> Int
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    lcm 1 ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ ([a] -> Int) -> [[a]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([[a]] -> [Int]) -> [[a]] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ Permutation a -> [[a]]
    forall a. Ord a => Permutation a -> [[a]]
    toCycles Permutation a
    g
    -- == order [g]

    -- |The Num instance is what enables us to write @g*h@ for the product of group elements and @1@ for the group identity.

    -- Unfortunately we can't of course give sensible definitions for the other functions declared in the Num typeclass.

    instance Ord a => Num (Permutation a) where
        g :: Permutation a
    g * :: Permutation a -> Permutation a -> Permutation a
    * h :: Permutation a
    h = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs' [(a
    x, a
    x a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    g a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    h) | a
    x <- Permutation a -> [a]
    forall a. Permutation a -> [a]
    supp Permutation a
    g [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    `union` Permutation a -> [a]
    forall a. Permutation a -> [a]
    supp Permutation a
    h]
        -- signum = sign -- doesn't work, complains about no (+) instance

        fromInteger :: Integer -> Permutation a
    fromInteger 1 = Map a a -> Permutation a
    forall a. Map a a -> Permutation a
    P (Map a a -> Permutation a) -> Map a a -> Permutation a
    forall a b. (a -> b) -> a -> b
    $ Map a a
    forall k a. Map k a
    M.empty
        _ + :: Permutation a -> Permutation a -> Permutation a
    + _ = [Char] -> Permutation a
    forall a. HasCallStack => [Char] -> a
    error "(Permutation a).+: not applicable"
        negate :: Permutation a -> Permutation a
    negate _ = [Char] -> Permutation a
    forall a. HasCallStack => [Char] -> a
    error "(Permutation a).negate: not applicable"
        abs :: Permutation a -> Permutation a
    abs _ = [Char] -> Permutation a
    forall a. HasCallStack => [Char] -> a
    error "(Permutation a).abs: not applicable"
        signum :: Permutation a -> Permutation a
    signum _ = [Char] -> Permutation a
    forall a. HasCallStack => [Char] -> a
    error "(Permutation a).signum: not applicable"

    -- |The HasInverses instance is what enables us to write @g^-1@ for the inverse of a group element.

    instance Ord a => HasInverses (Permutation a) where
        inverse :: Permutation a -> Permutation a
    inverse (P g :: Map a a
    g) = Map a a -> Permutation a
    forall a. Map a a -> Permutation a
    P (Map a a -> Permutation a) -> Map a a -> Permutation a
    forall a b. (a -> b) -> a -> b
    $ [(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)) -> [(a, a)] -> [(a, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(x :: a
    x,y :: a
    y)->(a
    y,a
    x)) ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
    forall a b. (a -> b) -> a -> b
    $ Map a a -> [(a, a)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map a a
    g

    -- |g ~^ h returns the conjugate of g by h, that is, h^-1*g*h.

    -- The tilde is meant to a mnemonic, because conjugacy is an equivalence relation.

    (~^) :: Ord a => Permutation a -> Permutation a -> Permutation a
    g :: Permutation a
    g ~^ :: Permutation a -> Permutation a -> Permutation a
    ~^ h :: Permutation a
    h = 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

    -- commutator

    comm :: a -> a -> a
    comm g :: a
    g h :: a
    h = a
    ga -> Integer -> a
    forall a b. (Num a, HasInverses a, Integral b) => a -> b -> a
    ^-1 a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    ha -> Integer -> a
    forall a b. (Num a, HasInverses a, Integral b) => a -> b -> a
    ^-1 a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    g a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    h

    -- ORBITS

    {-
    closureS xs fs = closure' S.empty (S.fromList xs) where
        closure' interior boundary
            | S.null boundary = interior
            | otherwise =
                let interior' = S.union interior boundary
                    boundary' = S.fromList [f x | x <- S.toList boundary, f <- fs] S.\\ interior'
                in closure' interior' boundary'
    -}
    closureS :: [a] -> [a -> a] -> Set a
    closureS xs :: [a]
    xs fs :: [a -> a]
    fs = Set a -> [a] -> Set a
    closure' Set a
    forall a. Set a
    S.empty [a]
    xs where
        closure' :: Set a -> [a] -> Set a
    closure' interior :: Set a
    interior (x :: a
    x:xs :: [a]
    xs)
            | a -> Set a -> Bool
    forall a. Ord a => a -> Set a -> Bool
    S.member a
    x Set a
    interior = Set a -> [a] -> Set a
    closure' Set a
    interior [a]
    xs
            | Bool
    otherwise = Set a -> [a] -> Set a
    closure' (a -> Set a -> Set a
    forall a. Ord a => a -> Set a -> Set a
    S.insert a
    x Set a
    interior) ([a -> a
    f a
    x | a -> a
    f <- [a -> a]
    fs] [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    xs)
        closure' interior :: Set a
    interior [] = Set a
    interior

    closure :: [a] -> [a -> a] -> [a]
    closure xs :: [a]
    xs fs :: [a -> a]
    fs = Set a -> [a]
    forall a. Set a -> [a]
    S.toList (Set a -> [a]) -> Set a -> [a]
    forall a b. (a -> b) -> a -> b
    $ [a] -> [a -> a] -> Set a
    forall a. Ord a => [a] -> [a -> a] -> Set a
    closureS [a]
    xs [a -> a]
    fs

    orbit :: (t -> t -> t) -> t -> [t] -> [t]
    orbit action :: t -> t -> t
    action x :: t
    x gs :: [t]
    gs = [t] -> [t -> t] -> [t]
    forall a. Ord a => [a] -> [a -> a] -> [a]
    closure [t
    x] [ (t -> t -> t
    `action` t
    g) | t
    g <- [t]
    gs]

    -- |x .^^ gs returns the orbit of the point or vertex x under the action of the gs

    (.^^) :: (Ord a) => a -> [Permutation a] -> [a]
    x :: a
    x .^^ :: a -> [Permutation a] -> [a]
    .^^ gs :: [Permutation a]
    gs = (a -> Permutation a -> a) -> a -> [Permutation a] -> [a]
    forall t t. Ord t => (t -> t -> t) -> t -> [t] -> [t]
    orbit a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    (.^) a
    x [Permutation a]
    gs

    orbitP :: [Permutation t] -> t -> [t]
    orbitP gs :: [Permutation t]
    gs x :: t
    x = (t -> Permutation t -> t) -> t -> [Permutation t] -> [t]
    forall t t. Ord t => (t -> t -> t) -> t -> [t] -> [t]
    orbit t -> Permutation t -> t
    forall a. Ord a => a -> Permutation a -> a
    (.^) t
    x [Permutation t]
    gs
    orbitV :: [Permutation t] -> t -> [t]
    orbitV gs :: [Permutation t]
    gs x :: t
    x = (t -> Permutation t -> t) -> t -> [Permutation t] -> [t]
    forall t t. Ord t => (t -> t -> t) -> t -> [t] -> [t]
    orbit t -> Permutation t -> t
    forall a. Ord a => a -> Permutation a -> a
    (.^) t
    x [Permutation t]
    gs

    -- |b -^^ gs returns the orbit of the block or edge b under the action of the gs

    (-^^) :: (Ord a) => [a] -> [Permutation a] -> [[a]]
    b :: [a]
    b -^^ :: [a] -> [Permutation a] -> [[a]]
    -^^ gs :: [Permutation a]
    gs = ([a] -> Permutation a -> [a]) -> [a] -> [Permutation a] -> [[a]]
    forall t t. Ord t => (t -> t -> t) -> t -> [t] -> [t]
    orbit [a] -> Permutation a -> [a]
    forall a. Ord a => [a] -> Permutation a -> [a]
    (-^) [a]
    b [Permutation a]
    gs

    orbitB :: [Permutation a] -> [a] -> [[a]]
    orbitB gs :: [Permutation a]
    gs b :: [a]
    b = ([a] -> Permutation a -> [a]) -> [a] -> [Permutation a] -> [[a]]
    forall t t. Ord t => (t -> t -> t) -> t -> [t] -> [t]
    orbit [a] -> Permutation a -> [a]
    forall a. Ord a => [a] -> Permutation a -> [a]
    (-^) [a]
    b [Permutation a]
    gs
    orbitE :: [Permutation a] -> [a] -> [[a]]
    orbitE gs :: [Permutation a]
    gs b :: [a]
    b = ([a] -> Permutation a -> [a]) -> [a] -> [Permutation a] -> [[a]]
    forall t t. Ord t => (t -> t -> t) -> t -> [t] -> [t]
    orbit [a] -> Permutation a -> [a]
    forall a. Ord a => [a] -> Permutation a -> [a]
    (-^) [a]
    b [Permutation a]
    gs

    action :: [t] -> (t -> t) -> Permutation t
    action xs :: [t]
    xs f :: t -> t
    f = [(t, t)] -> Permutation t
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [(t
    x, t -> t
    f t
    x) | t
    x <- [t]
    xs]

    -- find all the orbits of a group

    -- (as we typically work with transitive groups, this is more useful for studying induced actions)

    -- (Note that of course this won't find orbits of points which are fixed by all elts of G)

    orbits :: [Permutation a] -> [[a]]
    orbits gs :: [Permutation a]
    gs = let 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 in [a] -> [[a]]
    orbits' [a]
    xs
        where orbits' :: [a] -> [[a]]
    orbits' [] = []
              orbits' (x :: a
    x:xs :: [a]
    xs) = let o :: [a]
    o = a
    x a -> [Permutation a] -> [a]
    forall a. Ord a => a -> [Permutation a] -> [a]
    .^^ [Permutation a]
    gs in [a]
    o [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [a] -> [[a]]
    orbits' ([a]
    xs [a] -> [a] -> [a]
    forall a. Eq a => [a] -> [a] -> [a]
    L.\\ [a]
    o)

    -- GROUPS

    -- Some standard sequences of groups, and constructions of new groups from old

    -- |_C n returns generators for Cn, the cyclic group of order n

    _C :: (Integral a) => a -> [Permutation a]
    _C :: a -> [Permutation a]
    _C n :: a
    n | a
    n a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 2 = [[[a]] -> Permutation a
    forall a. Ord a => [[a]] -> Permutation a
    p [[1..a
    n]]]

    -- D2n, dihedral group of order 2n, symmetry group of n-gon

    -- For example, _D 8 == _D2 4 == symmetry group of square

    _D :: a -> [Permutation a]
    _D n :: a
    n | a
    r a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 = a -> [Permutation a]
    forall a. Integral a => a -> [Permutation a]
    _D2 a
    q where (q :: a
    q,r :: a
    r) = a
    n a -> a -> (a, a)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` 2

    _D2 :: a -> [Permutation a]
    _D2 n :: a
    n | a
    n a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 3 = [Permutation a
    a,Permutation a
    b] where
        a :: Permutation a
    a = [[a]] -> Permutation a
    forall a. Ord a => [[a]] -> Permutation a
    p [[1..a
    n]]                            -- rotation

        b :: Permutation a
    b = [[a]] -> Permutation a
    forall a. Ord a => [[a]] -> Permutation a
    p [[a
    i,a
    na -> a -> a
    forall a. Num a => a -> a -> a
    +1a -> a -> a
    forall a. Num a => a -> a -> a
    -a
    i] | a
    i <- [1..a
    n a -> a -> a
    forall a. Integral a => a -> a -> a
    `div` 2]]   -- reflection

        -- b = fromPairs $ [(i,n+1-i) | i <- [1..n]] -- reflection

    -- |_S n returns generators for Sn, the symmetric group on [1..n]

    _S :: (Integral a) => a -> [Permutation a]
    _S :: a -> [Permutation a]
    _S n :: a
    n | a
    n a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 3 = [Permutation a
    s,Permutation a
    forall a. (Ord a, Num a) => Permutation a
    t]
         | a
    n a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == 2 = [Permutation a
    forall a. (Ord a, Num a) => Permutation a
    t]
         | a
    n a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 = []
        where s :: Permutation a
    s = [[a]] -> Permutation a
    forall a. Ord a => [[a]] -> Permutation a
    p [[1..a
    n]]
              t :: Permutation a
    t = [[a]] -> Permutation a
    forall a. Ord a => [[a]] -> Permutation a
    p [[1,2]]

    -- |_A n returns generators for An, the alternating group on [1..n]

    _A :: (Integral a) => a -> [Permutation a]
    _A :: a -> [Permutation a]
    _A n :: a
    n | a
    n a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > 3 = [Permutation a
    s,Permutation a
    forall a. (Ord a, Num a) => Permutation a
    t]
         | a
    n a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == 3 = [Permutation a
    forall a. (Ord a, Num a) => Permutation a
    t]
         | a
    n a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == 2 = []
        where s :: Permutation a
    s | a -> Bool
    forall a. Integral a => a -> Bool
    odd a
    n  = [[a]] -> Permutation a
    forall a. Ord a => [[a]] -> Permutation a
    p [[3..a
    n]]
                | a -> Bool
    forall a. Integral a => a -> Bool
    even a
    n = [[a]] -> Permutation a
    forall a. Ord a => [[a]] -> Permutation a
    p [[1,2], [3..a
    n]]
              t :: Permutation a
    t = [[a]] -> Permutation a
    forall a. Ord a => [[a]] -> Permutation a
    p [[1,2,3]]

    -- |Given generators for groups H and K, acting on sets A and B respectively,

    -- return generators for the direct product H*K, acting on the disjoint union A+B (= Either A B)

    dp :: (Ord a, Ord b) => [Permutation a] -> [Permutation b] -> [Permutation (Either a b)]
    dp :: [Permutation a] -> [Permutation b] -> [Permutation (Either a b)]
    dp hs :: [Permutation a]
    hs ks :: [Permutation b]
    ks =
        [Map (Either a b) (Either a b) -> Permutation (Either a b)
    forall a. Map a a -> Permutation a
    P (Map (Either a b) (Either a b) -> Permutation (Either a b))
    -> Map (Either a b) (Either a b) -> Permutation (Either a b)
    forall a b. (a -> b) -> a -> b
    $ [(Either a b, Either a b)] -> Map (Either a b) (Either a b)
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Either a b, Either a b)] -> Map (Either a b) (Either a b))
    -> [(Either a b, Either a b)] -> Map (Either a b) (Either a b)
    forall a b. (a -> b) -> a -> b
    $ ((a, a) -> (Either a b, Either a b))
    -> [(a, a)] -> [(Either a b, Either a b)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(x :: a
    x,x' :: a
    x') -> (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
    x')) ([(a, a)] -> [(Either a b, Either a b)])
    -> [(a, a)] -> [(Either a b, Either a b)]
    forall a b. (a -> b) -> a -> b
    $ Map a a -> [(a, a)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map a a
    h' | P h' :: Map a a
    h' <- [Permutation a]
    hs] [Permutation (Either a b)]
    -> [Permutation (Either a b)] -> [Permutation (Either a b)]
    forall a. [a] -> [a] -> [a]
    ++
        [Map (Either a b) (Either a b) -> Permutation (Either a b)
    forall a. Map a a -> Permutation a
    P (Map (Either a b) (Either a b) -> Permutation (Either a b))
    -> Map (Either a b) (Either a b) -> Permutation (Either a b)
    forall a b. (a -> b) -> a -> b
    $ [(Either a b, Either a b)] -> Map (Either a b) (Either a b)
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Either a b, Either a b)] -> Map (Either a b) (Either a b))
    -> [(Either a b, Either a b)] -> Map (Either a b) (Either a b)
    forall a b. (a -> b) -> a -> b
    $ ((b, b) -> (Either a b, Either a b))
    -> [(b, b)] -> [(Either a b, Either a b)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(y :: b
    y,y' :: b
    y') -> (b -> Either a b
    forall a b. b -> Either a b
    Right b
    y,b -> Either a b
    forall a b. b -> Either a b
    Right b
    y')) ([(b, b)] -> [(Either a b, Either a b)])
    -> [(b, b)] -> [(Either a b, Either a b)]
    forall a b. (a -> b) -> a -> b
    $ Map b b -> [(b, b)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map b b
    k' | P k' :: Map b b
    k' <- [Permutation b]
    ks]

    -- Wreath product of groups

    -- Given generators for H and K, acting on sets X and Y respectively,

    -- return generators for H wr K, acting on X*Y (== (X,Y))

    -- (Cameron, Combinatorics, p229-230; Cameron, Permutation Groups, p11-12)

    wr :: [Permutation a] -> [Permutation a] -> [Permutation (a, a)]
    wr hs :: [Permutation a]
    hs ks :: [Permutation a]
    ks =
        let _X :: [a]
    _X = Set a -> [a]
    forall a. Set a -> [a]
    S.toList (Set a -> [a]) -> Set a -> [a]
    forall a b. (a -> b) -> a -> b
    $ (Set a -> Set a -> Set a) -> Set a -> [Set a] -> Set a
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Set a -> Set a -> Set a
    forall a. Ord a => Set a -> Set a -> Set a
    S.union Set a
    forall a. Set a
    S.empty [Map a a -> Set a
    forall k a. Map k a -> Set k
    M.keysSet Map a a
    h' | P h' :: Map a a
    h' <- [Permutation a]
    hs] -- set on which H acts

            _Y :: [a]
    _Y = Set a -> [a]
    forall a. Set a -> [a]
    S.toList (Set a -> [a]) -> Set a -> [a]
    forall a b. (a -> b) -> a -> b
    $ (Set a -> Set a -> Set a) -> Set a -> [Set a] -> Set a
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Set a -> Set a -> Set a
    forall a. Ord a => Set a -> Set a -> Set a
    S.union Set a
    forall a. Set a
    S.empty [Map a a -> Set a
    forall k a. Map k a -> Set k
    M.keysSet Map a a
    k' | P k' :: Map a a
    k' <- [Permutation a]
    ks] -- set on which K acts

            -- Then the wreath product acts on cartesian product X * Y,

            -- regarded as a fibre bundle over Y of isomorphic copies of X

            _B :: [Permutation (a, a)]
    _B = [Map (a, a) (a, a) -> Permutation (a, a)
    forall a. Map a a -> Permutation a
    P (Map (a, a) (a, a) -> Permutation (a, a))
    -> Map (a, a) (a, a) -> Permutation (a, a)
    forall a b. (a -> b) -> a -> b
    $ [((a, a), (a, a))] -> Map (a, a) (a, a)
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((a, a), (a, a))] -> Map (a, a) (a, a))
    -> [((a, a), (a, a))] -> Map (a, a) (a, a)
    forall a b. (a -> b) -> a -> b
    $ ((a, a) -> ((a, a), (a, a))) -> [(a, a)] -> [((a, a), (a, a))]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(x :: a
    x,x' :: a
    x') -> ((a
    x,a
    y),(a
    x',a
    y))) ([(a, a)] -> [((a, a), (a, a))]) -> [(a, a)] -> [((a, a), (a, a))]
    forall a b. (a -> b) -> a -> b
    $ Map a a -> [(a, a)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map a a
    h' | P h' :: Map a a
    h' <- [Permutation a]
    hs, a
    y <- [a]
    _Y]
            -- bottom group B applies the action of H within each fibre

            _T :: [Permutation (a, a)]
    _T = [Map (a, a) (a, a) -> Permutation (a, a)
    forall a. Map a a -> Permutation a
    P (Map (a, a) (a, a) -> Permutation (a, a))
    -> Map (a, a) (a, a) -> Permutation (a, a)
    forall a b. (a -> b) -> a -> b
    $ [((a, a), (a, a))] -> Map (a, a) (a, a)
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [((a
    x,a
    y),(a
    x,a
    y')) | a
    x <- [a]
    _X, (y :: a
    y,y' :: a
    y') <- Map a a -> [(a, a)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map a a
    k'] | P k' :: Map a a
    k' <- [Permutation a]
    ks]
            -- top group T uses the action of K to permute the fibres

        in [Permutation (a, a)]
    _B [Permutation (a, a)]
    -> [Permutation (a, a)] -> [Permutation (a, a)]
    forall a. [a] -> [a] -> [a]
    ++ [Permutation (a, a)]
    _T -- semi-direct product of B and T

    -- !! Why using M.keysSet rather than supp?

    -- embed group elts into Sn - ie, convert so that the set acted on is [1..n]

    toSn :: [Permutation a] -> [Permutation a]
    toSn gs :: [Permutation a]
    gs = [Permutation a -> Permutation a
    forall a. (Ord a, Num a, Enum a) => Permutation a -> Permutation a
    toSn' Permutation a
    g | Permutation a
    g <- [Permutation a]
    gs] where
        _X :: [a]
    _X = [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] -> [[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   -- the set on which G acts

        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]
    _X [1..] -- the mapping from _X to [1..n]

        toSn' :: Permutation a -> Permutation a
    toSn' g :: Permutation a
    g = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs' ([(a, a)] -> Permutation a) -> [(a, a)] -> Permutation a
    forall a b. (a -> b) -> a -> b
    $ ((a, a) -> (a, a)) -> [(a, a)] -> [(a, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(x :: a
    x,x' :: a
    x') -> (Map a a
    forall a. (Num a, Enum a) => Map a a
    mapping Map a a -> a -> a
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    x, Map a a
    forall a. (Num a, Enum a) => Map a a
    mapping Map a a -> a -> a
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    x')) ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
    forall a b. (a -> b) -> a -> b
    $ Permutation a -> [(a, a)]
    forall a. Permutation a -> [(a, a)]
    toPairs Permutation a
    g

    -- Given a permutation over lists of small positive integers, such as [1,2,3],

    -- return a permutation over the integers obtained by interpreting the lists as digits.

    -- For example, [1,2,3] -> 123.

    fromDigits :: Permutation [p] -> Permutation p
    fromDigits g :: Permutation [p]
    g = [(p, p)] -> Permutation p
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [([p] -> p
    forall p. Num p => [p] -> p
    fromDigits' [p]
    x, [p] -> p
    forall p. Num p => [p] -> p
    fromDigits' [p]
    y) | (x :: [p]
    x,y :: [p]
    y) <- Permutation [p] -> [([p], [p])]
    forall a. Permutation a -> [(a, a)]
    toPairs Permutation [p]
    g]

    fromDigits' :: [p] -> p
    fromDigits' xs :: [p]
    xs = [p] -> p
    forall p. Num p => [p] -> p
    f ([p] -> [p]
    forall a. [a] -> [a]
    reverse [p]
    xs) where
        f :: [p] -> p
    f (x :: p
    x:xs :: [p]
    xs) = p
    x p -> p -> p
    forall a. Num a => a -> a -> a
    + 10 p -> p -> p
    forall a. Num a => a -> a -> a
    * [p] -> p
    f [p]
    xs
        f [] = 0

    -- Given a permutation over lists of 0s and 1s,

    -- return the permutation obtained by interpreting these as binary digits.

    -- For example, [1,1,0] -> 6.

    fromBinary :: Permutation [p] -> Permutation p
    fromBinary g :: Permutation [p]
    g = [(p, p)] -> Permutation p
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [([p] -> p
    forall p. Num p => [p] -> p
    fromBinary' [p]
    x, [p] -> p
    forall p. Num p => [p] -> p
    fromBinary' [p]
    y) | (x :: [p]
    x,y :: [p]
    y) <- Permutation [p] -> [([p], [p])]
    forall a. Permutation a -> [(a, a)]
    toPairs Permutation [p]
    g]

    fromBinary' :: [p] -> p
    fromBinary' xs :: [p]
    xs = [p] -> p
    forall p. Num p => [p] -> p
    f ([p] -> [p]
    forall a. [a] -> [a]
    reverse [p]
    xs) where
        f :: [p] -> p
    f (x :: p
    x:xs :: [p]
    xs) = p
    x p -> p -> p
    forall a. Num a => a -> a -> a
    + 2 p -> p -> p
    forall a. Num a => a -> a -> a
    * [p] -> p
    f [p]
    xs
        f [] = 0

    -- INVESTIGATING GROUPS

    -- Functions to investigate groups in various ways

    -- Most of these functions will only be efficient for small groups (say |G| < 10000)

    -- For larger groups we will need to use Schreier-Sims and associated algorithms

    -- |Given generators for a group, return a (sorted) list of all elements of the group.

    -- Implemented using a naive closure algorithm, so only suitable for small groups (|G| < 10000)

    elts :: (Num a, Ord a) => [a] -> [a]
    elts :: [a] -> [a]
    elts gs :: [a]
    gs = [a] -> [a -> a] -> [a]
    forall a. Ord a => [a] -> [a -> a] -> [a]
    closure [1] [ (a -> a -> a
    forall a. Num a => a -> a -> a
    *a
    g) | a
    g <- [a]
    gs]

    eltsS :: [a] -> Set a
    eltsS gs :: [a]
    gs = [a] -> [a -> a] -> Set a
    forall a. Ord a => [a] -> [a -> a] -> Set a
    closureS [1] [ (a -> a -> a
    forall a. Num a => a -> a -> a
    *a
    g) | a
    g <- [a]
    gs]

    -- |Given generators for a group, return the order of the group (the number of elements).

    -- Implemented using a naive closure algorithm, so only suitable for small groups (|G| < 10000)

    order :: (Num a, Ord a) => [a] -> Int
    order :: [a] -> Int
    order gs :: [a]
    gs = Set a -> Int
    forall a. Set a -> Int
    S.size (Set a -> Int) -> Set a -> Int
    forall a b. (a -> b) -> a -> b
    $ [a] -> Set a
    forall a. (Ord a, Num a) => [a] -> Set a
    eltsS [a]
    gs -- length $ elts gs

    isMember :: [a] -> a -> Bool
    isMember gs :: [a]
    gs h :: a
    h = a
    h a -> Set a -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` [a] -> Set a
    forall a. (Ord a, Num a) => [a] -> Set a
    eltsS [a]
    gs -- h `elem` elts gs

    -- TRANSVERSAL GENERATING SETS

    -- The functions graphAuts2 and graphAuts3 return generating sets consisting of successive transversals

    -- In this case, we don't need to run Schreier-Sims to list elements or calculate order

    minsupp :: Permutation c -> c
    minsupp = [c] -> c
    forall a. [a] -> a
    head ([c] -> c) -> (Permutation c -> [c]) -> Permutation c -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permutation c -> [c]
    forall a. Permutation a -> [a]
    supp

    -- calculate the order of the group, given a "transversal generating set"

    orderTGS :: [Permutation c] -> a
    orderTGS tgs :: [Permutation c]
    tgs =
        let transversals :: [[Permutation c]]
    transversals = ([Permutation c] -> [Permutation c])
    -> [[Permutation c]] -> [[Permutation c]]
    forall a b. (a -> b) -> [a] -> [b]
    map (1Permutation c -> [Permutation c] -> [Permutation c]
    forall a. a -> [a] -> [a]
    :) ([[Permutation c]] -> [[Permutation c]])
    -> [[Permutation c]] -> [[Permutation c]]
    forall a b. (a -> b) -> a -> b
    $ (Permutation c -> Permutation c -> Bool)
    -> [Permutation c] -> [[Permutation c]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    L.groupBy (\g :: Permutation c
    g h :: Permutation c
    h -> Permutation c -> c
    forall c. Permutation c -> c
    minsupp Permutation c
    g c -> c -> Bool
    forall a. Eq a => a -> a -> Bool
    == Permutation c -> c
    forall c. Permutation c -> c
    minsupp Permutation c
    h) [Permutation c]
    tgs
        in [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    product ([a] -> a) -> [a] -> a
    forall a b. (a -> b) -> a -> b
    $ ([Permutation c] -> a) -> [[Permutation c]] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map [Permutation c] -> a
    forall i a. Num i => [a] -> i
    L.genericLength [[Permutation c]]
    transversals

    -- list the elts of the group, given a "transversal generating set"

    eltsTGS :: [Permutation c] -> [Permutation c]
    eltsTGS tgs :: [Permutation c]
    tgs =
        let transversals :: [[Permutation c]]
    transversals = ([Permutation c] -> [Permutation c])
    -> [[Permutation c]] -> [[Permutation c]]
    forall a b. (a -> b) -> [a] -> [b]
    map (1Permutation c -> [Permutation c] -> [Permutation c]
    forall a. a -> [a] -> [a]
    :) ([[Permutation c]] -> [[Permutation c]])
    -> [[Permutation c]] -> [[Permutation c]]
    forall a b. (a -> b) -> a -> b
    $ (Permutation c -> Permutation c -> Bool)
    -> [Permutation c] -> [[Permutation c]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    L.groupBy (\g :: Permutation c
    g h :: Permutation c
    h -> Permutation c -> c
    forall c. Permutation c -> c
    minsupp Permutation c
    g c -> c -> Bool
    forall a. Eq a => a -> a -> Bool
    == Permutation c -> c
    forall c. Permutation c -> c
    minsupp Permutation c
    h) [Permutation c]
    tgs
        in ([Permutation c] -> Permutation c)
    -> [[Permutation c]] -> [Permutation c]
    forall a b. (a -> b) -> [a] -> [b]
    map [Permutation c] -> Permutation c
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    product ([[Permutation c]] -> [Permutation c])
    -> [[Permutation c]] -> [Permutation c]
    forall a b. (a -> b) -> a -> b
    $ [[Permutation c]] -> [[Permutation c]]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [[Permutation c]]
    transversals

    -- recover a transversal generating set from a strong generating set

    -- A strong generating set is a generating set gs such that <gs intersect si> = si

    -- ie, its intersection with each successive stabiliser in the chain generates the stabiliser

    tgsFromSgs :: [Permutation a] -> [Permutation a]
    tgsFromSgs sgs :: [Permutation a]
    sgs = (a -> [Permutation a]) -> [a] -> [Permutation a]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap a -> [Permutation a]
    transversal [a]
    bs where
        bs :: [a]
    bs = [a] -> [a]
    forall a. Ord a => [a] -> [a]
    toListSet ([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]
    sgs
        transversal :: a -> [Permutation a]
    transversal b :: a
    b = a -> [Permutation a] -> [Permutation a]
    forall k. Ord k => k -> [Permutation k] -> [Permutation k]
    closure a
    b ([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 ( (a
    b a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <=) (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]
    sgs
        closure :: k -> [Permutation k] -> [Permutation k]
    closure b :: k
    b gs :: [Permutation k]
    gs = Map k (Permutation k) -> Map k (Permutation k) -> [Permutation k]
    closure' Map k (Permutation k)
    forall k a. Map k a
    M.empty ([(k, Permutation k)] -> Map k (Permutation k)
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(k
    b, 1)]) where
            closure' :: Map k (Permutation k) -> Map k (Permutation k) -> [Permutation k]
    closure' 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 = (Permutation k -> Bool) -> [Permutation k] -> [Permutation k]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Permutation k -> Permutation k -> Bool
    forall a. Eq a => a -> a -> Bool
    /=1) ([Permutation k] -> [Permutation k])
    -> [Permutation k] -> [Permutation k]
    forall a b. (a -> b) -> a -> b
    $ Map k (Permutation k) -> [Permutation k]
    forall k a. Map k a -> [a]
    M.elems 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
    x 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) | (x :: k
    x,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, Permutation k
    g <- [Permutation k]
    gs] 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 Map k (Permutation k) -> Map k (Permutation k) -> [Permutation k]
    closure' Map k (Permutation k)
    interior' Map k (Permutation k)
    boundary'
    -- For example, sgs (_A 5) == [[[1,2,3]],[[2,4,5]],[[3,4,5]]]

    -- So we need all three to generate the first transversal, then the last two to generate the second transversal, etc

    -- |Given a strong generating set, return the order of the group it generates.

    -- Note that the SGS is assumed to be relative to the natural order of the points on which the group acts.

    orderSGS :: (Ord a) => [Permutation a] -> Integer
    orderSGS :: [Permutation a] -> Integer
    orderSGS sgs :: [Permutation a]
    sgs = [Integer] -> Integer
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    product ([Integer] -> Integer) -> [Integer] -> Integer
    forall a b. (a -> b) -> a -> b
    $ (a -> Integer) -> [a] -> [Integer]
    forall a b. (a -> b) -> [a] -> [b]
    map ([a] -> Integer
    forall i a. Num i => [a] -> i
    L.genericLength ([a] -> Integer) -> (a -> [a]) -> a -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> [a]
    fundamentalOrbit) [a]
    bs where
        bs :: [a]
    bs = [a] -> [a]
    forall a. Ord a => [a] -> [a]
    toListSet ([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]
    sgs
        fundamentalOrbit :: a -> [a]
    fundamentalOrbit b :: a
    b = a
    b a -> [Permutation a] -> [a]
    forall a. Ord a => a -> [Permutation a] -> [a]
    .^^ (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ( (a
    b a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <=) (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]
    sgs

    -- !! Needs more testing

    -- |Given a base and strong generating set, return the order of the group it generates.

    orderBSGS :: (Ord a) => ([a],[Permutation a]) -> Integer
    orderBSGS :: ([a], [Permutation a]) -> Integer
    orderBSGS (bs :: [a]
    bs,sgs :: [Permutation a]
    sgs) = Integer -> [a] -> [Permutation a] -> Integer
    forall t a. (Num t, Ord a) => t -> [a] -> [Permutation a] -> t
    go 1 [a]
    bs [Permutation a]
    sgs where
        go :: t -> [a] -> [Permutation a] -> t
    go n :: t
    n [] _ = t
    n
        go n :: t
    n (b :: a
    b:bs :: [a]
    bs) gs :: [Permutation a]
    gs = t -> [a] -> [Permutation a] -> t
    go (t
    n t -> t -> t
    forall a. Num a => a -> a -> a
    * [a] -> t
    forall i a. Num i => [a] -> i
    L.genericLength (a
    b a -> [Permutation a] -> [a]
    forall a. Ord a => a -> [Permutation a] -> [a]
    .^^ [Permutation a]
    gs)) [a]
    bs ((Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\g :: Permutation a
    g -> a
    b a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    g a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    b) [Permutation a]
    gs)

    -- MORE INVESTIGATIONS

    -- given the elts of a group, find generators

    gens :: [a] -> [a]
    gens hs :: [a]
    hs = [a] -> Set a -> [a] -> [a]
    forall a. (Ord a, Num a) => [a] -> Set a -> [a] -> [a]
    gens' [] (a -> Set a
    forall a. a -> Set a
    S.singleton 1) [a]
    hs where
        gens' :: [a] -> Set a -> [a] -> [a]
    gens' gs :: [a]
    gs eltsG :: Set a
    eltsG (h :: a
    h:hs :: [a]
    hs) = if a
    h a -> Set a -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set a
    eltsG then [a] -> Set a -> [a] -> [a]
    gens' [a]
    gs Set a
    eltsG [a]
    hs else [a] -> Set a -> [a] -> [a]
    gens' (a
    ha -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    gs) ([a] -> Set a
    forall a. (Ord a, Num a) => [a] -> Set a
    eltsS ([a] -> Set a) -> [a] -> Set a
    forall a b. (a -> b) -> a -> b
    $ a
    ha -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    gs) [a]
    hs
        gens' gs :: [a]
    gs _ [] = [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    gs

    -- conjClass gs h = orbit (~^) gs h

    -- Conjugacy class - should only be used for small groups

    h :: Permutation a
    h ~^^ :: Permutation a -> [Permutation a] -> [Permutation a]
    ~^^ gs :: [Permutation a]
    gs = [Permutation a] -> Permutation a -> [Permutation a]
    forall a.
    Ord a =>
    [Permutation a] -> Permutation a -> [Permutation a]
    conjClass [Permutation a]
    gs Permutation a
    h

    conjClass :: [Permutation a] -> Permutation a -> [Permutation a]
    conjClass gs :: [Permutation a]
    gs h :: Permutation a
    h = [Permutation a]
    -> [Permutation a -> Permutation a] -> [Permutation a]
    forall a. Ord a => [a] -> [a -> a] -> [a]
    closure [Permutation a
    h] [ (Permutation a -> Permutation a -> Permutation a
    forall a. Ord a => Permutation a -> Permutation a -> Permutation a
    ~^ Permutation a
    g) | Permutation a
    g <- [Permutation a]
    gs]
    -- conjClass gs h = h ~^^ gs

    -- |conjClassReps gs returns conjugacy class representatives and sizes for the group generated by gs.

    -- This implementation is only suitable for use with small groups (|G| < 10000).

    conjClassReps :: (Ord a, Show a) => [Permutation a] -> [(Permutation a, Int)]
    conjClassReps :: [Permutation a] -> [(Permutation a, Int)]
    conjClassReps gs :: [Permutation a]
    gs = [Permutation a] -> [(Permutation a, Int)]
    conjClassReps' ([Permutation a] -> [Permutation a]
    forall a. (Num a, Ord a) => [a] -> [a]
    elts [Permutation a]
    gs) where
        conjClassReps' :: [Permutation a] -> [(Permutation a, Int)]
    conjClassReps' (h :: Permutation a
    h:hs :: [Permutation a]
    hs) =
            let cc :: [Permutation a]
    cc = [Permutation a] -> Permutation a -> [Permutation a]
    forall a.
    Ord a =>
    [Permutation a] -> Permutation a -> [Permutation a]
    conjClass [Permutation a]
    gs Permutation a
    h in (Permutation a
    h, [Permutation a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Permutation a]
    cc) (Permutation a, Int)
    -> [(Permutation a, Int)] -> [(Permutation a, Int)]
    forall a. a -> [a] -> [a]
    : [Permutation a] -> [(Permutation a, Int)]
    conjClassReps' ([Permutation a]
    hs [Permutation a] -> [Permutation a] -> [Permutation a]
    forall a. Ord a => [a] -> [a] -> [a]
    \\ [Permutation a]
    cc)
        conjClassReps' [] = []
    -- using the ListSet implementation of \\, since we know both lists are sorted

    {-
    -- This is just the orbits under conjugation. Can we generalise "orbits" to help us here?
    conjClasses gs = conjClasses' (elts gs)
        where conjClasses' [] = []
              conjClasses' (h:hs) = let c = conjClass gs h in c : conjClasses' (hs L.\\ c)
    -}

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

    reduceGens :: [a] -> [a]
    reduceGens (1:gs :: [a]
    gs) = [a] -> [a]
    reduceGens [a]
    gs
    reduceGens (g :: a
    g:gs :: [a]
    gs) = ([a], Set a) -> [a] -> [a]
    forall a. (Ord a, Num a) => ([a], Set a) -> [a] -> [a]
    reduceGens' ([a
    g], [a] -> Set a
    forall a. (Ord a, Num a) => [a] -> Set a
    eltsS [a
    g]) [a]
    gs where
        reduceGens' :: ([a], Set a) -> [a] -> [a]
    reduceGens' (gs :: [a]
    gs,eltsgs :: Set a
    eltsgs) (h :: a
    h:hs :: [a]
    hs) =
            if a
    h a -> Set a -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set a
    eltsgs
            then ([a], Set a) -> [a] -> [a]
    reduceGens' ([a]
    gs,Set a
    eltsgs) [a]
    hs
            else ([a], Set a) -> [a] -> [a]
    reduceGens' (a
    ha -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    gs, [a] -> Set a
    forall a. (Ord a, Num a) => [a] -> Set a
    eltsS ([a] -> Set a) -> [a] -> Set a
    forall a b. (a -> b) -> a -> b
    $ a
    ha -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    gs) [a]
    hs
        reduceGens' (gs :: [a]
    gs,_) [] = [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    gs

    -- SUBGROUPS

    isSubgp :: t a -> [a] -> Bool
    isSubgp hs :: t a
    hs gs :: [a]
    gs = (a -> Bool) -> t 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
    gs') t a
    hs
        where gs' :: Set a
    gs' = [a] -> Set a
    forall a. (Ord a, Num a) => [a] -> Set a
    eltsS [a]
    gs

    -- The following is similar to the "cyclic extension" method - Holt p385

    -- However, Holt only looks at normal cyclic extensions (ie, by an elt of prime order), and so only finds solvable subgps

    -- |Return the subgroups of a group. Only suitable for use on small groups (eg < 100 elts)

    subgps :: (Ord a, Show a) => [Permutation a] -> [[Permutation a]]
    subgps :: [Permutation a] -> [[Permutation a]]
    subgps gs :: [Permutation a]
    gs = [] [Permutation a] -> [[Permutation a]] -> [[Permutation a]]
    forall a. a -> [a] -> [a]
    : Set [Permutation a]
    -> [[Permutation a]] -> [[Permutation a]] -> [[Permutation a]]
    subgps' Set [Permutation a]
    forall a. Set a
    S.empty [] ((Permutation a -> [Permutation a])
    -> [Permutation a] -> [[Permutation a]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Permutation a -> [Permutation a] -> [Permutation a]
    forall a. a -> [a] -> [a]
    :[]) [Permutation a]
    hs) where
        hs :: [Permutation a]
    hs = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Permutation a -> Bool
    forall a. Ord a => Permutation a -> Bool
    isMinimal ([Permutation a] -> [Permutation a])
    -> [Permutation a] -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ [Permutation a] -> [Permutation a]
    forall a. (Num a, Ord a) => [a] -> [a]
    elts [Permutation a]
    gs
        subgps' :: Set [Permutation a]
    -> [[Permutation a]] -> [[Permutation a]] -> [[Permutation a]]
    subgps' found :: Set [Permutation a]
    found ls :: [[Permutation a]]
    ls (r :: [Permutation a]
    r:rs :: [[Permutation a]]
    rs) =
            let ks :: [Permutation a]
    ks = [Permutation a] -> [Permutation a]
    forall a. (Num a, Ord a) => [a] -> [a]
    elts [Permutation a]
    r in
            if [Permutation a]
    ks [Permutation a] -> Set [Permutation a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [Permutation a]
    found
            then Set [Permutation a]
    -> [[Permutation a]] -> [[Permutation a]] -> [[Permutation a]]
    subgps' Set [Permutation a]
    found [[Permutation a]]
    ls [[Permutation a]]
    rs
            else [Permutation a]
    r [Permutation a] -> [[Permutation a]] -> [[Permutation a]]
    forall a. a -> [a] -> [a]
    : Set [Permutation a]
    -> [[Permutation a]] -> [[Permutation a]] -> [[Permutation a]]
    subgps' ([Permutation a] -> Set [Permutation a] -> Set [Permutation a]
    forall a. Ord a => a -> Set a -> Set a
    S.insert [Permutation a]
    ks Set [Permutation a]
    found) ([Permutation a]
    r[Permutation a] -> [[Permutation a]] -> [[Permutation a]]
    forall a. a -> [a] -> [a]
    :[[Permutation a]]
    ls) [[Permutation a]]
    rs
        subgps' found :: Set [Permutation a]
    found [] [] = []
        subgps' found :: Set [Permutation a]
    found ls :: [[Permutation a]]
    ls [] = Set [Permutation a]
    -> [[Permutation a]] -> [[Permutation a]] -> [[Permutation a]]
    subgps' Set [Permutation a]
    found [] [[Permutation a]
    l [Permutation a] -> [Permutation a] -> [Permutation a]
    forall a. [a] -> [a] -> [a]
    ++ [Permutation a
    h] | [Permutation a]
    l <- [[Permutation a]] -> [[Permutation a]]
    forall a. [a] -> [a]
    reverse [[Permutation a]]
    ls, Permutation a
    h <- [Permutation a]
    hs, [Permutation a] -> Permutation a
    forall a. [a] -> a
    last [Permutation a]
    l Permutation a -> Permutation a -> Bool
    forall a. Ord a => a -> a -> Bool
    < Permutation a
    h]

    -- g is the minimal elt in the cyclic subgp it generates

    isMinimal :: Permutation a -> Bool
    isMinimal 1 = Bool
    False
    isMinimal g :: Permutation a
    g = (Permutation a -> Bool) -> [Permutation a] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Permutation a
    g Permutation a -> Permutation a -> Bool
    forall a. Ord a => a -> a -> Bool
    <=) [Permutation a]
    primitives -- g == minimum primitives

        where powers :: [Permutation a]
    powers = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (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] -> [Permutation a]
    forall a. [a] -> [a]
    tail ([Permutation a] -> [Permutation a])
    -> [Permutation a] -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ (Permutation a -> Permutation a)
    -> Permutation a -> [Permutation a]
    forall a. (a -> a) -> a -> [a]
    iterate (Permutation a -> Permutation a -> Permutation a
    forall a. Num a => a -> a -> a
    *Permutation a
    g) 1
              n :: Int
    n = Permutation a -> Int
    forall a. Ord a => Permutation a -> Int
    orderElt Permutation a
    g -- == length powers + 1

              primitives :: [Permutation a]
    primitives = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\h :: Permutation a
    h -> Permutation a -> Int
    forall a. Ord a => Permutation a -> Int
    orderElt Permutation a
    h Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    n) [Permutation a]
    powers

    -- centralizer of a subgroup or a set of elts

    -- the centralizer of H in G is the set of elts of G which commute with all elts of H

    centralizer :: [a] -> t a -> [a]
    centralizer gs :: [a]
    gs hs :: t a
    hs = [a
    k | a
    k <- [a] -> [a]
    forall a. (Num a, Ord a) => [a] -> [a]
    elts [a]
    gs, (a -> Bool) -> t a -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\h :: a
    h -> a
    ha -> a -> a
    forall a. Num a => a -> a -> a
    *a
    k a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    ka -> a -> a
    forall a. Num a => a -> a -> a
    *a
    h) t a
    hs]

    -- the centre of G is the set of elts of G which commute with all other elts

    centre :: [a] -> [a]
    centre gs :: [a]
    gs = [a] -> [a] -> [a]
    forall a (t :: * -> *).
    (Num a, Ord a, Foldable t) =>
    [a] -> t a -> [a]
    centralizer [a]
    gs [a]
    gs

    -- normaliser of a subgroup

    -- the normaliser of H in G is {g <- G | g^-1Hg == H}

    -- it is a subgroup of G, and H is a normal subgroup of it: H <|= N_G(H) <= G

    normalizer :: [Permutation a] -> [Permutation a] -> [Permutation a]
    normalizer gs :: [Permutation a]
    gs hs :: [Permutation a]
    hs = [Permutation a
    g | Permutation a
    g <- [Permutation a] -> [Permutation a]
    forall a. (Num a, Ord a) => [a] -> [a]
    elts [Permutation a]
    gs, (Permutation a -> Bool) -> [Permutation a] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\h :: Permutation a
    h -> Permutation a
    hPermutation a -> Permutation a -> Permutation a
    forall a. Ord a => Permutation a -> Permutation a -> Permutation a
    ~^Permutation a
    g Permutation a -> [Permutation a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Permutation a] -> [Permutation a]
    forall a. (Num a, Ord a) => [a] -> [a]
    elts [Permutation a]
    hs) [Permutation a]
    hs]

    -- stabilizer of a point

    stabilizer :: [Permutation a] -> a -> [Permutation a]
    stabilizer gs :: [Permutation a]
    gs x :: a
    x = [Permutation a
    g | Permutation a
    g <- [Permutation a] -> [Permutation a]
    forall a. (Num a, Ord a) => [a] -> [a]
    elts [Permutation a]
    gs, a
    x a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    g a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    x]

    -- pointwise stabiliser of a set

    ptStab :: [Permutation a] -> [a] -> [Permutation a]
    ptStab gs :: [Permutation a]
    gs xs :: [a]
    xs = [Permutation a
    g | Permutation a
    g <- [Permutation a] -> [Permutation a]
    forall a. (Num a, Ord a) => [a] -> [a]
    elts [Permutation a]
    gs, [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [a
    x a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    g a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    x | a
    x <- [a]
    xs] ]

    -- setwise stabiliser of a set

    setStab :: [Permutation a] -> [a] -> [Permutation a]
    setStab gs :: [Permutation a]
    gs xs :: [a]
    xs = [Permutation a
    g | Permutation a
    g <- [Permutation a] -> [Permutation a]
    forall a. (Num a, Ord a) => [a] -> [a]
    elts [Permutation a]
    gs, [a]
    xs [a] -> Permutation a -> [a]
    forall a. Ord a => [a] -> Permutation a -> [a]
    -^ Permutation a
    g [a] -> [a] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [a]
    xs]

    -- normal closure of H in G

    normalClosure :: [Permutation a] -> [Permutation a] -> [Permutation a]
    normalClosure gs :: [Permutation a]
    gs hs :: [Permutation a]
    hs = [Permutation a] -> [Permutation a]
    forall a. (Num a, Ord a) => [a] -> [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 [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. (Num a, Ord a) => [a] -> [a]
    reduceGens [Permutation a]
    hs
              ks' :: [Permutation a]
    ks' = [Permutation a] -> [Permutation a]
    forall a. (Num a, Ord a) => [a] -> [a]
    reduceGens [Permutation a]
    ks
              hsks :: [Permutation a]
    hsks = [Permutation a] -> [Permutation a]
    forall a. (Num a, Ord a) => [a] -> [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

    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]
    commutatorGp [Permutation a]
    gs [Permutation a]
    gs

    -- ACTION ON COSETS, QUOTIENT GROUPS

    xs :: [b]
    xs -*- :: [b] -> [b] -> [b]
    -*- ys :: [b]
    ys = [b] -> [b]
    forall a. Ord a => [a] -> [a]
    toListSet [b
    xb -> b -> b
    forall a. Num a => a -> a -> a
    *b
    y | b
    x <- [b]
    xs, b
    y <- [b]
    ys]

    xs :: [a]
    xs -* :: [a] -> a -> [a]
    -*  y :: a
    y  = [a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a
    xa -> a -> a
    forall a. Num a => a -> a -> a
    *a
    y | a
    x <- [a]
    xs] -- == xs -*- [y]

    x :: a
    x   *- :: a -> [a] -> [a]
    *- ys :: [a]
    ys = [a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a
    xa -> a -> a
    forall a. Num a => a -> a -> a
    *a
    y | a
    y <- [a]
    ys] -- == [x] -*- ys

    -- |isNormal gs ks returns True if \<ks\> is normal in \<gs\>.

    -- Note, it is caller's responsibility to ensure that \<ks\> is a subgroup of \<gs\> (ie that each k is in \<gs\>).

    isNormal :: (Ord a, Show a) => [Permutation a] -> [Permutation a] -> Bool
    isNormal :: [Permutation a] -> [Permutation a] -> Bool
    isNormal gs :: [Permutation a]
    gs ks :: [Permutation a]
    ks = ([Permutation a] -> Bool) -> [[Permutation a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([Permutation a] -> [Permutation a] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Permutation a]
    ks') [ (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. (Ord a, Num a) => a -> [a] -> [a]
    *- [Permutation a]
    ks' [Permutation a] -> Permutation a -> [Permutation a]
    forall a. (Ord a, Num a) => [a] -> a -> [a]
    -* Permutation a
    g | Permutation a
    g <- [Permutation a]
    gs]
        where ks' :: [Permutation a]
    ks' = [Permutation a] -> [Permutation a]
    forall a. (Num a, Ord a) => [a] -> [a]
    elts [Permutation a]
    ks

    -- |Return the normal subgroups of a group. Only suitable for use on small groups (eg < 100 elts)

    normalSubgps :: (Ord a, Show a) => [Permutation a] -> [[Permutation a]]
    normalSubgps :: [Permutation a] -> [[Permutation a]]
    normalSubgps 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.
    (Ord a, Show a) =>
    [Permutation a] -> [Permutation a] -> Bool
    isNormal [Permutation a]
    gs) ([Permutation a] -> [[Permutation a]]
    forall a. (Ord a, Show a) => [Permutation a] -> [[Permutation a]]
    subgps [Permutation a]
    gs)

    isSimple :: [Permutation a] -> Bool
    isSimple gs :: [Permutation a]
    gs = [[Permutation a]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Permutation a] -> [[Permutation a]]
    forall a. (Ord a, Show a) => [Permutation a] -> [[Permutation a]]
    normalSubgps [Permutation a]
    gs) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 2

    -- Note: caller must ensure that hs is a subgp of gs

    cosets :: [a] -> [a] -> [[a]]
    cosets gs :: [a]
    gs hs :: [a]
    hs = ([a] -> a -> [a]) -> [a] -> [a] -> [[a]]
    forall t t. Ord t => (t -> t -> t) -> t -> [t] -> [t]
    orbit [a] -> a -> [a]
    forall a. (Ord a, Num a) => [a] -> a -> [a]
    (-*) [a]
    hs' [a]
    gs
        where hs' :: [a]
    hs' = [a] -> [a]
    forall a. (Num a, Ord a) => [a] -> [a]
    elts [a]
    hs

    -- |quotientGp gs ks returns \<gs\> / \<ks\>

    quotientGp :: (Ord a, Show a) => [Permutation a] -> [Permutation a] -> [Permutation Int]
    quotientGp :: [Permutation a] -> [Permutation a] -> [Permutation Int]
    quotientGp gs :: [Permutation a]
    gs ks :: [Permutation a]
    ks
        | [Permutation a]
    ks [Permutation a] -> [Permutation a] -> Bool
    forall a.
    (Ord a, Show a) =>
    [Permutation a] -> [Permutation a] -> Bool
    `isNormal` [Permutation a]
    gs = [Permutation Int] -> [Permutation Int]
    forall a. (Ord a, Num a) => [a] -> [a]
    gens ([Permutation Int] -> [Permutation Int])
    -> [Permutation Int] -> [Permutation Int]
    forall a b. (a -> b) -> a -> b
    $ [Permutation [Permutation a]] -> [Permutation Int]
    forall a a.
    (Ord a, Num a, Enum a, Ord a) =>
    [Permutation a] -> [Permutation a]
    toSn [[[Permutation a]]
    -> ([Permutation a] -> [Permutation a])
    -> Permutation [Permutation a]
    forall t. Ord t => [t] -> (t -> t) -> Permutation t
    action [[Permutation a]]
    cosetsK ([Permutation a] -> Permutation a -> [Permutation a]
    forall a. (Ord a, Num a) => [a] -> a -> [a]
    -* Permutation a
    g) | Permutation a
    g <- [Permutation a]
    gs]
        | Bool
    otherwise = [Char] -> [Permutation Int]
    forall a. HasCallStack => [Char] -> a
    error "quotientGp: not well defined unless ks normal in gs"
        where cosetsK :: [[Permutation a]]
    cosetsK = [Permutation a] -> [Permutation a] -> [[Permutation a]]
    forall a. (Num a, Ord a) => [a] -> [a] -> [[a]]
    cosets [Permutation a]
    gs [Permutation a]
    ks

    -- |Synonym for quotientGp

    (//) :: (Ord a, Show a) => [Permutation a] -> [Permutation a] -> [Permutation Int]
    gs :: [Permutation a]
    gs // :: [Permutation a] -> [Permutation a] -> [Permutation Int]
    // ks :: [Permutation a]
    ks = [Permutation a] -> [Permutation a] -> [Permutation Int]
    forall a.
    (Ord a, Show a) =>
    [Permutation a] -> [Permutation a] -> [Permutation Int]
    quotientGp [Permutation a]
    gs [Permutation a]
    ks

    -- action of group element on a subset by conjugation

    xs :: [Permutation a]
    xs ~~^ :: [Permutation a] -> Permutation a -> [Permutation a]
    ~~^ g :: Permutation a
    g = [Permutation a] -> [Permutation a]
    forall a. Ord a => [a] -> [a]
    L.sort [Permutation a
    x Permutation a -> Permutation a -> Permutation a
    forall a. Ord a => Permutation a -> Permutation a -> Permutation a
    ~^ Permutation a
    g | Permutation a
    x <- [Permutation a]
    xs]

    conjugateSubgps :: [Permutation a] -> [Permutation a] -> [[Permutation a]]
    conjugateSubgps gs :: [Permutation a]
    gs hs :: [Permutation a]
    hs = ([Permutation a] -> Permutation a -> [Permutation a])
    -> [Permutation a] -> [Permutation a] -> [[Permutation a]]
    forall t t. Ord t => (t -> t -> t) -> t -> [t] -> [t]
    orbit [Permutation a] -> Permutation a -> [Permutation a]
    forall a.
    Ord a =>
    [Permutation a] -> Permutation a -> [Permutation a]
    (~~^) [Permutation a]
    hs' [Permutation a]
    gs
        where hs' :: [Permutation a]
    hs' = [Permutation a] -> [Permutation a]
    forall a. (Num a, Ord a) => [a] -> [a]
    elts [Permutation a]
    hs
    -- not necessarily transitive on isomorphic subgps - eg a gp with an outer aut

    subgpAction :: [Permutation a] -> [Permutation a] -> [Permutation a]
    subgpAction gs :: [Permutation a]
    gs hs :: [Permutation a]
    hs =
        let conjugatesH :: [[Permutation a]]
    conjugatesH = [Permutation a] -> [Permutation a] -> [[Permutation a]]
    forall a.
    Ord a =>
    [Permutation a] -> [Permutation a] -> [[Permutation a]]
    conjugateSubgps [Permutation a]
    gs [Permutation a]
    hs
        in [Permutation [Permutation a]] -> [Permutation a]
    forall a a.
    (Ord a, Num a, Enum a, Ord a) =>
    [Permutation a] -> [Permutation a]
    toSn [[[Permutation a]]
    -> ([Permutation a] -> [Permutation a])
    -> Permutation [Permutation a]
    forall t. Ord t => [t] -> (t -> t) -> Permutation t
    action [[Permutation a]]
    conjugatesH ([Permutation a] -> Permutation a -> [Permutation a]
    forall a.
    Ord a =>
    [Permutation a] -> Permutation a -> [Permutation a]
    ~~^ Permutation a
    g) | Permutation a
    g <- [Permutation a]
    gs]

    -- in cube gp, the subgps all appear to correspond to stabilisers of subsets, or of blocks

    -- right regular permutation representation

    rrpr :: [a] -> a -> Permutation a
    rrpr gs :: [a]
    gs h :: a
    h = [a] -> a -> Permutation a
    forall a. (Ord a, Num a) => [a] -> a -> Permutation a
    rrpr' ([a] -> [a]
    forall a. (Num a, Ord a) => [a] -> [a]
    elts [a]
    gs) a
    h

    rrpr' :: [a] -> a -> Permutation a
    rrpr' gs :: [a]
    gs h :: a
    h = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [(a
    g, a
    ga -> a -> a
    forall a. Num a => a -> a -> a
    *a
    h) | a
    g <- [a]
    gs]

    permutationMatrix :: [a] -> Permutation a -> [[a]]
    permutationMatrix xs :: [a]
    xs g :: Permutation a
    g = [ [if a
    x a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    g a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    y then 1 else 0 | a
    y <- [a]
    xs] | a
    x <- [a]
    xs ]