some methods for computing orth. discriminants (#2748)

- add `od_from_order`, `od_from_eigenvalues`, `od_for_specht_module`
- add utilities `character_of_entry`, `order_omega_mod_N`, `reduce_mod_squares`

experimental/OrthogonalDiscriminants/docs/doc.main

@@ -2,6 +2,7 @@
    "Orthogonal discriminants" => [
       "introduction.md",
       "access.md",
+      "compute.md",
       "misc.md",
    ],
 ]

experimental/OrthogonalDiscriminants/docs/src/compute.md

@@ -0,0 +1,16 @@
+```@meta
+CurrentModule = Oscar.OrthogonalDiscriminants
+DocTestSetup = quote
+  using Oscar
+end
+```
+
+# Criteria for computing orthogonal discriminants
+
+## Character-theoretical criteria
+
+```@docs
+od_from_order
+od_from_eigenvalues
+od_for_specht_module
+```

experimental/OrthogonalDiscriminants/src/OrthogonalDiscriminants.jl

@@ -17,8 +17,10 @@ import Oscar.Partition
 import Oscar.partition
 
 # The following code can be loaded at compile time.
+include("utils.jl")
 include("data.jl")
 include("gram_det.jl")
+include("theoretical.jl")
 include("exports.jl")
 
 end # module

experimental/OrthogonalDiscriminants/src/data.jl

@@ -89,11 +89,28 @@ function orthogonal_discriminants(tbl::Oscar.GAPGroupCharacterTable)
 end
 
 
-function comment_matches(str)
-  error("dummy function")
+# Return the character described by `d`.
+function character_of_entry(d::Dict)
+  @req haskey(d, :groupname) "the dictionary has no :groupname"
+  tbl = character_table(d[:groupname])
+  @req haskey(d, :characteristic) "the dictionary has no :characteristic"
+  p = d[:characteristic]
+  if p != 0
+    tbl = mod(tbl, p)
+  end
+  @req haskey(d, :charpos) "the dictionary has no :charpos"
+  return tbl[d[:charpos]]
+end
+
+
+# Return `true` if `str` occurs as an entry in `d[:comment]`
+function comment_matches(d::Dict, str::String)
+  @req haskey(d, :comment) "the dictionary has no :comment"
+  return str in d[:comment]
 end
 
 
+# Compare two character fields, by comparing their embeddings.
 function is_equal_field(emb1, emb2)
   dom1 = domain(emb1)
   dom2 = domain(emb2)

experimental/OrthogonalDiscriminants/src/theoretical.jl

