Reduction mod p for schemes (#2387)

* Small fix in the localizations.

* Implement base change for affine schemes of the common types.

* Base change for morphisms of affine schemes.

* Base change for PrincipalOpenSubsets and SpecOpen.

* Add base change for SimpleGlueings.

* Add base change for CoveredSchemes.

* Add base change for morphisms of CoveredSchemes.

docs/src/AlgebraicGeometry/Schemes/GeneralSchemes.md

@@ -13,3 +13,12 @@ Morphisms of schemes shall be derived from the abstract type
 ```@docs
     SchemeMor{DomainType, CodomainType, MorphismType, BaseMorType}
 ```
+
+## Change of base
+```@docs
+    base_change(phi::Any, X::Scheme)
+    base_change(phi::Any, f::SchemeMor;
+        domain_map::AbsSchemeMor, codomain_map::AbsSchemeMor
+      )
+```
+

src/AlgebraicGeometry/Schemes/AffineSchemes/Morphisms/Methods.jl

@@ -119,3 +119,53 @@ function Base.show(io::IO, f::AbsSpecMor)
   print(io, "$(pullback(f)(last(x)))")
 end
 
+########################################################################
+# (6) Base change
+########################################################################
+
+@doc raw"""
+    base_change(phi::Any, f::AbsSpecMor)
+        domain_map::AbsSpecMor=base_change(phi, domain(f))[2],
+        codomain_map::AbsSpecMor=base_change(phi, codomain(f))[2]
+      )
+
+For a morphism ``f : X → Y`` between two schemes over a `base_ring` ``𝕜`` 
+and a ring homomorphism ``φ : 𝕜 → 𝕂`` this returns a triple 
+`(b₁, F, b₂)` consisting of the maps in the commutative diagram 
+```
+             f
+    X        →    Y
+    ↑ b₁          ↑ b₂
+  X×ₖSpec(𝕂) → Y×ₖSpec(𝕂)
+             F
+
+The optional arguments `domain_map` and `codomain_map` can be used 
+to specify the morphisms `b₁` and `b₂`, respectively. 
+```
+"""
+function base_change(phi::Any, f::AbsSpecMor; 
+    domain_map::AbsSpecMor=base_change(phi, domain(f))[2],
+    codomain_map::AbsSpecMor=base_change(phi, codomain(f))[2]
+  )
+  X = domain(f)
+  Y = codomain(f)
+  XX = domain(domain_map)
+  YY = domain(codomain_map)
+  pbf = pullback(f)
+  pb1 = pullback(domain_map)
+  pb2 = pullback(codomain_map)
+
+  R = OO(Y)
+  S = OO(X)
+  RR = OO(YY)
+  SS = OO(XX)
+
+  img_gens = [pb1(pbf(x)) for x in gens(R)]
+  # For the pullback of F no explicit coeff_map is necessary anymore 
+  # since both rings in domain and codomain have the same (extended/reduced)
+  # coefficient ring by now.
+  pbF = hom(RR, SS, img_gens, check=true) # TODO: Set to false after testing
+
+  return domain_map, SpecMor(XX, YY, pbF, check=true), codomain_map # TODO: Set to false after testing
+end
+

src/AlgebraicGeometry/Schemes/AffineSchemes/Objects/Attributes.jl

@@ -157,10 +157,14 @@ function ambient_space(X::AbsSpec{BRT, RT}) where {BRT, RT<:MPolyRing}
   return X
 end
 
-@attr function ambient_space(X::Spec{BRT,RT}) where {BRT, RT <: Union{MPolyQuoRing,MPolyLocRing,MPolyQuoLocRing}}
+@attr function ambient_space(X::Spec{BRT,RT}) where {BRT<:Field, RT <: Union{MPolyQuoRing,MPolyLocRing,MPolyQuoLocRing}}
   return affine_variety(Spec(ambient_coordinate_ring(X)), check=false)
 end
 
+@attr function ambient_space(X::Spec{BRT,RT}) where {BRT, RT <: Union{MPolyQuoRing,MPolyLocRing,MPolyQuoLocRing}}
+  return Spec(ambient_coordinate_ring(X))
+end
+
 @attr function ambient_space(X::AbsSpec{BRT,RT}) where {BRT, RT <: Union{MPolyQuoRing,MPolyLocRing,MPolyQuoLocRing}}
   return ambient_space(underlying_scheme(X))
 end

src/AlgebraicGeometry/Schemes/AffineSchemes/Objects/Methods.jl

@@ -199,6 +199,67 @@ function components(X::AbsSpec)
   return result
 end
 
+########################################################################
+# Base change and reduction modulo p
+########################################################################
+
+@doc raw"""
+    base_change(phi::Any, X::AbsSpec)
+
+For an affine scheme `X` over a `base_ring` ``𝕜`` and a morphism 
+``φ : 𝕜 → 𝕂`` this computes ``Y = X × Spec(𝕂)`` and returns a pair 
+`(Y, psi)` where `psi` is the canonical map ``Y → X``.
+"""
+function base_change(phi::Any, X::AbsSpec)
+  kk = base_ring(X)
+  kk_red = parent(phi(zero(kk)))
+  R = OO(X)
+  R_red, Phi = _change_base_ring(phi, R)
+  Y = Spec(R_red)
+  return Y, SpecMor(Y, X, Phi)
+end
+
+### Some helper functions
+function _change_base_ring(phi::Any, R::MPolyRing)
+  K = coefficient_ring(R)
+  kk = parent(phi(zero(K)))
+  P, _ = polynomial_ring(kk, symbols(R))
+  Phi = hom(R, P, phi, gens(P))
+  return P, Phi
+end
 
+function _change_base_ring(phi::Any, A::MPolyQuoRing)
+  R = base_ring(A)
+  I = modulus(A)
+  P, Phi = _change_base_ring(phi, R)
+  I_red = ideal(P, Phi.(gens(I)))
+  Q, pr = quo(P, I_red)
+  Phi_bar = hom(A, Q, phi, gens(Q), check=false)
+  return Q, Phi_bar
+end
 
+function _change_base_ring(phi::Any, 
+    W::MPolyLocRing{<:Any, <:Any, <:Any, <:Any, 
+                    <:MPolyPowersOfElement}
+  )
+  R = base_ring(W)
+  P, Phi = _change_base_ring(phi, R)
+  U = inverted_set(W)
+  U_red = MPolyPowersOfElement(P, Phi.(denominators(U)))
+  W_red, loc_map = localization(P, U_red)
+  return W_red, hom(W, W_red, compose(Phi, loc_map), check=false)
+end
 
+function _change_base_ring(phi::Any, 
+    L::MPolyQuoLocRing{<:Any, <:Any, <:Any, <:Any, 
+                       <:MPolyPowersOfElement}
+  )
+  R = base_ring(L)
+  W = localized_ring(L)
+  W_red, Phi_W = _change_base_ring(phi, W)
+  I = modulus(L)
+  I_red = ideal(W_red, Phi_W.(gens(I)))
+  L_red, pr = quo(W_red, I_red)
+  res = compose(restricted_map(Phi_W), pr)
+  return L_red, hom(L, L_red, res, check=false)
+end

src/AlgebraicGeometry/Schemes/CoveredSchemes/Morphisms/Methods.jl

@@ -65,3 +65,33 @@ function maps_with_given_codomain(f::AbsCoveredSchemeMorphism, V::AbsSpec)
   return result
 end
 
+########################################################################
+# Comparison
+########################################################################
+function ==(f::AbsCoveredSchemeMorphism, g::AbsCoveredSchemeMorphism)
+  domain(f) === domain(g) || return false
+  codomain(f) === codomain(g) || return false
+  f_cov = covering_morphism(f)
+  g_cov = covering_morphism(g)
+  domain(f_cov) === domain(g_cov) || error("comparison across refinements not implemented")
+  codomain(f_cov) === codomain(g_cov) || error("comparison across refinements not implemented")
+  return all(U->(f_cov[U] == g_cov[U]), patches(domain(f_cov)))
+end
+
+########################################################################
+# Base change
+########################################################################
+function base_change(phi::Any, f::AbsCoveredSchemeMorphism;
+    domain_map::AbsCoveredSchemeMorphism=base_change(phi, domain(f))[2],
+    codomain_map::AbsCoveredSchemeMorphism=base_change(phi, codomain(f))[2]
+  )
+  f_cov = covering_morphism(f)
+  dom_cov = covering_morphism(domain_map)
+  cod_cov = covering_morphism(codomain_map)
+  _, ff_cov_map, _ = base_change(phi, f_cov, domain_map=dom_cov, codomain_map=cod_cov)
+  X = domain(f)
+  Y = codomain(f)
+  XX = domain(domain_map)
+  YY = domain(codomain_map)
+  return domain_map, CoveredSchemeMorphism(XX, YY, ff_cov_map, check=true), codomain_map #TODO: Set to false after testing.
+end

src/AlgebraicGeometry/Schemes/CoveredSchemes/Objects/Methods.jl

@@ -38,3 +38,13 @@ function Base.show(io::IO, X::AbsCoveredScheme)
   end
   print(io, "covered scheme with $(npatches(default_covering(X))) affine patches in its default covering")
 end
+
+########################################################################
+# Base change
+########################################################################
+function base_change(phi::Any, X::AbsCoveredScheme)
+  C = default_covering(X)
+  CC, f_CC = base_change(phi, C)
+  XX = CoveredScheme(CC)
+  return XX, CoveredSchemeMorphism(XX, X, f_CC)
+end

src/AlgebraicGeometry/Schemes/Covering/Morphisms/Methods.jl

@@ -49,3 +49,27 @@ function simplify(C::Covering)
   return Cnew, i_cov_mor, j_cov_mor
 end
 
+########################################################################
+# Base change
+########################################################################
+function base_change(phi::Any, f::CoveringMorphism;
+    domain_map::CoveringMorphism=base_change(phi, domain(f))[2],
+    codomain_map::CoveringMorphism=base_change(phi, codomain(f))[2]
+  )
+  D = domain(f)
+  C = codomain(f)
+  DD = domain(domain_map)
+  CC = domain(codomain_map)
+  mor_dict = IdDict{AbsSpec, AbsSpecMor}()
+  for UU in patches(DD)
+    U = codomain(domain_map[UU])
+    V = codomain(f[U])
+    g_V = first(maps_with_given_codomain(codomain_map, V)) # The result must be unique as it arises 
+                                                           # from a base change.
+    _, ff, _ = base_change(phi, f[U], domain_map=domain_map[UU], codomain_map=g_V)
+    mor_dict[UU] = ff
+  end
+
+  return domain_map, CoveringMorphism(DD, CC, mor_dict, check=true), codomain_map # TODO: Set to false after testing.
+end
+

src/AlgebraicGeometry/Schemes/Covering/Objects/Methods.jl

@@ -324,4 +324,29 @@ function is_refinement(D::Covering, C::Covering)
   return true, CoveringMorphism(D, C, map_dict, check=false)
 end
 
+########################################################################
+# Base change
+########################################################################
+function base_change(phi::Any, C::Covering)
+  U = patches(C)
+  patch_change = [base_change(phi, V) for V in U]
+
+  glueing_dict = IdDict{Tuple{AbsSpec, AbsSpec}, AbsGlueing}()
+  for i in 1:length(U)
+    (A, map_A) = patch_change[i]
+    for j in 1:length(U)
+      (B, map_B) = patch_change[j]
+      G = C[U[i], U[j]] # the glueing
+      GG = base_change(phi, G, patch_change1=map_A, patch_change2=map_B)
+      glueing_dict[A, B] = GG
+    end
+  end
+  CC = Covering([V for (V, _) in patch_change], glueing_dict)
 
+  mor_dict = IdDict{AbsSpec, AbsSpecMor}()
+  for (V, phi) in patch_change
+    mor_dict[V] = phi
+  end
+
+  return CC, CoveringMorphism(CC, C, mor_dict, check=true) # TODO: Set to false after testing
+end

src/AlgebraicGeometry/Schemes/Glueing/Methods.jl

@@ -124,3 +124,48 @@ function ==(G::AbsGlueing, H::AbsGlueing)
   return true
 end
 
+########################################################################
+# Base change
+########################################################################
+struct BaseChangeGlueingData{T1, T2}
+  phi::T1
+  G::T2
+  patch_change1::AbsSpecMor
+  patch_change2::AbsSpecMor
+end
+
+function _compute_glueing_base_change(gd::BaseChangeGlueingData)
+  # extraction of the glueing data
+  G = gd.G
+  pc1 = gd.patch_change1
+  pc2 = gd.patch_change2
+  phi = gd.phi
+
+  # computation of the new glueing
+  (X, Y) = patches(G)
+  (U, V) = glueing_domains(G)
+  (f, g) = glueing_morphisms(G)
+
+  XX = domain(pc1)
+  YY = domain(pc2)
+
+  UU, map_U = base_change(phi, U, ambient_map=pc1)
+  VV, map_V = base_change(phi, V, ambient_map=pc2)
+
+  # TODO: The following will not yet work for glueings along SpecOpens.
+  U isa PrincipalOpenSubset && V isa PrincipalOpenSubset || error("base change not implemented for glueings along SpecOpens")
+
+  _, ff, _ = base_change(phi, f, domain_map=map_U, codomain_map=map_V)
+  _, gg, _ = base_change(phi, g, domain_map=map_V, codomain_map=map_U)
+
+  return Glueing(XX, YY, ff, gg)
+end
+
+function base_change(phi::Any, G::AbsGlueing;
+    patch_change1::AbsSpecMor=base_change(phi, glueing_domains(G)[1])[2], # The base change morphism for 
+    patch_change2::AbsSpecMor=base_change(phi, glueing_domains(G)[2])[2]  # the two glueing patches
+  )
+  gd = BaseChangeGlueingData{typeof(phi), typeof(G)}(phi, G, patch_change1, patch_change2)
+  return LazyGlueing(domain(patch_change1), domain(patch_change2), _compute_glueing_base_change, gd)
+end
+

src/AlgebraicGeometry/Schemes/Methods.jl

@@ -0,0 +1,36 @@
+@doc raw"""
+    base_change(phi::Any, X::Scheme)
+
+For a `Scheme` ``X`` over a `base_ring` ``𝕜`` and a map ``φ : 𝕜 → R`` 
+we compute ``X' = X ×ₖ Spec(R)`` and return a pair `(X', f)` where 
+``f : X' → X`` is the canonical morphism.
+
+!!! note
+    We do not restrict `phi` to be a `Hecke.Map` so that one can also use coercion, anonymous functions, etc. 
+"""
+function base_change(phi::Any, X::Scheme)
+  error("base_change not implemented for input of type $(typeof(X))")
+end
+
+@doc raw"""
+    base_change(phi::Any, f::SchemeMor;
+        domain_map::SchemeMor, codomain_map::SchemeMor
+      )
+
+For a morphism ``f : X → Y`` with both ``X`` and ``Y`` defined over a 
+`base_ring` ``𝕜`` and a map ``φ : 𝕜 → R`` return a triple `(a, F, b)` 
+where ``a : X' → X`` is the morphism from `base_change(phi, X)`, 
+``b : Y' → Y`` the one for ``Y``, and ``F : X' → Y'`` the induced 
+morphism on those fiber products.
+
+!!! note
+    We do not restrict `phi` to be a `Hecke.Map` so that one can also use coercion, anonymous functions, etc. 
+
+!!! note 
+    The morphisms ``a`` and ``b`` can be passed as the optional arguments `domain_map` and `codomain_map`, respectively. 
+"""
+function base_change(phi::Any, f::SchemeMor;
+    domain_map::SchemeMor, codomain_map::SchemeMor
+  )
+  error("base_change not implemented for input of type $(typeof(f))")
+end

src/AlgebraicGeometry/Schemes/PrincipalOpenSubset/Objects/Methods.jl

@@ -39,3 +39,17 @@ function generic_fraction(a::MPolyQuoLocRingElem, U::PrincipalOpenSubset)
   return lifted_numerator(a)//lifted_denominator(a)
 end
 
+########################################################################
+# Base change
+########################################################################
+
+function base_change(phi::Any, U::PrincipalOpenSubset;
+    ambient_map::AbsSpecMor=base_change(phi, ambient_scheme(U))[2] # the base change on the ambient scheme
+  )
+  Y = domain(ambient_map)
+  pbf = pullback(ambient_map)
+  h = pbf(complement_equation(U))
+  UU = PrincipalOpenSubset(Y, h)
+  return UU, restrict(ambient_map, UU, U, check=true) # TODO: Set to false after testing
+end
+

src/AlgebraicGeometry/Schemes/ProjectiveSchemes/Objects/Attributes.jl

@@ -291,7 +291,7 @@ end
 
 @attr function affine_cone(
     P::AbsProjectiveScheme{RT, <:MPolyQuoRing}
-  ) where {RT<:Field}
+  ) where {RT<:Union{Field, ZZRing}}
   S = homogeneous_coordinate_ring(P)
   PS = base_ring(S)
   PP = forget_grading(PS) # the ungraded polynomial ring
@@ -305,7 +305,7 @@ end
 
 @attr function affine_cone(
     P::AbsProjectiveScheme{RT, <:MPolyDecRing}
-  ) where {RT<:Field}
+  ) where {RT<:Union{Field, ZZRing}}
   S = homogeneous_coordinate_ring(P)
   PP = forget_grading(S) # the ungraded polynomial ring
   phi = hom(S, PP, gens(PP))

src/AlgebraicGeometry/Schemes/SpecOpen/Objects/Methods.jl

@@ -144,3 +144,16 @@ function Base.show(io::IO, U::SpecOpen)
   print(io, "complement of zero locus of $(complement_equations(U)) in $(ambient_scheme(U))")
 end
 
+########################################################################
+# Base change
+########################################################################
+function base_change(phi::Any, U::SpecOpen;
+    ambient_map::AbsSpecMor=base_change(phi, ambient_scheme(U))[2] # the base change on the ambient scheme
+  )
+  Y = domain(ambient_map)
+  pbf = pullback(ambient_map)
+  h = pbf.(complement_equations(U))
+  UU = SpecOpen(Y, h)
+  return UU, restrict(ambient_map, UU, U, check=true) # TODO: Set to false after testing
+end
+