///////////////////////////////////////////////////////////////////////////
// "Growth of torsion groups of elliptic curves upon base changes"
// Enrique González-Jiménez & Filip Najman
///////////////////////////////////////////////////////////////////////////

// 22/3/2019 - Magma 2.21
// 13/10/2016 - Magma 2.21

// Magma script related to Lemma 8.14


Qt<t>:=FunctionField(Rationals());
Qtx<x>:=PolynomialRing(Qt);

// Tate normal form of an elliptic curve with a point of order 10
E10:=EllipticCurve([t^3-2*t^2-4*t+4,-(t-1)*(t-2)*t^3,-(t-1)*(t-2)*(t^2-6*t+4)*t^3,0,0]);

// (0,0) is a point of order 10 in E10 over Q(t)
assert Order(E10![0,0]) eq 10;

P2:=DivisionPolynomial(E10,2);
P3:=DivisionPolynomial(E10,3);
// Using the formula for the double of a point,
// we obtain that a necessary condition is that q10(x)=0.
q10:=x*P2-P3; // 2*(x,y)=(0,0);


S<a>:=quo<Qtx | q10>;
ES:=BaseChange(E10,S);
Q:=Points(ES,a)[1];

P20:=ES!Q;
// P20 is of order 20 over Qt[x]/<q10(x)>
assert (2*P20) eq (ES![0,0]); 

/*
> 2*P20;
(0 : 0 : 1)
> 10*(P20); 
(-1/4*t^6 + 2*t^5 - 4*t^4 + 2*t^3 : 1/8*t^9 - 5/4*t^8 + 4*t^7 - 5*t^6 + 2*t^5 : 1)
> 20*(P20); 
(0 : 1 : 0)
*/


// The condition that Q(sqrt(Delta_E)) is contained in Q(P20)=Qt[x]/<q10(x)>:

F:=FunctionField(q10);
d10:=Discriminant(E10)*Discriminant(DefiningPolynomial(Subfields(F)[2,1]));

assert Denominator(d10) eq 1;

Zt<t>:=PolynomialRing(Integers());
d10N:=Zt!Polynomial(Zt,Coefficients(Numerator(d10)));
L10:=Factorization(d10N);
H10:=HyperellipticCurve(&*[l[1]^(l[2] mod 2) : l in L10]);

/* OUTPUT:The condition that Q(sqrt(Delta_E)) is contained in Q(P20)=Qt[x]/<q10(x)> 
           is equivalent to the existence of (non-trivial) rational points on H10. 
>H10;
Hyperelliptic Curve defined by y^2 = x^7 - 10*x^6 + 32*x^5 - 39*x^4 + 8*x^3 + 16*x^2 - 8*x over Rational Field
> Factorization(x^7 - 10*x^6 + 32*x^5 - 39*x^4 + 8*x^3 + 16*x^2 - 8*x);
[
    <x, 1>,
    <x - 2, 1>,
    <x - 1, 1>,
    <x^2 - 6*x + 4, 1>,
    <x^2 - x - 1, 1>
]
*/

// We look for some points on the hyperelliptic curve H10:
c:=Points(H10:Bound:=100000);
/* OUTPUT:
> c;
{@ (1 : 0 : 0), (0 : 0 : 1), (1 : 0 : 1), (2 : 0 : 1) @}
*/

// For all automorphisms g of H10 defined over Q we compute
// * the quotient curve Hg=H10/<g> and its genus,
// * the degree of pg :H10 ---> Hg
// * if Hg is an elliptic curve we compute:
//   - its Cremona Reference
//   - its Mordell-Weil group over Q
//   - and the image of the points in the set c under pg. 

