Attempt for first round of fixes.

Author: HechtiDerLachs

Diff for: src/AlgebraicGeometry/Schemes/AffineSchemes/Morphisms/Methods.jl

@@ -478,9 +478,36 @@ 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::AbsAffineSchemeMor;
-    domain_map::AbsAffineSchemeMor=base_change(phi, domain(f))[2],
-    codomain_map::AbsAffineSchemeMor=base_change(phi, codomain(f))[2]
+    domain_map::Union{AbsAffineSchemeMor, Nothing} = nothing,
+    codomain_map::Union{AbsAffineSchemeMor, Nothing} = nothing
   )
+  # We need to cater for the case where `phi` is a natural inclusion. 
+  # In that case, we have the same `ambient_coordinate_ring` for domain and codomain
+  # and we need to make sure, its base change is performed only once.
+  if domain_map === nothing 
+    ambient_coordinate_map = nothing # initialize the variable
+    if codomain_map !== nothing && ambient_coordinate_ring(domain(f)) === ambient_coordinate_ring(codomain(f))
+      # The `ambient_coordinate_ring` is already determined by the map on the codomain
+      R = ambient_coordinate_ring(domain(f))
+      R_red = ambient_coordinate_ring(domain(codomain_map))
+      ambient_ring_map_domain = hom(R, R_red, phi, gens(R_red))
+    else
+      _, ambient_ring_map_domain = _change_base_ring(phi, ambient_coordinate_ring(domain(f)))
+    end
+    _, domain_map = base_change(phi, domain(f); ambient_ring_map=ambient_ring_map_domain)
+  end
+  if codomain_map === nothing 
+    ambient_ring_map_codomain = nothing # initialize the variable
+    if ambient_coordinate_ring(domain(f)) === ambient_coordinate_ring(codomain(f))
+      # The `ambient_ring` is already determined by the map on the domain
+      R = ambient_coordinate_ring(domain(f))
+      R_red = ambient_coordinate_ring(domain(domain_map))
+      ambient_ring_map_codomain = hom(R, R_red, phi, gens(R_red))
+    else
+      ambient_ring_map_codomain = _change_base_ring(phi, ambient_coordinate_ring(codomain(f)))
+    end
+    _, codomain_map = base_change(phi, codomain(f); ambient_ring_map=ambient_ring_map_codomain)
+  end
   X = domain(f)
   Y = codomain(f)
   XX = domain(domain_map)
@@ -503,20 +530,20 @@ function base_change(phi::Any, f::AbsAffineSchemeMor;
 end
 
 function base_change(phi::Any, f::ClosedEmbedding;
-    domain_map::AbsAffineSchemeMor=base_change(phi, domain(f))[2],
-    codomain_map::AbsAffineSchemeMor=base_change(phi, codomain(f))[2]
+    domain_map::Union{AbsAffineSchemeMor, Nothing} = nothing,
+    codomain_map::Union{AbsAffineSchemeMor, Nothing} = nothing
   )
-  @assert codomain(codomain_map) === codomain(f)
-  @assert codomain(domain_map) === domain(f)
+  codomain_map !== nothing && @req codomain(codomain_map) === codomain(f) "incompatible map"
+  domain_map !== nothing && @req codomain(domain_map) === domain(f) "incompatible map"
   g = underlying_morphism(f)
-  _, bc_g, _ = base_change(phi, g; domain_map, codomain_map)
+  domain_map, bc_g, codomain_map = base_change(phi, g; domain_map, codomain_map)
   I = image_ideal(f)
   @assert base_ring(I) === OO(codomain(f))
   @assert base_ring(I) === OO(codomain(f))
   #bc_I = ideal(OO(codomain(bc_g)), pullback(codomain_map).(gens(I)))
   bc_I = pullback(codomain_map)(I)
-  @assert domain(bc_g) === domain(domain_map)
-  @assert codomain(bc_g) === domain(codomain_map)
+  domain_map !== nothing && @req domain(bc_g) === domain(domain_map) "incompatible map"
+  codomain_map !== nothing && @req codomain(bc_g) === domain(codomain_map) "incompatible map"
   return domain_map, ClosedEmbedding(bc_g, bc_I; check=false), codomain_map
 end
 

Diff for: src/AlgebraicGeometry/Schemes/AffineSchemes/Objects/Methods.jl

@@ -412,45 +412,54 @@ 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::AbsAffineScheme)
-  kk = base_ring(X)
-  kk_red = parent(phi(zero(kk)))
+function base_change(
+    phi::Any, X::AbsAffineScheme;
+    ambient_ring_map::Map=_change_base_ring(phi, ambient_coordinate_ring(X))[2]
+  )
   R = OO(X)
-  R_red, Phi = _change_base_ring(phi, R)
+  R_red, Phi = _change_base_ring(phi, R; ambient_ring_map)
   Y = spec(R_red)
   return Y, morphism(Y, X, Phi; check=false)
 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); cached=false)
