From 4d1d833f694753985f5a2c941e62dbd3be7ea423 Mon Sep 17 00:00:00 2001
From: Matthias Zach <85350711+HechtiDerLachs@users.noreply.github.com>
Date: Tue, 8 Oct 2024 07:41:37 +0200
Subject: [PATCH] Elliptic surfaces fixes (#4177)

* Disable some internal checks in elliptic_surface.

* Repair methods for has_dim_leq_zero.

* Fix up decomposition_info.

* Add possibility to compute intersection numbers in pos. char.
---
 experimental/Schemes/src/BlowupMorphism.jl    |  6 +++-
 experimental/Schemes/src/elliptic_surface.jl  | 33 ++++++++++++++++---
 .../Schemes/Covering/Objects/Attributes.jl    | 16 +++++----
 .../Schemes/Divisors/base_change.jl           |  8 ++++-
 .../Schemes/Sheaves/CoherentSheaves.jl        | 13 --------
 .../Schemes/Sheaves/IdealSheaves.jl           | 11 ++++---
 .../Schemes/CoveredScheme.jl                  |  2 +-
 7 files changed, 58 insertions(+), 31 deletions(-)

diff --git a/experimental/Schemes/src/BlowupMorphism.jl b/experimental/Schemes/src/BlowupMorphism.jl
index 166d8491aea2..9498e0586c56 100644
--- a/experimental/Schemes/src/BlowupMorphism.jl
+++ b/experimental/Schemes/src/BlowupMorphism.jl
@@ -644,13 +644,17 @@ function produce_object_on_affine_chart(I::StrictTransformIdealSheaf, U::AbsAffi
   f_loc = covering_morphism(f)[U]
   V = codomain(f_loc)
   IE_loc = IE(U)
+  @assert isone(ngens(IE_loc)) "ideal sheaf of exceptional locus is not principal"
   tot = pullback(f_loc)(J(V))
   #return saturation_with_index(tot, IE_loc)
   # It is usually better to pass to the simplified covering to do the computations
   simp_cov = simplified_covering(X)
   U_simp = first([V for V in patches(simp_cov) if original(V) === U])
   a, b = identification_maps(U_simp)
-  result, _ = saturation_with_index(pullback(a)(tot), pullback(a)(IE_loc))
+  # This used to be the following line. But we don't use the index, so we 
+  # switch to the more performant version
+  # result, _ = saturation_with_index(pullback(a)(tot), pullback(a)(IE_loc))
+  result = _iterative_saturation(pullback(a)(tot), elem_type(OO(U_simp))[pullback(a)(u) for (u, _) in factor(lifted_numerator(first(gens(IE_loc))))])
   return pullback(b)(result)
 end
 
diff --git a/experimental/Schemes/src/elliptic_surface.jl b/experimental/Schemes/src/elliptic_surface.jl
index d8eeacad7164..1aa0c17040c4 100644
--- a/experimental/Schemes/src/elliptic_surface.jl
+++ b/experimental/Schemes/src/elliptic_surface.jl
@@ -1213,7 +1213,7 @@ function _section_on_weierstrass_ambient_space(X::EllipticSurface, P::EllipticCu
   U = X0[1][1]
   (x,y,t) = coordinates(U)
   b = P
-  return ideal_sheaf(X0,U,[OO(U)(i) for i in [x*denominator(b[1])(t)-numerator(b[1])(t),y*denominator(b[2])(t)-numerator(b[2])(t)]])
+  return ideal_sheaf(X0,U,[OO(U)(i) for i in [x*denominator(b[1])(t)-numerator(b[1])(t),y*denominator(b[2])(t)-numerator(b[2])(t)]]; check=false)
 end
 
 function _section(X::EllipticSurface, P::EllipticCurvePoint)
@@ -1649,6 +1649,19 @@ function extended_ade(ADE::Symbol, n::Int)
   return -G, kernel(G; side = :left)
 end
 
+# This function allows to store a reduction map to positive characteristic,
+# e.g. for computing intersection numbers.
+function reduction_to_pos_char(X::EllipticSurface, red_map::Map)
+  return get_attribute!(X, :reduction_to_pos_char) do
+    kk0 = base_ring(X)
+    @assert domain(red_map) === kk0
+    kkp = codomain(red_map)
+    @assert characteristic(kkp) > 0
+    _, result = base_change(red_map, X)
+    return red_map, result
+  end::Tuple{<:Map, <:Map}
+end
+
 @doc raw"""
     basis_representation(X::EllipticSurface, D::WeilDivisor)
 
@@ -1661,9 +1674,21 @@ function basis_representation(X::EllipticSurface, D::WeilDivisor)
   n = length(basis_ambient)
   v = zeros(ZZRingElem, n)
   @vprint :EllipticSurface 3 "computing basis representation of $D\n"
-  for i in 1:n
-    @vprintln :EllipticSurface 4 "intersecting with $(i): $(basis_ambient[i])"
-    v[i] = intersect(basis_ambient[i], D)
+  kk = base_ring(X)
+  if iszero(characteristic(kk)) && has_attribute(X, :reduction_to_pos_char)
+    red_map, bc = get_attribute(X, :reduction_to_pos_char)
+    for i in 1:n
+      @vprintln :EllipticSurface 4 "intersecting with $(i): $(basis_ambient[i])"
+      
+      v[i] = intersect(base_change(red_map, basis_ambient[i]; scheme_base_change=bc), 
+                       base_change(red_map, D; scheme_base_change=bc))
+    end
+  else
+    for i in 1:n
+      @vprintln :EllipticSurface 4 "intersecting with $(i): $(basis_ambient[i])"
+
+      v[i] = intersect(basis_ambient[i], D)
+    end
   end
   @vprint :EllipticSurface 3 "done computing basis representation\n"
   return v*inv(G)
diff --git a/src/AlgebraicGeometry/Schemes/Covering/Objects/Attributes.jl b/src/AlgebraicGeometry/Schemes/Covering/Objects/Attributes.jl
index 34fe511ed2d5..07e66f27a558 100644
--- a/src/AlgebraicGeometry/Schemes/Covering/Objects/Attributes.jl
+++ b/src/AlgebraicGeometry/Schemes/Covering/Objects/Attributes.jl
@@ -107,18 +107,22 @@ function inherit_decomposition_info!(
 
   for V in patches(orig_cov)
     # Collect the patches in `ref_cov` refining V
-    V_ref = [U for U in patches(ref_cov) if decomp_dict[U][1] === V]
-    # Collect the corresponding complement equations
-    comp_eqns = [decomp_dict[U][2] for U in V_ref]
+    V_ref = [(U, h) for (U, (UV, h)) in decomp_dict if UV === V]
+    _compl(a) = sum(length(lifted_numerator(b)) + length(lifted_denominator(b)) for b in a[2]; init=0)
+    V_ref = sort!(V_ref, by=_compl)
     # Start out from the original decomposition info
     dec_inf = copy(decomposition_info(orig_cov)[V])
-    for (i, U) in enumerate(V_ref)
+    for (i, (U, h)) in enumerate(V_ref)
       # Cast the already made decomposition info down to U
       tmp = elem_type(OO(U))[OX(V, U)(i) for i in dec_inf] # help the compiler
       # Append the equations for the previously covered patches
       for j in 1:i-1
-        W = V_ref[j]
-        surplus = OX(V, U).(decomp_dict[W][2])
+        _, hh = V_ref[j]
+        if is_empty(hh) # The patch for hh already covered everything; this one can hence be discarded.
+          push!(tmp, one(OO(U)))
+          break
+        end
+        surplus = OX(V, U).(hh)
         push!(tmp, prod(surplus; init=one(OO(U))))
       end
       set_decomposition_info!(ref_cov, U, tmp)
diff --git a/src/AlgebraicGeometry/Schemes/Divisors/base_change.jl b/src/AlgebraicGeometry/Schemes/Divisors/base_change.jl
index b57f1184f3f1..9c25ee85ac93 100644
--- a/src/AlgebraicGeometry/Schemes/Divisors/base_change.jl
+++ b/src/AlgebraicGeometry/Schemes/Divisors/base_change.jl
@@ -6,7 +6,13 @@ function base_change(
   @assert codomain(scheme_base_change) === X
   Y = domain(scheme_base_change)
   kk = coefficient_ring(C)
-  return AlgebraicCycle(Y, kk, IdDict{AbsIdealSheaf, elem_type(kk)}(pullback(scheme_base_change, I)=>c for (I, c) in coefficient_dict(C)); check=false)
+  ideal_dict = IdDict{AbsIdealSheaf, elem_type(kk)}()
+  for (I, c) in coefficient_dict(C)
+    I_red = pullback(scheme_base_change, I)
+    has_attribute(I, :_self_intersection) && set_attribute!(I_red, :_self_intersection=>(get_attribute(I, :_self_intersection)::Int))
+    ideal_dict[I_red] = c
+  end
+  return AlgebraicCycle(Y, kk, ideal_dict; check=false)
 end
 
 function base_change(
diff --git a/src/AlgebraicGeometry/Schemes/Sheaves/CoherentSheaves.jl b/src/AlgebraicGeometry/Schemes/Sheaves/CoherentSheaves.jl
index 7d545157679a..57f50b262b50 100644
--- a/src/AlgebraicGeometry/Schemes/Sheaves/CoherentSheaves.jl
+++ b/src/AlgebraicGeometry/Schemes/Sheaves/CoherentSheaves.jl
@@ -784,19 +784,6 @@ end
   return C
 end
 
-function inherit_decomposition_info!(C::Covering, X::AbsCoveredScheme)
-  D = default_covering(X)
-  OOX = OO(X)
-  if has_decomposition_info(D)
-    for U in patches(C)
-      V = __find_chart(U, D)
-      phi = OOX(V, U)
-      set_decomposition_info!(C, U, phi.(decomposition_info(D)[V]))
-    end
-  end
-  return C
-end
-
 @attr Covering function trivializing_covering(M::HomSheaf)
   X = scheme(M)
   OOX = OO(X)
diff --git a/src/AlgebraicGeometry/Schemes/Sheaves/IdealSheaves.jl b/src/AlgebraicGeometry/Schemes/Sheaves/IdealSheaves.jl
index b3a347593522..7628da425b3b 100644
--- a/src/AlgebraicGeometry/Schemes/Sheaves/IdealSheaves.jl
+++ b/src/AlgebraicGeometry/Schemes/Sheaves/IdealSheaves.jl
@@ -345,7 +345,6 @@ end
 end
   
 @attr Bool function has_dimension_leq_zero(I::Ideal)
-  is_one(I) && return true
   return dim(I) <= 0
 end
 
@@ -354,14 +353,13 @@ end
   P = base_ring(R)::MPolyRing
   J = ideal(P, numerator.(gens(I)))
   has_dimension_leq_zero(J) && return true
-  is_one(I) && return true
   return dim(I) <= 0
 end
 
 @attr Bool function has_dimension_leq_zero(I::MPolyQuoLocalizedIdeal)
   R = base_ring(I)
   P = base_ring(R)::MPolyRing
-  J = ideal(P, lifted_numerator.(gens(I)))
+  J = pre_saturated_ideal(pre_image_ideal(I))
   has_dimension_leq_zero(J) && return true
   is_one(I) && return true
   return dim(I) <= 0
@@ -562,9 +560,12 @@ function extend!(
 end
 
 function _iterative_saturation(I::Ideal, f::RingElem)
-  fac = factor(f)
+  return _iterative_saturation(I, typeof(f)[u for (u, _) in factor(f)])
+end
+
+function _iterative_saturation(I::Ideal, f::Vector{T}) where{T<:RingElem}
   R = base_ring(I)
-  for (u, k) in fac
+  for u in f
     I = saturation(I, ideal(R, u))
   end
   return I
diff --git a/test/AlgebraicGeometry/Schemes/CoveredScheme.jl b/test/AlgebraicGeometry/Schemes/CoveredScheme.jl
index 8cac4e68fda3..d7a7a37f39c4 100644
--- a/test/AlgebraicGeometry/Schemes/CoveredScheme.jl
+++ b/test/AlgebraicGeometry/Schemes/CoveredScheme.jl
@@ -250,7 +250,7 @@
     new_cov = Covering(append!(AbsAffineScheme[V1, V2], patches(orig_cov)[2:end]))
     Oscar.inherit_gluings!(new_cov, orig_cov)
     Oscar.inherit_decomposition_info!(X, new_cov, orig_cov=orig_cov)
-    @test Oscar.decomposition_info(new_cov)[V2] == [OO(V2)(x-1)]
+    @test Oscar.decomposition_info(new_cov)[V1] == [OO(V1)(x)]
   end
 
   @testset "fiber products of coverings" begin