G10,map10:=AutomorphismGroup(H10);
for g in G10 do 
  if Order(g) ne 1 then 
    C,proj:=CurveQuotient(AutomorphismGroup(H10,[map10(g)]));
    printf "%o - %o\n", Genus( C ),C;
    printf "-----> %o \n",Degree(proj);
    if Genus( C ) eq 1 then 
      printf "(%o) - %o\n",CremonaReference( C ),AbelianInvariants(MordellWeilGroup( C ));
      printf " %o\n",AbelianInvariants(MordellWeilGroup( C ));
      {proj(point) : point in c};
    end if;
   end if; 
end for;
/*  OUTPUT:
0 - Conic over Rational Field defined by
$.2^2 - $.1*$.3
-----> 2 
1 - Elliptic Curve defined by y^2 = x^3 - 7*x - 6 over Rational Field
-----> 2 
(40a1) - [ 2, 2 ]
 [ 2, 2 ]
{ (0 : 1 : 0), (-1 : 0 : 1) }
1 - Elliptic Curve defined by y^2 = x^3 + 13*x - 34 over Rational Field
-----> 4 
(40a4) - [ 4 ]
 [ 4 ]
{ (0 : 1 : 0) }
1 - Elliptic Curve defined by y^2 = x^3 + 13*x - 34 over Rational Field
-----> 4 
(40a4) - [ 4 ]
 [ 4 ]
{ (0 : 1 : 0) }
2 - Hyperelliptic Curve defined by y^2 = 2*x^5 - 3*x^4 - 3*x^2 - 2*x over 
Rational Field
-----> 2 
0 - Conic over Rational Field defined by
y^2 - x*z + 9*z^2
-----> 4 
0 - Conic over Rational Field defined by
y^2 - x*z + 9*z^2
-----> 4 
*/

//computation that the torsion group cannot be C_40 in a dihedral quartic field.


/*
// Let E/Q an elliptic curve, K a dihedral quartic field and F the quadratic field of K.
// Suppose:
//       (1)  E(Q)[2^infty]=Z/2Z 
//       (2)  E(F)[2^infty]=Z/2Z
//       (3)  Z/8Z < E(K)[2^infty] 
// Then the 2-adic Galois representation of E has Rouse-Zureick-Brown label X191

load "2primary_Ss.txt";
>{r[1] : r in RZB | r[3][1,1] eq 1 and r[3][1,2] eq 4 and r[3][1,3] eq 4};
{ X191 }

*/

// X191 covers X11 (RZB labels)
// Let us compute the rational pointsof the fiber product of X11 and X_0(5)

_<t>:=RationalFunctionField(Rationals());
f6:=t^2-16;
f1:=f6^3/(f6+16); // j-map of X11
f2:=(t^2+10*t+5)^3/t; // j-map of X_0(5)
R<x,y>:=PolynomialRing(Rationals(),2);
C:=ProjectiveClosure(Curve(AffineSpace(R),Numerator(Evaluate(f1,x)-Evaluate(f2,y))));//Fiber product X11 x X_0(5)
	
bound:=10^3;
Pts := PointSearch(C,bound);
Pts:=[p : p in Pts | Multiplicity(p) eq 1];
assert #Pts ne 0;
Pt:=Pts[1];
E,mp1 := EllipticCurve(C,Pt);
CremonaReference(E);
EE,mm := MinimalModel(E);
mm:=mm^-1;
MW:=AbelianInvariants(MordellWeilGroup(EE));
//printf "Abelian Invariants of  MW %o\n", MW;
DescentInformation(E);
/*

Torsion Subgroup = Z/2 x Z/2
Analytic rank = 0
     ==> Rank(E) = 0

[ 0, 0 ]
[]
[]
*/
T,mp2 := TorsionSubgroup(EE);
PtsC := { };
for p in T do
	PtsC := PtsC join RationalPoints(mm(mp2(p)) @@ mp1);
end for;
j:=f1;
{Evaluate(j,P[1]/P[3]) : P in PtsC | Evaluate(Denominator(j),P[1]) ne 0 and P[3] ne 0};
/*
{}
*/