Finish Bruhat order for Weyl groups and add tests (#3615)

Co-authored-by: Lars Göttgens <[email protected]>

experimental/LieAlgebras/src/RootSystem.jl

@@ -803,7 +803,7 @@ function conjugate_dominant_weight_with_elem(w::WeightLatticeElem)
 
   # 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)
+  return wt, weyl_group(R)(reverse!(word); normalize=false)
 end
 
 function expressify(w::WeightLatticeElem, s=:w; context=nothing)

experimental/LieAlgebras/src/WeylGroup.jl

@@ -82,7 +82,7 @@ end
     (W::WeylGroup)(word::Vector{Int}) -> WeylGroupElem
 """
 function (W::WeylGroup)(word::Vector{<:Integer}; normalize::Bool=true)
-  return weyl_group_elem(W, word; normalize=normalize)
+  return WeylGroupElem(W, word; normalize=normalize)
 end
 
 function Base.IteratorSize(::Type{WeylGroup})
@@ -221,14 +221,6 @@ end
 ###############################################################################
 # Weyl group elements
 
-function weyl_group_elem(R::RootSystem, word::Vector{<:Integer}; normalize::Bool=true)
-  return WeylGroupElem(weyl_group(R), word; normalize=normalize)
-end
-
-function weyl_group_elem(W::WeylGroup, word::Vector{<:Integer}; normalize::Bool=true)
-  return WeylGroupElem(W, word; normalize=normalize)
-end
-
 function Base.:(*)(x::WeylGroupElem, y::WeylGroupElem)
   @req x.parent === y.parent "$x, $y must belong to the same Weyl group"
 
@@ -269,27 +261,34 @@ function Base.:(^)(x::WeylGroupElem, n::Int)
 end
 
 @doc raw"""
-    Base.:(<)(x::WeylGroupElem, y::WeylGroupElem)
+    <(x::WeylGroupElem, y::WeylGroupElem) -> Bool
 
-Returns whether `x` is smaller than `y` with respect to the Bruhat order.
+Returns whether `x` is smaller than `y` with respect to the Bruhat order,
+i.e., whether some (not necessarily connected) subexpression of a reduced
+decomposition of `y`, is a reduced decomposition of `x`.
 """
 function Base.:(<)(x::WeylGroupElem, y::WeylGroupElem)
   @req parent(x) === parent(y) "$x, $y must belong to the same Weyl group"
 
   if length(x) >= length(y)
     return false
+  elseif isone(x)
+    return true
   end
 
-  # x < y in the Bruhat order, iff some (not necessarily connected) subexpression
-  # of a reduced decomposition of y, is a reduced decomposition of x
-  j = length(x)
-  for i in length(y):-1:1
-    if word(y)[i] == word(x)[j]
-      j -= 1
-      if j == 0
+  tx = deepcopy(x)
+  for i in 1:length(y)
+    b, j, _ = explain_lmul(tx, y[i])
+    if !b
+      deleteat!(word(tx), j)
+      if isone(tx)
         return true
       end
     end
+
+    if length(tx) > length(y) - i
+      return false
+    end
   end
 
   return false
@@ -399,6 +398,20 @@ end
 Returns the result of multiplying `x` in place from the left by the `i`th simple reflection.
 """
 function lmul!(x::WeylGroupElem, i::Integer)
+  b, j, r = explain_lmul(x, i)
+  if b
+    insert!(word(x), j, r)
+  else
+    deleteat!(word(x), j)
+  end
+
+  return x
+end
+
+# explains what multiplication of s_i from the left will do.
+# Returns a tuple where the first entry is true/false, depending on whether an insertion or deletion will happen,
+# the second entry is the position, and the third is the simple root.
+function explain_lmul(x::WeylGroupElem, i::Integer)
   @req 1 <= i <= rank(root_system(parent(x))) "Invalid generator"
 
   insert_index = 1
@@ -407,14 +420,13 @@ function lmul!(x::WeylGroupElem, i::Integer)
   root = insert_letter
   for s in 1:length(x)
     if x[s] == root
-      deleteat!(word(x), s)
-      return x
+      return false, s, x[s]
     end
 
     root = parent(x).refl[Int(x[s]), Int(root)]
     if iszero(root)
       # r is no longer a minimal root, meaning we found the best insertion point
-      break
+      return true, insert_index, insert_letter
     end
 
     # check if we have a better insertion point now. Since word[i] is a simple
@@ -425,8 +437,7 @@ function lmul!(x::WeylGroupElem, i::Integer)
     end
   end
 
-  insert!(word(x), insert_index, insert_letter)
-  return x
+  return true, insert_index, insert_letter
 end
 
 function parent_type(::Type{WeylGroupElem})

experimental/LieAlgebras/test/WeylGroup-test.jl

@@ -91,6 +91,58 @@ include(
     # test_GroupElem_interface(rand(G, 2)...)
   end
 
+  @testset "<(x::WeylGroupElem, y::WeylGroupElem)" begin
+    # for rank 2 v < w iff l(v) < l(w), since W is a dihedral group
+    for fam in [:A, :B, :C, :G]
+      W = weyl_group(fam, 2)
+      for v in W
+        v2 = deepcopy(v)
+        for w in W
+          w2 = deepcopy(w)
+          @test (v < w) == (length(v) < length(w))
+          @test v == v2 && w == w2
+        end
+      end
+    end
+
+    # test case where normal form of the lhs is not in the rhs
+    W = weyl_group(:A, 3)
+    s = gens(W)
+    @test s[1] * s[2] * s[1] < s[2] * s[3] * s[1] * s[2]
+
+    # different implementation for Bruhat order
+    # was not as performant in benchmarks
+    function bruhat_less(x::WeylGroupElem, y::WeylGroupElem)
+      if length(x) >= length(y)
+        return false
+      elseif isone(x)
+        return true
+      end
+
+      wt = x * weyl_vector(root_system(parent(x)))
+      j = length(x)
+      for i in 1:length(y)
+        if wt[Int(y[i])] < 0
+          reflect!(wt, Int(y[i]))
+
+          j -= 1
+          if j == 0
+            return true
+          end
+        end
+      end
+
+      return false
+    end
+
+    for (fam, rk) in [(:A, 3), (:B, 3), (:D, 4)]
+      W = weyl_group(fam, rk)
+      for v in W, w in W
+        @test (v < w) == bruhat_less(v, w)
+      end
+    end
+  end
+
   @testset "inv(x::WeylGroupElem)" begin
     W = weyl_group(:A, 2)
     s = gens(W)