/* ************************************************************ ** ** ** HeckeAlgebra.mg ** ** ** ** written by Gabor Wiese ** ** ** ** version of 11 September 2006 ** ** ** ************************************************************ */ // ******** global definitions *********************** declare verbose HeckeAlgebra,1; SetVerbose ("HeckeAlgebra",true); ModularFormFormat := recformat < Character : GrpDrchElt, Weight : RngIntElt, CoefficientFunction : Map, ImageName : MonStgElt, // name of the image of the Galois representation Polynomial : RngUPolElt // defining polynomial for extension >; AlgebraData := recformat < Level : RngIntElt, Weight : RngIntElt, Characteristic : RngIntElt, // the characteristic of the base field BaseFieldDegree : RngIntElt, // the degree of the base field for modular symbols CharacterOrder : RngIntElt, // the order of the character CharacterConductor: RngIntElt, // the conductor of the character CharacterIndex : RngIntElt, // the index in Elements(DirichletGroup()) AlgebraFieldDegree: RngIntElt, // the degree of the base field of the algebra ResidueDegree : RngIntElt, // the residue field degree of the algebra Dimension : RngIntElt, // the dimension of the local algebra GorensteinDefect : RngIntElt, EmbeddingDimension: RngIntElt, NilpotencyOrder : RngIntElt, Relations : Tup, NumberGenUsed : RngIntElt, // number of generators used ImageName : MonStgElt, // name of the image of the Galois representation Polynomial : RngUPolElt // defining polynomial for extension >; // ********* subspace handling ******************** intrinsic ChangeTypeToAlgebra ( M :: Mtrx ) -> Mtrx {Given a square matrix M, return M as an element of the corresponding matrix algebra.} d := Nrows(M); e := Ncols(M); require (d eq e) : "Argument 1 must be a square matrix."; F := CoefficientRing(M); return MatrixAlgebra(F,d)!M; end intrinsic; intrinsic BaseChangeMatrices ( V :: ModTupFld ) -> Tup {Computes a tuple consisting of the standard base change matrices for the basis of the vector space V.} C := BasisMatrix(V); M := MatrixAlgebra(CoefficientRing(V),Dimension(V)); D := Transpose(Solution(Transpose(C),M!1)); return ; end intrinsic; intrinsic BaseChange ( M :: Mtrx, T :: Tup ) -> Mtrx {Given a matrix M and a tuple T = of base change matrices (for a subspace), computes the matrix of M wrt. the basis corresponding to T.} F := CoefficientRing(T[1]); return T[1] * ChangeRing(M,F) * T[2]; end intrinsic; intrinsic BaseChange ( S :: Tup, T :: Tup ) -> Tup {Computes the composition of the base change matrices in T, followed by those in S.} F := CoefficientRing(T[1]); return ; end intrinsic; intrinsic BaseChange ( M :: AlgMat, T :: Tup ) -> AlgMat {Given a matrix algebra M and a tuple T = of base change matrices (for a subspace), computes the matrix algebra of M wrt. the basis corresponding to T.} F := CoefficientRing(T[1]); alg := MatrixAlgebra(F,Nrows(T[1])); if Dimension(M) eq 0 then return sub< alg | >; else gen := [alg!(T[1] * ChangeRing(g,F) * T[2]) : g in Generators(M)]; return sub< alg | gen >; end if; end intrinsic; // ******* matrix algebra handling ********************* intrinsic MatrixAlgebra ( L :: SeqEnum ) -> AlgMat {Given a list of matrices, return the matrix algebra generated by L.} require L ne [] : "Argument 1 must not be the empty list."; require Nrows(L[1]) eq Ncols(L[1]) : "Matrices in Argument 1 must be square."; F := BaseRing(L[1]); d := Nrows(L[1]); a := MatrixAlgebra(F,d); return sub< a | [a!l : l in L] >; end intrinsic; // ******* general decomposition functions ************* intrinsic Decomposition ( M :: Mtrx : DegBound := 0 ) -> Tup {Given a matrix M, computes a decomposition of the standard vector space such that M acts as multiplication by a scalar on each summand. The output is a tuple consisting of base change tuples corresponding to the summands.} L := <>; F := CoefficientRing(M); mipo := Factorisation(MinimalPolynomial(M)); for fac in mipo do if (DegBound eq 0) or (Degree(fac[1]) le DegBound) then K := ext; Pol := PolynomialRing(K); facK := Factorisation(Pol!(fac[1])); for i := 1 to #facK do W := Kernel(Evaluate(facK[i][1]^(fac[2]),ChangeRing(M,K))); T := BaseChangeMatrices(W); Append(~L, T); end for; end if; end for; return L; end intrinsic; intrinsic DecompositionUpToConjugation ( M :: Mtrx : DegBound := 0 ) -> Tup {Given a matrix M, computes a decomposition of the standard vector space such that M acts as multiplication by a scalar on each summand. The output is a tuple consisting of base change tuples corresponding to the summands. Summands conjugate under the absolute Galois group only appear once.} L := <>; F := CoefficientRing(M); mipo := Factorisation(MinimalPolynomial(M)); for fac in mipo do if (DegBound eq 0) or (Degree(fac[1]) le DegBound) then K := ext; Pol := PolynomialRing(K); facK := Factorisation(Pol!(fac[1])); W := Kernel(Evaluate(facK[1][1]^(fac[2]),ChangeRing(M,K))); T := BaseChangeMatrices(W); Append(~L, T); end if; end for; return L; end intrinsic; intrinsic Decomposition ( L :: SeqEnum : DegBound := 0 ) -> Tup {Given a sequence L of commuting matrices, computes a decomposition of the standard vector space such that each l in L acts as multiplication by a scalar on each summand. The output is a tuple consisting of base change tuples corresponding to the summands.} output := <>; dec1 := Decomposition(L[1] : DegBound := DegBound); if #L eq 1 then return dec1; else for d in dec1 do L2 := [ BaseChange(L[i], d) : i in [2..#L] ]; dec2 := Decomposition(L2 : DegBound := DegBound); for a in dec2 do Append(~output, BaseChange(d,a)); end for; end for; return output; end if; end intrinsic; intrinsic Decomposition ( A :: AlgMat : DegBound := 0 ) -> Tup {Given a commutative matrix algebra, computes a decomposition of the standard vector space such that each a in A acts as multiplication by a scalar on each summand. The output is a tuple consisting of base change tuples corresponding to the summands.} return Decomposition(SetToSequence(Generators(A)) : DegBound := DegBound); end intrinsic; intrinsic DecompositionUpToConjugation ( L :: SeqEnum : DegBound := 0) -> Tup {Given a sequence L of commuting matrices, computes a decomposition of the standard vector space such that each l in L acts as multiplication by a scalar on each summand. The output is a tuple consisting of base change tuples corresponding to the summands. Summands conjugate under the absolute Galois group only appear once.} output := <>; dec1 := DecompositionUpToConjugation(L[1] : DegBound := DegBound); if #L eq 1 then return dec1; else for d in dec1 do L2 := [ BaseChange(L[i], d) : i in [2..#L] ]; dec2 := DecompositionUpToConjugation(L2 : DegBound := DegBound); for a in dec2 do Append(~output, BaseChange(d,a)); end for; end for; return output; end if; end intrinsic; intrinsic DecompositionUpToConjugation ( A :: AlgMat : DegBound := 0 ) -> Tup {Given a commutative matrix algebra, computes a decomposition of the standard vector space such that each a in A acts as multiplication by a scalar on each summand. The output is a tuple consisting of base change tuples corresponding to the summands. Summands conjugate under the absolute Galois group only appear once.} return DecompositionUpToConjugation(SetToSequence(Generators(A)) : DegBound := DegBound); end intrinsic; intrinsic AlgebraDecompositionUpToConjugation ( A :: AlgMat : DegBound := 0 ) -> SeqEnum {Given a matrix algebra A over a finite field k, returns a local factor of A tensor K for each Galois conjugacy class where K is the residue field of A.} L := SetToSequence(Generators(A)); dec := DecompositionUpToConjugation(L : DegBound := DegBound); return [MatrixAlgebra([BaseChange(l,D) : l in L]) : D in dec]; end intrinsic; intrinsic AlgebraDecomposition ( A :: AlgMat : DegBound := 0 ) -> SeqEnum {Given a matrix algebra A over a finite field k, returns a local factor of A tensor K where K is the residue field of A.} L := SetToSequence(Generators(A)); dec := Decomposition(L : DegBound := DegBound); return [MatrixAlgebra([BaseChange(l,D) : l in L]) : D in dec]; end intrinsic; intrinsic ChangeToResidueField ( A :: AlgMat ) -> SeqEnum {Given a matrix algebra A over a finite field k, returns a local factor of A tensor K for each Galois conjugacy class where K is the residue field of A.} L := SetToSequence(Generators(A)); dec := DecompositionUpToConjugation(L); return [MatrixAlgebra([BaseChange(l,D) : l in L]) : D in dec]; end intrinsic; // ---------------- affine algebras --------------------------------- forward HomogeneousBasis; HomogeneousBasis := function (R, n) if n eq 1 then return [[R.i : i in [1..Rank(R)]]]; else H := HomogeneousBasis(R,n-1); h := H[#H]; l := []; for g in h do for i in [1..Rank(R)] do s := g*R.i; if not (s in l) then Append(~l,s); end if; end for; end for; return Append(H,l); end if; end function; intrinsic AffineAlgebra (A :: AlgMat : try_minimal := true) -> RngMPolRes {Turn the local algebra A into an affine algebra over the residue field.} return AffineAlgebra(AffineAlgebraTup(A : try_minimal := try_minimal)); end intrinsic; intrinsic AffineAlgebra (A :: AlgAss : try_minimal := true) -> RngMPolRes {Turn the local algebra A into an affine algebra over the residue field.} return AffineAlgebra(AffineAlgebraTup(A : try_minimal := try_minimal)); end intrinsic; intrinsic AffineAlgebraTup (A :: AlgMat : try_minimal := true ) -> Tup {Given a local algebra A, return a tuple , consisting of the residue field k of A, the embedding dimension e, the nilpotency order n and relations R.} return AffineAlgebraTup(Algebra(A) : try_minimal := try_minimal); end intrinsic; intrinsic AffineAlgebraTup (A :: AlgAss : try_minimal := true) -> Tup {Given a local algebra A, return a tuple , consisting of the residue field k of A, the embedding dimension e, the nilpotency order n and relations R.} // determine the maximal ideal max := MaximalIdeals(A); error if #max ne 1, "Error. The algebra is not local!"; m := max[1]; // base change the algebra to its residue field and // take one conjugate factor. if Dimension(A) - Dimension(m) ne 1 then A := Algebra(AlgebraDecompositionUpToConjugation(MatrixAlgebra(A))[1]); max := MaximalIdeals(A); error if #max ne 1, "Error. The algebra is not local!"; m := max[1]; end if; // determine base field k := CoefficientRing(A); // determine the embedding dimension e e := Dimension(m) - Dimension(m^2); if e eq 0 then return >; end if; // determine the nilpotency order n // i.e. the maximum st m^n ne 0 n := 0; mi := m; while Dimension(mi) ne 0 do mi := mi*m; n := n+1; end while; // determine generators of m qu,phi := quo; psi := Inverse(phi); gen := [psi(ba) : ba in Basis(qu)]; // identify the algebra with a vector space V V := VectorSpace(k,Degree(Vector(ElementToSequence(gen[1])))); // get the relations L := []; // will contain a basis of m L1 := [];// will contain the elements of V corresponding to L M := <>; // will contain relations in a form to be stored M1 := [];// will contain relations as polynomials R := PolynomialRing(k,e); S := PolynomialRing(A,e); hp := HomogeneousBasis(R,n+1); if try_minimal then M1 := hp[n+1]; end if; for d := 1 to n do // d stands for degree for i := 1 to #hp[d] do f := hp[d][i]; if #L1 ne 0 then W := VectorSpaceWithBasis(L1); else W := sub; end if; v := V!Vector(ElementToSequence(m!Evaluate(S!f,gen))); if not (v in W) then Append(~L1,v); Append(~L,); else co := Coordinates(W,v); r := R!0; for j := 1 to #co do r := r+ co[j]*hp[L[j][1]][L[j][2]]; end for; rel := f-r; if not try_minimal then Append(~M,); else if not (rel in ideal) then Append(~M,); Append(~M1,rel); end if; end if; end if; end for; end for; return ; end intrinsic; intrinsic AffineAlgebra (form :: Rec) -> RngMPolRes {Given a modular form record, return the corresponding Hecke algebra as an affine algebra.} return AffineAlgebra (); end intrinsic; intrinsic AffineAlgebra (A :: Tup) -> RngMPolRes {Turns a tuple , consisting of a field k, two integers e,n (the embedding dimension and the nilpotency order) and relations R, into an affine algebra.} k := A[1]; e := A[2]; n := A[3]; M := A[4]; if e eq 0 then return k; end if; R := PolynomialRing(k,e); hp := HomogeneousBasis(R,n+1); W := [ : c in M]; L := []; for d := 1 to n do // d stands for degree for i := 1 to #hp[d] do if not ( in W) then Append(~L,); end if; end for; end for; idealgen := []; for m in M do co := m[3]; r := R!0; for i := 1 to #co do r := r+ co[i]*hp[L[i][1],L[i][2]]; end for; Append(~idealgen,hp[m[1]][m[2]]-r); end for; idealgen := idealgen cat hp[n+1]; return quo; end intrinsic; // ---------------- associative algebra manipulations ------------------- intrinsic Localisations ( A :: AlgAss ) -> SeqEnum {Returns a list of all localisations of the Artin associative algebra A (assumed to be commutative). The output is a list of associative algebras.} max := MaximalIdeals(A); if #max eq 1 then return [A]; end if; output := []; for m in max do n := m; while Dimension(m*n) ne Dimension(n) do n := n*m; end while; Append(~output,quo); end for; return output; end intrinsic; intrinsic Localisations ( L :: SeqEnum ) -> Tup, Tup {Given a list L of commuting matrices, this function computes two tuples C,D, where C contains a tuple consisting of the localisations of the matrix algebra generated by L, and D consists of the corresponding base change tuples.} return Localisations (MatrixAlgebra(L)); end intrinsic; intrinsic Localisations ( A :: AlgMat ) -> Tup, Tup {Given an Artin matrix algebra A which is assumed to be commutative, this function computes two tuples C,D, where C contains a tuple consisting of the localisations of A, and D consists of the corresponding base change tuples.} max := MaximalIdeals(A); gen := SetToSequence(Generators(A)); bctup := <>; alg := <>; for m in max do n := m; while Dimension(m*n) ne Dimension(n) do n := n*m; end while; bas := Basis (n); Vm := VectorSpace(BaseRing(A),Degree(A)); for i := 1 to #bas do Vm := Vm meet Kernel(bas[i]); end for; bcmat := BaseChangeMatrices(Vm); Append(~bctup,bcmat); Append(~alg, MatrixAlgebra([BaseChange(h,bcmat) : h in gen])); end for; return alg,bctup; end intrinsic; // ************************ Gorenstein property ***************************** intrinsic GorensteinDefect ( A :: RngMPolRes) -> RngIntElt {Returns the Gorenstein defect of the local commutative algebra A, that is the number of module generators of the annihilator of the maximal ideal minus one.} return GorensteinDefect(MatrixAlgebra(A)); end intrinsic; intrinsic GorensteinDefect ( A :: AlgAss) -> RngIntElt {Returns the Gorenstein defect of the local commutative algebra A, that is the number of module generators of the annihilator of the maximal ideal minus one.} return GorensteinDefect(MatrixAlgebra(A)); end intrinsic; intrinsic GorensteinDefect ( A :: AlgMat ) -> RngIntElt {Returns the Gorenstein defect of the local commutative algebra A, that is the number of module generators of the annihilator of the maximal ideal minus one.} local m,n,an; if Dimension(A) eq 0 then return 0; end if; A := Algebra(A); // change type m := MaximalIdeals(A); error if #m ne 1, "Error. The algebra is not local!"; an := LeftAnnihilator(A,m[1]); n := Dimension (A) - Dimension(m[1]); return ((Dimension(an)) div n) - 1; end intrinsic; intrinsic IsGorenstein ( M :: AlgMat ) -> BoolElt {Tests whether the commutative local algebra M is Gorenstein.} return (GorensteinDefect(M) eq 0); end intrinsic; intrinsic IsGorenstein ( M :: RngMPolRes ) -> BoolElt {Tests whether the commutative local algebra M is Gorenstein.} return (GorensteinDefect(M) eq 0); end intrinsic; intrinsic IsGorenstein ( M :: AlgAss ) -> BoolElt {Tests whether the commutative local algebra M is Gorenstein.} return (GorensteinDefect(M) eq 0); end intrinsic; // ************************ Regular representation *************************** intrinsic RegularRepresentation ( A :: AlgMat ) -> AlgMat {Computes the regular representation of the commutative matrix algebra A.} if Dimension(A) eq 0 then return A; end if; B := Basis(A); dim := #B; d := Degree(A); R := BaseRing(A); M := MatrixAlgebra(R,dim); L := []; Mt := RMatrixSpace(R,d,d); At := RMatrixSpaceWithBasis([Mt!b : b in B]); for b in B do l := M!0; for i := 1 to dim do l[i] := Vector(Coordinates(At,At!(b*B[i]))); end for; Append (~L, l); end for; return MatrixAlgebra(L); end intrinsic; // ************************* Lower triangular representation ****************** intrinsic IdealTorsion ( m :: AlgMat ) -> ModTupFld {Given an ideal m in a matrix algebra of degree d over a field F, calculate the sub vector space of F^d consisting of those elements killed by every element of m.} local g,i,Vi; if Degree(m) eq 0 then return VectorSpace(GF(2),0); end if; g := SetToSequence(Generators(m)); Vi := VectorSpace(CoefficientRing(m),Degree(m)); for i := 1 to #g do Vi := Vi meet (Kernel (g[i])); end for; return Vi; end intrinsic; intrinsic CommonLowerTriangular ( A :: AlgMat ) -> AlgMat {Given a local commutative matrix algebra A this function returns an isomorphic matrix algebra whose matrices are all lower triangular.} if Dimension(A) eq 0 then return A; end if; d := Degree(A); C := A!0; // the base change matrix to be determined L := []; // store the dimensions of the primary spaces in here r := 1; // row number of matrix C currently treated // get maximal ideals max := MaximalIdeals(A); error if #max ne 1, "Error. The algebra is not local. Number of factors:", #max; // for the maximal ideal m calculate the power m^i st m^i = m^(i+1) // and a basis of V[ m^i ], which becomes part of the basis to // be calculated n := max[1]; V := IdealTorsion (n); b := Basis(V); m := n * max[1]; while m ne n do W := IdealTorsion(m); b := ExtendBasis (b, W); n := m; m := m * max[1]; end while; for j := 1 to #b do C[j] := b[j]; end for; D := C^(-1); B := Basis(A); E := [BaseChange(b,) : b in B]; return MatrixAlgebra(E); end intrinsic; // *********** Hecke bound ************************** intrinsic HeckeBound ( N :: RngIntElt, k :: RngIntElt ) -> RngIntElt {Computes the Hecke bound for level N and weight k.} local B,L; B := k * N / 12; L := Factorization (N); for i := 1 to #L do B := B * (1 + (1/L[i][1])); end for; return Ceiling(B); end intrinsic; intrinsic HeckeBound ( eps :: GrpDrchElt, k :: RngIntElt ) -> RngIntElt {Computes the Hecke bound for the character eps in weight k.} return HeckeBound (Modulus(eps),k); end intrinsic; // -------------- Hecke algebra computation ------------------------ // Removes the first occurance of the entry p from the list, // and then includes p at the n-th place in the list. // If the list is too short, just append p at the end. function PutAt (list, p, n) i := Index(list,p); if i ne 0 then outlist := Remove(list,i); else outlist := list; end if; if #outlist lt (n-1) then return Append(outlist, p); else return outlist[1..(n-1)] cat [p] cat outlist[n..#outlist]; end if; end function; // returns true iff the degree of all algebras is factor times their dimension. function DimensionTest (OpList : factor := 2) vprint HeckeAlgebra: "Dimension testing..."; output := true; i := 1; while output and (i le #OpList) do deg := NumberOfRows(OpList[i][1]); dim := Dimension(MatrixAlgebra(OpList[i])); output := output and (factor*dim eq deg); i := i + 1; end while; return output; end function; intrinsic HeckeAlgebras (eps :: GrpDrchElt, weight :: RngIntElt : UserBound := 0, // overwrite HeckeBound by UserBound, 0 means usual HeckeBound first_test := 3, // when is the first dim test performed test_interval := 1, // after how many primes the dim test is performed when_test_p := 3, // in which step test T_p: 0 means usual point when_test_bad := 4, // in which step test T_l with l dividing the level test_sequence := [], // test these operators first dimension_factor := 2, // dimension test factor ms_space := 0, // 1 for plus, -1 minus space cuspidal := true, // use cuspical subspace DegreeBound := 0, // degree bound OperatorList := [], // list of precomputed Hecke operators, OperatorList[l] is the l-th op. over_residue_field := true, // change the output to residue field try_minimal := true, // should a minimal presentation of the affine algebras be tried? force_local := false // compute T_p's until local ) -> SeqEnum, SeqEnum, ModSym, Tup, Tup {Computes all local Hecke algebras (up to Galois conjugacy) in the specified weight for the given Dirichlet character. The function returns 5 values A,B,C,D,E. A contains a list of records of type AlgebraData describing the local Hecke algebra factors. B is a list containing the local Hecke algebra factors as matrix algebras. C is the space of modular symbols used in the computations. D is a tuple containing the base change tuples describing the local Hecke factors. Its knowledge is necessary in order to compute matrices representing Hecke operators in the local factor. Finally, E contains a tuple consisting of all computed Hecke operators for each local factor of the Hecke algebra. For a closer description and the usage of the option, please consult the manual.} form := rec< ModularFormFormat | Character := eps, Weight := weight >; return HeckeAlgebras(form : UserBound := UserBound, first_test := first_test, test_interval := test_interval, when_test_p := when_test_p, when_test_bad := when_test_bad, test_sequence := test_sequence, dimension_factor := dimension_factor, ms_space := ms_space, cuspidal := cuspidal, DegreeBound := DegreeBound, OperatorList := OperatorList, over_residue_field := over_residue_field, try_minimal := try_minimal, force_local := force_local); end intrinsic; intrinsic HeckeAlgebras ( t :: Rec : UserBound := 0, // overwrite HeckeBound by UserBound, 0 means usual HeckeBound first_test := 3, // when is the first dim test performed test_interval := 1, // after how many primes the dim test is performed when_test_p := 3, // in which step test T_p: 0 means usual point when_test_bad := 4, // in which step test T_l with l dividing the level test_sequence := [], // test these operators first dimension_factor := 2, // dimension test factor ms_space := 0, // 1 for plus, -1 minus space cuspidal := true, // use cuspical subspace DegreeBound := 0, // degree bound OperatorList := [], // list of precomputed Hecke operators, OperatorList[l] is the l-th op. over_residue_field := true, // change the output to residue field try_minimal := true, // should a minimal presentation of the affine algebras be tried? force_local := false // compute T_p's until local ) -> SeqEnum, SeqEnum, ModSym, Tup, Tup {Computes all local Hecke algebras (up to Galois conjugacy) corresponding to the specified modular form t which is supposed to be of type ModularFormFormat. The function returns 5 values A,B,C,D,E. A contains a list of records of type AlgebraData describing the local Hecke algebra factors. B is a list containing the local Hecke algebra factors as matrix algebras. C is the space of modular symbols used in the computations. D is a tuple containing the base change tuples describing the local Hecke factors. Its knowledge is necessary in order to compute matrices representing Hecke operators in the local factor. Finally, E contains a tuple consisting of all computed Hecke operators for each local factor of the Hecke algebra. For a closer description and the usage of the option, please consult the manual.} // Initialise some values. eps := t`Character; weight := t`Weight; p := Characteristic(CoefficientRing(eps)); N := Modulus(eps); // Is the Hecke bound overwritten? // Let HB contain the bound for the computation. if UserBound gt 0 then HB := UserBound; vprint HeckeAlgebra: "Warning. Using user given bound instead of Hecke bound!"; else HB := HeckeBound(N,weight); end if; // Is a ModularForm given? if assigned t`CoefficientFunction then have_mf := true; ModularForm := t`CoefficientFunction; else have_mf := false; end if; // Let M contain the modular symbols space specified // by the respective options. vprint HeckeAlgebra: "Getting modular symbols..."; if ms_space eq 0 then M := ModularSymbols(eps,weight); else M := ModularSymbols(eps,weight,ms_space); end if; if cuspidal then vprint HeckeAlgebra: "Getting cuspidal subspace."; M := CuspidalSubspace(M); end if; // Let TestList contain prime numbers indicating the // sequence in which Hecke operators will be computed. TestList := test_sequence; // Add all primes smaller than HB. l := 2; while l le HB do if not (l in TestList) then Append(~TestList,l); end if; l := NextPrime(l); end while; // Add p at the right place. if when_test_p gt 0 then TestList := PutAt(TestList,p,when_test_p); end if; // Add all "bad" primes at the right places. if when_test_bad gt 0 then for l in PrimeDivisors(N) do // Discard all bad primes beyond the real Hecke bound. if l le HeckeBound(N,weight) then TestList := PutAt(TestList,l,when_test_bad); end if; end for; end if; // Initialise data for the computation. Id := HeckeOperator(M,1); calc_step := 1; BC := <>; OpList := <[Id]>; stop_now := false; // Do the computation. while (calc_step le #TestList) and (not stop_now) do // Use the algorithm for the operator l. l := TestList[calc_step]; // If a list of operators is given, take the operator from it. if IsDefined(OperatorList,l) then vprint HeckeAlgebra: "Take Hecke operator",l,"from list."; T := OperatorList[l]; else vprint HeckeAlgebra: "Compute Hecke operator",l; T := HeckeOperator(M,l); end if; // Restrict the operator to all factors found so far, // and decompose further. NewBC := <>; NewOpList := <>; for i := 1 to #BC do bc := BC[i]; S := BaseChange(T,bc); S := MatrixAlgebra(CoefficientRing(S),NumberOfRows(S))!S; mipo := MinimalPolynomial(S); // If a modular form was given, get minimal polynomial from it. // Otherwise, factor the minimal polynomial of the operator. if (not have_mf) or (N*p mod l) eq 0 then vprint HeckeAlgebra: "Factor minimal polynomial."; FactorMipo := FactorisationDeg(mipo, DegreeBound); else pol := Factorisation(ModularForm(l)); FactorMipo := []; for po in pol do j := 1; while (mipo mod (po[1]^j)) eq 0 do j := j + 1; end while; Append(~FactorMipo,); end for; end if; // For every factor of the minimal polynomial of the operator, // resp. the minimal polynomial of the coefficient of the given modular form, // restrict the modular symbols space to the corresponding primary space. for fac in FactorMipo do vprint HeckeAlgebra: "Compute base change."; W := Kernel(Evaluate(fac[1]^(fac[2]),S)); if Dimension(W) ne 0 then bcmat := BaseChangeMatrices(W); Append(~NewBC,BaseChange(bc, bcmat)); Append(~NewOpList,[BaseChange(h,bcmat) : h in OpList[i]] cat [BaseChange(S,bcmat)]); end if; end for; end for; BC := NewBC; OpList := NewOpList; // Dimension testing if ((calc_step mod test_interval) eq 0) and (calc_step ge first_test) then // Is the stop criterion satisfied? stop_now := DimensionTest(OpList : factor := dimension_factor); // If force_local then only stop if all algebras are local. if force_local then // Check whether all algebras are local. ij := 1; while stop_now and (ij le #OpList) do stop_now := #MaximalIdeals(MatrixAlgebra(OpList[ij])) eq 1; ij := ij + 1; end while; end if; end if; // Make the next step. calc_step := calc_step + 1; end while; // Attention: the algebras need not yet be local. That will be // taken care of now. vprint HeckeAlgebra: "Doing final localisations..."; NewBC := <>; NewOpList := <>; AlgebraList := []; for i := 1 to #OpList do if over_residue_field then bctup := DecompositionUpToConjugation(OpList[i]); else _,bctup := Localisations(OpList[i]); end if; for bcmat in bctup do Append(~NewBC,BaseChange(BC[i],bcmat)); ol := [BaseChange(h,bcmat) : h in OpList[i]]; Append(~NewOpList,ol); Append(~AlgebraList,MatrixAlgebra(ol)); end for; end for; BC := NewBC; OpList := NewOpList; vprint HeckeAlgebra: "Creating output..."; // create output DataList := []; for a in AlgebraList do b := AffineAlgebraTup(a : try_minimal := try_minimal); outEl := rec < AlgebraData | Level := N, Weight := weight, Characteristic := p, BaseFieldDegree := Degree(CoefficientRing(eps)), CharacterOrder := Order(eps), CharacterConductor := Conductor(eps), CharacterIndex := Index(Elements(Parent(eps)), eps), AlgebraFieldDegree := Degree(b[1]), ResidueDegree := Degree(CoefficientRing(a)) * (Dimension(a) - Dimension(MaximalIdeals(a)[1])), Dimension := Dimension(a), GorensteinDefect := GorensteinDefect(a), EmbeddingDimension := b[2], NilpotencyOrder := b[3], Relations := b[4], NumberGenUsed := calc_step - 1 >; if assigned t`ImageName then outEl`ImageName := t`ImageName; end if; if assigned t`Polynomial then outEl`Polynomial := t`Polynomial; end if; Append(~DataList, outEl); end for; return DataList, AlgebraList, M, BC, OpList; end intrinsic; // -------------- storing and reloading ----------------------------- intrinsic CreateStorageFile ( filename :: MonStgElt ) {Creates a file for storing data.} PrintFile(filename,"// File for storing Hecke algebra data." : Overwrite := true); PrintFile(filename,"LoadIn := [];"); PrintFile(filename,"LoadInRel := <>;\n"); end intrinsic; intrinsic StoreData (filename :: MonStgElt, forms :: SeqEnum) {Appends the list of Hecke algebra data forms to the file filename. That file must have been created by CreateStorageFile.} for a in forms do StoreData(filename,a); end for; end intrinsic; intrinsic StoreData (filename :: MonStgElt, form :: Rec) {Appends the Hecke algebra data form to the file filename. That file must have been created by CreateStorageFile.} if not assigned form`ImageName then form`ImageName := ""; end if; if not assigned form`Polynomial then form`Polynomial := PolynomialRing(Integers())!0; end if; s := "Append(~LoadIn, "* Sprint(< form`Level, form`Weight, form`Characteristic, form`BaseFieldDegree, form`CharacterOrder, form`CharacterConductor, form`CharacterIndex, form`AlgebraFieldDegree, form`ResidueDegree, form`Dimension, form`GorensteinDefect, form`EmbeddingDimension, form`NilpotencyOrder, form`NumberGenUsed, "\""*form`ImageName*"\"", Sprint(form`Polynomial, "Magma") >)*");\n"; if #form`Relations eq 0 then s := s * "Append(~LoadInRel, <>);\n"; else hKi := Parent(form`Relations[1][3][1]); s := s*"hKi := "*Sprint(Parent(form`Relations[1][3][1]),"Magma")*";\n"; s := s * "Append(~LoadInRel, "* Sprint(form`Relations,"Magma") *");\n"; end if; PrintFile (filename,s); end intrinsic; intrinsic RecoverData (LoadIn :: SeqEnum, LoadInRel :: Tup ) -> SeqEnum {In order to read Hecke algebra data from file filename, proceed as follows: load filename; readData := RecoverData(LoadIn,LoadInRel).} FormList := []; for i := 1 to #LoadIn do newEl := rec < AlgebraData | Level := LoadIn[i][1], Weight := LoadIn[i][2], Characteristic := LoadIn[i][3], BaseFieldDegree := LoadIn[i][4], CharacterOrder := LoadIn[i][5], CharacterConductor := LoadIn[i][6], CharacterIndex := LoadIn[i][7], AlgebraFieldDegree := LoadIn[i][8], ResidueDegree := LoadIn[i][9], Dimension := LoadIn[i][10], GorensteinDefect := LoadIn[i][11], EmbeddingDimension := LoadIn[i][12], NilpotencyOrder := LoadIn[i][13], NumberGenUsed := LoadIn[i][14], ImageName := LoadIn[i][15], Polynomial := LoadIn[i][16], Relations := LoadInRel[i] >; Append(~FormList,newEl); end for; return FormList; end intrinsic; // ------------------ A5 handling -------------------------------- // test for wild ramification IsWR := function (L) outp := false; for l in L do p := l[1]; for r in l[2] do outp := outp or ((r[1] mod p) eq 0); end for; end for; return outp; end function; // for a ramification tuple return the // mod 2 conductor and the order of twist. getCond := function (t) s := SequenceToSet(t[2]); if <5,1> in s then if (t[1]-1) mod 5 eq 0 then return ; else return ; end if; elif (<3,1> in s) then if (t[1]-1) mod 3 eq 0 then return ; else return ; end if; else return ; end if; end function; getChar := function (cond) eps := DirichletGroup(1,GF(2))!1; N := 1; deg := 1; for c in cond do if c[3] eq 1 then G := DirichletGroup(c[1],GF(2)); eps1 := G!1; elif c[3] eq 3 then G := [e : e in Elements(DirichletGroup(c[1],GF(4))) | Order(e) eq 3]; if deg eq 1 then deg := 2; end if; if #G eq 0 then eps1 := DirichletGroup(c[1],GF(2,deg))!1; else eps1 := G[1]; end if; elif c[3] eq 5 then G := [e : e in Elements(DirichletGroup(c[1],GF(16))) | Order(e) eq 5]; deg := 4; if #G eq 0 then eps1 := DirichletGroup(c[1],GF(2,deg))!1; else eps1 := G[1]; end if; end if; N := N * c[1]; eps := DirichletGroup(N,GF(2,deg))!eps * DirichletGroup(N,GF(2,deg))!eps1; end for; return eps; end function; getCoeffPoly := function(l,eps,f) K := NumberField(f); O := MaximalOrder(K); R := PolynomialRing(CoefficientRing(eps)); F := {Degree(P[1]) : P in Factorisation(l*O)}; if 5 in F then return x^2 + Evaluate(eps,l)*x + Evaluate(eps,l)^2; elif 3 in F then return x + Evaluate(eps,l); else return x; end if; end function; intrinsic A5Form (f :: RngUPolElt) -> Rec {Returns the A5 form in characteristic 2 and weight 2 of smallest predicted level corresponding to the polynomial f. No checks about f are performed.} K := NumberField(f); O := MaximalOrder(K); D := Factorisation(Discriminant(O)); // get ramification type L := []; for d in D do p := d[1]; F := Factorisation(p*O); Append(~L, : P in F]>); end for; // test for wild ramification error if IsWR(L), "Error. Wild ramification is not supported."; // compute the conductor cond := [getCond(l) : l in L]; co := 1; for c in cond do co := co * (c[1]^(c[2])); end for; // compute the character eps := getChar(cond); // give it the good modulus eps := DirichletGroup(co,CoefficientRing(eps))!eps; // compute the coefficient function coeff := map< Integers() -> PolynomialRing(CoefficientRing(eps)) | l :-> getCoeffPoly(l,eps,f) >; form := rec< ModularFormFormat | Character := eps^2, Weight := 2, CoefficientFunction := coeff, ImageName := "A_5", Polynomial := f >; return form; end intrinsic; // ---------------- dihedral handling -------------------- intrinsic GetLegendre (N :: RngIntElt, K :: FldFin ) -> GrpDrchElt {For an odd integer N this function returns the element of the DirichletGroup(Abs(N),K) (with K a finite field of char ne 2) which corresponds to the Legendre symbol p |-> (+-N/p). The sign in front of N is chosen so that the number is congruent to 1 mod 4. } G := DirichletGroup(Abs(N),K); if Characteristic(K) eq 2 then return G!1; end if; // choose N such that the quadratic field K // is unramified at 2 if (N mod 4) eq 3 then N := -N; elif ((N mod 4) eq 0) or ((N mod 4) eq 2) then print "N even is not supported."; return G!1; end if; E := [ e : e in Elements(G) | (Order(e) eq 2)]; p := 3; while #E gt 1 do if (N mod p) ne 0 then E1 := []; for e in E do if K!(LegendreSymbol(N,p)) eq e(p) then Append(~E1,e); end if; end for; E := E1; end if; p := NextPrime(p); end while; return E[1]; end intrinsic; // modified Legendre symbol LS := function(a,b) if b eq 2 then if IsSplit(2,MaximalOrder(QuadraticField(a))) then return 1; else return -1; end if; else return LegendreSymbol(a,b); end if; end function; intrinsic DihedralFieldDegree (n :: Any, p :: Any) -> Any {For an integer n>0 and a prime p this function returns the smallest d such that the traces of D_n as a subgroup of GL_2(F_p^bar) all lie in F_(p^d).} // compute the smallest power p^r such that p^r+1 or p^r-1 is divisible by n i := 1; while ((((p^i) +1) mod n) ne 0) and ((((p^i) -1) mod n) ne 0) do i := i + 1; end while; return i; end intrinsic; intrinsic DihedralForms (N :: RngIntElt : bound := 100, ListOfPrimes := [], completely_split := true, odd_only := true, quad_disc := 0, all_conjugacy_classes := true ) -> Rec {Gets all modular forms in level N over a finite field of characteristic p that come from dihedral representations which arise from the quadratic field K=Q(sqrt(+-quad_disc)) by induction of an unramified character of K. If quad_disc is 0, then N is used instead. The sign in front of quad_disc is chosen so that the number is congruent to 1 mod 4. If the option completely_split is set, only those representations are returned which are completely split at p. If the option ListOfPrimes is set, only those primes are considered as characteristic. If it is the empty set, all primes up to the bound are taken into consideration. If if the odd_only is true, only odd representations will be returned. If all_conjugacy_classes is true, all conjugacy classes of the character of the quadratic field are used, otherwise, only one is taken.} if ListOfPrimes eq [] then ListOfPrimes := [p : p in [1..bound] | IsPrime(p)]; end if; level := N; if quad_disc ne 0 then N := quad_disc; end if; // choose N such that the quadratic field K // is unramified at 2 if (N mod 4) eq 3 then N := -N; elif ((N mod 4) eq 0) or ((N mod 4) eq 2) then print "N even is not yet programmed."; return <>; end if; K := NumberField(Polynomial([-N,0,1])); O := MaximalOrder(K); CL,phi := ClassGroup(O); psi := Inverse(phi); output := []; for g in Subgroups(CL) do H,alpha := quo; h := #H; if (h ne 1) and IsCyclic(H) then for p in ListOfPrimes do if IsPrime(p) and ((N mod p) ne 0) and ((h mod p) ne 0) and ((not completely_split) or (IsSplit(p,O) and (Order(alpha(psi(Factorisation(p*O)[1][1]))) eq 1))) then d := DihedralFieldDegree(h,p); eps := GetLegendre(N,GF(p)); // possibly make modulus bigger eps := DirichletGroup(level, BaseRing(eps))!eps; // run through all Gal(Fbar/F_p)-conjugacy classes // of h-th roots of unity; but never take both zeta and its inverse factors := Factorisation(PolynomialRing(GF(p))!CyclotomicPolynomial(h)); if not all_conjugacy_classes then factors := [factors[1]]; end if; SetOfZetas := []; SetOfFactors := []; for fac in factors do zeta := -Evaluate(Factorisation(PolynomialRing(GF(p,Degree(fac[1])))!(fac[1]))[1][1],0); if not (MinimalPolynomial(zeta^(-1)) in SetOfFactors) then Append(~SetOfZetas,zeta); Append(~SetOfFactors,fac[1]); end if; end for; for zeta in SetOfZetas do beta := map < Integers() -> PolynomialRing(GF(p)) | l :-> MinimalPolynomial( (GF(p,d)!((LS(N,l) + 1) div 2)) * (zeta^(ElementToSequence(alpha(psi(Factorisation(l*O)[1][1])))[1] ) + zeta^(- ElementToSequence(alpha(psi(Factorisation(l*O)[1][1])))[1]) )) >; form := rec< ModularFormFormat | Character := eps, Weight := p, CoefficientFunction := beta, ImageName := "D_\{"*Sprint(h)*"\}" >; if (not odd_only) or (Evaluate(eps,-1) eq -1) then Append(~output, form); end if; end for; end if; end for; end if; end for; return output; end intrinsic; // ------------------ general functions ---------------------------- // This function can be very much improved upon for small // degrees by trying all irreducible small polynomials!!!!! intrinsic FactorisationDeg ( f :: Any, deg :: RngIntElt ) -> SeqEnum {Computes the factors of f up to degree deg. If deg is zero, this is the usual factorisation function.} if deg eq 0 then return Factorisation(f); else return [F : F in Factorisation(f) | Degree(F[1]) le deg]; end if; end intrinsic; intrinsic FactorisationFpbar ( f :: Any ) -> Any {Factorisation of the polynomial f with coefficients in a finite field over an algebraic closure.} k := CoefficientRing(f); F := Factorisation(f); L := [Degree(a[1]) : a in F]; d := Lcm(L); K := ext; R := PolynomialRing(K); return Factorisation(R!f); end intrinsic; // ------------------ generate LaTeX / nice output ------------------ intrinsic HeckeAlgebraPrint (ha :: SeqEnum) {Prints part of the data stored in the list ha of records of type AlgebraData in a human readable format.} for i:=1 to #ha do s := ""; if assigned ha[i]`Level then s := s*"Level "*Sprint(ha[i]`Level); end if; if assigned ha[i]`Weight then s := s*", Weight "*Sprint(ha[i]`Weight); end if; if assigned ha[i]`Characteristic then s := s*", Characteristic "*Sprint(ha[i]`Characteristic); end if; if assigned ha[i]`GorensteinDefect then s := s*", Gorenstein defect "*Sprint(ha[i]`GorensteinDefect); end if; if assigned ha[i]`Dimension then s := s*", Dimension "*Sprint(ha[i]`Dimension); end if; if assigned ha[i]`NumberGenUsed then s := s*", Number of operators used "*Sprint(ha[i]`NumberGenUsed); end if; if (assigned ha[i]`Level) and (assigned ha[i]`Weight) then s := s*", Primes lt Hecke bound "*Sprint(#PrimesUpTo(HeckeBound(ha[i]`Level,ha[i]`Weight))); end if; if assigned ha[i]`ResidueDegree then s := s*", Residue degree "*Sprint(ha[i]`ResidueDegree); end if; print s; end for; end intrinsic; intrinsic HeckeAlgebraPrint1 (ha :: SeqEnum) {Prints part of the data stored in the list ha of records of type AlgebraData in a human readable format.} for i:=1 to #ha do if assigned ha[i]`Level then print "Level",ha[i]`Level; end if; if assigned ha[i]`Weight then print "Weight",ha[i]`Weight; end if; if assigned ha[i]`Characteristic then print "Characteristic",ha[i]`Characteristic; end if; if assigned ha[i]`GorensteinDefect then print "Gorenstein defect",ha[i]`GorensteinDefect; end if; if assigned ha[i]`Dimension then print "Dimension",ha[i]`Dimension; end if; if assigned ha[i]`NumberGenUsed then print "Number of operators used",ha[i]`NumberGenUsed; end if; if (assigned ha[i]`Level) and (assigned ha[i]`Weight) then print "Primes lt Hecke bound",#PrimesUpTo(HeckeBound(ha[i]`Level,ha[i]`Weight)); end if; if assigned ha[i]`ResidueDegree then print "Residue degree",ha[i]`ResidueDegree; end if; print "---------------------------"; end for; end intrinsic; intrinsic GetLevel (a :: Rec) -> Any {Returns the level of a which must be a record of type AlgebraData.} if assigned a`Level then return a`Level; else return ""; end if; end intrinsic; intrinsic GetWeight (a :: Rec) -> Any {Returns the weight of a which must be a record of type AlgebraData.} if assigned a`Weight then return a`Weight; else return ""; end if; end intrinsic; intrinsic GetCharacteristic (a :: Rec) -> Any {Returns the characteristic of a which must be a record of type AlgebraData.} if assigned a`Characteristic then return a`Characteristic; else return ""; end if; end intrinsic; intrinsic GetResidueDegree (a :: Rec) -> Any {Returns the residue degree of a which must be a record of type AlgebraData.} if assigned a`ResidueDegree then return a`ResidueDegree; else return ""; end if; end intrinsic; intrinsic GetDimension (a :: Rec) -> Any {Returns the dimension of a which must be a record of type AlgebraData.} if assigned a`Dimension then return a`Dimension; else return ""; end if; end intrinsic; intrinsic GetGorensteinDefect (a :: Rec) -> Any {Returns the GorensteinDefect of a which must be a record of type AlgebraData.} if assigned a`GorensteinDefect then return a`GorensteinDefect; else return ""; end if; end intrinsic; intrinsic GetEmbeddingDimension (a :: Rec) -> Any {Returns the embedding dimension of a which must be a record of type AlgebraData.} if assigned a`EmbeddingDimension then return a`EmbeddingDimension; else return ""; end if; end intrinsic; intrinsic GetNilpotencyOrder (a :: Rec) -> Any {Returns the nilpotency order of a which must be a record of type AlgebraData.} if assigned a`NilpotencyOrder then return a`NilpotencyOrder; else return ""; end if; end intrinsic; intrinsic GetNumberOperatorsUsed (a :: Rec) -> Any {Returns the number of operators used for a which must be a record of type AlgebraData.} if assigned a`NumberGenUsed then return a`NumberGenUsed; else return ""; end if; end intrinsic; intrinsic GetHeckeBound (a :: Rec) -> Any {Returns the Hecke bound for a which must be a record of type AlgebraData.} if (assigned a`Weight) and (assigned a`Level) then return HeckeBound(a`Level, a`Weight); else return ""; end if; end intrinsic; intrinsic GetPrimesUpToHeckeBound (a :: Rec) -> Any {Returns how many primes there are up to the Hecke bound for a which must be a record of type AlgebraData.} if (assigned a`Weight) and (assigned a`Level) then return #PrimesUpTo(HeckeBound(a`Level, a`Weight)); else return ""; end if; end intrinsic; intrinsic GetPolynomial (a :: Rec) -> Any {Returns the polynomial of a which must be a record of type AlgebraData.} if assigned a`Polynomial then return a`Polynomial; else return ""; end if; end intrinsic; intrinsic GetImageName (a :: Rec) -> Any {Returns the name of the image of a which must be a record of type AlgebraData.} if assigned a`ImageName then return "$"*a`ImageName*"$"; else return ""; end if; end intrinsic; intrinsic HeckeAlgebraLaTeX (ha :: SeqEnum, filename :: MonStgElt : which := [ , , , , , , , , , ] ) {Creates the LaTeX file filename containing a longtable consisting of certain properties of the objects in ha which are records of type AlgebraData. The properties to be written are indicated by the option which that is a list consisting of tuples . Here f is a function that evaluates a record of type AlgebraData to some Magma object which is afterwards transformed into a string using Sprint. The name will appear in the table header.} // print table header s := ""; for l in which do s := s*"|c"; end for; PrintFile (filename,"\\begin{longtable}{|"*s*"||}" : Overwrite := true); PrintFile (filename, "\\hline"); // print first row s := ""; for i := 1 to #which do s := s*which[i][2]; if i eq #which then s := s*" \\\\"; else s := s*" & "; end if; end for; PrintFile (filename, s); PrintFile (filename, "\\hline\\endhead\\hline\\endfoot\\hline\\hline\\endlastfoot"); for a in ha do s := ""; for i := 1 to #which do s := s*Sprint(which[i][1](a)); if i eq #which then s := s*" \\\\"; else s := s*" & "; end if; end for; PrintFile (filename, s); end for; // print table bottom PrintFile (filename, "\\end{longtable}"); end intrinsic;