-- 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)