{-# LANGUAGE NoMonomorphismRestriction #-}
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, (\\) )
import Math.Core.Utils hiding (elts)
import Math.Algebra.LinearAlgebra hiding (inverse)
infix 8 ~^
rotateL :: [a] -> [a]
rotateL (x :: a
x:xs :: [a]
xs) = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x]
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)
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
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')
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
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)
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
(.^) :: (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
(-^) :: (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]
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)
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
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
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]
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"
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
(~^) :: 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
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
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]
(.^^) :: (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
(-^^) :: (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]
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)
_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]]]
_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]]
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]]
_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 :: (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]]
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]
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]
_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]
_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]
_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]
in [Permutation (a, a)]
_B [Permutation (a, a)]
-> [Permutation (a, a)] -> [Permutation (a, a)]
forall a. [a] -> [a] -> [a]
++ [Permutation (a, a)]
_T
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
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..]
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
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
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
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]
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
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
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
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
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
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'
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
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)
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
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]
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' [] = []
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
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
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]
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
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
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 :: [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]
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
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 :: [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]
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] ]
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]
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]
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')
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
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]
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]
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
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
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 :: (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
(//) :: (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
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
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]
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 ]