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

    module Math.Projects.RootSystem where

    import Prelude hiding ( (*>) )

    import Data.Ratio
    import qualified Data.List as L
    import qualified Data.Set as S

    import Math.Algebra.LinearAlgebra
    import Math.Algebra.Group.PermutationGroup hiding (elts, order, closure)
    import Math.Algebra.Group.SchreierSims as SS
    import Math.Algebra.Group.StringRewriting as SG

    import Math.Algebra.Field.Base -- for Q

    data Type = A | B | C | D | E | F | G

    -- Humphreys, Reflection Groups and Coxeter Groups

    -- SIMPLE SYSTEMS

    -- sometimes called fundamental systems

    -- The ith basis vector in K^n

    basisElt :: Int -> Int -> [Q] -- this type signature determines all the rest

    basisElt :: Int -> Int -> [Q]
    basisElt n :: Int
    n i :: Int
    i = Int -> Q -> [Q]
    forall a. Int -> a -> [a]
    replicate (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1) 0 [Q] -> [Q] -> [Q]
    forall a. [a] -> [a] -> [a]
    ++ 1 Q -> [Q] -> [Q]
    forall a. a -> [a] -> [a]
    : Int -> Q -> [Q]
    forall a. Int -> a -> [a]
    replicate (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    i) 0
    -- We need to work over the rationals to ensure that arithmetic is exact

    -- So long as our simple systems are rational, then reflection matrices are rational

    -- A simple system is like a basis for the root system (see Humphreys p8 for full definition)

    -- simpleSystem :: Type -> Int -> [[Q]]

    simpleSystem :: Type -> Int -> [[Q]]
    simpleSystem A n :: Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 1 = [Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1) | Int
    i <- [1..Int
    n]]
        where e :: Int -> [Q]
    e = Int -> Int -> [Q]
    basisElt (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1)
    simpleSystem B n :: Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 2 = [Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1) | Int
    i <- [1..Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1]] [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [Int -> [Q]
    e Int
    n]
        where e :: Int -> [Q]
    e = Int -> Int -> [Q]
    basisElt Int
    n
    simpleSystem C n :: Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 2 = [Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1) | Int
    i <- [1..Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1]] [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [2 Q -> [Q] -> [Q]
    forall a. Num a => a -> [a] -> [a]
    *> Int -> [Q]
    e Int
    n]
        where e :: Int -> [Q]
    e = Int -> Int -> [Q]
    basisElt Int
    n
    simpleSystem D n :: Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 4 = [Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1) | Int
    i <- [1..Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1]] [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [Int -> [Q]
    e (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1) [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <+> Int -> [Q]
    e Int
    n]
        where e :: Int -> [Q]
    e = Int -> Int -> [Q]
    basisElt Int
    n
    simpleSystem E n :: Int
    n | Int
    n Int -> [Int] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [6,7,8] = Int -> [[Q]] -> [[Q]]
    forall a. Int -> [a] -> [a]
    take Int
    n [[Q]]
    simpleroots
        where e :: Int -> [Q]
    e = Int -> Int -> [Q]
    basisElt 8
              simpleroots :: [[Q]]
    simpleroots = ((1Q -> Q -> Q
    forall a. Fractional a => a -> a -> a
    /2) Q -> [Q] -> [Q]
    forall a. Num a => a -> [a] -> [a]
    *> (Int -> [Q]
    e 1 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e 2 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e 3 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e 4 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e 5 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e 6 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e 7 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <+> Int -> [Q]
    e 8))
                          [Q] -> [[Q]] -> [[Q]]
    forall a. a -> [a] -> [a]
    : (Int -> [Q]
    e 1 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <+> Int -> [Q]
    e 2)
                          [Q] -> [[Q]] -> [[Q]]
    forall a. a -> [a] -> [a]
    : [Int -> [Q]
    e (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1) [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -2) | Int
    i <- [3..8]]
    simpleSystem F 4 = [Int -> [Q]
    e 2 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e 3, Int -> [Q]
    e 3 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e 4, Int -> [Q]
    e 4, (1Q -> Q -> Q
    forall a. Fractional a => a -> a -> a
    /2) Q -> [Q] -> [Q]
    forall a. Num a => a -> [a] -> [a]
    *> (Int -> [Q]
    e 1 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e 2 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e 3 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e 4)]
        where e :: Int -> [Q]
    e = Int -> Int -> [Q]
    basisElt 4
    simpleSystem G 2 = [Int -> [Q]
    e 1 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e 2, ((-2) Q -> [Q] -> [Q]
    forall a. Num a => a -> [a] -> [a]
    *> Int -> [Q]
    e 1) [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <+> Int -> [Q]
    e 2 [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <+> Int -> [Q]
    e 3]
        where e :: Int -> [Q]
    e = Int -> Int -> [Q]
    basisElt 3

    -- ROOT SYSTEMS

    -- Calculating the full root system from the fundamental roots

    -- Humphreys p3

    -- Weyl group element corresponding to a root

    -- w r is the reflection in the hyperplane orthogonal to r

    w :: [a] -> [a] -> [a]
    w r :: [a]
    r s :: [a]
    s = [a]
    s [a] -> [a] -> [a]
    forall a. Num a => [a] -> [a] -> [a]
    <-> (2 a -> a -> a
    forall a. Num a => a -> a -> a
    * ([a]
    s [a] -> [a] -> a
    forall a. Num a => [a] -> [a] -> a
    <.> [a]
    r) a -> a -> a
    forall a. Fractional a => a -> a -> a
    / ([a]
    r [a] -> [a] -> a
    forall a. Num a => [a] -> [a] -> a
    <.> [a]
    r)) a -> [a] -> [a]
    forall a. Num a => a -> [a] -> [a]
    *> [a]
    r

    -- Given a simple system, return the full root system

    -- The closure of a set of roots under reflection

    closure :: [[a]] -> [[a]]
    closure rs :: [[a]]
    rs = 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]
    closure' Set [a]
    forall a. Set a
    S.empty ([[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList [[a]]
    rs) where
        closure' :: Set [a] -> Set [a] -> Set [a]
    closure' interior :: Set [a]
    interior boundary :: Set [a]
    boundary
            | Set [a] -> Bool
    forall a. Set a -> Bool
    S.null Set [a]
    boundary = Set [a]
    interior
            | Bool
    otherwise =
                let interior' :: Set [a]
    interior' = Set [a] -> Set [a] -> Set [a]
    forall a. Ord a => Set a -> Set a -> Set a
    S.union Set [a]
    interior Set [a]
    boundary
                    boundary' :: Set [a]
    boundary' = [[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList [[a] -> [a] -> [a]
    forall a. Fractional a => [a] -> [a] -> [a]
    w [a]
    r [a]
    s | [a]
    r <- [[a]]
    rs, [a]
    s <- Set [a] -> [[a]]
    forall a. Set a -> [a]
    S.toList Set [a]
    boundary] Set [a] -> Set [a] -> Set [a]
    forall a. Ord a => Set a -> Set a -> Set a
    S.\\ Set [a]
    interior'
                in Set [a] -> Set [a] -> Set [a]
    closure' Set [a]
    interior' Set [a]
    boundary'

    -- WEYL GROUP

    -- The finite reflection group generated by the root system

    -- Generators of the Weyl group as permutation group on the roots

    weylPerms :: Type -> Int -> [Permutation [Q]]
    weylPerms t :: Type
    t n :: Int
    n =
        let rs :: [[Q]]
    rs = Type -> Int -> [[Q]]
    simpleSystem Type
    t Int
    n
            xs :: [[Q]]
    xs = [[Q]] -> [[Q]]
    forall a. (Ord a, Fractional a) => [[a]] -> [[a]]
    closure [[Q]]
    rs
            toPerm :: [Q] -> Permutation [Q]
    toPerm r :: [Q]
    r = [([Q], [Q])] -> Permutation [Q]
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [([Q]
    x, [Q] -> [Q] -> [Q]
    forall a. Fractional a => [a] -> [a] -> [a]
    w [Q]
    r [Q]
    x) | [Q]
    x <- [[Q]]
    xs]
        in ([Q] -> Permutation [Q]) -> [[Q]] -> [Permutation [Q]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Q] -> Permutation [Q]
    toPerm [[Q]]
    rs

    -- Generators of the Weyl group as a matrix group

    weylMatrices :: Type -> Int -> [[[Q]]]
    weylMatrices t :: Type
    t n :: Int
    n = ([Q] -> [[Q]]) -> [[Q]] -> [[[Q]]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Q] -> [[Q]]
    wMx (Type -> Int -> [[Q]]
    simpleSystem Type
    t Int
    n)

    -- The Weyl group element corresponding to a root, represented as a matrix

    wMx :: [Q] -> [[Q]]
    wMx r :: [Q]
    r = ([Q] -> [Q]) -> [[Q]] -> [[Q]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Q] -> [Q] -> [Q]
    forall a. Fractional a => [a] -> [a] -> [a]
    w [Q]
    r) [Int -> [Q]
    e Int
    i | Int
    i <- [1..Int
    d]] -- matrix for reflection in hyperplane orthogonal to r

        where d :: Int
    d = [Q] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Q]
    r -- dimension of the space

              e :: Int -> [Q]
    e = Int -> Int -> [Q]
    basisElt Int
    d
    -- the images of the basis elts form the columns of the matrix

    -- however, reflection matrices are symmetric, so they also form the rows

    -- CARTAN MATRIX, DYNKIN DIAGRAM, COXETER SYSTEM

    cartanMatrix :: Type -> Int -> [[Q]]
    cartanMatrix t :: Type
    t n :: Int
    n = [[2 Q -> Q -> Q
    forall a. Num a => a -> a -> a
    * ([Q]
    ai [Q] -> [Q] -> Q
    forall a. Num a => [a] -> [a] -> a
    <.> [Q]
    aj) Q -> Q -> Q
    forall a. Fractional a => a -> a -> a
    / ([Q]
    ai [Q] -> [Q] -> Q
    forall a. Num a => [a] -> [a] -> a
    <.> [Q]
    ai) | [Q]
    aj <- [[Q]]
    roots] | [Q]
    ai <- [[Q]]
    roots]
        where roots :: [[Q]]
    roots = Type -> Int -> [[Q]]
    simpleSystem Type
    t Int
    n
    -- Note: The Cartan matrices for A, D, E systems are symmetric.

    -- Those of B, C, F, G are not

    -- Carter, Simple Groups of Lie Type, p44-5 gives the expected answers

    -- They agree with our answers except for G2, which is the transpose

    -- (So probably Carter defines the roots of G2 the other way round to Humphreys)

    -- set the diagonal entries of (square) matrix mx to constant c

    setDiag :: a -> [[a]] -> [[a]]
    setDiag c :: a
    c mx :: [[a]]
    mx@((x :: a
    x:xs :: [a]
    xs):rs :: [[a]]
    rs) = (a
    ca -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    xs) [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : (a -> [a] -> [a]) -> [a] -> [[a]] -> [[a]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (:) (([a] -> a) -> [[a]] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> a
    forall a. [a] -> a
    head [[a]]
    rs) (a -> [[a]] -> [[a]]
    setDiag a
    c ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ ([a] -> [a]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> [a]
    forall a. [a] -> [a]
    tail [[a]]
    rs)
    setDiag _ [[]] = [[]]

    -- Carter, Segal, Macdonald p17-18

    -- given a Cartan matrix, derive the corresponding matrix describing the Dynkin diagram

    -- nij = Aij * Aji, nii = 0

    dynkinFromCartan :: [[a]] -> [[a]]
    dynkinFromCartan aij :: [[a]]
    aij = a -> [[a]] -> [[a]]
    forall a. a -> [[a]] -> [[a]]
    setDiag 0 ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ (([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]])
    -> ((a -> a -> a) -> [a] -> [a] -> [a])
    -> (a -> a -> a)
    -> [[a]]
    -> [[a]]
    -> [[a]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> a -> a) -> [a] -> [a] -> [a]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith) a -> a -> a
    forall a. Num a => a -> a -> a
    (*) [[a]]
    aij ([[a]] -> [[a]]
    forall a. [[a]] -> [[a]]
    L.transpose [[a]]
    aij)

    dynkinDiagram :: Type -> Int -> [[Q]]
    dynkinDiagram t :: Type
    t n :: Int
    n = [[Q]] -> [[Q]]
    forall a. Num a => [[a]] -> [[a]]
    dynkinFromCartan ([[Q]] -> [[Q]]) -> [[Q]] -> [[Q]]
    forall a b. (a -> b) -> a -> b
    $ Type -> Int -> [[Q]]
    cartanMatrix Type
    t Int
    n

    -- given the Dynkin diagram nij, derive the coefficients mij of the Coxeter group <si | si^2, (sisj)^mij> (so mii == 1)

    -- using nij = 4 cos^2 theta_ij

    -- nij == 0 <=> theta = pi/2

    -- nij == 1 <=> theta = pi/3

    -- nij == 2 <=> theta = pi/4

    -- nij == 3 <=> theta = pi/6

    coxeterFromDynkin :: [[a]] -> [[a]]
    coxeterFromDynkin nij :: [[a]]
    nij = a -> [[a]] -> [[a]]
    forall a. a -> [[a]] -> [[a]]
    setDiag 1 ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ (([a] -> [a]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map (([a] -> [a]) -> [[a]] -> [[a]])
    -> ((a -> a) -> [a] -> [a]) -> (a -> a) -> [[a]] -> [[a]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> a) -> [a] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map) a -> a
    forall a p. (Eq a, Num a, Num p) => a -> p
    f [[a]]
    nij
        where f :: a -> p
    f 0 = 2; f 1 = 3; f 2 = 4; f 3 = 6

    -- The mij coefficients of the Coxeter group <si | si^2, (sisj)^mij>, as a matrix

    coxeterMatrix :: Type -> Int -> [[a]]
    coxeterMatrix t :: Type
    t n :: Int
    n = [[Q]] -> [[a]]
    forall a a. (Eq a, Num a, Num a) => [[a]] -> [[a]]
    coxeterFromDynkin ([[Q]] -> [[a]]) -> [[Q]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ Type -> Int -> [[Q]]
    dynkinDiagram Type
    t Int
    n

    -- Given the matrix of coefficients mij, return the Coxeter group <si | si^2, (sisj)^mij>

    -- We assume but don't check that mii == 1 and mij == mji

    fromCoxeterMatrix :: [[Int]] -> ([SGen], [([SGen], [a])])
    fromCoxeterMatrix mx :: [[Int]]
    mx = ([SGen]
    gs,[([SGen], [a])]
    forall a. [([SGen], [a])]
    rs) where
        n :: Int
    n = [[Int]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Int]]
    mx
        gs :: [SGen]
    gs = (Int -> SGen) -> [Int] -> [SGen]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> SGen
    s_ [1..Int
    n]
        rs :: [([SGen], [a])]
    rs = [[Int]] -> Int -> [([SGen], [a])]
    forall a. [[Int]] -> Int -> [([SGen], [a])]
    rules [[Int]]
    mx 1
        rules :: [[Int]] -> Int -> [([SGen], [a])]
    rules [] _ = []
        rules ((1:xs :: [Int]
    xs):rs :: [[Int]]
    rs) i :: Int
    i = ([Int -> SGen
    s_ Int
    i, Int -> SGen
    s_ Int
    i],[]) ([SGen], [a]) -> [([SGen], [a])] -> [([SGen], [a])]
    forall a. a -> [a] -> [a]
    : [Int -> Int -> Int -> ([SGen], [a])
    forall a. Int -> Int -> Int -> ([SGen], [a])
    powerRelation Int
    i Int
    j Int
    m | (j :: Int
    j,m :: Int
    m) <- [Int] -> [Int] -> [(Int, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..] [Int]
    xs] [([SGen], [a])] -> [([SGen], [a])] -> [([SGen], [a])]
    forall a. [a] -> [a] -> [a]
    ++ [[Int]] -> Int -> [([SGen], [a])]
    rules (([Int] -> [Int]) -> [[Int]] -> [[Int]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Int] -> [Int]
    forall a. [a] -> [a]
    tail [[Int]]
    rs) (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1)
        powerRelation :: Int -> Int -> Int -> ([SGen], [a])
    powerRelation i :: Int
    i j :: Int
    j m :: Int
    m = ([[SGen]] -> [SGen]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[SGen]] -> [SGen]) -> [[SGen]] -> [SGen]
    forall a b. (a -> b) -> a -> b
    $ Int -> [SGen] -> [[SGen]]
    forall a. Int -> a -> [a]
    replicate Int
    m [Int -> SGen
    s_ Int
    i, Int -> SGen
    s_ Int
    j],[])

    -- Another presentation for the Coxeter group, using braid relations

    fromCoxeterMatrix2 :: [[Int]] -> ([SGen], [([SGen], [SGen])])
    fromCoxeterMatrix2 mx :: [[Int]]
    mx = ([SGen]
    gs,[([SGen], [SGen])]
    rs) where
        n :: Int
    n = [[Int]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Int]]
    mx
        gs :: [SGen]
    gs = (Int -> SGen) -> [Int] -> [SGen]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> SGen
    s_ [1..Int
    n]
        rs :: [([SGen], [SGen])]
    rs = [[Int]] -> Int -> [([SGen], [SGen])]
    rules [[Int]]
    mx 1
        rules :: [[Int]] -> Int -> [([SGen], [SGen])]
    rules [] _ = []
        rules ((1:xs :: [Int]
    xs):rs :: [[Int]]
    rs) i :: Int
    i = ([Int -> SGen
    s_ Int
    i, Int -> SGen
    s_ Int
    i],[]) ([SGen], [SGen]) -> [([SGen], [SGen])] -> [([SGen], [SGen])]
    forall a. a -> [a] -> [a]
    : [Int -> Int -> Int -> ([SGen], [SGen])
    braidRelation Int
    i Int
    j Int
    m | (j :: Int
    j,m :: Int
    m) <- [Int] -> [Int] -> [(Int, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..] [Int]
    xs] [([SGen], [SGen])] -> [([SGen], [SGen])] -> [([SGen], [SGen])]
    forall a. [a] -> [a] -> [a]
    ++ [[Int]] -> Int -> [([SGen], [SGen])]
    rules (([Int] -> [Int]) -> [[Int]] -> [[Int]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Int] -> [Int]
    forall a. [a] -> [a]
    tail [[Int]]
    rs) (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1)
        braidRelation :: Int -> Int -> Int -> ([SGen], [SGen])
    braidRelation i :: Int
    i j :: Int
    j m :: Int
    m = (Int -> [SGen] -> [SGen]
    forall a. Int -> [a] -> [a]
    take Int
    m ([SGen] -> [SGen]) -> [SGen] -> [SGen]
    forall a b. (a -> b) -> a -> b
    $ [SGen] -> [SGen]
    forall a. [a] -> [a]
    cycle [Int -> SGen
    s_ Int
    j, Int -> SGen
    s_ Int
    i], Int -> [SGen] -> [SGen]
    forall a. Int -> [a] -> [a]
    take Int
    m ([SGen] -> [SGen]) -> [SGen] -> [SGen]
    forall a b. (a -> b) -> a -> b
    $ [SGen] -> [SGen]
    forall a. [a] -> [a]
    cycle [Int -> SGen
    s_ Int
    i, Int -> SGen
    s_ Int
    j])

    coxeterPresentation :: Type -> Int -> ([SGen], [([SGen], [a])])
    coxeterPresentation t :: Type
    t n :: Int
    n = [[Int]] -> ([SGen], [([SGen], [a])])
    forall a. [[Int]] -> ([SGen], [([SGen], [a])])
    fromCoxeterMatrix ([[Int]] -> ([SGen], [([SGen], [a])]))
    -> [[Int]] -> ([SGen], [([SGen], [a])])
    forall a b. (a -> b) -> a -> b
    $ Type -> Int -> [[Int]]
    forall a. Num a => Type -> Int -> [[a]]
    coxeterMatrix Type
    t Int
    n

    eltsCoxeter :: Type -> Int -> [[SGen]]
    eltsCoxeter t :: Type
    t n :: Int
    n = ([SGen], [([SGen], [SGen])]) -> [[SGen]]
    forall a. Ord a => ([a], [([a], [a])]) -> [[a]]
    SG.elts (([SGen], [([SGen], [SGen])]) -> [[SGen]])
    -> ([SGen], [([SGen], [SGen])]) -> [[SGen]]
    forall a b. (a -> b) -> a -> b
    $ [[Int]] -> ([SGen], [([SGen], [SGen])])
    fromCoxeterMatrix2 ([[Int]] -> ([SGen], [([SGen], [SGen])]))
    -> [[Int]] -> ([SGen], [([SGen], [SGen])])
    forall a b. (a -> b) -> a -> b
    $ Type -> Int -> [[Int]]
    forall a. Num a => Type -> Int -> [[a]]
    coxeterMatrix Type
    t Int
    n
    -- it's just slightly faster to use the braid presentation

    poincarePoly :: Type -> Int -> [Int]
    poincarePoly t :: Type
    t n :: Int
    n = ([Int] -> Int) -> [[Int]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [Int] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([[Int]] -> [Int]) -> [[Int]] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [[Int]]
    forall a. Eq a => [a] -> [[a]]
    L.group ([Int] -> [[Int]]) -> [Int] -> [[Int]]
    forall a b. (a -> b) -> a -> b
    $ ([SGen] -> Int) -> [[SGen]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [SGen] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([[SGen]] -> [Int]) -> [[SGen]] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ Type -> Int -> [[SGen]]
    eltsCoxeter Type
    t Int
    n

    -- LIE ALGEBRAS

    elemMx :: Int -> Int -> Int -> [[Q]]
    elemMx n :: Int
    n i :: Int
    i j :: Int
    j = Int -> [Q] -> [[Q]]
    forall a. Int -> a -> [a]
    replicate (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1) [Q]
    z [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Q]
    e Int
    j [Q] -> [[Q]] -> [[Q]]
    forall a. a -> [a] -> [a]
    : Int -> [Q] -> [[Q]]
    forall a. Int -> a -> [a]
    replicate (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    i) [Q]
    z
        where z :: [Q]
    z = Int -> Q -> [Q]
    forall a. Int -> a -> [a]
    replicate Int
    n 0
              e :: Int -> [Q]
    e = Int -> Int -> [Q]
    basisElt Int
    n

    lieMult :: a -> a -> a
    lieMult x :: a
    x y :: a
    y = a
    xa -> a -> a
    forall a. Num a => a -> a -> a
    *a
    y a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    ya -> a -> a
    forall a. Num a => a -> a -> a
    *a
    x

    -- for gluing matrices together

    +|+ :: [[a]] -> [[a]] -> [[a]]
    (+|+) = ([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++) -- glue two matrices together side by side

    +-+ :: [a] -> [a] -> [a]
    (+-+) = [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++)         -- glue two matrices together above and below

    form :: Type -> Int -> [[a]]
    form D n :: Int
    n = (Int -> [[a]]
    forall t. Num t => Int -> [[t]]
    zMx Int
    n [[a]] -> [[a]] -> [[a]]
    forall a. [[a]] -> [[a]] -> [[a]]
    +|+ Int -> [[a]]
    forall t. Num t => Int -> [[t]]
    idMx Int
    n)
                      [[a]] -> [[a]] -> [[a]]
    forall a. [a] -> [a] -> [a]
    +-+
              (Int -> [[a]]
    forall t. Num t => Int -> [[t]]
    idMx Int
    n [[a]] -> [[a]] -> [[a]]
    forall a. [[a]] -> [[a]] -> [[a]]
    +|+ Int -> [[a]]
    forall t. Num t => Int -> [[t]]
    zMx Int
    n)
    form C n :: Int
    n = (2 a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : Int -> a -> [a]
    forall a. Int -> a -> [a]
    replicate (2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    n) 0) [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :
               (([a] -> [a]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map (0a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) (Type -> Int -> [[a]]
    form Type
    D Int
    n))
    form B n :: Int
    n = let id' :: [[a]]
    id' = (-1) a -> [[a]] -> [[a]]
    forall a. Num a => a -> [[a]] -> [[a]]
    *>> Int -> [[a]]
    forall t. Num t => Int -> [[t]]
    idMx Int
    n
               in (Int -> [[a]]
    forall t. Num t => Int -> [[t]]
    zMx Int
    n [[a]] -> [[a]] -> [[a]]
    forall a. [[a]] -> [[a]] -> [[a]]
    +|+ Int -> [[a]]
    forall t. Num t => Int -> [[t]]
    idMx Int
    n)
                         [[a]] -> [[a]] -> [[a]]
    forall a. [a] -> [a] -> [a]
    +-+
                   ([[a]]
    id'  [[a]] -> [[a]] -> [[a]]
    forall a. [[a]] -> [[a]] -> [[a]]
    +|+ Int -> [[a]]
    forall t. Num t => Int -> [[t]]
    zMx Int
    n)

    -- TESTING

    -- The expected values of the root system, number of roots, order of Weyl group

    -- for comparison against the calculated values

    -- !! Not yet got root systems for E6,7,8, F4

    -- Humphreys p41ff

    -- The full root system

    -- L.sort (rootSystem t n) == closure (simpleSystem t n)

    -- rootSystem :: Type -> Int -> [[QQ]]

    rootSystem :: Type -> Int -> [[Q]]
    rootSystem A n :: Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 1 = [Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    j | Int
    i <- [1..Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1], Int
    j <- [1..Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1], Int
    i Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    j]
        where e :: Int -> [Q]
    e = Int -> Int -> [Q]
    basisElt (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1)
    rootSystem B n :: Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 2 = [[Q]]
    shortRoots [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [[Q]]
    longRoots
        where e :: Int -> [Q]
    e = Int -> Int -> [Q]
    basisElt Int
    n
              shortRoots :: [[Q]]
    shortRoots = [Int -> [Q]
    e Int
    i | Int
    i <- [1..Int
    n]]
                        [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [[] [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    i | Int
    i <- [1..Int
    n]]
              longRoots :: [[Q]]
    longRoots  = [Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <+> Int -> [Q]
    e Int
    j | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n]]
                        [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    j | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n]]
                        [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [[] [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <+> Int -> [Q]
    e Int
    j | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n]]
                        [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [[] [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    j | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n]]
    rootSystem C n :: Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 2 = [[Q]]
    longRoots [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [[Q]]
    shortRoots
        where e :: Int -> [Q]
    e = Int -> Int -> [Q]
    basisElt Int
    n
              longRoots :: [[Q]]
    longRoots  = [2 Q -> [Q] -> [Q]
    forall a. Num a => a -> [a] -> [a]
    *> Int -> [Q]
    e Int
    i | Int
    i <- [1..Int
    n]]
                        [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [[] [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> (2 Q -> [Q] -> [Q]
    forall a. Num a => a -> [a] -> [a]
    *> Int -> [Q]
    e Int
    i) | Int
    i <- [1..Int
    n]]
              shortRoots :: [[Q]]
    shortRoots = [Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <+> Int -> [Q]
    e Int
    j | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n]]
                        [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    j | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n]]
                        [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [[] [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <+> Int -> [Q]
    e Int
    j | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n]]
                        [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [[] [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    j | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n]]
    rootSystem D n :: Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 4 =
        [Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <+> Int -> [Q]
    e Int
    j | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n]]
        [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    j | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n]]
        [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [[] [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <+> Int -> [Q]
    e Int
    j | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n]]
        [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [[] [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    j | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n]]
        where e :: Int -> [Q]
    e = Int -> Int -> [Q]
    basisElt Int
    n
    rootSystem G 2 = [[Q]]
    shortRoots [[Q]] -> [[Q]] -> [[Q]]
    forall a. [a] -> [a] -> [a]
    ++ [[Q]]
    longRoots
        where e :: Int -> [Q]
    e = Int -> Int -> [Q]
    basisElt 3
              shortRoots :: [[Q]]
    shortRoots = [Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    j | Int
    i <- [1..3], Int
    j <- [1..3], Int
    i Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    j]
              longRoots :: [[Q]]
    longRoots = ([Q] -> [[Q]]) -> [[Q]] -> [[Q]]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\r :: [Q]
    r-> [[Q]
    r,[] [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> [Q]
    r]) [2 Q -> [Q] -> [Q]
    forall a. Num a => a -> [a] -> [a]
    *> Int -> [Q]
    e Int
    i [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    j [Q] -> [Q] -> [Q]
    forall a. Num a => [a] -> [a] -> [a]
    <-> Int -> [Q]
    e Int
    k | Int
    i <- [1..3], [j :: Int
    j,k :: Int
    k] <- [[1..3] [Int] -> [Int] -> [Int]
    forall a. Eq a => [a] -> [a] -> [a]
    L.\\ [Int
    i]] ]

    -- numRoots t n == length (closure $ simpleSystem t n)

    numRoots :: Type -> a -> a
    numRoots A n :: a
    n = a
    na -> a -> a
    forall a. Num a => a -> a -> a
    *(a
    na -> a -> a
    forall a. Num a => a -> a -> a
    +1)
    numRoots B n :: a
    n = 2a -> a -> a
    forall a. Num a => a -> a -> a
    *a
    na -> a -> a
    forall a. Num a => a -> a -> a
    *a
    n
    numRoots C n :: a
    n = 2a -> a -> a
    forall a. Num a => a -> a -> a
    *a
    na -> a -> a
    forall a. Num a => a -> a -> a
    *a
    n
    numRoots D n :: a
    n = 2a -> a -> a
    forall a. Num a => a -> a -> a
    *a
    na -> a -> a
    forall a. Num a => a -> a -> a
    *(a
    na -> a -> a
    forall a. Num a => a -> a -> a
    -1)
    numRoots E 6 = 72
    numRoots E 7 = 126
    numRoots E 8 = 240
    numRoots F 4 = 48
    numRoots G 2 = 12

    -- The order of the Weyl group

    -- orderWeyl t n == S.order (weylPerms t n)

    orderWeyl :: Type -> a -> Integer
    orderWeyl A n :: a
    n = a -> Integer
    forall a. Integral a => a -> Integer
    factorial (a
    na -> a -> a
    forall a. Num a => a -> a -> a
    +1)
    orderWeyl B n :: a
    n = 2Integer -> a -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^a
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * a -> Integer
    forall a. Integral a => a -> Integer
    factorial a
    n
    orderWeyl C n :: a
    n = 2Integer -> a -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^a
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * a -> Integer
    forall a. Integral a => a -> Integer
    factorial a
    n
    orderWeyl D n :: a
    n = 2Integer -> a -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(a
    na -> a -> a
    forall a. Num a => a -> a -> a
    -1) Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * a -> Integer
    forall a. Integral a => a -> Integer
    factorial a
    n
    orderWeyl E 6 = 2Integer -> Integer -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^7 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * 3Integer -> Integer -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^4 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * 5
    orderWeyl E 7 = 2Integer -> Integer -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^10 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * 3Integer -> Integer -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^4 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * 5 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * 7
    orderWeyl E 8 = 2Integer -> Integer -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^14 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * 3Integer -> Integer -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^5 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * 5Integer -> Integer -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * 7
    orderWeyl F 4 = 2Integer -> Integer -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^7 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * 3Integer -> Integer -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2
    orderWeyl G 2 = 12

    factorial :: a -> Integer
    factorial n :: a
    n = [Integer] -> Integer
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    product [1..a -> Integer
    forall a. Integral a => a -> Integer
    toInteger a
    n]

    {-
    -- now moved to TRootSystem
    test1 = all (\(t,n) -> orderWeyl t n == L.genericLength (eltsCoxeter t n))
        [(A,3),(A,4),(A,5),(B,3),(B,4),(B,5),(C,3),(C,4),(C,5),(D,4),(D,5),(F,4),(G,2)]

    test2 = all (\(t,n) -> orderWeyl t n == SS.order (weylPerms t n))
        [(A,3),(A,4),(A,5),(B,3),(B,4),(B,5),(C,3),(C,4),(C,5),(D,4),(D,5),(E,6),(F,4),(G,2)]
    -}