@@ -0,0 +1,174 @@
+
+# character-theoretical methods
+
+
+@doc raw"""
+    od_from_order(chi::GAPGroupClassFunction)
+
+Return `(flag, val)` where `flag` is `true` if the order of the group
+of `chi` divides only one of the orders of the two orthogonal groups
+[`omega_group`](@ref)`(+/-1, d, q)`, where `d` is the degree of `chi`
+and `q` is the order of the field of definition of `chi`.
+
+In this case, `val` is `"O+"` or `"O-"`.
+
+```jldoctest
+julia> t = character_table("L3(2)");
+
+julia> Oscar.OrthogonalDiscriminants.od_from_order(mod(t, 3)[4])
+(true, "O-")
+
+julia> Oscar.OrthogonalDiscriminants.od_from_order(mod(t, 2)[4])
+(false, "")
+```
+"""
+function od_from_order(chi::GAPGroupClassFunction)
+  characteristic(chi) == 0 && return (false, "")
+  d = numerator(degree(chi))
+  q = order_field_of_definition(chi)
+  tbl = ordinary_table(chi.table)
+  ord = order(ZZRingElem, tbl)
+
+  # Compute the order of the subgroup that shall embed into
+  # the perfect group `omega_group(epsilon, d, q)`.
+  n = sum(class_lengths(tbl)[class_positions_of_solvable_residuum(tbl)])
+  flag1, flag2 = order_omega_mod_N(d, q, n)
+  if flag1
+    return flag2 ? (false, "") : (true, "O+")
+  else
+    return flag2 ? (true, "O-") : (false, "")
+  end
+end
+
+
+@doc raw"""
+    od_from_eigenvalues(chi::GAPGroupClassFunction)
+
+Return `(flag, val)` where `flag` is `true` if there is a conjugacy class
+on which representing matrices for `chi` have no eigenvalue $\pm 1$.
+In this case, if `chi` is orthogonally stable (this is not checked here)
+then `val` is a string that describes the orthogonal discriminant of `chi`.
+
+If `flag` is `false` then `val` is equal to `""`.
+
+This criterion works only if the characteristic of `chi` is not $2$,
+`(false, "")` is returned if the characteristic is $2$.
+
+# Examples
+```jldoctest
+julia> t = character_table("A5");
+
+julia> Oscar.OrthogonalDiscriminants.od_from_eigenvalues(t[4])
+(true, "5")
+
+julia> Oscar.OrthogonalDiscriminants.od_from_eigenvalues(mod(t, 3)[4])
+(true, "O-")
+
+julia> Oscar.OrthogonalDiscriminants.od_from_eigenvalues(mod(t, 2)[4])
+(false, "")
+```
+"""
+function od_from_eigenvalues(chi::GAPGroupClassFunction)
+  p = characteristic(chi)
+  p == 2 && return (false, "")
+
+  tbl = chi.table
+  ord = orders_class_representatives(tbl)
+  for i in 2:length(chi)
+    n = ord[i]
+    ev = multiplicities_eigenvalues(chi, i)
+    if ev[end] != 0 || (iseven(n) && ev[divexact(n, 2)] != 0)
+      continue
+    end
+
+    F, z = cyclotomic_field(n)
+    od = prod(x -> x[1]^x[2], [(z^i-z^-i, ev[i]) for i in 1:n])
+    if mod(degree(chi), 4) == 2
+      od = -od
+    end
+
+    K, _ = abelian_closure(QQ)
+    if p == 0
+      # Coerce `od` into the character field of `chi`.
+      F, emb = character_field(chi)
+      od = preimage(emb, K(od))
+
+      # Reduce the representative `od` mod obvious squares
+      # in the character field.
+      od = reduce_mod_squares(od)
+
+      # Embed this value into the alg. closure.
+      od = emb(od)
+
+      # Turn the value into a string (using Atlas notation).
+      str = atlas_description(od)
+    else
+      # Decide if the reduction mod `p` is a square in the char. field.
+      str = is_square(reduce(K(od), character_field(chi)[1])) ? "O+" : "O-"
+    end
+
+    return true, str
+  end
+
+  return false, ""
+end
+
+@doc raw"""
+    od_for_specht_module(chi::GAPGroupClassFunction)
+
+Return `(flag, val)` where `flag` is `true` if `chi` is an ordinary
+irreducible character of a symmetric group or of an alternating group
+such that `chi` extends to the corresponding symmetric group.
+In this case, if `chi` is orthogonally stable (this is not checked here)
+then `val` is a string that describes the orthogonal discriminant of `chi`;
+the discriminant is computed using the Jantzen-Schaper formula,
+via [`gram_determinant_specht_module`](@ref).
+
+`(false, "")` is returned in all cases where this criterion is not applicable.
+
+# Examples
+```jldoctest
+julia> t = character_table("A5");
+
+julia> Oscar.OrthogonalDiscriminants.od_for_specht_module(t[4])
+(true, "5")
+
+julia> Oscar.OrthogonalDiscriminants.od_for_specht_module(mod(t, 3)[4])
+(false, "")
+```
+"""
+function od_for_specht_module(chi::GAPGroupClassFunction)
+  characteristic(chi) == 0 || return (false, "")
+
+  # Find out to which alternating or symmetric group `chi` belongs.
+  tbl = chi.table
+  name = identifier(tbl)
+  startswith(name, "A") || return (false, "")
+  pos = findfirst('.', name)
+  if pos == nothing
+    n = parse(Int, name[2:end])
+  else
+    n = parse(Int, name[2:(pos-1)])
+  end
+  n == nothing && return (false, "")
+  name == "A$n" || name == "A$n.2" || name == "A6.2_1" || return (false, "")
+
+  chipos = findfirst(isequal(chi), tbl)
+  chipos == nothing && return (false, "")
+  para = character_parameters(tbl)[chipos]
+  isa(para, Vector{Int}) || return (false, "")
+
+  # Now we know that `chi` belongs to Sym(n) or extends to Sym(n)
+  gramdet = gram_determinant_specht_module(partition(para))
+  res = ZZRingElem(1)
+  for pair in gramdet
+    if is_odd(pair[2])
+      res = res * pair[1]
+    end
+  end
+  if mod(degree(ZZRingElem, chi), 4) == 2
+    res = - res
+  end
+
+  return true, string(res)
+end

experimental/OrthogonalDiscriminants/src/utils.jl

