Add Coxeter Groups and Root Systems

experimental/GModule/Cohomology.jl

@@ -3,6 +3,7 @@ module GrpCoh
 using Oscar
 import Oscar: action
 import Oscar: induce
+import Oscar: word
 import Oscar: GAPWrap, pc_group, fp_group, direct_product, direct_sum
 import AbstractAlgebra: Group, Module
 import Base: parent

experimental/JuLie/src/JuLie.jl

@@ -1,7 +1,7 @@
 module JuLie
 
 using ..Oscar
-import Oscar: IntegerUnion
+import Oscar: IntegerUnion, weight
 
 include("partitions.jl")
 include("schur_polynomials.jl")

experimental/LieAlgebras/src/AbstractLieAlgebra.jl

@@ -4,6 +4,9 @@
   struct_consts::Matrix{SRow{C}}
   s::Vector{Symbol}
 
+  # only set if known
+  root_system::RootSystem
+
   function AbstractLieAlgebra{C}(
     R::Field,
     struct_consts::Matrix{SRow{C}},
@@ -69,6 +72,52 @@
 
 dim(L::AbstractLieAlgebra) = L.dim
 
+###############################################################################
+#
+#   Root system getters
+#
+###############################################################################
+
+has_root_system(L::LieAlgebra) = isdefined(L, :root_system)
+
+function root_system(L::LieAlgebra)
+  @req has_root_system(L) "No root system known."
+  return L.root_system
+end
+
+has_root_system_type(L::AbstractLieAlgebra) =
+  has_root_system(L) && has_root_system_type(L.root_system)
+
+function root_system_type(L::AbstractLieAlgebra)
+  @req has_root_system_type(L) "No root system type known."
+  return root_system_type(root_system(L))
+end
+
+function root_system_type_string(L::AbstractLieAlgebra)
+  @req has_root_system_type(L) "No root system type known."
+  return root_system_type_string(root_system(L))
+end
+
+@doc raw"""
+    chevalley_basis(L::AbstractLieAlgebra{C}) -> NTuple{3,Vector{AbstractLieAlgebraElem{C}}}
+
+Return the Chevalley basis of the Lie algebra `L` in three vectors, stating first the positive root vectors, 
+then the negative root vectors, and finally the basis of the Cartan subalgebra. The order of root vectors corresponds
+to the order of the roots in the root system.
+"""
+function chevalley_basis(L::AbstractLieAlgebra)
+  @req has_root_system(L) "No root system known."
+
+  npos = num_positive_roots(root_system(L))
+  b = basis(L)
+  # root vectors
+  r_plus = b[1:npos]
+  r_minus = b[(npos + 1):(2 * npos)]
+  # basis for cartan algebra
+  h = b[(2 * npos + 1):dim(L)]
+  return (r_plus, r_minus, h)
+end
+
 ###############################################################################
 #
 #   String I/O
@@ -79,6 +128,8 @@
   io = pretty(io)
   println(io, "Abstract Lie algebra")
   println(io, Indent(), "of dimension $(dim(L))", Dedent())
+  has_root_system_type(L) &&
+    println(io, Indent(), "of type $(root_system_type_string(L))", Dedent())
   print(io, "over ")
   print(io, Lowercase(), coefficient_ring(L))
 end
@@ -267,23 +318,74 @@
     lie_algebra(R::Field, dynkin::Tuple{Char,Int}; cached::Bool) -> AbstractLieAlgebra{elem_type(R)}
 
 Construct the simple Lie algebra over the ring `R` with Dynkin type given by `dynkin`.
-The actual construction is done in GAP.
+The internally used basis of this Lie algebra is the Chevalley basis.
 
 If `cached` is `true`, the constructed Lie algebra is cached.
 """
-function lie_algebra(R::Field, dynkin::Tuple{Char,Int}; cached::Bool=true)
-  @req dynkin[1] in 'A':'G' "Unknown Dynkin type"
+function lie_algebra(R::Field, S::Symbol, n::Int; cached::Bool=true)
+  rs = root_system(S, n)
+  cm = cartan_matrix(rs)
+  @req is_cartan_matrix(cm; generalized=false) "The type does not correspond to a classical root system"
+
+  npos = num_positive_roots(rs)
+  nsimp = num_simple_roots(rs)
+  n = 2 * npos + nsimp
+
+  #=
+  struct_consts = Matrix{SRow{elem_type(R)}}(undef, n, n)
+  for i in 1:npos, j in 1:npos
+    # [x_i, x_j]
+    fl, k = is_positive_root_with_index(positive_root(rs, i) + positive_root(rs, j))
+    struct_consts[i, j] = fl ? sparse_row(R, [k], [1]) : sparse_row(R)
+    # [x_i, y_j] = δ_ij h_i
+    struct_consts[i, npos + j] = i == j ? sparse_row(R, [2 * npos + i], [1]) : sparse_row(R)
+    # [y_j, x_i] = -[x_i, y_j]
+    struct_consts[npos + j, i] = -struct_consts[i, npos + j]
+    # [y_i, y_j]
+    fl, k = is_negative_root_with_index(negative_root(rs, i) + negative_root(rs, j))
+    struct_consts[npos + i, npos + j] = fl ? sparse_row(R, [npos + k], [1]) : sparse_row(R)
+  end
+  for i in 1:nsimp, j in 1:npos
+    # [h_i, x_j] = <α_j, α_i> x_j
+    struct_consts[2 * npos + i, j] = sparse_row(R, [j], [cm[j, i]])
+    # [h_i, y_j] = - <α_j, α_i> y_j
+    struct_consts[2 * npos + i, npos + j] = sparse_row(R, [npos + j], [-cm[j, i]])
+    # [x_j, h_i] = -[h_i, x_j]
+    struct_consts[j, 2 * npos + i] = -struct_consts[2 * npos + i, j]
+    # [y_j, h_i] = -[h_i, y_j]
+    struct_consts[npos + j, 2 * npos + i] = -struct_consts[2 * npos + i, npos + j]
+  end
+  for i in 1:nsimp, j in 1:nsimp
+    # [h_i, h_j] = 0
+    struct_consts[2 * npos + i, 2 * npos + j] = sparse_row(R)
+  end
+
+  s = [
+    [Symbol("x_$i") for i in 1:npos]
+    [Symbol("y_$i") for i in 1:npos]
+    [Symbol("h_$i") for i in 1:nsimp]
+  ]
 
+  L = lie_algebra(R, struct_consts, s; cached, check=true) # TODO: remove check
+  =#
+
+  # start temporary workaround # TODO: reenable code above
+  type = only(root_system_type(rs))
   coeffs_iso = inv(Oscar.iso_oscar_gap(R))
-  LG = GAP.Globals.SimpleLieAlgebra(
-    GAP.Obj(string(dynkin[1])), dynkin[2], domain(coeffs_iso)
-  )
-  s = [Symbol("x_$i") for i in 1:GAPWrap.Dimension(LG)]
-  LO = codomain(
+  LG = GAP.Globals.SimpleLieAlgebra(GAP.Obj(string(type[1])), type[2], domain(coeffs_iso))
+  @req GAPWrap.Dimension(LG) == n "Dimension mismatch. Something went wrong."
+  s = [
+    [Symbol("x_$i") for i in 1:npos]
+    [Symbol("y_$i") for i in 1:npos]
+    [Symbol("h_$i") for i in 1:nsimp]
+  ]
+  L = codomain(
     _iso_gap_oscar_abstract_lie_algebra(LG, s; coeffs_iso, cached)
   )::AbstractLieAlgebra{elem_type(R)}
+  # end temporary workaround
 
-  return LO
+  set_attribute!(L, :is_simple, true)
+  return L
 end
 
 function abelian_lie_algebra(::Type{T}, R::Field, n::Int) where {T<:AbstractLieAlgebra}

experimental/LieAlgebras/src/CartanMatrix.jl

@@ -0,0 +1,144 @@
+###############################################################################
+#
+#   Cartan Matrix Helpers
+#   
+###############################################################################
+
+@doc raw"""
+    cartan_matrix(fam::Symbol, rk::Int) -> ZZMatrix
+"""
+function cartan_matrix(fam::Symbol, rk::Int)
+  if fam == :A
+    @req rk >= 1 "type An requires rank rk of at least 1"
+
+    mat = diagonal_matrix(ZZ(2), rk)
+    for i in 1:(rk - 1)
+      mat[i + 1, i], mat[i, i + 1] = -1, -1
+    end
+  elseif fam == :B
+    @req rk >= 2 "type Bn requires rank rk of at least  2"
+
+    mat = diagonal_matrix(ZZ(2), rk)
+    for i in 1:(rk - 1)
+      mat[i + 1, i], mat[i, i + 1] = -1, -1
+    end
+    mat[rk, rk - 1] = -2
+  elseif fam == :C
+    @req rk >= 2 "type Cn requires rank rk of at least 2"
+
+    mat = diagonal_matrix(ZZ(2), rk)
+    for i in 1:(rk - 1)
+      mat[i + 1, i], mat[i, i + 1] = -1, -1
+    end
+    mat[rk - 1, rk] = -2
+  elseif fam == :D
+    @req rk >= 3 "type Dn requires rank rk of at least 3"
+
+    mat = diagonal_matrix(ZZ(2), rk)
+    for i in 1:(rk - 1)
+      mat[i + 1, i], mat[i, i + 1] = -1, -1
+    end
+    mat[rk - 1, rk] = -2
+  elseif fam == :E
+    @req rk in 6:8 "type En requires rank to be one of 6, 7, 8"
+    mat = matrix(
+      ZZ,
+      [
+        2 0 -1 0 0 0 0 0
+        0 2 0 -1 0 0 0 0
+        -1 0 2 -1 0 0 0 0
+        0 -1 -1 2 -1 0 0 0
+        0 0 0 -1 2 -1 0 0
+        0 0 0 0 -1 2 -1 0
+        0 0 0 0 0 -1 2 -1
+        0 0 0 0 0 0 -1 2
+      ],
+    )
+
+    if rk == 6
+      mat = mat[1:6, 1:6]
+    elseif rk == 7
+      mat = mat[1:7, 1:7]
+    end
+  elseif fam == :F
+    @req rk == 4 "type Fn requires rank rk to be 4"
+    mat = matrix(ZZ, [2 -1 0 0; -1 2 -1 0; 0 -2 2 -1; 0 0 -1 2])
+  elseif fam == :G
+    @req rk == 2 "type Gn requires rank rk to be 2"
+    mat = matrix(ZZ, [2 -3; -1 2])
+  else
+    error("unknown family $fam")
+  end
+
+  return mat
+end
+
+function cartan_matrix(types::Tuple{Symbol,Int}...)
+  blocks = ZZMatrix[cartan_matrix(type...) for type in types]
+
+  return block_diagonal_matrix(blocks)
+end
+
+function cartan_to_coxeter_matrix(mat; check=true)
+  @req !check || !is_cartan_matrix(mat) "$mat is not a (generalized) Cartan matrix"
+
+  cm = identity_matrix(mat)
+  rk, _ = size(mat)
+  for i in 1:rk, j in 1:rk
+    if i == j
+      continue
+    end
+
+    if mat[i, j] == 0
+      cm[i, j] = 2
+    elseif mat[i, j] == -1
+      cm[i, j] = 3
+    elseif mat[i, j] == -2
+      cm[i, j] = 4
+    elseif mat[i, j] == -3
+      cm[i, j] = 6
+    end
+  end
+
+  return cm
+end
+
+@doc raw"""
+    is_cartan_matrix(mat::ZZMatrix) -> Bool
+
+Test if `mat` is a (`generalized`) Cartan matrix.
+"""
+function is_cartan_matrix(mat::ZZMatrix; generalized::Bool=true)
+  n, m = size(mat)
+  if n != m
+    return false
+  end
+
+  if !all(mat[i, i] == 2 for i in 1:n)
+    return false
+  end
+
+  for i in 1:n
+    for j in (i + 1):n
+      if is_zero_entry(mat, i, j) && is_zero_entry(mat, j, i)
+        continue
+      end
+
+      # mat[i,j] != 0 or mat[j,i] != 0, so both entries must be < 0
+      if mat[i, j] >= 0 || mat[j, i] >= 0
+        return false
+      end
+
+      # if we only want a generalized Cartan matrix, we are done with this pair of entries
+      if generalized
+        continue
+      end
+
+      if !(mat[i, j] * mat[j, i] in 1:3)
+        return false
+      end
+    end
+  end
+
+  return true
+end

experimental/LieAlgebras/src/CoxeterGroup.jl

@@ -0,0 +1,3 @@
+abstract type CoxeterGroup end # <: Group
+
+#function is_coxeter_matrix(M::ZZMatrix) end