
// Make newform 1800.4.a.x in Magma, downloaded from the LMFDB on 19 April 2024.
// To make the character of type GrpDrchElt, type "MakeCharacter_1800_a();"
// To make the coeffs of the qexp of the newform in the Hecke field type "qexpCoeffs();"
// To make the newform (type ModFrm), type "MakeNewformModFrm_1800_4_a_x();".
// This may take a long time!  To see verbose output, uncomment the SetVerbose lines below.
// The precision argument determines an initial guess on how many Fourier coefficients to use.
// This guess is increased enough to uniquely determine the newform.
// To make the Hecke irreducible modular symbols subspace (type ModSym)
// containing the newform, type "MakeNewformModSym_1800_4_a_x();".
// This may take a long time!  To see verbose output, uncomment the SetVerbose line below.
// The default sign is -1.  You can change this with the optional parameter "sign".
function ConvertToHeckeField(input: pass_field := false, Kf := [])
    if not pass_field then
        Kf := Rationals();
    end if;
    return [Kf!elt[1] : elt in input];
end function;


// To make the character of type GrpDrchElt, type "MakeCharacter_1800_a();"
function MakeCharacter_1800_a()
    N := 1800;
    order := 1;
    char_gens := [1351, 901, 1001, 577];
    v := [1, 1, 1, 1];
    // chi(gens[i]) = zeta^v[i]
    assert UnitGenerators(DirichletGroup(N)) eq char_gens;
    F := CyclotomicField(order);
    chi := DirichletCharacterFromValuesOnUnitGenerators(DirichletGroup(N,F),[F|F.1^e:e in v]);
    return MinimalBaseRingCharacter(chi);
end function;

function MakeCharacter_1800_a_Hecke(Kf)
    return MakeCharacter_1800_a();
end function;