@@ -0,0 +1,98 @@
+@doc raw"""
+    order_omega_mod_N(d::IntegerUnion, q::IntegerUnion, N::IntegerUnion) -> Pair{Bool, Bool}
+
+Return `(flag_plus, flag_minus)` where `flag_plus` and `flag_minus`
+are `true` or `false`, depending on whether `N` divides the order
+of the orthogonal groups $\Omega^+(d, q)$ and $\Omega^-(d, q)$.
+
+# Examples
+```jldoctest
+julia> Oscar.OrthogonalDiscriminants.order_omega_mod_N(4, 2, 60)
+(false, true)
+
+julia> Oscar.OrthogonalDiscriminants.order_omega_mod_N(4, 5, 60)
+(true, true)
+```
+"""
+function order_omega_mod_N(d::IntegerUnion, q::IntegerUnion, N::IntegerUnion)
+  @req is_even(d) "d must be even"
+  m = div(d, 2)
+  exp, N = remove(N, q)
+  facts = collect(factor(q))
+  p = facts[1][1]
+  if mod(N, p) == 0
+    exp = exp + 1
+    _, N = remove(N, p)
+  end
+  if m*(m-1) < exp
+    # A group of order `N` does not embed in any candidate.
+    return (false, false)
+  end
+
+  q2 = ZZ(q)^2
+  q2i = ZZ(1)
+  for i in  1:(m-1)
+    q2i = q2 * q2i
+    if i == 1 && is_odd(q)
+      g = gcd(N, div(q2i-1, 2))
+    else
+      g = gcd(N, q2i-1)
+    end
+    N = div(N, g)
+    if N == 1
+      # A group of order N may embed in both candidates.
+      return (true, true)
+    end
+  end
+
+  # embeds in + type?, embeds in - type?
+  return (mod(q^m-1, N) == 0, mod(q^m+1, N) == 0)
+end
+
+
+@doc raw"""
+    reduce_mod_squares(val::nf_elem)
+
+Return an element of `F = parent(val)` that is equal to `val`
+modulo squares in `F`.
+
+If `val` describes an integer then the result corresponds to the
+squarefree part of this integer.
+Otherwise the coefficients of the result have a squarefree g.c.d.
+
+# Examples
+```jldoctest
+julia> F, z = cyclotomic_field(4);
+
+julia> Oscar.OrthogonalDiscriminants.reduce_mod_squares(4*z^0)
+1
+
+julia> Oscar.OrthogonalDiscriminants.reduce_mod_squares(-8*z^0)
+-2
+```
+"""
+function reduce_mod_squares(val::nf_elem)
+  is_zero(val) && return val
+  d = denominator(val)
+  if ! isone(d)
+    val = val * d^2
+  end
+  if is_integer(val)
+    intval = ZZ(val)
+    sgn = sign(intval)
+    good = [x[1] for x in collect(factor(intval)) if is_odd(x[2])]
+    F = parent(val)
+    return F(prod(good, init = sgn))
+  end
+  # Just get rid of the square part of the gcd of the coefficients.
+  c = map(numerator, coefficients(val))
+  s = 1
+  for (p, e) in collect(factor(gcd(c)))
+    if iseven(e)
+      s = s * p^e
+    elseif e > 1
+      s = s * p^(e-1)
+    end
+  end
+  return val//s
+end

experimental/OrthogonalDiscriminants/test/runtests.jl

@@ -2,3 +2,5 @@ using Oscar
 using Test
 
 include("gram_det.jl")
+include("utils.jl")
+include("theoretical.jl")

experimental/OrthogonalDiscriminants/test/theoretical.jl

@@ -0,0 +1,51 @@
+@testset "group order" begin
+  d = 8
+  q = 3
+  order_oplus = order(omega_group(1, d, q))
+  order_ominus = order(omega_group(-1, d, q))
+  f = Oscar.OrthogonalDiscriminants.order_omega_mod_N
+  @test f(d, q, order_oplus) == (true, false)
+  @test f(d, q, order_ominus) == (false, true)
+  @test f(d, q, order(omega_group(0, d-1, q))) == (true, true)
+  @test f(d, q, q*order_oplus) == (false, false)
+  @test f(d, q, (q-1)*order_oplus) == (false, false)
+
+  @test_throws ArgumentError f(5, 2, 1)
+
+  for entry in all_od_infos(comment_matches => "order")
+    chi = Oscar.OrthogonalDiscriminants.character_of_entry(entry)
+    @test Oscar.OrthogonalDiscriminants.od_from_order(chi) == (true, entry[:valuestring])
+  end
+  for entry in all_od_infos(identifier => "A8")
+    if ! comment_matches(entry, "order")
+      chi = Oscar.OrthogonalDiscriminants.character_of_entry(entry)
+      @test Oscar.OrthogonalDiscriminants.od_from_order(chi) == (false, "")
+    end
+  end
+end
+
+@testset "eigenvalues" begin
+  for entry in all_od_infos(comment_matches => "ev")
+    chi = Oscar.OrthogonalDiscriminants.character_of_entry(entry)
+    @test Oscar.OrthogonalDiscriminants.od_from_eigenvalues(chi) == (true, entry[:valuestring])
+  end
+  for entry in all_od_infos(identifier => "A8")
+    if ! comment_matches(entry, "ev")
+      chi = Oscar.OrthogonalDiscriminants.character_of_entry(entry)
+      @test Oscar.OrthogonalDiscriminants.od_from_eigenvalues(chi) == (false, "")
+    end
+  end
+end
+
+@testset "Specht modules" begin
+  for entry in all_od_infos(comment_matches => "specht")
+    chi = Oscar.OrthogonalDiscriminants.character_of_entry(entry)
+    @test Oscar.OrthogonalDiscriminants.od_for_specht_module(chi) == (true, entry[:valuestring])
+  end
+  for entry in all_od_infos(identifier => "A8")
+    if ! comment_matches(entry, "specht")
+      chi = Oscar.OrthogonalDiscriminants.character_of_entry(entry)
+      @test Oscar.OrthogonalDiscriminants.od_for_specht_module(chi) == (false, "")
+    end
+  end
+end