clean up files oscar-system#1

experimental/LieAlgebras/src/AbstractRootSystem.jl

@@ -1,93 +1,185 @@
 ###############################################################################
 #
-#   Root System
+#   Root Systems and Weights
 #
 ###############################################################################
 
-struct AbstractRootSystem <: RootSystem
+struct AbstractRootSystem{T<:CoxeterGroup} <: RootSystem
   # familiy (A, ..., G) of the root system
-  fam::Symbol
+  # fam::Vector{Tuple{Symbol, Int}}
+
+  # (generalized) Cartan matrix
+  cartan_matrix::ZZMatrix
 
   # fundamental weights as linear combination of simple roots
-  fw::QQMatrix
+  #fw::QQMatrix
+
+  positive_roots::Vector
+
+  weyl_group::T
+
+  function AbstractRootSystem(mat::ZZMatrix)
+    R = new{WeylGroup}()
+
+    roots, refl = positive_roots_and_reflections(gcm)
+    finite = count(refl .== 0) == rank
 
-  # generalized Cartan matrix
-  gcm::ZZMatrix
+    R.cartan_matrix = cartan_matrix
+    R.positive_roots = roots
+    R.weyl_group = WeylGroup(finite, mat, refl, R)
+  end
 end
 
-function root_system(gcm::ZZMatrix)
-  fw = solve(change_base_ring(QQ, gcm), identity_matrix(QQ, nrows(gcm)))
-  return AbstractRootSystem(:Z, fw, gcm)
+function root_system(cartan_matrix::ZZMatrix)
+  #fw = solve(change_base_ring(QQ, gcm), identity_matrix(QQ, nrows(gcm)))
+  return AbstractRootSystem(ZZMatrix(gcm))
 end
 
 function root_system(fam::Symbol, rk::Int)
-  return root_system(cartan_matrix(fam, rk))
+  cartan = cartan_matrix(fam, rk)
+  #fw = solve(change_base_ring(QQ, cartan), identity_matrix(QQ, nrows(cartan)))
+  return AbstractRootSystem(fam, fw, cartan)
+end
+
+function root_system(types::Tuple{Symbol,Int}...)
+  return root_system(cartan_matrix(types...))
 end
 
 function Base.show(io::IO, R::RootSystem)
-  print(io, "root system of type $(R.fam)$(rank(R))")
+  println(io, "root system defined by Cartan matrix")
+  show(io, R.cartan_matrix)
 end
 
-function basis(R::RootSystem)
-  rk = rank(R)
-  it = 1:rk
-  return [RootLatticeElem(R, matrix(QQ, 1, rk, i .== it)) for i in 1:rk]
+function cartan_matrix(R::RootSystem)
+  return R.cartan_matrix
+end
+
+#function basis(R::RootSystem)
+#  rk = rank(R)
+#  it = 1:rk
+#  return [RootLatticeElem(R, matrix(QQ, 1, rk, i .== it)) for i in 1:rk]
+#end
+
+function fundamental_weights(R::RootSystem)
+  it = 1:rank(R)
+  return [weight(R, i .== it)) for i in 1:rank(R)]
 end
 
 function positive_roots(R::RootSystem)
 end
 
 function rank(R::RootSystem)
-  return nrows(R.gcm)
+  return nrows(R.cartan_matrix)
+end
+
+function weyl_group(R::RootSystem)
+  return R.weyl_group
 end
 
-struct RootLatticeElem
+function weyl_vector(R::RootSystem)
+  rk = rank(R)
+  return WeightLatticeElem(R, matrix(ZZ, rk, 1, fill(1, rk)))
+end
+
+###############################################################################
+# WIP
+
+struct RootSpaceElem
   parent::RootSystem
 
-  # coefficients of simple roots
+  # vec is the coordinate (row) vector with respect to the simple roots
   vec::QQMatrix
 end
 
-function Base.:(*)(n::Int, r::RootLatticeElem)
-  return RootLatticeElem(r.parent, n * r.vec)
+###############################################################################
+# Weights
+
+struct WeightLatticeElem
+  root_system::RootSystem
+
+  # vec is the coordinate (column) vector with respect to the fundamental weights
+  vec::ZZMatrix
 end
 
-function Base.:(+)(r::RootLatticeElem, s::RootLatticeElem)
-  @req r.parent == s.parent "r and s must belong to the same root lattice"
+function weight(R::RootSystem, v::Vector{Int})
+  return WeightLatticeElem(R, matrix(ZZ, rank(R), 1, v))
+end
 
-  return RootLatticeElem(r.parent, r.vec + s.vec)
+function Base.:(*)(n::IntegerUnion, w::WeightLatticeElem)
+  return WeightLatticeElem(w.root_system, n * w.vec)
 end
 
-function Base.:(-)(r::RootLatticeElem, s::RootLatticeElem)
+function Base.:(+)(r::WeightLatticeElem, s::WeightLatticeElem)
   @req r.parent == s.parent "r and s must belong to the same root lattice"
 
-  return RootLatticeElem(r.parent, r.vec - s.vec)
+  return RootLatticeElem(r.parent, r.vec + s.vec)
 end
 
-function Base.:(-)(r::RootLatticeElem)
-  return RootLatticeElem(r.parent, -r.vec)
-end
+function Base.:(-)(v::WeightLatticeElem, w::WeightLatticeElem)
+  @req v.parent == w.parent "v and w must belong to the same weight lattice"
 