function ExtendMultiplicatively(weight, aps, character)
    prec := NextPrime(NthPrime(#aps)) - 1; // we will able to figure out a_0 ... a_prec
    primes := PrimesUpTo(prec);
    prime_powers := primes;
    assert #primes eq #aps;
    log_prec := Floor(Log(prec)/Log(2)); // prec < 2^(log_prec+1)
    F := Universe(aps);
    FXY<X, Y> := PolynomialRing(F, 2);
    // 1/(1 - a_p T + p^(weight - 1) * char(p) T^2) = 1 + a_p T + a_{p^2} T^2 + ...
    R<T> := PowerSeriesRing(FXY : Precision := log_prec + 1);
    recursion := Coefficients(1/(1 - X*T + Y*T^2));
    coeffs := [F!0: i in [1..(prec+1)]];
    coeffs[1] := 1; //a_1
    for i := 1 to #primes do
        p := primes[i];
        coeffs[p] := aps[i];
        b := p^(weight - 1) * F!character(p);
        r := 2;
        p_power := p * p;
        //deals with powers of p
        while p_power le prec do
            Append(~prime_powers, p_power);
            coeffs[p_power] := Evaluate(recursion[r + 1], [aps[i], b]);
            p_power *:= p;
            r +:= 1;
        end while;    
    end for;
    Sort(~prime_powers);
    for pp in prime_powers do
        for k := 1 to Floor(prec/pp) do
            if GCD(k, pp) eq 1 then
                coeffs[pp*k] := coeffs[pp]*coeffs[k];
            end if;
        end for;
    end for;
    return coeffs;
end function;


function qexpCoeffs()
    // To make the coeffs of the qexp of the newform in the Hecke field type "qexpCoeffs();"
    weight := 4;
    raw_aps := [[0], [0], [0], [10], [14], [-82], [-18], [-136], [140], [-112], [72], [26], [446], [396], [144], [-158], [342], [314], [-152], [932], [-548], [-512], [-284], [810], [1304], [-936], [1450], [-1292], [-2142], [1418], [1674], [-1134], [2866], [-764], [3060], [-1304], [1582], [3232], [2988], [918], [1238], [1450], [-4860], [-1412], [1170], [2080], [2692], [-846], [-2884], [3150], [4014], [-4900], [-2314], [2002], [450], [-180], [-2448], [6776], [6426], [-2718], [6048], [-1246], [1244], [6372], [5500], [-378], [-11888], [-9116], [4676], [11906], [2142], [-9824], [5354], [7694], [-6004], [-9432], [6156], [7866], [2074], [-2746], [6426], [-10610], [-8384], [1980], [864], [13212], [16290], [6336], [13716], [-14626], [5796], [8348], [-1898], [-16654], [-10600], [10048], [15088], [-8582], [16928], [-11150], [-19628], [-8694], [828], [17514], [-5552], [-12896], [1588], [-22262], [-4640], [-2574], [-11170], [-3646], [7646], [26668], [7712], [22302], [2232], [-9464], [4878], [-10206], [20906], [-6812], [-10026], [21236], [-11520], [400], [-5930], [-7160], [-8874], [5562], [-12096], [-21312], [-6832], [-7174], [15394], [9730], [24206], [-31312], [-10746], [-30546], [-2628], [-26280], [-26146], [-29268], [6202], [-4680], [12122], [26006], [-17684], [-15084], [17614], [3298], [9496], [50220], [20636], [-13680], [21456], [-16510], [-36296], [-13540], [-32940], [22482], [-9566], [-10062], [-48506], [41144], [16120], [-36666], [33974], [13806], [41630], [-1962], [-576], [-37612], [14696], [-31262], [-33876], [28436], [-17738], [-29826], [34982], [-61110], [11898], [39474], [-43992], [27004], [15454], [-65440], [-42398], [62748], [6148], [-54972], [-55988], [11412], [47268], [-13478], [-62450], [-27730], [54274], [46904], [8676], [58240], [-14138], [-74546], [29902], [80842], [77248], [-19724], [26834], [8272], [4148], [25236], [76202], [22244], [26564], [77446], [-29630], [-454], [6944], [-17510], [20870], [11464], [-12114], [-10458], [13316], [72566], [-70110], [87512], [-31202], [45198], [-67114], [66996], [34560], [-34078], [-3032], [-69948], [-17794], [54810], [60926], [-7740], [36364], [65816], [-12554], [26594], [-22122], [82516], [-48142], [-72378], [49248], [49532], [24642], [19710], [42300], [12790], [-106006], [-109134], [-111070], [15208], [14738], [78300], [77570], [90364], [-57122], [-62918], [24642], [-3888], [40028], [-32674], [37872], [-71658], [40582], [13708], [-46420], [113896], [-39132], [-132598], [39676], [-100494], [-80010], [89042], [-77612], [92464], [-5440], [-31922], [113156], [57420], [102376], [97254], [103960], [-55778], [54652], [-34204], [-111434], [-103482], [26946], [-24156], [-64576], [112302], [-12370], [-140932], [-91124], [19966], [47144], [-96228], [15704], [76608], [95652], [2494], [123012], [177902], [-79884], [8496], [82786], [-30572], [180536], [-108666], [-145962], [187700], [175356], [-61618], [-128240], [-72676], [66632], [-88146], [-43114], [-109594], [-150716], [138996], [-14296], [154750], [171262], [-62950], [-83240], [-170644], [-130284], [-131980], [59734], [-50162], [122346], [-63126], [-145394], [-143258], [177016], [-108368], [8154], [202014], [100870], [-92988], [128340], [13550], [12412], [30736], [-91296], [14850], [-90694], [123638], [34240], [-13882], [-119606], [131692], [-21898], [-82962], [206104], [-108018], [-124136], [-85312], [44874], [68410], [43514], [-189378], [-68660], [-250056], [-80464], [-46664], [-144694], [-158674], [-74808], [13256], [86242], [69560], [-229068], [-223574], [-8990], [83326], [-190036], [-69372], [-254952], [-123758], [162172], [-158868], [158418], [245250], [-23234], [-229112], [130280], [-20096], [-20024], [-90810], [-115776], [154516], [150102], [231250], [-49662], [-72814], [-3024], [17120], [-59806], [-138838], [140480], [-104342], [-103592], [-145062], [-42804], [19232], [213436], [175792], [-169560], [-222182], [-211190], [78628], [36068], [301646], [-264384], [-234414], [-72396], [169002], [1364], [148838], [122312], [-128344]];
    aps := ConvertToHeckeField(raw_aps);
    chi := MakeCharacter_1800_a_Hecke(Universe(aps));
    return ExtendMultiplicatively(weight, aps, chi);
end function;


// To make the newform (type ModFrm), type "MakeNewformModFrm_1800_4_a_x();".
// This may take a long time!  To see verbose output, uncomment the SetVerbose lines below.
// The precision argument determines an initial guess on how many Fourier coefficients to use.
// This guess is increased enough to uniquely determine the newform.
function MakeNewformModFrm_1800_4_a_x(:prec:=1)
    chi := MakeCharacter_1800_a();
    f_vec := qexpCoeffs();
    Kf := Universe(f_vec);
    // SetVerbose("ModularForms", true);
    // SetVerbose("ModularSymbols", true);
    S := CuspidalSubspace(ModularForms(chi, 4));
    S := BaseChange(S, Kf);
    maxprec := NextPrime(2999) - 1;
    while true do
        trunc_vec := Vector(Kf, [0] cat [f_vec[i]: i in [1..prec]]);
        B := Basis(S, prec + 1);
        S_basismat := Matrix([AbsEltseq(g): g in B]);
        if Rank(S_basismat) eq Min(NumberOfRows(S_basismat), NumberOfColumns(S_basismat)) then
            S_basismat := ChangeRing(S_basismat,Kf);
            f_lincom := Solution(S_basismat,trunc_vec);
            f := &+[f_lincom[i]*Basis(S)[i] : i in [1..#Basis(S)]];
            return f;
        end if;
        error if prec eq maxprec, "Unable to distinguish newform within newspace";
        prec := Min(Ceiling(1.25 * prec), maxprec);
    end while;
end function;


// To make the Hecke irreducible modular symbols subspace (type ModSym)
// containing the newform, type "MakeNewformModSym_1800_4_a_x();".
// This may take a long time!  To see verbose output, uncomment the SetVerbose line below.
// The default sign is -1.  You can change this with the optional parameter "sign".
function MakeNewformModSym_1800_4_a_x( : sign := -1)
    R<x> := PolynomialRing(Rationals());
    chi := MakeCharacter_1800_a();
    // SetVerbose("ModularSymbols", true);
    Snew := NewSubspace(CuspidalSubspace(ModularSymbols(chi,4,sign)));
    Vf := Kernel([<7,R![-10, 1]>,<11,R![-14, 1]>,<17,R![18, 1]>],Snew);
    return Vf;
end function;