CoCalc Public Fileswww / tables / magma_src / ModFrm / operators.mOpen with one click!
Author: William A. Stein
1
freeze;
2
3
/****-*-magma-* EXPORT DATE: 2004-03-08 ************************************
4
5
MODFORM: Modular Forms in MAGMA
6
7
William A. Stein
8
9
FILE: operators.m
10
11
01/04/04 (WAS) - fixed bug in the require statement in
12
"intrinsic AtkinLehnerOperator(M::ModFrm, q::RngIntElt)"
13
14
15
16
04/06/03 (WAS) - added caching of eigenvector for T2 when computing level 1 charpolys.
17
18
04/06/03 (WAS) - found bug in charpoly routine: In a part of HeckePolynomial it
19
was finding charpoly of Tn instead of T2 which led to a hang.
20
21
04/05/03 (WAS) - fixed bug in HeckeOperator (it said BaseField instead
22
of BaseRing at a certain point).
23
24
$Header: /home/was/magma/packages/ModFrm/code/RCS/operators.m,v 1.9 2002/10/20 06:30:02 was Exp was $
25
26
$Log: operators.m,v $
27
Revision 1.9 2002/10/20 06:30:02 was
28
Fixed serious bug in function WqOnNewSpace(M, q, prec) that meant Wq was
29
computed wrt wrong basis.
30
31
Revision 1.8 2002/05/04 18:33:24 was
32
Made AtkinLehnerOperator much much more efficient by not computing T_p.
33
34
Revision 1.7 2002/04/25 05:34:11 was
35
some improvements to HeckePolynomial in the level 1 case.
36
37
Revision 1.6 2002/04/25 00:21:40 was
38
*** empty log message ***
39
40
Revision 1.5 2001/07/13 02:33:01 was
41
Changed a name.
42
43
Revision 1.4 2001/06/08 06:49:36 was
44
Added AtkinLehnerEigenvalue
45
46
Revision 1.3 2001/05/30 18:56:17 was
47
Created.
48
49
Revision 1.2 2001/05/16 04:11:40 was
50
*** empty log message ***
51
52
Revision 1.1 2001/05/16 03:52:06 was
53
Initial revision
54
55
56
***************************************************************************/
57
58
forward
59
ApplyHeckeOperator,
60
ComputeHeckePolynomialUsingHeckeOperator,
61
Tn, Tp;
62
63
import "eisenstein.m":
64
AtkinLehnerOnEisensteinModularFormsSpace;
65
66
import "level1.m":
67
Level1CharacteristicPolynomialOfTp,
68
EigenvectorOfMatrixWithCharpoly;
69
70
import "modular_symbols.m":
71
MF_ModularSymbols;
72
73
import "predicates.m":
74
AssociatedSpaceOverZ,
75
SpaceType,
76
SpaceTypeParam;
77
78
intrinsic HeckeOperator(M::ModFrm, n::RngIntElt) -> AlgMatElt
79
{Matrix representing the n-th Hecke operator on M.}
80
require IsGamma0(M) :
81
"Hecke operator computation currently only supported for Gamma_0(N).";
82
requirege n, 1;
83
if not assigned M`hecke_operator then
84
M`hecke_operator := [];
85
end if;
86
if exists(i) { i : i in [1..#M`hecke_operator]
87
| M`hecke_operator[i][1] eq n } then
88
return M`hecke_operator[i][2];
89
end if;
90
if n eq 1 then
91
Tn := MatrixAlgebra(BaseRing(M),Dimension(M))!1;
92
else
93
Tn := MatrixAlgebra(BaseRing(M),Dimension(M))!
94
&cat[Eltseq(ApplyHeckeOperator(n,M.i)) : i in [1..Dimension(M)]];
95
end if;
96
Append(~M`hecke_operator,<n,Tn>);
97
return Tn;
98
end intrinsic;
99
100
function ApplyHeckeOperator(n, f)
101
// The image of f under the n-th Hecke operator.
102
assert Type(n) eq RngIntElt;
103
assert Type(f) eq ModFrmElt;
104
assert IsGamma0(Parent(f));
105
if n eq 1 then
106
return f;
107
end if;
108
prec := (n+1)*PrecisionBound(AmbientSpace(Parent(f)));
109
Tnf := Tn(Level(f), DirichletGroup(Level(f),Integers())!1, Weight(f), n,
110
PowerSeries(f, prec));
111
return Parent(f)!Tnf;
112
end function;
113
114
intrinsic AtkinLehnerEigenvalue(f::ModFrmElt, q::RngIntElt) -> RngElt
115
{The eigenvalue of the Atkin-Lehner involution W_q on the cuspidal newform f.}
116
if assigned f`elliptic_curve and not assigned f`mf_modular_symbols then
117
require false : "Not yet programmed for elliptic curve newforms.";
118
end if;
119
require assigned f`is_newform and f`is_newform and
120
assigned f`mf_modular_symbols : "f must be a cuspidal newform.";
121
Wq := AtkinLehner(f`mf_modular_symbols,q);
122
assert IsDiagonal(Wq);
123
return Wq[1,1];
124
end intrinsic;
125
126
127
function CoerceUnivariatePolynomialElement(R, f)
128
assert Type(R) eq RngUPol;
129
assert Type(f) eq RngUPolElt;
130
return &+[R.1^i*(R!(Integers()!Coefficient(f,i))) : i in [0..Degree(f)]];
131
end function;
132
133
134
function GaloisConjugatesOfPolynomial(f)
135
assert Type(f) eq RngUPolElt;
136
F := BaseRing(Parent(f));
137
if Degree(F) eq 1 then
138
return [f];
139
end if;
140
assert Type(F) eq FldCyc;
141
X := Parent(f).1;
142
ans := [f];
143
m := CyclotomicOrder(F);
144
for n in [2..EulerPhi(m)] do
145
Append(~ans,&+[Conjugate(Coefficient(f,j),n)*X^j : j in [0..Degree(f)]]);
146
end for;
147
return ans;
148
end function;
149
150
function ComputeHeckePolynomialOfModularSymbolsSpace(M, modsym, n, Proof)
151
assert Type(M) eq ModFrm;
152
assert Type(modsym) eq ModSym;
153
assert Type(n) eq RngIntElt and n ge 1;
154
assert Type(Proof) eq BoolElt;
155
156
if Dimension(M) eq 0 then
157
return PolynomialRing(BaseRing(M))!1;
158
end if;
159
f := HeckePolynomial(modsym, n : Proof := Proof);
160
normf := &*GaloisConjugatesOfPolynomial(f);
161
return normf;
162
163
end function;
164
165
function CharpolyOfEigenvalue(a)
166
if Type(Parent(a)) eq FldRat then
167
return PolynomialRing(RationalField()).1 - a;
168
end if;
169
return CharacteristicPolynomial(a);
170
end function;
171
172
function ComputeHeckePolynomialUsingEisensteinSeries(M,n)
173
assert Type(M) eq ModFrm;
174
assert IsEisenstein(M);
175
assert GCD(Level(M),n) eq 1;
176
177
if Dimension(M) eq 0 then
178
return PolynomialRing(BaseRing(M))!1;
179
end if;
180
181
// This is incorrect, because the n-th coefficient of the
182
// Eisenstein series need not be the Eigenvalue of T_n,
183
// except in some special cases.
184
print "Computing Hecke polynomial on Eisenstein series not yet implemented. (Returning 1.)";
185
R := PolynomialRing(CyclotomicField(EulerPhi(Level(M))));
186
return R!1;
187
188
E := EisensteinSeries(M);
189
F := &*[R|R.1 - R!Coefficient(PowerSeries(f,n+1),n) : f in E];
190
return F;
191
end function;
192
193
194
function ComputeHeckePolynomialUsingModularSymbols(M,n, Proof)
195
assert Type(M) eq ModFrm;
196
assert Type(n) eq RngIntElt;
197
assert Type(Proof) eq BoolElt;
198
199
if Dimension(M) eq 0 then
200
return PolynomialRing(BaseRing(M))!1;
201
end if;
202
if IsEisenstein(M) then
203
if IsNew(M) then
204
if IsGamma0(M) then
205
return ComputeHeckePolynomialUsingHeckeOperator(M,n,Proof);
206
else
207
error "Not yet programmed -- I haven't coded an algorithm to compute "*
208
"the char poly of T_n on the new Eisenstein series when n divides "*
209
"the level (and we're not in the Gamma_0(N) case).";
210
211
end if;
212
end if;
213
modsym := MF_ModularSymbols(M,0);
214
return &*[ComputeHeckePolynomialOfModularSymbolsSpace(M,m,n,Proof)
215
: m in modsym];
216
elif IsCuspidal(M) then
217
modsym := MF_ModularSymbols(M,+1);
218
return &*[ComputeHeckePolynomialOfModularSymbolsSpace(M,m,n,Proof)
219
: m in modsym];
220
end if;
221
222
return ComputeHeckePolynomialUsingModularSymbols(
223
EisensteinSubspace(M),n,Proof) *
224
ComputeHeckePolynomialUsingModularSymbols(
225
CuspidalSubspace(M),n,Proof) ;
226
end function;
227
228
229
230
function ComputeHeckePolynomialUsingHeckeOperator(M, n, Proof)
231
assert Type(M) eq ModFrm;
232
assert Type(n) eq RngIntElt;
233
assert Type(Proof) eq BoolElt;
234
Tn := HeckeOperator(M,n);
235
if Type(BaseRing(M)) in {RngInt, FldRat} then
236
return CharacteristicPolynomial(Tn : Al := "Modular", Proof := Proof);
237
end if;
238
return CharacteristicPolynomial(Tn);
239
end function;
240
241
242
intrinsic HeckePolynomial(M::ModFrm, n::RngIntElt :
243
Proof := false) -> AlgMatElt
244
{The characteristic polynomial of the n-th Hecke operator on M.}
245
require n ge 1 : "Argument 2 must be at least 1.";
246
if not assigned M`hecke_polynomial then
247
M`hecke_polynomial := []; // sequence of pairs <n,f(x)>
248
end if;
249
250
if exists(i) { i : i in [1..#M`hecke_polynomial]
251
| M`hecke_polynomial[i][1] eq n } then
252
return M`hecke_polynomial[i][2];
253
end if;
254
255
vprint ModularForms, 2: "Computing Hecke polynomial of index", n;
256
if n eq 1 then
257
f := (PolynomialRing(BaseRing(M)).1-1)^Dimension(M);
258
elif assigned M`made_from_newform then
259
f := CharpolyOfEigenvalue(
260
Coefficient(PowerSeries(M`made_from_newform,n+1),n));
261
elif Characteristic(BaseRing(M)) eq 0 and Level(M) eq 1 and n le Dimension(CuspidalSubspace(M)) and Proof eq false then
262
A := AssociatedSpaceOverZ(CuspidalSubspace(M));
263
assert Dimension(A) eq Dimension(CuspidalSubspace(M));
264
d := Dimension(A);
265
T2 := HeckeOperator(A,2); // yes, T2, because my algorithm uses T2!!
266
if exists(i) { i : i in [1..#A`hecke_polynomial]
267
| A`hecke_polynomial[i][1] eq n } then
268
f2 := A`hecke_polynomial[i][2];
269
else
270
vprint ModularForms, 2:
271
"Computing characteristic polynomial of T_2 using standard algorithm.";
272
t := Cputime();
273
f2 := CharacteristicPolynomial(T2 : Proof := false, Al := "Modular");
274
vprintf ModularForms, 2: "Time = %o seconds\n", Cputime(t);
275
Append(~A`hecke_polynomial, <2, f2>);
276
end if;
277
278
if not assigned A`t2_eigenvector then
279
T2Q := MatrixAlgebra(RationalField(),Nrows(T2))!Eltseq(T2);
280
f2Q := PolynomialRing(RationalField())!f2;
281
A`t2_eigenvector := EigenvectorOfMatrixWithCharpoly(T2Q, f2Q);
282
end if;
283
284
if n gt 2 then
285
cuspidal_part := Level1CharacteristicPolynomialOfTp(Weight(A),n,d,A`t2_eigenvector);
286
else
287
cuspidal_part := f2;
288
end if;
289
eisenstein_part := ComputeHeckePolynomialUsingEisensteinSeries(EisensteinSubspace(M), n);
290
f := cuspidal_part * eisenstein_part;
291
292
else
293
MC := AssociatedSpaceOverZ(M);
294
if GCD(Level(M),n) eq 1 then
295
f_cuspidal := ComputeHeckePolynomialUsingModularSymbols(
296
CuspidalSubspace(MC), n, Proof);
297
f_eisenstein := ComputeHeckePolynomialUsingEisensteinSeries(
298
EisensteinSubspace(MC), n);
299
f := f_cuspidal * f_eisenstein;
300
else
301
f := ComputeHeckePolynomialUsingModularSymbols(MC, n, Proof);
302
end if;
303
end if;
304
f := CoerceUnivariatePolynomialElement(PolynomialRing(BaseRing(M)), f);
305
Append(~M`hecke_polynomial, <n, f>);
306
return f;
307
end intrinsic;
308
309
function Tp(N, eps, k, p, r, f)
310
assert Type(p) eq RngIntElt;
311
assert Type(r) eq RngIntElt;
312
assert Type(f) eq RngSerPowElt;
313
314
if r gt 1 then
315
return Tp(N,eps,k, p,1,Tp(N,eps,k,p,r-1,f))
316
- Evaluate(eps,p)*p^(k-1)*Tp(N,eps,k,p,r-2,f);
317
end if;
318
if r eq 1 then
319
R := Parent(f);
320
q := R.1;
321
prec := Floor(((AbsolutePrecision(f)-1)/p) + 1);
322
h := &+[R|Coefficient(f,n*p)*q^n +
323
Evaluate(eps,p)*p^(k-1)*Coefficient(f,n)*q^(n*p) :
324
n in [0..prec-1]] + O(q^prec);
325
return h;
326
end if;
327
if r eq 0 then
328
return f;
329
end if;
330
end function;
331
332
function Tn(N, eps, k, n, f)
333
// The image T_n(f) of f under the Hecke operator T_n on level-N
334
// weight-k modular forms with character eps.
335
assert Type(N) eq RngIntElt and N ge 1;
336
assert Type(n) eq RngIntElt and n ge 1;
337
assert Type(k) eq RngIntElt and k ge 2;
338
assert Type(eps) eq GrpDrchElt;
339
assert Type(f) eq RngSerPowElt;
340
341
for p in Factorization(n) do
342
f := Tp(N, eps, k, p[1],p[2], f);
343
end for;
344
return f;
345
end function;
346
347
/*
348
intrinsic UOperator(f::ModFrmElt, p::RngIntElt) -> ModFrmElt
349
{The modular forms f(q^p).}
350
error "not written.";
351
end intrinsic;
352
*/
353
354
// write each element of B2 as a linear combination
355
// of the elements of B1.
356
function PowerSeriesCoordinates(B1, B2)
357
if #B1 eq 0 then
358
return [];
359
end if;
360
K := FieldOfFractions(BaseRing(Parent(B1[1])));
361
prec := AbsolutePrecision(B1[1]);
362
V := VectorSpace(K, prec);
363
C1 := [V![Coefficient(f,i) : i in [0..prec-1]] : f in B1];
364
C2 := [V![Coefficient(f,i) : i in [0..prec-1]] : f in B2];
365
W := VectorSpaceWithBasis(C2);
366
D1 := [Coordinates(W,v) : v in C1];
367
return D1;
368
end function;
369
370
// The matrix A is written wrt the basis B1 of power series. The function
371
// B2 return the matrix A written wrt to the basis B2.
372
function ChangeBasis(A, B1, B2)
373
assert Type(A) eq AlgMatElt;
374
assert Type(B1) eq SeqEnum;
375
assert Type(B2) eq SeqEnum;
376
assert #B1 eq #B2;
377
assert #B1 eq Degree(Parent(A));
378
379
n := #B1;
380
if n eq 0 then
381
return A;
382
end if;
383
K := FieldOfFractions(BaseRing(Parent(A)));
384
C := PowerSeriesCoordinates(B1, B2);
385
S := MatrixAlgebra(K, n)!(&cat[Eltseq(v) : v in C]);
386
return S^(-1)*A*S;
387
end function;
388
389
390
// The matrix Wq of Atkin Lehner q on Basis(M).
391
// Here M must be completely new.
392
function WqOnNewSpace(M, q, prec)
393
assert Type(M) eq ModFrm;
394
assert Type(q) eq RngIntElt;
395
assert IsPrime(q);
396
assert Type(prec) eq RngIntElt;
397
assert M subset NewSubspace(M);
398
399
N := Level(M);
400
if Dimension(M) eq 0 or Valuation(N, q) lt 1 then
401
return MatrixAlgebra(BaseRing(M),Dimension(M))!1;
402
end if;
403
/* Don't do this -- it is very very very slow, though conceptually simple.
404
elif Valuation(N, q) eq 1 then
405
// use that Wq = -Tq/q^(k/2-1) on newforms when q is prime.
406
return -(1/q^((Weight(M) div 2)-1))* HeckeOperator(M,q);
407
*/
408
D := [];
409
B := [];
410
for i in [1..NumberOfNewformClasses(M)] do
411
f := Newform(M,i);
412
eps := AtkinLehnerEigenvalue(f,q);
413
D := D cat [eps : i in [1..Dimension(Parent(f))]];
414
B := B cat [PowerSeriesRing(BaseRing(M))!PowerSeries(g,prec) : g in Basis(Parent(f))];
415
end for;
416
assert #D eq Dimension(M);
417
Wq := DiagonalMatrix(MatrixAlgebra(Rationals(),Dimension(M)), D);
418
// Now change from the B basis that Wq is written wrt to Basis(M),
419
// which is what we want.
420
return ChangeBasis(Wq, B, [PowerSeries(f,prec) : f in Basis(M)]);
421
end function;
422
423
424
function Frob(n, f)
425
assert Type(n) eq RngIntElt;
426
assert Type(f) eq RngSerPowElt;
427
x := Parent(f).1;
428
return Evaluate(f,x^n) + O(x^AbsolutePrecision(f));
429
end function;
430
431
432
// Matrix of Wq on image of M at level Level(M)*t on the basis B, which
433
// is returned as the second part.
434
// Here q should be prime and prec is the precision of computations.
435
function WqOnImageOfNewSpace(M, q, t, prec)
436
assert Type(M) eq ModFrm;
437
assert Type(q) eq RngIntElt;
438
assert IsPrime(q);
439
assert Type(prec) eq RngIntElt;
440
441
K := FieldOfFractions(BaseRing(M));
442
k := Weight(M);
443
assert Type(k) eq RngIntElt;
444
WqOld := WqOnNewSpace(M, q, prec);
445
x := PowerSeriesRing(K).1;
446
B := [];
447
WqB := [];
448
qq := q^Valuation(Level(M)*t,q);
449
for f in Basis(M) do
450
for d in Divisors(t) do
451
ps := PowerSeries(f,prec);
452
Append(~B, Frob(d,ps));
453
alpha := Valuation(Level(M)*t, q);
454
beta := alpha - Valuation(Level(M),q);
455
gamma := Valuation(d, q);
456
dd := Integers()!(q^(beta-2*gamma)*d);
457
assert IsEven(k);
458
pow := (k div 2)*(beta-2*gamma);
459
g := Evaluate(PowerSeries(f*WqOld,prec),x^dd)*q^pow + O(x^prec);
460
Append(~WqB, g);
461
end for;
462
end for;
463
C := PowerSeriesCoordinates(B, WqB);
464
Wq := MatrixAlgebra(K,#B)!(&cat[Eltseq(v) : v in C]);
465
return <Wq, B>;
466
end function;
467
468
469
function compute_Wq_cuspidal(M, q)
470
if Dimension(M) eq 0 then
471
return MatrixAlgebra(RationalField(),0)!1;
472
end if;
473
assert Type(M) eq ModFrm;
474
assert Type(q) eq RngIntElt;
475
assert IsPrime(q);
476
assert IsCuspidal(M);
477
478
K := FieldOfFractions(BaseRing(M));
479
if Type(BaseRing(M)) ne RngInt then
480
MZ := AssociatedSpaceOverZ(M);
481
Wq := compute_Wq_cuspidal(MZ);
482
return MatrixAlgebra(FieldOfFractions(K),Dimension(M))!Wq;
483
end if;
484
485
N := Level(M);
486
prec := PrecisionBound(M) + 1;
487
type := SpaceType(M); assert type in {"cusp", "cusp_new"}; // the types we know about.
488
param := SpaceTypeParam(M); assert param eq 0 or IsPrime(param); // all we know about.
489
B := [];
490
Wq := MatrixAlgebra(K,Dimension(M))!0;
491
for d in Divisors(N) do
492
NS := false;
493
if type eq "cusp" then
494
NS := NewSubspace(CuspidalSubspace(ModularForms(M,d)));
495
elif type eq "cusp_new" then
496
if param eq 0 then
497
if d eq N then
498
NS := M;
499
end if;
500
else
501
if Valuation(d,param) eq Valuation(N,param) then
502
NS := NewSubspace(CuspidalSubspace(ModularForms(M,d)));
503
end if;
504
end if;
505
end if;
506
if Type(NS) ne BoolElt then
507
W, basis := Explode(WqOnImageOfNewSpace(NS, q, N div d, prec));
508
for i in [1..Degree(Parent(W))] do
509
for j in [1..Degree(Parent(W))] do
510
Wq[#B + i, #B + j] := W[i,j];
511
end for;
512
end for;
513
B := B cat basis;
514
end if;
515
end for;
516
C := ChangeBasis(Wq, B, [PowerSeries(f,prec) : f in Basis(M)]);
517
return C;
518
end function;
519
520
521
function compute_Wq(M, q)
522
assert Type(M) eq ModFrm;
523
assert Type(q) eq RngIntElt;
524
525
S := CuspidalSubspace(M);
526
E := EisensteinSubspace(M);
527
WS := &*[compute_Wq_cuspidal(S,F[1]) : F in Factorization(q)];
528
WE := AtkinLehnerOnEisensteinModularFormsSpace(E,q);
529
W := DirectSum(WS,WE);
530
BS := Basis(S);
531
BE := Basis(E);
532
BS_BE := [M!b : b in BS] cat [M!b : b in BE];
533
// Change of basis from BS cat BE to Basis(M).
534
C := MatrixAlgebra(RationalField(),Dimension(M))!
535
&cat[Eltseq(b) : b in BS_BE];
536
return C^(-1)*W*C;
537
end function;
538
539
intrinsic AtkinLehnerOperator(M::ModFrm) -> AlgMatElt
540
{}
541
return AtkinLehnerOperator(M,Level(M));
542
end intrinsic;
543
544
intrinsic AtkinLehnerOperator(M::ModFrm, q::RngIntElt) -> AlgMatElt
545
{The matrix representing the q-th Atkin-Lehner involution W_q on M
546
with respect to Basis(M). At present M must be a cuspidal space of
547
modular forms for Gamma_0(N). Note that the Atkin-Lehner operator
548
W_q can send a q-expansion with integer coefficients to one with nontrivial
549
denominators.}
550
551
if Dimension(M) eq 0 or GCD(q,Level(M)) eq 1 then
552
return MatrixAlgebra(BaseRing(M),0)!1;
553
end if;
554
555
require GCD(q,Level(M) div q) eq 1 : "Argument 2 (=q) must have the property " *
556
"that GCD(q, N/q) = 1, where N is the level of argument 1.";
557
require IsGamma0(CuspidalSubspace(M))
558
: "Argument 1 must be a space of modular forms on Gamma_0.";
559
require Type(Weight(M)) eq RngIntElt :
560
"Argument 1 must have integral weight.";
561
if Dimension(EisensteinSubspace(M)) ne 0 then
562
require q eq Level(M) : "Atkin-Lehner W_q for q not equal to the "*
563
"level is not yet implemented on Eisenstein spaces.";
564
end if;
565
566
if not assigned M`atkin_operator then
567
M`atkin_operator := [];
568
end if;
569
if exists(i) { i : i in [1..#M`atkin_operator] |
570
M`atkin_operator[i][1] eq q } then
571
return M`atkin_operator[i][2];
572
end if;
573
Wq := compute_Wq(M,q);
574
Append(~M`atkin_operator, <q, Wq>);
575
return Wq;
576
end intrinsic;
577
578