map_word and parabolic_subgroup for Weyl groups (#4519)

experimental/LieAlgebras/src/LieAlgebras.jl

@@ -69,6 +69,7 @@ import ..Oscar:
   isomorphism,
   kernel,
   lower_central_series,
+  map_word,
   matrix,
   normalizer,
   number_of_generators,

experimental/LieAlgebras/src/WeylGroup.jl

@@ -247,7 +247,7 @@ function isomorphism(::Type{PermGroup}, W::WeylGroup; set_properties::Bool=true)
   end
 
   iso = function (w::WeylGroupElem)
-    reduce(*, (gen(G, Int(i)) for i in word(w)); init=one(G))
+    map_word(w, gens(G); init=one(G))
   end
 
   isoinv = function (p::PermGroupElem)
@@ -257,3 +257,161 @@ function isomorphism(::Type{PermGroup}, W::WeylGroup; set_properties::Bool=true)
 
   return MapFromFunc(W, G, iso, isoinv)
 end
+
+@doc raw"""
+    map_word(w::WeylGroupElem, genimgs::Vector; genimgs_inv::Vector = genimgs, init = nothing)
+
+If `init` is `nothing` and `word(w) = [`$i_1$`, ..., `$i_n$`]`,
+then return the product $R_1 R_2 \cdots R_n$ with $R_j =$ `genimgs[`$i_j$`]`.
+Otherwise return the product $xR_1 R_2 \cdots R_n$ where $x =$ `init`.
+
+The length of `genimgs` must be equal to the rank of the parent of `w`.
+If `w` is the trivial element, then `init` is returned if it is different
+from `nothing`, and otherwise `one(genimgs[1])` is returned if `genimgs` is non-empty.
+If `w` is trivial, `init` is nothing and `genimgs` is empty, an error occurs.
+
+See also: [`map_word(::Union{FPGroupElem, SubFPGroupElem}, ::Vector)`](@ref),
+[`map_word(::Union{PcGroupElem, SubPcGroupElem}, ::Vector)`](@ref).
+Note that `map_word(::WeylGroupElem)` accepts the `genimgs_inv` keyword argument
+for consistency with other `map_word` methods, but ignores it because the
+generators of a Weyl group are always self-inverse.
+
+# Examples
+```jldoctest
+julia> W = weyl_group(:B, 3); imgs = [2, 3, 5];
+
+julia> map_word(one(W), imgs)
+1
+
+julia> map_word(W([1]), imgs)
+2
+
+julia> map_word(W([1]), imgs; init=7)
+14
+
+julia> map_word(W([1,2,1]), imgs)
+12
+
+julia> map_word(W([2,1,2]), imgs) # W([2,1,2]) == W([1,2,1])
+12
+
+julia> map_word(W([3, 2, 1, 3, 2, 3]), imgs)
+2250
+```
+"""
+function map_word(
+  w::WeylGroupElem, genimgs::Vector; genimgs_inv::Vector=genimgs, init=nothing
+)
+  @req length(genimgs) == number_of_generators(parent(w)) begin
+    "Length of vector of images does not equal rank of Weyl group"
+  end
+  return map_word(Int.(word(w)), genimgs; init=init)
+end
+
+@doc raw"""
+    parabolic_subgroup(W::WeylGroup, vec::Vector{<:Integer}, w::WeylGroupElem=one(W)) -> WeylGroup, Map{WeylGroup, WeylGroup}
+
+Return a Weyl group `P` and an embedding $f:P\to W$ such that $f(P)$ is
+the subgroup `U` of `W` generated by `[inv(w)*u*w for u in gens(W)[vec]]`.
+Further, `f` maps `gen(P, i)` to `inv(w)*gen(W, vec[i])*w`.
+The elements of `vec` must be pairwise distinct integers in
+`1:number_of_generators(W)` and `vec` must be non-empty.
+
+# Examples
+```jldoctest
+julia> W = weyl_group(:B, 3)
+Weyl group
+  of root system of rank 3
+    of type B3
+
+julia> P1, f1 = parabolic_subgroup(W, [1, 2])
+(Weyl group of root system of type A2, Map: P1 -> W)
+
+julia> f1(P1[1] * P1[2]) == W[1] * W[2]
+true
+
+julia> P2, f2 = parabolic_subgroup(W, [1, 2], W[1])
+(Weyl group of root system of type A2, Map: P2 -> W)
+
+julia> f2(P2[1]) == W[1] && f2(P2[2]) == W[1] * W[2] * W[1]
+true
+
+julia> P3, f3 = parabolic_subgroup(W, [1,3,2])
+(Weyl group of root system of type B3 (non-canonical ordering), Map: P3 -> W)
+
+julia> f3(P3[2]) == W[3]
+true
+```
+"""
+function parabolic_subgroup(W::WeylGroup, vec::Vector{<:Integer}, w::WeylGroupElem=one(W))
+  @req allunique(vec) "Elements of vector are not pairwise distinct"
+  @req all(i -> 1 <= i <= number_of_generators(W), vec) "Invalid indices"
+  cm = cartan_matrix(root_system(W))[vec, vec]
+  para = weyl_group(cm)
+  genimgs = [conj(W[i], w) for i in vec]
+  emb = function (u::WeylGroupElem)
+    return map_word(u, genimgs)
+  end
+  return para, MapFromFunc(para, W, emb)
+end
+
+@doc raw"""
+    parabolic_subgroup_with_projection(W::WeylGroup, vec::Vector{<:Integer}; check::Bool=true) -> WeylGroup, Map{WeylGroup, WeylGroup}, Map{WeylGroup, WeylGroup}
+
+Return a triple `(P, emb, proj)` that describes a factor of `W`, that is,
+a product of irreducible factors.
+Here `P, emb = `[`parabolic_subgroup`](@ref)`(W, vec)`
+and `proj` is the projection map from `W` onto `P`,
+which is a left-inverse of `emb`.
+
+If `check = true`, then it is checked whether `vec` actually describes
+a union of irreducible components of the Dynkin diagram.
+
+# Examples
+```jldoctest
+julia> W = weyl_group([(:A, 3), (:B, 3)])
+Weyl group
+  of root system of rank 6
+    of type A3 x B3
+
+julia> P1, f1, p1 = parabolic_subgroup_with_projection(W, [1,2,3])
+(Weyl group of root system of type A3, Map: P1 -> W, Map: W -> P1)
+
+julia> p1(W[1]*W[4]*W[2]*W[6]) == P1[1] * P1[2]
+true
+
+julia> P2, f2, p2 = parabolic_subgroup_with_projection(W, [4,6,5])
+(Weyl group of root system of type B3 (non-canonical ordering), Map: P2 -> W, Map: W -> P2)
+
+julia> p2(W[5]) == P2[3]
+true
+```
+"""
+function parabolic_subgroup_with_projection(
+  W::WeylGroup, vec::Vector{<:Integer}; check::Bool=true
+)
+  if check
+    # Check that every generator in gens(W)[vec] commutes with every other generator.
+    # In other words, vec describes a union of irreducible components of the Coxeter diagram.
+    cm = cartan_matrix(root_system(W))
+    for i in setdiff(1:number_of_generators(W), vec)
+      for j in vec
+        @req is_zero_entry(cm, i, j) begin
+          "Input vector must describe a direct factor of the Weyl group"
+        end
+      end
+    end
+  end
+
+  factor, emb = parabolic_subgroup(W, vec)
+  # Generators of W are mapped to the corresponding generators of factor,
+  # or to 1 if there is no corresponding generator
+  proj_gen_imgs = fill(one(factor), ngens(W))
+  for i in 1:length(vec)
+    proj_gen_imgs[vec[i]] = gen(factor, i)
+  end
+  proj = function (w::WeylGroupElem)
+    return map_word(w, proj_gen_imgs)
+  end
+  return factor, emb, MapFromFunc(W, factor, proj)
+end

experimental/LieAlgebras/src/exports.jl

@@ -40,6 +40,8 @@ export killing_matrix
 export lie_algebra
 export lower_central_series
 export matrix_repr_basis
+export parabolic_subgroup
+export parabolic_subgroup_with_projection
 export show_dynkin_diagram
 export simple_module
 export special_linear_lie_algebra

experimental/LieAlgebras/test/WeylGroup-test.jl

@@ -135,4 +135,99 @@
       end
     end
   end
+
+  @testset "WeylGroup parabolic subgroup test for $(Wname)" for (
+    Wname, W, vec, check_proj
+  ) in [
+    ("A1", weyl_group(:A, 1), [1], true),
+    ("A5", weyl_group(:A, 5), [1, 5, 3], false),
+    ("B2", weyl_group(:B, 2), [2, 1], false),
+    ("F4", weyl_group(:F, 4), [2, 3], false),
+    ("A5+E8+D4", weyl_group((:A, 5), (:E, 8), (:D, 4)), [6:13; 1:5], true),
+    (
+      "A3 with non-canonical ordering of simple roots",
+      weyl_group(root_system([2 -1 -1; -1 2 0; -1 0 2])),
+      [2, 3], false,
+    ),
+    (
+      "B4 with non-canonical ordering of simple roots",
+      weyl_group(root_system([2 -1 -1 0; -1 2 0 -1; -2 0 2 0; 0 -1 0 2])),
+      [2, 4], false,
+    ),
+    (
+      "complicated case 1",
+      begin
+        cm = cartan_matrix((:A, 3), (:C, 3), (:E, 6), (:G, 2))
+        for _ in 1:50
+          i, j = rand(1:nrows(cm), 2)
+          if i != j
+            swap_rows!(cm, i, j)
+            swap_cols!(cm, i, j)
+          end
+        end
+        weyl_group(cm)
+      end,
+      unique(rand(1:14, 5)), false,
+    ),
+    (
+      "complicated case 2",
+      begin
+        cm = cartan_matrix((:F, 4), (:B, 2), (:E, 7), (:G, 2))
+        for _ in 1:50
+          i, j = rand(1:nrows(cm), 2)
+          if i != j
+            swap_rows!(cm, i, j)
+            swap_cols!(cm, i, j)
+          end
+        end
+        weyl_group(root_system(cm))
+      end,
+      unique(rand(1:15, 6)), false,
+    ),
+  ]
+    for k in 1:4
+      if k == 1
+        # On the first run, test the standard parabolics and projections
+        if check_proj
+          para, emb, proj = parabolic_subgroup_with_projection(W, vec)
+        else
+          para, emb = parabolic_subgroup(W, vec)
+        end
+        genimgs = [gen(W, i) for i in vec] # Desired images of gens(para) in W
+      else
+        # On subsequent runs, conjugate by random elements
+        r = rand(W)
+        para, emb = parabolic_subgroup(W, vec, r)
+        genimgs = [conj(W[i], r) for i in vec]
+      end
+      # Test that emb maps gens(para) to genimgs
+      for i in 1:length(vec)
+        @test emb(gen(para, i)) == genimgs[i]
+      end
+      # Test that emb is a homomorphism
+      for _ in 1:5
+        p1 = rand(para)
+        p2 = rand(para)
+        @test emb(p1) * emb(p2) == emb(p1 * p2)
+      end
+      # Test proj
+      if k == 1 && check_proj
+        # Test that proj maps gens(para) to gens(W)[vec]
+        for i in 1:length(vec)
+          @test proj(gen(W, vec[i])) == gen(para, i)
+        end
+        # Test that proj is a homomorphism
+        for _ in 1:5
+          w1 = rand(W)
+          w2 = rand(W)
+          @test proj(w1) * proj(w2) == proj(w1 * w2)
+        end
+        # Test that proj is the left-inverse of emb
+        for _ in 1:5
+          p = rand(para)
+          @test proj(emb(p)) == p
+        end
+      end
+    end
+  end
 end

src/Groups/GAPGroups.jl

@@ -2023,7 +2023,8 @@ If `init == nothing` and `genimgs` is empty, an error occurs.
 Thus the intended value for the empty word must be specified as `init`
 whenever it is possible that the elements in `genimgs` do not support `one`.
 
-See also: [`map_word(::Union{PcGroupElem, SubPcGroupElem}, ::Vector)`](@ref).
+See also: [`map_word(::Union{PcGroupElem, SubPcGroupElem}, ::Vector)`](@ref),
+[`map_word(::WeylGroupElem, ::Vector)](@ref).
 
 # Examples
 ```jldoctest
@@ -2106,7 +2107,8 @@ and $R_j =$ `genimgs[`$i_j$`]`$^{e_j}$.
 
 If `init` is different from `nothing`, return $x g_{i_1}^{e_1} g_{i_2}^{e_2} \cdots g_{i_n}^{e_n}$ where $x =$ `init`.
 
-See also: [`map_word(::Union{FPGroupElem, SubFPGroupElem}, ::Vector)`](@ref).
+See also: [`map_word(::Union{FPGroupElem, SubFPGroupElem}, ::Vector)`](@ref),
+[`map_word(::WeylGroupElem, ::Vector)](@ref).
 
 # Examples
 ```jldoctest