-function cartan_matrix(R::RootSystem)
-  return R.gcm
+  return WeightLatticeElem(w.parent, r.vec - s.vec)
 end
 
-function coroot(R::RootSystem, a::Vector{QQFieldElem})
-  a .*= 2//inner_product(R.real_space, a, a)
+function Base.:(-)(w::WeightLatticeElem)
+  return WeightLatticeElem(w.parent, -w.vec)
 end
 
-# s=symbols(parent(v))
-function expressify(r::RootLatticeElem, s=:a; context=nothing)
+function expressify(w::WeightLatticeElem, s=:w; context=nothing)
   sum = Expr(:call, :+)
-  for i in 1:length(r.vec)
-    push!(sum.args, Expr(:call, :*, expressify(r.vec[i]; context=context), "$s$i"))
+  for i in 1:length(w.vec)
+    push!(sum.args, Expr(:call, :*, expressify(w.vec[i]; context=context), "$s$i"))
   end
   return sum
 end
+@enable_all_show_via_expressify WeightLatticeElem
 
-@enable_all_show_via_expressify RootLatticeElem
+###############################################################################
+# internal helpers
+
+# cartan matrix in the format <a^v, b>
+function positive_roots_and_reflections(cartan_matrix::ZZMatrix)
+  rank, _ = size(C)
+
+  roots = [[l == s ? 1 : 0 for l in 1:rank] for s in 1:rank]
+  rootidx = Dict(roots[s] => s for s in 1:rank)
+  refl = Dict((s, s) => 0 for s in 1:rank)
+
+  i = 1
+  while i <= length(roots)
+    for s in 1:rank
+      if haskey(refl, (s, i))
+        continue
+      end
+
+      pairing = sum(roots[i][l] * C[s, l] for l in 1:rank)
+      copairing = sum(roots[i][l] * C[l, s] for l in 1:rank)
+      if pairing * copairing >= 4
+        refl[s, i] = 0
+        continue
+      end
+
+      r = copy(roots[i])
+      r[s] -= pairing
+
+      # If we've not seen this root before, then add it to our list.
+      if !haskey(rootidx, r)
+        push!(roots, r)
+        rootidx[r] = length(roots)
+      end
+
+      # record the reflection data
+      si = rootidx[r]
+      refl[s, i] = si
+      refl[s, si] = i
+    end
+    i += 1
+  end
 
-struct WeightLatticeElem
-  coeffs::ZZMatrix
-  root_system::RootSystem
-end
+  table = zero_matrix(ZZ, rank, length(roots))
+  for i in 1:length(roots), s in 1:rank
+    table[s, i] = refl[s, i]
+  end
+
+  roots, table
+end

experimental/LieAlgebras/src/CartanMatrix.jl

@@ -83,3 +83,54 @@ function cartan_matrix(types::Tuple{Symbol,Int}...)
 
   return block_diagonal_matrix(blocks)
 end
+
+function cartan_to_coxeter_matrix(mat; check=true)
+  #if !is_gcm(gcm)
+  #  throw(DomainError(gcm, "Is not a generalised Cartan matrix"))
+  #end
+
+  cm = identity_matrix(gcm)
+  rk, _ = size(cm)
+
+  function a_to_m(a)
+    a == 0 && return 2
+    a == -1 && return 3
+    a == -2 && return 4
+    a == -3 && return 6
+    return 0
+  end
+
+  for i in 1:rk, j in 1:rk
+    if i == j
+      continue
+    end
+
+    cm[i, j] = a_to_m(gcm[i, j])
+  end
+
+  cm
+end
+
+function is_cartan_matrix(mat::ZZMatrix; generalized=true)
+  n, m = size(mat)
+  if n != m
+    return false
+  end
+
+  if !all(mat[i,i] == 2 for 1 in 1:n)
+    return false
+  end
+
+  for i in 1:n
+    for j in j+1:m
+      if mat[i,j] == mat[j,i] == 0
+        continue
+      end
+      if mat[i,j] > 0 || mat[j,i] > 0
+        return false
+      end
+    end
+  end
+
+  return true
+end

experimental/LieAlgebras/src/CoxeterGroup.jl

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

experimental/LieAlgebras/src/LieAlgebras.jl

@@ -55,7 +55,7 @@ import ..Oscar:
   symbols,
   symmetric_power,
   tensor_product,
-  word,
+  weight,
   ⊕,
   ⊗
 
@@ -105,7 +105,7 @@ export trivial_module
 export universal_enveloping_algebra
 
 # RootSystem.jl
-export RootSystem, RootSystemElem, cartan_matrix, inner_product, inner_product_matrix, rank, root_system, weyl_group
+export RootSystem, RootSystemElem, cartan_matrix, inner_product, inner_product_matrix, rank, root_system, weyl_group, weyl_vector
 export WeightLatticeElem
 
 # WeylGroup.jl
@@ -176,7 +176,7 @@ export universal_enveloping_algebra
 export cartan_matrix
 
 # RootSystem.jl
-export RootSystem, RootSystemElem, cartan_matrix, inner_product, inner_product_matrix, rank, root_system, weyl_group
+export RootSystem, RootSystemElem, cartan_matrix, inner_product, inner_product_matrix, rank, root_system, weyl_group, weyl_vector
 export WeightLatticeElem
 
 # WeylGroup.jl

experimental/LieAlgebras/src/RootSystem.jl

@@ -1 +1 @@
-abstract type RootSystem end
+abstract type RootSystem end