https://github.com/koffie/mdmagma
Revision f69d0e06f67b9ac6f57e7d8e6ba3b3d69e650352 authored by Maarten Derickx on 02 November 2020, 22:43:35 UTC, committed by Maarten Derickx on 02 November 2020, 22:43:35 UTC
1 parent 0460952
Raw File
Tip revision: f69d0e06f67b9ac6f57e7d8e6ba3b3d69e650352 authored by Maarten Derickx on 02 November 2020, 22:43:35 UTC
Quickly lists all non cuspidal places up to diamond operators on X_1(N)
Tip revision: f69d0e0
hecke_operators.m
load "X_1_n.m";

function pIsogeniesFiniteField1(E,p);
//Returns the p+1 elliptic curves that are p-isogenous to an initial E
//curve defined over a finite field
//Raises an error in characteristic 2,3 or if E is supersingular 
    Fq := BaseRing(E);
    jE := jInvariant(E);
    fp := ClassicalModularPolynomial(p);
    fp := ChangeRing(Parent(fp),Fq) ! fp;
    fpjE := UnivariatePolynomial(Evaluate(fp,2,jE));
    Fqn := SplittingField(fpjE);
    
    A2 := AffineSpace(Fqn,2);
    X0p := ModularCurve(A2,"Canonical",p);
    mp := ModuliPoints(X0p,BaseChange(E,Fqn));
    assert #mp eq p+1;
    return [Isogeny(BaseChange(E,Fqn),x) : x in mp];
end function;