-  Phi = hom(R, P, phi, gens(P); check=false)
-  return P, Phi
+function _change_base_ring(
+    phi::Any, R::MPolyRing;
+    ambient_ring_map::Map=begin
+      K = coefficient_ring(R)
+      kk = parent(phi(zero(K)))
+      P, _ = polynomial_ring(kk, symbols(R); cached=false)
+      Phi = hom(R, P, phi, gens(P); check=false)
+      Phi
+    end
+  )
+  return codomain(ambient_ring_map), ambient_ring_map
 end
 
-function _change_base_ring(phi::Any, A::MPolyQuoRing)
-  R = base_ring(A)
+function _change_base_ring(
+    phi::Any, A::MPolyQuoRing;
+    ambient_ring_map::Map=_change_base_ring(phi, base_ring(A))[2]
+  )
   I = modulus(A)
-  P, Phi = _change_base_ring(phi, R)
-  I_red = ideal(P, Phi.(gens(I)))
+  P = codomain(ambient_ring_map)
+  I_red = ideal(P, ambient_ring_map.(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,
+function _change_base_ring(
+    phi::Any,
     W::MPolyLocRing{<:Any, <:Any, <:Any, <:Any,
-                    <:MPolyPowersOfElement}
+                    <:MPolyPowersOfElement};
+    ambient_ring_map::Map=_change_base_ring(phi, base_ring(W))[2]
   )
-  R = base_ring(W)
-  P, Phi = _change_base_ring(phi, R)
-  @assert _has_coefficient_map(Phi)
+  P = codomain(ambient_ring_map)
+  @assert _has_coefficient_map(ambient_ring_map)
   U = inverted_set(W)
-  U_red = MPolyPowersOfElement(P, Phi.(denominators(U)))
+  U_red = MPolyPowersOfElement(P, ambient_ring_map.(denominators(U)))
   W_red, loc_map = localization(P, U_red)
-  comp = hom(R, W_red, phi, gens(W_red); check=false)
+  comp = hom(base_ring(W), W_red, phi, gens(W_red); check=false)
   @assert _has_coefficient_map(comp)
   res_map = hom(W, W_red, comp, check=false)
   @assert _has_coefficient_map(res_map)
@@ -459,11 +468,11 @@ end
 
 function _change_base_ring(phi::Any,
     L::MPolyQuoLocRing{<:Any, <:Any, <:Any, <:Any,
-                       <:MPolyPowersOfElement}
+                       <:MPolyPowersOfElement};
+    ambient_ring_map::Map=_change_base_ring(phi, base_ring(L))[2]
   )
-  R = base_ring(L)
   W = localized_ring(L)
-  W_red, Phi_W = _change_base_ring(phi, W)
+  W_red, Phi_W = _change_base_ring(phi, W; ambient_ring_map)
   I = modulus(L)
   I_red = ideal(W_red, Phi_W.(gens(I)))
   L_red, pr = quo(W_red, I_red)

Diff for: test/AlgebraicGeometry/Schemes/AffineSchemes.jl

@@ -267,20 +267,28 @@ end
   P = OO(IA2)
   x, y = gens(P)
 
-  X = subscheme(IA2, x^2 + y^2)
+  X, inc_X = sub(IA2, x^2 + y^2)
 
   U = hypersurface_complement(IA2, x)
+  inc_U = inclusion_morphism(U, IA2)
 
   V = hypersurface_complement(X, x)
+  inc_V = inclusion_morphism(V, X)
 
   kk, pr = quo(ZZ, 5)
   IA2_red, phi1 = base_change(pr, IA2)
-  X_red, phi2 = base_change(pr, X)
-  U_red, phi3 = base_change(pr, U)
-  V_red, phi4 = base_change(pr, V)
+  red_X, phi2, _ = base_change(pr, inc_X; codomain_map=phi1)
+  X_red = domain(red_X)
+  @test ambient_coordinate_ring(IA2_red) === ambient_coordinate_ring(X_red)
+  red_U, phi3, _ = base_change(pr, inc_U; codomain_map=phi1)
+  U_red = domain(red_U)
+  @test ambient_coordinate_ring(IA2_red) === ambient_coordinate_ring(U_red)
+  red_V, phi4, _ = base_change(pr, inc_V; codomain_map=red_X)
+  V_red = domain(red_V)
+  @test ambient_coordinate_ring(IA2_red) === ambient_coordinate_ring(V_red)
 
   m1 = compose(inclusion_morphism(V_red, IA2_red), phi1);
-  m2 = compose(phi4, inclusion_morphism(V, IA2));
+  m2 = compose(red_V, inclusion_morphism(V, IA2));
   @test m1 == m2
 
   # Testing morphisms