diff --git a/experimental/Schemes/src/elliptic_surface.jl b/experimental/Schemes/src/elliptic_surface.jl index e9144342748c..889966615e45 100644 --- a/experimental/Schemes/src/elliptic_surface.jl +++ b/experimental/Schemes/src/elliptic_surface.jl @@ -291,7 +291,7 @@ function _algebraic_lattice(X::EllipticSurface, mwl_basis::Vector{<:EllipticCurv tors = [section(X, h) for h in mordell_weil_torsion(X)] torsV = QQMatrix[] for T in tors - @vprint :EllipticSurface 2 "computing basis representation of $(T)\n" + @vprint :EllipticSurface 2 "computing basis representation of torsion point $(T)\n" vT = zero_matrix(QQ, 1, n) for i in 1:r if i== 2 @@ -851,32 +851,13 @@ function weierstrass_contraction_iterative(Y::EllipticSurface) return piY end -# global divisors0 = [strict_transform(pr_X1, e) for e in divisors0] -#exceptionals_res = [pullback(inc_Y0)(e) for e in exceptionals] -@doc raw""" - _trivial_lattice(S::EllipticSurface) - -Internal function. Returns a list consisting of: -- basis of the trivial lattice -- gram matrix -- fiber_components without multiplicities -""" -@attr Any function _trivial_lattice(S::EllipticSurface) - #= - inc_Y = S.inc_Y - X = codomain(inc_Y) - exceptionals_res = [pullback(inc_Y0)(e) for e in exceptionals] - ExWeil = WeilDivisor.(exceptional_res) - tmp = [] - ExWeil = reduce(append!, [components(i) for i in ExWeil], init= tmp) - =# - W = weierstrass_model(S) - d = numerator(discriminant(generic_fiber(S))) - j = j_invariant(generic_fiber(S)) +function _reducible_fibers_disc(X::EllipticSurface; sort::Bool=true) + E = generic_fiber(X) + j = j_invariant(E) + d = numerator(discriminant(E)) kt = parent(d) k = coefficient_ring(kt) - # find the reducible fibers - sing = elem_type(k)[] + sing = Vector{elem_type(k)}[] for (p,v) in factor(d) if v == 1 continue @@ -890,48 +871,76 @@ Internal function. Returns a list consisting of: if v == 2 # not a type II fiber if j!=0 - push!(sing, rt) + push!(sing, [rt,k(1)]) end end if v > 2 - push!(sing, rt) + push!(sing, [rt,k(1)]) end end - # the reducible fibers are over the points in sing - # and possibly the point at infinity - f = [[k.([i,1]), fiber_components(S,[i,k(1)])] for i in sing] - if degree(d) <= 12*euler_characteristic(S) - 2 - pt = k.([1, 0]) - push!(f, [pt, fiber_components(S, pt)]) - end - - O = zero_section(S) - pt0, F = fiber(S) - set_attribute!(components(O)[1], :_self_intersection, -euler_characteristic(S)) - - - basisT = [F, O] - - grams = [ZZ[0 1;1 -euler_characteristic(S)]] - fiber_componentsS = [] - for (pt, ft) in f - @vprint :EllipticSurface 2 "normalizing fiber: over $pt \n" - Ft0 = standardize_fiber(S, ft) - @vprint :EllipticSurface 2 "$(Ft0[1]) \n" - append!(basisT , Ft0[3][2:end]) - push!(grams,Ft0[4][2:end,2:end]) - push!(fiber_componentsS, vcat([pt], collect(Ft0))) - end - G = block_diagonal_matrix(grams) - # make way for some more pretty printing - for (pt,root_type,_,comp) in fiber_componentsS - for (i,I) in enumerate(comp) - name = string(root_type[1], root_type[2]) - set_attribute!(components(I)[1], :name, string("Component ", name, "_", i-1," of fiber over ", Tuple(pt))) - set_attribute!(components(I)[1], :_self_intersection, -2) + if sort + sort!(sing, by=x->by_total_order(x[1])) + end + # fiber over infinity is always last (if it is there) + if degree(d) <= 12*euler_characteristic(X) - 2 + push!(sing, k.([1, 0])) + end + return sing +end + +function by_total_order(x::FqFieldElem) + return [lift(ZZ, i) for i in absolute_coordinates(x)] +end + +by_total_order(x::QQFieldElem) = x + +function by_total_order(x::NumFieldElem) + return absolute_coordinates(x) +end + +# global divisors0 = [strict_transform(pr_X1, e) for e in divisors0] +# exceptionals_res = [pullback(inc_Y0)(e) for e in exceptionals] +@doc raw""" + _trivial_lattice(S::EllipticSurface; reducible_singular_fibers_in_PP1=_reducible_fibers_disc(S)) + +Internal function. Returns a list consisting of: +- basis of the trivial lattice +- gram matrix +- fiber_components without multiplicities + +The keyword argument `reducible_singular_fibers_in_PP1` must be a list of vectors of length `2` over +the base field representing the points in projective space over which there are reducible fibers. +Specify it to force this ordering of the basis vectors of the ambient space of the `algebraic_lattice` +""" +function _trivial_lattice(S::EllipticSurface; reducible_singular_fibers_in_PP1=_reducible_fibers_disc(S)) + get_attribute!(S, :_trivial_lattice) do + O = zero_section(S) + pt0, F = fiber(S) + set_attribute!(components(O)[1], :_self_intersection, -euler_characteristic(S)) + basisT = [F, O] + grams = [ZZ[0 1;1 -euler_characteristic(S)]] + sing = reducible_singular_fibers_in_PP1 + f = [[pt, fiber_components(S,pt)] for pt in sing] + fiber_componentsS = [] + for (pt, ft) in f + @vprint :EllipticSurface 2 "normalizing fiber: over $pt \n" + Ft0 = standardize_fiber(S, ft) + @vprint :EllipticSurface 2 "$(Ft0[1]) \n" + append!(basisT , Ft0[3][2:end]) + push!(grams,Ft0[4][2:end,2:end]) + push!(fiber_componentsS, vcat([pt], collect(Ft0))) end + G = block_diagonal_matrix(grams) + # make way for some more pretty printing + for (pt,root_type,_,comp) in fiber_componentsS + for (i,I) in enumerate(comp) + name = string(root_type[1], root_type[2]) + set_attribute!(components(I)[1], :name, string("Component ", name, "_", i-1," of fiber over ", Tuple(pt))) + set_attribute!(components(I)[1], :_self_intersection, -2) + end + end + return basisT, G, fiber_componentsS end - return basisT, G, fiber_componentsS end @doc raw""" @@ -1230,6 +1239,7 @@ function _section(X::EllipticSurface, P::EllipticCurvePoint) set_attribute!(W, :is_prime=>true) I = first(components(W)) set_attribute!(I, :is_prime=>true) + set_attribute!(W, :point=>P) return W end @@ -1491,35 +1501,10 @@ function horizontal_decomposition(X::EllipticSurface, F::Vector{QQFieldElem}) rk_triv = nrows(trivial_lattice(X)[2]) n = rank(NS) @assert degree(NS) == rank(NS) - P0 = sum([ZZ(F[i])*X.MWL[i-rk_triv] for i in (rk_triv+1):n], init = E([0,1,0])) - P0_div = section(X, P0) - @vprint :EllipticSurface 2 "Computing basis representation of $(P0)\n" - p0 = basis_representation(X, P0_div) # this could be done from theory alone - F1 = F - p0 # should be contained in the QQ-trivial-lattice - if all(isone(denominator(i)) for i in F1) - # no torsion - P = P0 - P_div = P0_div - F2 = F1 - else - found = false - for (i,(T, tor)) in enumerate(tors) - d = F1 - _vec(tor) - if all(isone(denominator(i)) for i in d) - found = true - T0 = mordell_weil_torsion(X)[i] - P = P0 + T0 - break - end - end - @assert found - P_div = section(X, P) - p = basis_representation(X, P_div) - F2 = F - p - @assert all( isone(denominator(i)) for i in F2) - end + p, P = _vertical_part(X,F) + D = section(X, P) + F2 = F - p @vprint :EllipticSurface 4 "F2 = $(F2)\n" - D = P_div D = D + ZZ(F2[2])*zero_section(X) D1 = D F2 = ZZ.(F2); F2[2] = 0 @@ -2880,4 +2865,95 @@ function _prepare_section(D::AbsWeilDivisor{<:EllipticSurface}) return weil_divisor(I) end - +# internal method used for two neighbor steps +# in the horizontal_decomposition +function _vertical_part(X::EllipticSurface, v::QQMatrix) + @req nrows(v)==1 "not a row vector" + _,tors, NS = algebraic_lattice(X) + E = generic_fiber(X) + @req ncols(v)==degree(NS) "vector of wrong size $(ncols(v))" + @req v in NS "not an element of the lattice" + mwl_rank = length(X.MWL) + rk_triv = rank(NS)-mwl_rank + n = rank(NS) + P = sum([ZZ(v[1,i])*X.MWL[i-rk_triv] for i in (rk_triv+1):n], init = E([0,1,0])) + p = zero_matrix(QQ, 1, rank(NS)) # the section part + p[1,end-mwl_rank+1:end] = v[1,end-mwl_rank+1:end] + p[1,2] = 1 - sum(p) # assert p.F = 1 by adding a multiple of the zero section O + + # P meets exactly one fiber component per fiber + # and that one must be simple, it can be the one meeting O or not + # assert this by adding fiber components under the additional condition that p stays in the algebraic lattice + simples = [] + E = identity_matrix(QQ,rank(NS)) + z = zero_matrix(QQ,1, rank(NS)) + r = 2 + for fiber in _trivial_lattice(X)[3] + fiber_type = fiber[2] + fiber_rk = fiber_type[2] + h = highest_root(fiber_type...) + simple_indices = [r+i for i in 1:ncols(h) if isone(h[1,i])] + simple_or_zero = [E[i:i,:] for i in simple_indices] + push!(simple_or_zero, z) + push!(simples,simple_or_zero) + r += fiber_rk + end + G = gram_matrix(ambient_space(NS)) + pG = (p*G)[1:1,3:r] + T = Tuple(simples) + GF = G[3:r,3:r] + candidates = QQMatrix[] + for s in Base.Iterators.ProductIterator(T) + g = sum(s)[:,3:r] + y = (g - pG) + xx = solve(GF,y;side=:left) + x = zero_matrix(QQ,1, rank(NS)) + x[:,3:r] = xx + if x in NS + push!(candidates,p+x) + end + end + @assert length(candidates)>0 + # Select the candidate congruent to v modulo Triv + mwg = _mordell_weil_group(X) + vmwg = mwg(vec(collect(v))) + candidates2 = [mwg(vec(collect(x))) for x in candidates] + i = findfirst(==(vmwg), candidates2) + t = mwg(vec(collect(p - candidates[i]))) + mwl_tors_gens = [mwg(vec(collect(i[2]))) for i in tors] + ag = abelian_group(zeros(ZZ,length(tors))) + mwlAb = abelian_group(mwg) + phi = hom(ag, mwlAb, mwlAb.(mwl_tors_gens)) + a = preimage(phi, mwlAb(t)) + for i in 1:ngens(ag) + P += a[i]*get_attribute(tors[i][1],:point) + end + + p = candidates[i] + k = (p*G*transpose(p))[1,1] + # assert p^2 = -2 + p[1,1] = -k/2-1 + V = ambient_space(NS) + @hassert :EllipticSurface 1 inner_product(V, p, p)[1,1]== -2 + @hassert :EllipticSurface 1 mwg(vec(collect(p))) == mwg(vec(collect(p))) + @hassert :EllipticSurface 3 basis_representation(X,section(X,P))==vec(collect(p)) + return p, P +end + +function _vertical_part(X::EllipticSurface, v::Vector{QQFieldElem}) + vv = matrix(QQ,1,length(v),v) + p, P = _vertical_part(X,vv) + pp = vec(collect(p)) + return pp, P +end + +# TODO: Instead return an abelian group A and two maps. +# algebraic_lattice -> A +# A -> MWL= E(k(t)) +function _mordell_weil_group(X) + N = algebraic_lattice(X)[3] + V = ambient_space(N) + t = nrows(trivial_lattice(X)[2]) + Triv = lattice(V, identity_matrix(QQ,dim(V))[1:t,:]) + return torsion_quadratic_module(N, Triv;modulus=1, modulus_qf=1, check=false) +end diff --git a/src/AlgebraicGeometry/Surfaces/K3Auto.jl b/src/AlgebraicGeometry/Surfaces/K3Auto.jl index ead5e1da989a..da5b04533dee 100644 --- a/src/AlgebraicGeometry/Surfaces/K3Auto.jl +++ b/src/AlgebraicGeometry/Surfaces/K3Auto.jl @@ -625,9 +625,11 @@ function separating_hyperplanes(gram::QQMatrix, v::QQMatrix, h::QQMatrix, d) gramW = gram_matrix(W) s = solve(bW, v*prW; side = :left) * gramW Q = gramW + transpose(s)*s*ch*cv^-2 + @vprint :K3Auto 5 Q LQ = integer_lattice(gram=-Q*denominator(Q)) + S = QQMatrix[] h = change_base_ring(QQ, h) diff --git a/test/AlgebraicGeometry/Schemes/elliptic_surface.jl b/test/AlgebraicGeometry/Schemes/elliptic_surface.jl index 844b319a3960..1d38d185653f 100644 --- a/test/AlgebraicGeometry/Schemes/elliptic_surface.jl +++ b/test/AlgebraicGeometry/Schemes/elliptic_surface.jl @@ -121,8 +121,6 @@ end end -#= -# These tests are disabled, because they are dependent on factorisation order... @testset "two neighbor steps" begin K = GF(7) Kt, t = polynomial_ring(K, :t) @@ -144,11 +142,18 @@ end [2 1 -1 -2 -3 -2 -1 0 -2 -1 -1 -2 -2 -2 -2 -2 -2 -1 0 1], [2 1 0 0 0 0 0 0 0 -2 -2 -4 -4 -4 -4 -3 -2 -1 0 1] ]] + NS = algebraic_lattice(X2)[3] + if !(fibers_in_X2[4] in NS) + # account for the order of the basis not being unique + f = fibers_in_X2[4] + f[10:11] = reverse(f[10:11]) + fibers_in_X2[4] = f + end g4,_ = two_neighbor_step(X2, fibers_in_X2[4]) # this should be the 2-torsion case g5,_ = two_neighbor_step(X2, fibers_in_X2[5]) # the non-torsion case g6,_ = two_neighbor_step(X2, fibers_in_X2[6]) # the non-torsion case end -=# + #= # The following tests take roughly 10 minutes which is too much for the CI testsuite. diff --git a/test/book/specialized/brandhorst-zach-fibration-hopping/vinberg_2.jlcon b/test/book/specialized/brandhorst-zach-fibration-hopping/vinberg_2.jlcon index 9555ea4be50a..e36b701630ba 100644 --- a/test/book/specialized/brandhorst-zach-fibration-hopping/vinberg_2.jlcon +++ b/test/book/specialized/brandhorst-zach-fibration-hopping/vinberg_2.jlcon @@ -75,8 +75,8 @@ julia> basisNSY1, gramTriv = trivial_lattice(Y1); julia> [(i[1],i[2]) for i in reducible_fibers(Y1)] 3-element Vector{Tuple{Vector{QQFieldElem}, Tuple{Symbol, Int64}}}: - ([1, 1], (:A, 2)) ([0, 1], (:E, 8)) + ([1, 1], (:A, 2)) ([1, 0], (:E, 8)) julia> basisNSY1, _, NSY1 = algebraic_lattice(Y1); @@ -85,8 +85,6 @@ julia> basisNSY1 20-element Vector{Any}: Fiber over (2, 1) section: (0 : 1 : 0) - component A2_1 of fiber over (1, 1) - component A2_2 of fiber over (1, 1) component E8_1 of fiber over (0, 1) component E8_2 of fiber over (0, 1) component E8_3 of fiber over (0, 1) @@ -95,6 +93,8 @@ julia> basisNSY1 component E8_6 of fiber over (0, 1) component E8_7 of fiber over (0, 1) component E8_8 of fiber over (0, 1) + component A2_1 of fiber over (1, 1) + component A2_2 of fiber over (1, 1) component E8_1 of fiber over (1, 0) component E8_2 of fiber over (1, 0) component E8_3 of fiber over (1, 0) @@ -112,7 +112,7 @@ given as the formal sum of 1 * sheaf of ideals julia> b, I = Oscar._is_equal_up_to_permutation_with_permutation(gram_matrix(NS), gram_matrix(NSY1)) -(true, [1, 2, 19, 20, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18]) +(true, [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 19, 20, 11, 12, 13, 14, 15, 16, 17, 18]) julia> @assert gram_matrix(NSY1) == gram_matrix(NS)[I,I]