// Auxiliary functions used to deal with 96a1 in section7.magma // ========================================================================== // Tom Fisher's functions for twists of X(11). See // [Fi] Tom Fisher, On families of 7- and 11-congruent elliptic curves, // LMS J. Comput. Math. 17 (2014), no. 1, 536–564. // This returns the cubic forms given in Theorem 1.2 in [Fi]. // The curves X_E(11) and X_E^-(11) arise as the singular locus of // the Hessian of F and G, respectively. function XE11Equations(a, b : R := PolynomialRing(Universe([a,b]),5)) v,w,x,y,z := Explode([R.i: i in [1..5]]); F := v^3 + a*v^2*z - 2*a*v*x^2 + 4*a*v*x*y - 6*b*v*x*z + a*v*y^2 + 6*b*v*y*z + a^2*v*z^2 - w^3 + a*w^2*z - 4*a*w*x^2 - 12*b*w*x*z + a^2*w*z^2 - 2*b*x^3 + 3*b*x^2*y + 2*a^2*x^2*z + 6*b*x*y^2 + 4*a*b*x*z^2 + b*y^3 - a^2*y^2*z + a*b*y*z^2 + 2*b^2*z^3; G := v^2*z + 2*v*w*y + 4*v*x*y + 2*w^2*x - a*w^2*z + 2*w*x^2 - 2*a*w*y^2 - 6*b*w*y*z + 6*x^3 - 6*a*x^2*z + 2*a^2*x*z^2 + b*y^3 - 2*a^2*y^2*z - 5*a*b*y*z^2 - b^2*z^3; return F, G; end function; // Some abbreviations Deriv := Derivative; MC := MonomialCoefficient; MD := MonomialsOfDegree; CD := CremonaDatabase(); // this gives a string describing the elliptic curve E CR := func; // See page 548 in [Fi]. function c4Invariant(F) R := Parent(F); PP := PolynomialRing(R); KK := quo; Hmat1 := Matrix(5, 5, [Deriv(Deriv(F, i), j) : i, j in [1..5]]); H := (1/32)*Determinant(Hmat1); Hmat2 := Matrix(5, 5, [Deriv(Deriv(H, i), j) : i, j in [1..5]]); poly := Determinant(Hmat1 + KK.1*Hmat2); assert Coefficient(poly,0) eq 32*H; return (-1/8)*Coefficient(poly, 3); end function; R := PolynomialRing(Rationals(),5); // This constructs X_E(11) or X_E^-(11) as a projective curve in P^4. function XE11twist(label, sign, ring) // label: Cremona label for elliptic curve // sign: -1 or 1 (correspond to G <--> X_E^-(11) and F <--> X_E(11), respectively) // ring: coordinate ring of ambient P^4 E := EllipticCurve(label); ainv := aInvariants(E); if ainv[1] ne 0 or ainv[2] ne 0 or ainv[3] ne 0 then E := WeierstrassModel(E); ainv:=aInvariants(E); end if; a := ainv[4]; b := ainv[5]; F, G := XE11Equations(a, b : R := ring); if sign gt 0 then inv := -4*(4*a^3+27*b^2)^2; equation := F; else inv := 8*(4*a^3+27*b^2); equation := G; end if; // construct the Hessian H := Matrix(5, 5, [Deriv(Deriv(equation, i), j) : i, j in [1..5]]); P4 := Proj(ring); cc4 := c4Invariant(equation); // curve is singular locus of H minors := Setseq(Set(Minors(H, 4))); // eliminate duplicates due to symmetry C := Curve(P4, minors); return C, minors, cc4, inv, equation; end function; // j-function from twist of X(11) to P1, in terms of c_4, inv, F and the point. function jP(cc4, inv, F, P) FP := Evaluate(F, Eltseq(P)); c4P := Evaluate(cc4, Eltseq(P)); return c4P^3/(inv^8*FP^11); end function; // ========================================================================== // The following are functions that can be used to partition the Q_p-points of // a twist of X(11) into open p-adic disks. defaultprec := 50; function purify(pols) // replace pols by a basis of the Z-lattice given by intersecting Z[vars] // with the Q-vector space generated by pols mons := Setseq(&join{Set(Monomials(p)) : p in pols}); bas := Basis(LLL(PureLattice(Lattice(Matrix([[MonomialCoefficient(p, m) : m in mons] : p in pols]))))); return [&+[b[i]*mons[i] : i in [1..#mons]] : b in bas]; end function; function param2adic(pols, pt : p := 2) // determine power series with coefficients in Z_p parameterizing residue disk near pt // pols: polynomials defining an affine curve containing the point with coordinates pt Z2 := pAdicRing(p, defaultprec); two := Z2!p; // was written orginally for p = 2... Pws := PowerSeriesAlgebra(Z2); eqns := purify(pols); center := [Integers()!c : c in pt]; n := Rank(Universe(eqns)); // dimension of ambient affine space P := PolynomialRing(Integers(), n); PF2 := PolynomialRing(GF(p), n); // shift point to origin subst := [center[i] + P.i : i in [1..n]]; neweqns := [Evaluate(pol, subst) : pol in eqns]; // Jacobian matrix of the equations at the origin jacmat := Matrix(GF(p), [[MonomialCoefficient(pol, P.i) : i in [1..n]] : pol in neweqns]); assert Rank(jacmat) eq n-1; // point must be smooth over F_p // find n-1 linearly independent rows inds := []; rows := []; i := 1; while #inds lt n-1 do if Rank(Matrix(Append(rows, jacmat[i]))) gt #inds then Append(~inds, i); Append(~rows, jacmat[i]); end if; i +:= 1; end while; // find uniformizing coordinate u := 1; trp := Transpose(Matrix(rows)); while Rank(Matrix(trp[[1..u-1] cat [u+1..n]])) lt n-1 do u +:= 1; end while; matu := Transpose(Matrix(trp[[1..u-1] cat [u+1..n]])); // set up local equations locpols := neweqns[inds]; imat := ChangeRing(matu^-1, Integers()); locpols := [&+[imat[i,j]*locpols[j] : j in [1..n-1]] : i in [1..n-1]]; iter := [i ne u select -locpols[i lt u select i else i-1] + P.i else P.u : i in [1..n]]; // iterate power series solution err := Pws![O(two^(defaultprec-i)) : i in [0..defaultprec-1]] + O(Pws.1^defaultprec); newseq := [Pws| i ne u select 0 else Pws.1 : i in [1..n]]; repeat oldseq := newseq; newseq := [Evaluate(it, oldseq) + err: it in iter]; diffs := [newseq[i] - oldseq[i] : i in [1..n]]; prec := Min([defaultprec] cat [Min([j + Valuation(Coefficient(d, j)) : j in [0..defaultprec-1]]) : d in diffs]); vprintf User1: "prec = %o\n", prec; until prec ge defaultprec; return [Evaluate(s, newseq) + err : s in subst]; end function; // This gives a lower bound on the p-adic valuation of the values // of the power series ser with coefficients in Z_p when evaluated // on p Z_p. function precision(ser) return Min(AbsolutePrecision(ser), Min([j + Valuation(Coefficient(ser, j)) : j in [0..AbsolutePrecision(ser)-1]])); end function; function twoadicdiscs(C : p := 2) // given a smooth projective curve over Q, determine its p-adic residue disks eqns := purify(DefiningPolynomials(C)); n := Rank(Universe(eqns)) - 1; // dimension of ambient projective space P := PolynomialRing(Integers(), n); PF2 := PolynomialRing(GF(p), n); Aff := AffineSpace(PF2); Z2 := pAdicRing(p); two := Z2!p; function recurse(pols, depth : index := 0) // pols in P, index: up to this index, coord. must be divisible by p if depth eq 0 then vprintf User2: "recurse: index = %o\n", index; end if; result := []; // model (of given affine part) over F_p polsF2 := ChangeUniverse(pols, PF2); Cred := Scheme(Aff, polsF2); dim := Dimension(Cred); pts := Points(Cred); vprintf User2: " "^depth*"recurse: %o points on Cred\n", #pts; // check if points are regular for pt in pts do if forall{i : i in [1..index] | pt[i] eq 0} then vprintf User2: " "^depth*"recurse: pt = %o", pt; jacmat := Matrix([[Evaluate(Derivative(pol, PF2.i), Eltseq(pt)) : i in [1..n]] : pol in polsF2]); rk := Rank(jacmat); vprintf User2: " --> rank = %o\n", rk; if rk lt n-1 then // refine ptsubst := [p*P.i + Integers()!pt[i] : i in [1..n]]; newpols := purify([Evaluate(pol, ptsubst) : pol in pols]); rdisks := recurse(newpols, depth+1); result cat:= [[p*d[i] + Integers()!pt[i] : i in [1..n]] : d in rdisks]; else vprintf User2: " "^depth*" parameterize disk..."; Append(~result, param2adic(pols, Eltseq(pt) : p := p)); vprintf User2: " done\n"; end if; end if; end for; return result; end function; // look at all affine pieces result := []; for i := 1 to n+1 do substi := [j lt i select P.j else j eq i select 1 else P.(j-1) : j in [1..n+1]]; resi := recurse([Evaluate(pol, substi) : pol in eqns], 0 : index := i-1); result cat:= [d[1..i-1] cat [1] cat d[i..n] : d in resi]; end for; // check that parametrized arcs lie on curve (up to default precision) assert forall{d : d in result | forall{e : e in eqns | precision(Evaluate(e, d)) ge defaultprec}}; return result; end function; // Given a 2-adic disk on a twist of X(11), // check if it can produce 2-adically primitive solutions to x^2 + y^3 = z^11 // and determine its image on the j-line. function test_disk(param, c4, F, inv) // param: parameterization by power series describing the disk // c4, F, inv: data giving the twist of X(11) // returns c4 and F as power series on the disk, the unit part of inv // and the 2-adic valuation of the j-invariant on the disk. valc4 := Valuation(GCD([Numerator(c) : c in Coefficients(c4)]), 2); c4red := c4/2^valc4; // normalize c4 valF := Valuation(GCD([Numerator(c) : c in Coefficients(F)]), 2); Fred := F/2^valF; // normalize F i0 := inv/2^Valuation(inv, 2); // normalize inv vinv8 := 8*Valuation(inv, 2); printf "valc4 = %o, valF = %o, vinv8 = %o\n", valc4, valF, vinv8; c4ser := Evaluate(c4red, param); // c4 and F (normalized) as power series in the uniformizer Fser := Evaluate(Fred, param); Z2 := pAdicRing(2, defaultprec); two := Z2!2; // determine precision of c4 when evaluated on 2 Z_2 c4prec := Min([AbsolutePrecision(c4ser)] cat [j + AbsolutePrecision(Coefficient(c4ser, j)) : j in [0..AbsolutePrecision(c4ser)-1]]); c4vals := [j + Valuation(Coefficient(c4ser, j)) : j in [0..AbsolutePrecision(c4ser)-1]]; // same for F Fprec := Min([AbsolutePrecision(Fser)] cat [j + AbsolutePrecision(Coefficient(Fser, j)) : j in [0..AbsolutePrecision(Fser)-1]]); Fvals := [j + Valuation(Coefficient(Fser, j)) : j in [0..AbsolutePrecision(Fser)-1]]; // lower bound for valuation of values of c4, F c4val := Min(c4vals); Fval := Min(Fvals); // determine whether information fixes the valuation of c4 on 2 Z_2 flagc4 := c4val lt c4prec and forall{j : j in [2..#c4vals] | c4vals[j] gt c4val}; fc := flagc4 select 1 else 0; min2c := Min(c4vals[2..#c4vals]); // lower bound for valuation of higher-order terms diffc := min2c - c4val; // relative precision compared to constant term // same for F flagF := Fval lt Fprec and forall{j : j in [2..#Fvals] | Fvals[j] gt Fval}; fF := flagF select 1 else 0; min2F := Min(Fvals[2..#Fvals]); diffF := min2F - Fval; // valuation of j = c4^3/inv^8/F^11 val := 3*(valc4 + c4val) - vinv8 - 11*(valF + Fval); // normalized values of c4 and F at the center of the disk c0 := (Integers()!c)/2^Valuation(c) where c := Coefficient(c4ser, 0); F0 := (Integers()!c)/2^Valuation(c) where c := Coefficient(Fser, 0); // relative precision of j compared to the value at the center // (0 if valuation of j is not fixed) dv := fc*fF eq 1 select Min(diffc, diffF) else 0; // this gives the center of the image of the disk under j j0 := Integers()!(Z2!(c0^3/i0^8/F0^11) + O(two^dv)); // print information on values of j printf "%o, v(j) %o %o; j in %o + O(2^%o)\n", fc*fF eq 1 select "OK" else "NOT DETERMINED", [">=<", "<=", ">=", "="][1+fc+2*fF], val, j0*2^val, val + dv; // check if information is consistent with 2-adically primitive solutions val1 := Valuation(12^3 - 2^val*j0, 2); if flagc4 and flagF and ((val lt 0 and (val mod 11) ne 6) or (val ge 6 and ((val mod 3) ne 0 or (IsOdd(val1) and val1 lt val + dv))) or val in [0..5]) then printf " ==> this disk cannot produce 2-adically primitive solutions\n"; end if; return c4ser, Fser, i0, val; end function;