More functionality for Weyl groups (#3051)

docs/oscar_references.bib

@@ -1785,6 +1785,18 @@ @Misc{Stacks
   url           = {https://stacks.math.columbia.edu/}
 }
 
+@InCollection{Ste01,
+  author        = {Stembridge, John R.},
+  title         = {Computational aspects of root systems, {C}oxeter groups, and {W}eyl characters},
+  booktitle     = {Interaction of combinatorics and representation theory},
+  series        = {MSJ Memoirs},
+  volume        = {11},
+  publisher     = {The Mathematical Society of Japan},
+  pages         = {1--38},
+  year          = {2001},
+  doi           = {10.2969/msjmemoirs/01101C010}
+}
+
 @InCollection{Ste91,
   author        = {Stevens, Jan},
   title         = {On the versal deformation of cyclic quotient singularities},

experimental/LieAlgebras/src/CartanMatrix.jl

@@ -181,38 +181,46 @@ function cartan_symmetrizer(gcm::ZZMatrix; check::Bool=true)
       undone[plan[head]] = false
     end
 
+    prev = head
     i = plan[head]
     for j in 1:rk
       if i == j
         continue
       end
 
-      if undone[j] && !is_zero_entry(gcm, i, j)
-        head += 1
-        plan[head] = j
-        undone[j] = false
-
-        if diag[i] * gcm[i, j] == diag[j] * gcm[j, i]
-          continue
-        elseif gcm[i, j] == gcm[j, i]
-          diag[i] = lcm(diag[i], diag[j])
-          diag[j] = diag[i]
-          continue
-        end
+      if !undone[j] || is_zero_entry(gcm, i, j)
+        continue
+      end
+
+      head += 1
+      plan[head] = j
+      undone[j] = false
+
+      if diag[i] * gcm[i, j] == diag[j] * gcm[j, i]
+        continue
+      elseif gcm[i, j] == gcm[j, i]
+        diag[i] = lcm(diag[i], diag[j])
+        diag[j] = diag[i]
+        continue
+      end
 
-        if gcm[j, i] < -1
+      if gcm[j, i] < -1
+        tail += 1
+        v = -gcm[j, i]
+        while tail < head
+          diag[plan[tail]] *= v
           tail += 1
-          v = -gcm[j, i]
-          while tail < head
-            diag[plan[tail]] *= v
-            tail += 1
-          end
-        end
-        if gcm[i, j] < -1
-          diag[j] *= -gcm[i, j]
-          tail = head - 1
         end
       end
+      if gcm[i, j] < -1
+        diag[j] *= -gcm[i, j]
+        tail = head - 1
+      end
+    end
+
+    # we found new roots, meaning we are done with this component of the root system
+    if prev == head
+      tail = head
     end
   end
 

experimental/LieAlgebras/src/CoxeterGroup.jl

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

experimental/LieAlgebras/src/LieAlgebras.jl

@@ -5,7 +5,9 @@ module LieAlgebras
 
 using ..Oscar
 
-import Oscar: GAPWrap, IntegerUnion, MapHeader
+import Oscar: GAPWrap, GroupsCore, IntegerUnion, MapHeader
+
+import Random
 
 # not importet in Oscar
 using AbstractAlgebra: CacheDictType, ProductIterator, get_cached!, ordinal_number_string
@@ -62,6 +64,7 @@ import ..Oscar:
   matrix,
   ngens,
   normalizer,
+  order,
   parent_type,
   rank,
   root,
@@ -91,6 +94,7 @@ export RootSpaceElem
 export RootSystem
 export WeightLatticeElem
 export WeylGroup, WeylGroupElem
+export WeylOrbitIterator
 
 export abelian_lie_algebra
 export abstract_module
@@ -107,6 +111,7 @@ export coefficient_vector
 export coerce_to_lie_algebra_elem
 export combinations
 export conjugate_dominant_weight
+export conjugate_dominant_weight_with_elem
 export coroot
 export coroots
 export coxeter_matrix
@@ -122,9 +127,10 @@ export induced_map_on_symmetric_power
 export induced_map_on_tensor_power
 export is_cartan_matrix
 export is_cartan_type
+export is_coroot_with_index
 export is_direct_sum
+export is_dominant
 export is_dual
-export is_coroot_with_index
 export is_negative_coroot_with_index
 export is_negative_root_with_index
 export is_positive_coroot_with_index
@@ -136,8 +142,9 @@ export is_simple_root_with_index
 export is_standard_module
 export is_symmetric_power
 export is_tensor_power
+export is_tensor_product
 export lie_algebra
-export lmul!
+export lmul, lmul!
 export longest_element
 export lower_central_series
 export matrix_repr_basis
@@ -174,6 +181,7 @@ export tensor_product_decomposition
 export trivial_module
 export universal_enveloping_algebra
 export weyl_group
+export weyl_orbit
 export word
 
 include("Combinatorics.jl")
@@ -213,6 +221,7 @@ export RootSpaceElem
 export RootSystem
 export WeightLatticeElem
 export WeylGroup, WeylGroupElem
+export WeylOrbitIterator
 
 export abelian_lie_algebra
 export abstract_module
@@ -227,6 +236,7 @@ export cartan_type_with_ordering
 export chevalley_basis
 export coerce_to_lie_algebra_elem
 export conjugate_dominant_weight
+export conjugate_dominant_weight_with_elem
 export coroot
 export coroots
 export coxeter_matrix
@@ -242,9 +252,10 @@ export induced_map_on_symmetric_power
 export induced_map_on_tensor_power
 export is_cartan_matrix
 export is_cartan_type
+export is_coroot_with_index
 export is_direct_sum
+export is_dominant
 export is_dual
-export is_coroot_with_index
 export is_negative_coroot_with_index
 export is_negative_root_with_index
 export is_positive_coroot_with_index
@@ -258,11 +269,10 @@ export is_symmetric_power
 export is_tensor_power
 export is_tensor_product
 export lie_algebra
-export lmul!
+export lmul, lmul!
 export longest_element
 export lower_central_series
 export matrix_repr_basis
-export matrix_repr_basis
 export negative_coroot
 export negative_coroots
 export negative_root
@@ -295,4 +305,5 @@ export tensor_product_decomposition
 export trivial_module
 export universal_enveloping_algebra
 export weyl_group
+export weyl_orbit
 export word

experimental/LieAlgebras/src/RootSystem.jl

@@ -344,6 +344,10 @@ function simple_roots(R::RootSystem)
   return positive_roots(R)[1:rank(R)]
 end
 
+function type(R::RootSystem)
+  return R.type
+end
+
 @doc raw"""
     simple_coroot(R::RootSystem, i::Int) -> RootSpaceElem
 
@@ -756,6 +760,34 @@ function conjugate_dominant_weight(w::WeightLatticeElem)
   return conj
 end
 
+@doc raw"""
+    conjugate_dominant_weight_with_elem(w::WeightLatticeElem) -> Tuple{WeightLatticeElem, WeylGroupElem}
+
+Returns the unique dominant weight `dom` conjugate to `w` and a Weyl group element `x`
+such that `x*w == dom`.
+"""
+function conjugate_dominant_weight_with_elem(w::WeightLatticeElem)
+  R = root_system(w)
+  wt = deepcopy(w)
+
+  # determine the Weyl group element taking w to the fundamental chamber
+  word = sizehint!(UInt8[], count(<(0), coefficients(wt))^2)
+  s = 1
+  while s <= rank(R)
+    if wt[s] < 0
+      push!(word, UInt8(s))
+      reflect!(wt, s)
+      s = 1
+    else
+      s += 1
+    end
+  end
+
+  # reversing word means it is in short revlex normal form
+  # and it is the element taking w to wt
+  return wt, weyl_group_elem(R, reverse!(word); normalize=false)
+end
+
 function expressify(w::WeightLatticeElem, s=:w; context=nothing)
   sum = Expr(:call, :+)
   for i in 1:length(w.vec)
@@ -765,6 +797,10 @@ function expressify(w::WeightLatticeElem, s=:w; context=nothing)
 end
 @enable_all_show_via_expressify WeightLatticeElem
 
+function is_dominant(w::WeightLatticeElem)
+  return all(>=(0), coefficients(w))
+end
+
 @doc raw"""
     reflect(w::WeightLatticeElem, s::Int) -> WeightLatticeElem
     
@@ -837,10 +873,11 @@ function positive_roots_and_reflections(cartan_matrix::ZZMatrix)
 
   # sort roots by height
   perm = sortperm(roots; by=sum)
+  invp = invperm(perm)
 
-  table = zero_matrix(ZZ, rank, length(roots))
+  table = zeros(UInt, rank, length(roots))
   for i in 1:length(roots), s in 1:rank
-    table[s, i] = refl[s, perm[i]]
+    table[s, i] = iszero(refl[s, perm[i]]) ? 0 : invp[refl[s, perm[i]]]
   end
 
   roots[perm], coroots[perm], table