

//**********************************************************************************************************************************
//**********************************************************************************************************************************

// Function "Gen-Params" is a modified version of code written for the article
// "Descent via (3,3)-isogeny on Jacobians of genus 2 curves"
// Original code available at http://www.cecm.sfu.ca/~nbruin/c3xc3/

//***************************************

//The formulas below are written in a form that, with minor modifications, should be
//readable by most computer algebra software.
//In for instance magma, one might want to predefine
k :=Rationals();
//  L<r,s,t>:=RationalFunctionField(base,3);
K<t>:=FunctionField(k);
//  _<k1,k2,k3,k4>:=PolynomialRing(L,4);
//
// or predefine the values r,s,t to special values of interest prior to
// evaluating the assignments defined in this file.


//Expressions Gi, lambdai, Hi (for i=1,2,3,4) such that
//Frst=Gi^2+lambda_i*H_i^3
//is a sextic polynomial in x, independent of the choice of i.
//The genus 2 curve
//  Crst: y^2 = Frst(x)
//has an isotropic (3,3) level structure marked on it.
//See Theorem 6

function GenParams(a,b,c)

    H1:=t^2 + b*t + a;
    lambda1:=4*c;
    G1:=(-c*a + c - 1)*t^3 + (-3*c*a + 3*c*b)*t^2 + (-3*c*a*b + 3*c*b^2)*t - c*a^2 + c*b^3 + a;


    H2:=t^2 + t + b;
    lambda2:=4*c*a;
    G2:=(-c*a + c + 1)*t^3 + (-3*c*a + 3*c*b)*t^2 + (-3*c*a*b + 3*c*b^2)*t - c*a^2 + c*b^3 - a;


    H3:=c*t^2 + (-c*a + 2*c*b - 1)*t + c*b^2;
    lambda3:=4*a/(c^2*a^2 + 2*c*a + 1);
    G3:=(c^2*a^2 - c^2*a + 2*c*a + c + 1)/(c*a + 1)*t^3 + (3*c^2*a^2 - 3*c^2*a*b + 3*c*a + 3*c*b)/(c*a + 1)*t^2 + (3*c^2*a^2*b - 3*c^2*a*b^2 + 3*c*a*b + 3*c*b^2)/(c*a + 1)*t + (c^2*a^3 - c^2*a*b^3 + 2*c*a^2 + c*b^3 + a)/(c*a + 1);


    H4:=(c*a*b - c*a - c*b^2 + c*b + b)*t^2 + (c*a^2 - c*a*b - c*a - c*b^3 + 2*c*b^2 + a)*t + c*a^2 - c*a*b^2 - c*a*b + c*b^3 + a;
    lambda4:=4*c*a/(c^2*a^4 - 6*c^2*a^3*b + 2*c^2*a^3 + 2*c^2*a^2*b^3 + 9*c^2*a^2*b^2 - 6*c^2*a^2*b + c^2*a^2 - 6*c^2*a*b^4 + 2*c^2*a*b^3 + c^2*b^6 + 2*c*a^3 - 6*c*a^2*b + 2*c*a^2 + 2*c*a*b^3 + a^2);
    G4:=(c^2*a^3 - 3*c^2*a^2*b - c^2*a*b^3 + 6*c^2*a*b^2 - 3*c^2*a*b + c^2*a - c^2*b^3 + 2*c*a^2 - 3*c*a*b + 2*c*a - c*b^3 + a)/(c*a^2 - 3*c*a*b + c*a + c*b^3 + a)*t^3 + (3*c^2*a^3 - 6*c^2*a^2*b^2 - 3*c^2*a^2 + 9*c^2*a*b^3 - 3*c^2*a*b^2 + 3*c^2*a*b - 3*c^2*b^4 + 3*c*a^2 - 6*c*a*b^2 + 3*c*a*b)/(c*a^2 - 3*c*a*b + c*a + c*b^3 + a)*t^2 + (-3*c^2*a^3*b + 6*c^2*a^3 - 9*c^2*a^2*b + 3*c^2*a*b^4 + 3*c^2*a*b^3 + 3*c^2*a*b^2 - 3*c^2*b^5 - 3*c*a^2*b + 6*c*a^2 - 3*c*a*b^2)/(c*a^2 - 3*c*a*b + c*a + c*b^3 + a)*t + (-c^2*a^4 + 3*c^2*a^3*b + c^2*a^3 - 6*c^2*a^2*b^2 + 3*c^2*a*b^4 + c^2*a*b^3 - c^2*b^6 - 2*c*a^3 + 3*c*a^2*b + c*a^2 - 2*c*a*b^3 - a^2)/(c*a^2 - 3*c*a*b + c*a + c*b^3 + a);


    return [lambda1, lambda2, lambda3, lambda4], [H1,H2,H3,H4], [G1,G2,G3,G4];
end function;

//**********************************************************************************************************************************
//**********************************************************************************************************************************

// 

// Define the parameters (parameters generated by a point search. See below).
// Note that a must be a cube.
init := 11/2;
a := init^3;
c := 1/(1-a);
b := -55/8;

L, H, G := GenParams(a,b,c);

f := G[1]^2 + L[1]*H[1]^3;
assert &and[ f eq G[i]^2 + L[i]*H[i]^3 : i in [1 .. 4]];

// Function for taking cube roots of cubes.
function RatCubeRoot(x)
    _<T> := PolynomialRing(Parent(x));
    fact := Factorization(T^3-x);
    assert #fact eq 2;
    return Roots(T^3-x)[1][1];
end function;

// Make the elliptic curve over K
_<X> := PolynomialRing(K);
Cf := HyperellipticCurve(f - L[1]*X^3);
E,phi := EllipticCurve(Cf);

// Critically, we have chosen the initial parameters so that each L[i]/L[1] is a cube.
sects := [[H[i]*RatCubeRoot(L[i]/L[1]), G[i]] : i in [1 .. 4]];
sects := [phi(Cf ! s) : s in sects];

// Check that the branch curve has the right genus.
// Note that it is immediate that KC admits a mu3-automorphism.
KC := ext<K | f - L[1]*X^3>;
assert Genus(KC) eq 4;

// Check that the sections generate a rank 4 subgroup of JC[2](Q).
// It suffices by Proposition 2.8.4 to compute the rank of the subgroup generated
// by the marked sections of the elliptic surface.
assert Rank(HeightPairingMatrix(sects)) eq 4;
print "Kodaira Symbols:", KodairaSymbols(E);


// END OF PROGRAM

/*
// Code used to find good specializations. The output of the search is hard-coded as input in the script above.

L<s> := FunctionField(k);
a := s^3;
c := 1/(1-a);

_<b> := PolynomialRing(L);

lambda4num:=4*c*a;
lambda4den:= (c^2*a^4 - 6*c^2*a^3*b + 2*c^2*a^3 + 2*c^2*a^2*b^3 + 9*c^2*a^2*b^2 - 6*c^2*a^2*b + c^2*a^2 - 6*c^2*a*b^4 + 2*c^2*a*b^3 + c^2*b^6 + 2*c*a^3 - 6*c*a^2*b + 2*c*a^2 + 2*c*a*b^3 + a^2);


k := Rationals();
A3<b,s,y> := AffineSpace(k,3);
F := b^3 - 3*s^3*b + 2*s^3 - (s^3-1)*y^3;
X := Scheme(A3, F);

lst := PointSearch(X,10);
[ p : p in lst | p[2] ne 0 and p[2] ne 1];
*/
