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

    module Math.Projects.ChevalleyGroup.Classical where

    import Prelude hiding ( (*>) )

    import Math.Algebra.Field.Base
    import Math.Algebra.Field.Extension hiding ( (<+>), (<*>) )
    import Math.Algebra.LinearAlgebra

    import Math.Algebra.Group.PermutationGroup
    import Math.Algebra.Group.SchreierSims as SS

    import Math.Combinatorics.FiniteGeometry

    numPtsAG n q = q^n

    numPtsPG n q = (q^(n+1)-1) `div` (q-1)

    -- LINEAR GROUPS

    -- |The special linear group SL(n,Fq), generated by elementary transvections, returned as matrices
    sl :: FiniteField k => Int -> [k] -> [[[k]]]
    sl n fq = [elemTransvection n (r,c) l | r <- [1..n], c <- [1..n], r /= c, l <- fq']
        where fq' = basisFq undefined -- tail fq
        -- Carter p68 - x_r(t1) x_r(t2) == x_r(t1+t2) - this is true in general, not just in this case

    elemTransvection n (r,c) l = fMatrix n (\i j -> if i == j then 1 else if (i,j) == (r,c) then l else 0)

    -- |The projective special linear group PSL(n,Fq) == A(n,Fq) == SL(n,Fq)/Z,
    -- returned as permutations of the points of PG(n-1,Fq).
    -- This is a finite simple group provided n>2 or q>3.
    l :: (FiniteField k, Ord k) => Int -> [k] -> [Permutation [k]]
    l n fq = [fromPairs $ [(p, pnf (p <*>> m)) | p <- ps] | m <- sl n fq]
        where ps = ptsPG (n-1) fq

    orderL n q = ( q^(n*(n-1) `div` 2) * product [ q^i-1 | i <- [n,n-1..2] ] )
                  `div` gcd (q-1) n

    -- SYMPLECTIC GROUPS
    -- Carter p186 and 181-3

    -- |The symplectic group Sp(2n,Fq), returned as matrices
    sp2 :: FiniteField k => Int -> [k] -> [[[k]]]
    sp2 n fq =
        [_I <<+>> t *>> (e i j <<->> e (-j) (-i)) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++
        [_I <<->> t *>> (e (-i) (-j) <<->> e j i) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++
        [_I <<+>> t *>> (e i (-j) <<+>> e j (-i)) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++
        [_I <<+>> t *>> (e (-i) j <<+>> e (-j) i) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++ -- Carter expresses this slightly differently
        [_I <<+>> t *>> e i (-i) | i <- [1..n], t <- fq' ] ++
        [_I <<+>> t *>> e (-i) i | i <- [1..n], t <- fq' ]
        where
            fq' = basisFq undefined -- tail fq -- multiplicative group
            _I = idMx (2*n)
            e i j = e' (if i > 0 then i else n-i) (if j > 0 then j else n-j)
            e' i j = fMatrix (2*n) (\k l -> if (k,l) == (i,j) then 1 else 0)

    -- |The projective symplectic group PSp(2n,Fq) == Cn(Fq) == Sp(2n,Fq)/Z,
    -- returned as permutations of the points of PG(2n-1,Fq).
    -- This is a finite simple group for n>1, except for PSp(4,F2).
    s2 :: (FiniteField k, Ord k) => Int -> [k] -> [Permutation [k]]
    s2 n fq = [fromPairs $ [(p, pnf (p <*>> m)) | p <- ps] | m <- sp2 n fq]
        where ps = ptsPG (2*n-1) fq

    s n fq | even n = s2 (n `div` 2) fq

    orderS2 n q = (q^n^2 * product [ q^i-1 | i <- [2*n,2*n-2..2] ]) `div` gcd (q-1) 2

    orderS n q | even n = orderS2 (n `div` 2) q

    -- ORTHOGONAL GROUPS

    -- Carter p185 and 178-9
    -- Omega2n(q) - commutator subgroup of O2n(q)
    omegaeven n fq =
        [_I <<+>> t *>> (e i j <<->> e (-j) (-i)) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++
        [_I <<->> t *>> (e (-i) (-j) <<->> e j i) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++
        [_I <<+>> t *>> (e i (-j) <<->> e j (-i)) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++
        [_I <<->> t *>> (e (-i) j <<->> e (-j) i) | i <- [1..n], j <- [i+1..n], t <- fq' ]
        where
            fq' = basisFq undefined -- tail fq -- multiplicative group
            _I = idMx (2*n)
            e i j = e' (if i > 0 then i else n-i) (if j > 0 then j else n-j)
            e' i j = fMatrix (2*n) (\k l -> if (k,l) == (i,j) then 1 else 0)

    -- O+2n(Fq)  Artin/Conway notation (Atlas, pxii)
    -- Dn(Fq)    Chevalley group
    d n fq = [fromPairs $ [(p, pnf (p <*>> m)) | p <- ps] | m <- omegaeven n fq]
        where ps = ptsPG (2*n-1) fq

    -- Carter p186-8
    -- Omega2n+1(q)
    omegaodd n fq
        | char fq /= 2 =
            [_I <<+>> t *>> (e i j <<->> e (-j) (-i)) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++
            [_I <<->> t *>> (e (-i) (-j) <<->> e j i) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++
            [_I <<+>> t *>> (e i (-j) <<->> e j (-i)) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++
            [_I <<->> t *>> (e (-i) j <<->> e (-j) i) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++
            [_I <<+>> t *>> (2 *>> e i 0 <<->> e 0 (-i)) <<->> (t^2) *>> e i (-i) | i <- [1..n], t <- fq' ] ++
            [_I <<->> t *>> (2 *>> e (-i) 0 <<->> e 0 i) <<->> (t^2) *>> e (-i) i | i <- [1..n], t <- fq' ]
        | char fq == 2 =
            [_I <<+>> t *>> (e i j <<->> e (-j) (-i)) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++
            [_I <<->> t *>> (e (-i) (-j) <<->> e j i) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++
            [_I <<+>> t *>> (e i (-j) <<->> e j (-i)) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++ -- !! Carter has a + in place of a - here
            [_I <<->> t *>> (e (-i) j <<->> e (-j) i) | i <- [1..n], j <- [i+1..n], t <- fq' ] ++
            [_I <<+>> (t^2) *>> e i (-i) | i <- [1..n], t <- fq' ] ++
            [_I <<+>> (t^2) *>> e (-i) i | i <- [1..n], t <- fq' ]
        where
            fq' = basisFq undefined -- tail fq -- multiplicative group
            _I = idMx (2*n+1)
            e i j = e' (if i >= 0 then i else n-i) (if j >= 0 then j else n-j)
            e' i j = fMatrix' (2*n+1) (\k l -> if (k,l) == (i,j) then 1 else 0)

    -- O2n+1(Fq)  Artin/Conway notation
    -- Bn(Fq)     Chevalley group
    b n fq = [fromPairs $ [(p, pnf (p <*>> m)) | p <- ps] | m <- omegaodd n fq]
        where ps = ptsPG (2*n) fq

    o n fq | even n = d (n `div` 2) fq
           | odd  n = b (n `div` 2) fq

    -- The orthogonal groups aren't transitive on PG(n-1,Fq),
    -- so the above permutation representation actually splits into smaller representations on the orbits
    -- eg map length $ orbits $ o 7 f3 -> [364,378,351]
    -- which is the first three permutation representations listed at http://brauer.maths.qmul.ac.uk/Atlas/v3/clas/O73/

    -- UNITARY GROUPS
    -- The unitary group U(n+1,q) is the twisted Chevalley group 2An(q)