function pIsogeniesFiniteField(E,p);
//Returns the p+1 elliptic curves that are p-isogenous to an initial E
//curve defined over a finite field
    assert IsPrime(p);
    //assert p ne 2; 
    Fq := BaseRing(E);
    fp := DivisionPolynomial(E,p);
    Fqn := SplittingField(fp);
    Fq2n := RandomExtension(Fqn, 2);
    xi := Roots(ChangeRing(fp,Fq2n));
    Eq2n := BaseChange(E,Fq2n);
    fE := DefiningEquation(Eq2n);
    yi := [Roots(UnivariatePolynomial(Evaluate(Evaluate(fE,3,1),1,x[1])))[1][1] : x in xi];
    Pi := [E(Fq2n) ! [xi[i][1],yi[i]] : i in [1..#xi]];
    //now Pi is a list with all torsion points
    
    R<X> := PolynomialRing(Fq2n);
    kernel_polynomials := {&*[X-(j*P)[1] : j in [1..Ceiling((p-1)/2)]] : P in Pi};
    isogenies := [PowerStructure(MapSch) | ];
    for f in kernel_polynomials do;
        Ef,phi := IsogenyFromKernel(Eq2n,f);

        Append(~isogenies,phi);
    end for;
    return isogenies;
end function;



function TateNormalForm_bc(E,P);
//Return the b,c of the tate normal form of (E,P) as in equation (2) of http://arxiv.org/pdf/1307.5719v1.pdf
    assert P[3] eq 1;
    x0:=P[1];
    y0:=P[2];

    a1,a2,a3,a4,a6:=Explode(aInvariants(E));	
    aa1:=a1;
    aa3:=2*y0+a3+a1*x0;
    aa2:=3*x0+a2;
    aa4:=3*x0^2+2*x0*a2+a4-a1*y0;

    aaa1:=2*aa4/aa3+aa1;
    aaa3:=aa3;
    aaa2:=aa2-(aa4/aa3)^2-aa1*aa4/aa3;


    b:=-aaa2^3/aaa3^2;
    c:=-(aaa1*aaa2-aaa3)/aaa3;
    return [b,c];
end function;

function TateNormalForm_xy(E,P);
//return the x,y of the tate normal form of (E,P) as in section 2.1 http://arxiv.org/pdf/1307.5719v1.pdf
    b,c := Explode(TateNormalForm_bc(E,P));
    r := b/c;
    s := c^2/(b-c);
    t := (r*s-2*r+1);
    x := (s-r)/t;
    y := t/(s^2-s-r+1);
    return [x,y];
end function;


function MyMultiset(itterable);
    uniques := [];
    for i in itterable do;
        if i notin uniques then;
            Append(~uniques,i);
        end if;
    end for;
    
    return [<j,#[1 : i in itterable | i eq j]> : j in uniques];
end function;

function Tp_X1N_noncuspidal_place(P,p);
    assert IsPrime(p);
    ZZ := IntegerRing();
    E := EllipticCurveFromX1Place(P);
    X1N := Curve(P);
    assert Characteristic(BaseRing(X1N)) ne p;
    isogenies := pIsogeniesFiniteField(E,p);
    Eq2n := Domain(isogenies[1]);
    Fq2n := BaseRing(Eq2n);

    Pi := [<Codomain(phi),phi(Eq2n ! [0,0])> : phi in isogenies];
    xyi := [TateNormalForm_xy(P[1],P[2]) : P in Pi];
    places := [Places(X1N(Fq2n) ! xy) : xy in xyi];
    assert &and[#p eq 1 :  p in places];
    places := MyMultiset(&cat places);
    d := Degree(P);
    return &+[ (ZZ ! (place[2]*d/Degree(place[1])))*place[1] : place in places]; 
end function;

function Tp_X1N_noncuspidal(D,p);
  P,e := Support(D);
  return &+[e[i]*Tp_X1N_noncuspidal_place(P[i],p) : i in [1..#P]]; 
end function;

function diamond_operator_X1N_noncuspidal_place(P,d);
    E := EllipticCurveFromX1Place(P);
    X1N := Curve(P);
    Fq := BaseRing(E);
    xy := TateNormalForm_xy(E,d*(E ! [0,0]));
    dP := Places(X1N(Fq) ! xy);
    assert #dP eq 1;
    return dP[1];
end function;

function diamond_operator_X1N_noncuspidal(D,p);
  P,e := Support(D);
  return &+[e[i]*diamond_operator_X1N_noncuspidal_place(P[i],p) : i in [1..#P]]; 
end function;


function Tp_pdp_1_noncuspidal_place(P,p);
    return Tp_X1N_noncuspidal_place(P,p)-p*diamond_operator_X1N_noncuspidal_place(P,p)-P;
end function;

function Tp_pdp_1_noncuspidal(D,p);
  P,e := Support(D);
  return &+[e[i]*Tp_pdp_1_noncuspidal_place(P[i],p) : i in [1..#P]]; 
end function;


function PositiveRankHeckePolynomial(S,n);
//Returns the characteristic polynomial of the hecke operator n on the subspace
//of the cuspidal modular symbol spaces S corresponding to the part where the LRatio is 0
//Under BSD this is exactly the part corresponding to the part of S where the corresponding abelian variety has positive rank
 return &*[HeckePolynomial(Si,n) : Si in NewformDecomposition(S) | LRatio(AssociatedNewSpace(Si),1) eq 0];
end function;



function PositiveRankHeckePolynomialX1N(N,n,chars);
//The input space needs to be cuspidal of sign 0
//Returns the characteristic polynomial of the hecke operator n on the subspace
//of the cuspidal modular symbol spaces S corresponding to the part where the LRatio is 0
//with respect to at least one of the characters in chars
//Under BSD this is exactly the part corresponding to the part of S where the corresponding abelian variety when twisted by one of the characters has positive rank

  D := FullDirichletGroup(N);
  chars := [D ! chi : chi in chars];
  ann_pol := 1;
  for d in Elements(D) do;
    M := ModularSymbols(d,2,0);
    S := CuspidalSubspace(M);
    for Si in NewformDecomposition(S) do;
      Snew := AssociatedNewSpace(Si);
      rank_0 := &or[Dimension(Snew)/2 ne Dimension(TwistedWindingSubmodule(Snew,1,chi)) : chi in chars];
      if rank_0 then;
        ann_pol := ann_pol*Sqrt(HeckePolynomial(Si,n));
      end if;
    end for;
  end for;
  return ann_pol;
end function;




    
back to top