Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
Download

Testing latest pari + WASM + node.js... and it works?! Wow.

28479 views
License: GPL3
ubuntu2004
1
/* Copyright (C) 2000 The PARI group.
2
3
This file is part of the PARI/GP package.
4
5
PARI/GP is free software; you can redistribute it and/or modify it under the
6
terms of the GNU General Public License as published by the Free Software
7
Foundation; either version 2 of the License, or (at your option) any later
8
version. It is distributed in the hope that it will be useful, but WITHOUT
9
ANY WARRANTY WHATSOEVER.
10
11
Check the License for details. You should have received a copy of it, along
12
with the package; see the file 'COPYING'. If not, write to the Free Software
13
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
14
#include "pari.h"
15
#include "paripriv.h"
16
17
/*********************************************************************/
18
/** **/
19
/** GENERIC ABELIAN CHARACTERS **/
20
/** **/
21
/*********************************************************************/
22
/* check whether G is a znstar */
23
int
24
checkznstar_i(GEN G)
25
{
26
return (typ(G) == t_VEC && lg(G) == 6
27
&& typ(znstar_get_faN(G)) == t_VEC
28
&& typ(gel(G,1)) == t_VEC && lg(gel(G,1)) == 3);
29
}
30
31
int
32
char_check(GEN cyc, GEN chi)
33
{ return typ(chi) == t_VEC && lg(chi) == lg(cyc) && RgV_is_ZV(chi); }
34
35
/* Shallow; return [ d[1], d[1]/d[2],...,d[1]/d[n] ] */
36
GEN
37
cyc_normalize(GEN d)
38
{
39
long i, l = lg(d);
40
GEN C, D;
41
if (l == 1) return mkvec(gen_1);
42
D = cgetg(l, t_VEC); gel(D,1) = C = gel(d,1);
43
for (i = 2; i < l; i++) gel(D,i) = diviiexact(C, gel(d,i));
44
return D;
45
}
46
47
/* chi character [D,C] given by chi(g_i) = \zeta_D^C[i] for all i, return
48
* [d,c] such that chi(g_i) = \zeta_d^c[i] for all i and d minimal */
49
GEN
50
char_simplify(GEN D, GEN C)
51
{
52
GEN d = D;
53
if (lg(C) == 1) d = gen_1;
54
else
55
{
56
GEN t = gcdii(d, ZV_content(C));
57
if (!equali1(t))
58
{
59
long tc = typ(C);
60
C = ZC_Z_divexact(C, t); settyp(C, tc);
61
d = diviiexact(d, t);
62
}
63
}
64
return mkvec2(d,C);
65
}
66
67
/* Shallow; ncyc from cyc_normalize(): ncyc[1] = cyc[1],
68
* ncyc[i] = cyc[i]/cyc[1] for i > 1; chi character on G ~ cyc.
69
* Return [d,c] such that: chi( g_i ) = e(chi[i] / cyc[i]) = e(c[i]/ d) */
70
GEN
71
char_normalize(GEN chi, GEN ncyc)
72
{
73
long i, l = lg(chi);
74
GEN c = cgetg(l, t_VEC);
75
if (l > 1) {
76
gel(c,1) = gel(chi,1);
77
for (i = 2; i < l; i++) gel(c,i) = mulii(gel(chi,i), gel(ncyc,i));
78
}
79
return char_simplify(gel(ncyc,1), c);
80
}
81
82
/* Called by function 's'. x is a group object affording ".cyc" method, and
83
* chi an abelian character. Return NULL if the group is (Z/nZ)^* [special
84
* case more character types allowed] and x.cyc otherwise */
85
static GEN
86
get_cyc(GEN x, GEN chi, const char *s)
87
{
88
if (nftyp(x) == typ_BIDZ)
89
{
90
if (!zncharcheck(x, chi)) pari_err_TYPE(s, chi);
91
return NULL;
92
}
93
else
94
{
95
if (typ(x) != t_VEC || !RgV_is_ZV(x)) x = member_cyc(x);
96
if (!char_check(x, chi)) pari_err_TYPE(s, chi);
97
return x;
98
}
99
}
100
101
/* conjugate character [ZV/ZC] */
102
GEN
103
charconj(GEN cyc, GEN chi)
104
{
105
long i, l;
106
GEN z = cgetg_copy(chi, &l);
107
for (i = 1; i < l; i++)
108
{
109
GEN c = gel(chi,i);
110
gel(z,i) = signe(c)? subii(gel(cyc,i), c): gen_0;
111
}
112
return z;
113
}
114
GEN
115
charconj0(GEN x, GEN chi)
116
{
117
GEN cyc = get_cyc(x, chi, "charconj");
118
return cyc? charconj(cyc, chi): zncharconj(x, chi);
119
}
120
121
GEN
122
charorder(GEN cyc, GEN x)
123
{
124
pari_sp av = avma;
125
long i, l = lg(cyc);
126
GEN f = gen_1;
127
for (i = 1; i < l; i++)
128
if (signe(gel(x,i)))
129
{
130
GEN c, o = gel(cyc,i);
131
c = gcdii(o, gel(x,i));
132
if (!is_pm1(c)) o = diviiexact(o,c);
133
f = lcmii(f, o);
134
}
135
return gerepileuptoint(av, f);
136
}
137
GEN
138
charorder0(GEN x, GEN chi)
139
{
140
GEN cyc = get_cyc(x, chi, "charorder");
141
return cyc? charorder(cyc, chi): zncharorder(x, chi);
142
}
143
144
/* chi character of abelian G: chi[i] = chi(z_i), where G = \oplus Z/cyc[i] z_i.
145
* Return Ker chi */
146
GEN
147
charker(GEN cyc, GEN chi)
148
{
149
long i, l = lg(cyc);
150
GEN nchi, ncyc, m, U;
151
152
if (l == 1) return cgetg(1,t_MAT); /* trivial subgroup */
153
ncyc = cyc_normalize(cyc);
154
nchi = char_normalize(chi, ncyc);
155
m = shallowconcat(gel(nchi,2), gel(nchi,1));
156
U = gel(ZV_extgcd(m), 2); setlg(U,l);
157
for (i = 1; i < l; i++) setlg(U[i], l);
158
return hnfmodid(U, gel(ncyc,1));
159
}
160
GEN
161
charker0(GEN x, GEN chi)
162
{
163
GEN cyc = get_cyc(x, chi, "charker");
164
return cyc? charker(cyc, chi): zncharker(x, chi);
165
}
166
167
GEN
168
charpow(GEN cyc, GEN a, GEN N)
169
{
170
long i, l;
171
GEN v = cgetg_copy(a, &l);
172
for (i = 1; i < l; i++) gel(v,i) = Fp_mul(gel(a,i), N, gel(cyc,i));
173
return v;
174
}
175
GEN
176
charmul(GEN cyc, GEN a, GEN b)
177
{
178
long i, l;
179
GEN v = cgetg_copy(a, &l);
180
for (i = 1; i < l; i++) gel(v,i) = Fp_add(gel(a,i), gel(b,i), gel(cyc,i));
181
return v;
182
}
183
GEN
184
chardiv(GEN cyc, GEN a, GEN b)
185
{
186
long i, l;
187
GEN v = cgetg_copy(a, &l);
188
for (i = 1; i < l; i++) gel(v,i) = Fp_sub(gel(a,i), gel(b,i), gel(cyc,i));
189
return v;
190
}
191
GEN
192
charpow0(GEN x, GEN a, GEN N)
193
{
194
GEN cyc = get_cyc(x, a, "charpow");
195
return cyc? charpow(cyc, a, N): zncharpow(x, a, N);
196
}
197
GEN
198
charmul0(GEN x, GEN a, GEN b)
199
{
200
const char *s = "charmul";
201
GEN cyc = get_cyc(x, a, s);
202
if (!cyc)
203
{
204
if (!zncharcheck(x, b)) pari_err_TYPE(s, b);
205
return zncharmul(x, a, b);
206
}
207
else
208
{
209
if (!char_check(cyc, b)) pari_err_TYPE(s, b);
210
return charmul(cyc, a, b);
211
}
212
}
213
GEN
214
chardiv0(GEN x, GEN a, GEN b)
215
{
216
const char *s = "chardiv";
217
GEN cyc = get_cyc(x, a, s);
218
if (!cyc)
219
{
220
if (!zncharcheck(x, b)) pari_err_TYPE(s, b);
221
return znchardiv(x, a, b);
222
}
223
else
224
{
225
if (!char_check(cyc, b)) pari_err_TYPE(s, b);
226
return chardiv(cyc, a, b);
227
}
228
}
229
230
static GEN
231
chareval_i(GEN nchi, GEN dlog, GEN z)
232
{
233
GEN o, q, r, b = gel(nchi,1);
234
GEN a = FpV_dotproduct(gel(nchi,2), dlog, b);
235
/* image is a/b in Q/Z */
236
if (!z) return gdiv(a,b);
237
if (typ(z) == t_INT)
238
{
239
q = dvmdii(z, b, &r);
240
if (signe(r)) pari_err_TYPE("chareval", z);
241
return mulii(a, q);
242
}
243
/* return z^(a*o/b), assuming z^o = 1 and b | o */
244
if (typ(z) != t_VEC || lg(z) != 3) pari_err_TYPE("chareval", z);
245
o = gel(z,2); if (typ(o) != t_INT) pari_err_TYPE("chareval", z);
246
q = dvmdii(o, b, &r); if (signe(r)) pari_err_TYPE("chareval", z);
247
q = mulii(a, q); /* in [0, o[ since a is reduced mod b */
248
z = gel(z,1);
249
if (typ(z) == t_VEC)
250
{
251
if (itos_or_0(o) != lg(z)-1) pari_err_TYPE("chareval", z);
252
return gcopy(gel(z, itos(q)+1));
253
}
254
else
255
return gpow(z, q, DEFAULTPREC);
256
}
257
258
static GEN
259
not_coprime(GEN z)
260
{ return (!z || typ(z) == t_INT)? gen_m1: gen_0; }
261
262
static GEN
263
get_chi(GEN cyc, GEN chi)
264
{
265
if (!char_check(cyc,chi)) pari_err_TYPE("chareval", chi);
266
return char_normalize(chi, cyc_normalize(cyc));
267
}
268
/* G a bnr. FIXME: horribly inefficient to check that (x,N)=1, what to do ? */
269
static int
270
bnr_coprime(GEN G, GEN x)
271
{
272
GEN t, N = gel(bnr_get_mod(G), 1);
273
if (typ(x) == t_INT) /* shortcut */
274
{
275
t = gcdii(gcoeff(N,1,1), x);
276
if (equali1(t)) return 1;
277
t = idealadd(G, N, x);
278
return equali1(gcoeff(t,1,1));
279
}
280
x = idealnumden(G, x);
281
t = idealadd(G, N, gel(x,1));
282
if (!equali1(gcoeff(t,1,1))) return 0;
283
t = idealadd(G, N, gel(x,2));
284
return equali1(gcoeff(t,1,1));
285
}
286
GEN
287
chareval(GEN G, GEN chi, GEN x, GEN z)
288
{
289
pari_sp av = avma;
290
GEN nchi, L;
291
292
switch(nftyp(G))
293
{
294
case typ_BNR:
295
if (!bnr_coprime(G, x)) return not_coprime(z);
296
L = isprincipalray(G, x);
297
nchi = get_chi(bnr_get_cyc(G), chi);
298
break;
299
case typ_BNF:
300
L = isprincipal(G, x);
301
nchi = get_chi(bnf_get_cyc(G), chi);
302
break;
303
case typ_BIDZ:
304
if (checkznstar_i(G)) return gerepileupto(av, znchareval(G, chi, x, z));
305
/* don't implement chars on general bid: need an nf... */
306
default:
307
pari_err_TYPE("chareval", G);
308
return NULL;/* LCOV_EXCL_LINE */
309
}
310
return gerepileupto(av, chareval_i(nchi, L, z));
311
}
312
313
/* nchi = [ord,D] a quasi-normalized character (ord may be a multiple of
314
* the character order); return v such that v[n] = -1 if (n,N) > 1 else
315
* chi(n) = e(v[n]/ord), 1 <= n <= N */
316
GEN
317
ncharvecexpo(GEN G, GEN nchi)
318
{
319
long N = itou(znstar_get_N(G)), ord = itou(gel(nchi,1)), i, j, l;
320
GEN cyc, gen, d, t, t1, t2, t3, e, u, u1, u2, u3;
321
GEN D = gel(nchi,2), v = const_vecsmall(N,-1);
322
pari_sp av = avma;
323
if (typ(D) == t_COL) {
324
cyc = znstar_get_conreycyc(G);
325
gen = znstar_get_conreygen(G);
326
} else {
327
cyc = znstar_get_cyc(G);
328
gen = znstar_get_gen(G);
329
}
330
l = lg(cyc);
331
e = u = cgetg(N+1,t_VECSMALL);
332
d = t = cgetg(N+1,t_VECSMALL);
333
*++d = 1;
334
*++e = 0; v[*d] = *e;
335
for (i = 1; i < l; i++)
336
{
337
ulong g = itou(gel(gen,i)), c = itou(gel(cyc,i)), x = itou(gel(D,i));
338
for (t1=t,u1=u,j=c-1; j; j--,t1=t2,u1=u2)
339
for (t2=d,u2=e, t3=t1,u3=u1; t3<t2; )
340
{
341
*++d = Fl_mul(*++t3, g, N);
342
*++e = Fl_add(*++u3, x, ord); v[*d] = *e;
343
}
344
}
345
set_avma(av); return v;
346
}
347
348
/*****************************************************************************/
349
350
static ulong
351
lcmuu(ulong a, ulong b) { return (a/ugcd(a,b)) * b; }
352
static ulong
353
zv_charorder(GEN cyc, GEN x)
354
{
355
long i, l = lg(cyc);
356
ulong f = 1;
357
for (i = 1; i < l; i++)
358
if (x[i])
359
{
360
ulong o = cyc[i];
361
f = lcmuu(f, o / ugcd(o, x[i]));
362
}
363
return f;
364
}
365
366
/* N > 0 */
367
GEN
368
coprimes_zv(ulong N)
369
{
370
GEN v = const_vecsmall(N,1);
371
pari_sp av = avma;
372
GEN P = gel(factoru(N),1);
373
long i, l = lg(P);
374
for (i = 1; i < l; i++)
375
{
376
ulong p = P[i], j;
377
for (j = p; j <= N; j += p) v[j] = 0;
378
}
379
set_avma(av); return v;
380
}
381
/* cf zv_cyc_minimal: return k such that g*k is minimal (wrt lex) */
382
long
383
zv_cyc_minimize(GEN cyc, GEN g, GEN coprime)
384
{
385
pari_sp av = avma;
386
long d, k, e, i, maxi, k0, bestk, l = lg(g), o = lg(coprime)-1;
387
GEN best, gk, gd;
388
ulong t;
389
if (o == 1) return 1;
390
for (i = 1; i < l; i++)
391
if (g[i]) break;
392
if (g[i] == 1) return 1;
393
k0 = Fl_invgen(g[i], cyc[i], &t);
394
d = cyc[i] / (long)t;
395
if (k0 > 1) g = vecmoduu(Flv_Fl_mul(g, k0, cyc[i]), cyc);
396
for (i++; i < l; i++)
397
if (g[i]) break;
398
if (i == l) return k0;
399
cyc = vecslice(cyc,i,l-1);
400
g = vecslice(g, i,l-1);
401
e = cyc[1];
402
gd = Flv_Fl_mul(g, d, e);
403
bestk = 1; best = g; maxi = e/ugcd(d,e);
404
for (gk = g, k = d+1, i = 1; i < maxi; k += d, i++)
405
{
406
long ko = k % o;
407
gk = Flv_add(gk, gd, e); if (!ko || !coprime[ko]) continue;
408
gk = vecmoduu(gk, cyc);
409
if (vecsmall_lexcmp(gk, best) < 0) { best = gk; bestk = k; }
410
}
411
return gc_long(av, bestk == 1? k0: (long) Fl_mul(k0, bestk, o));
412
}
413
/* g of order o in abelian group G attached to cyc. Is g a minimal generator
414
* [wrt lex order] of the cyclic subgroup it generates;
415
* coprime = coprimes_zv(o) */
416
long
417
zv_cyc_minimal(GEN cyc, GEN g, GEN coprime)
418
{
419
pari_sp av = avma;
420
long i, maxi, d, k, e, l = lg(g), o = lg(coprime)-1; /* elt order */
421
GEN gd, gk;
422
if (o == 1) return 1;
423
for (k = 1; k < l; k++)
424
if (g[k]) break;
425
if (g[k] == 1) return 1;
426
if (cyc[k] % g[k]) return 0;
427
d = cyc[k] / g[k]; /* > 1 */
428
for (k++; k < l; k++) /* skip following 0s */
429
if (g[k]) break;
430
if (k == l) return 1;
431
cyc = vecslice(cyc,k,l-1);
432
g = vecslice(g, k,l-1);
433
e = cyc[1];
434
/* find k in (Z/e)^* such that g*k mod cyc is lexicographically minimal,
435
* k = 1 mod d to fix the first nonzero entry */
436
gd = Flv_Fl_mul(g, d, e); maxi = e/ugcd(d,e);
437
for (gk = g, k = d+1, i = 1; i < maxi; i++, k += d)
438
{
439
long ko = k % o;
440
gk = Flv_add(gk, gd, e); if (!coprime[ko]) continue;
441
gk = vecmoduu(gk, cyc);
442
if (vecsmall_lexcmp(gk, g) < 0) return gc_long(av,0);
443
}
444
return gc_long(av,1);
445
}
446
447
static GEN
448
coprime_tables(long N)
449
{
450
GEN D = divisorsu(N), v = const_vec(N, NULL);
451
long i, l = lg(D);
452
for (i = 1; i < l; i++) gel(v, D[i]) = coprimes_zv(D[i]);
453
return v;
454
}
455
/* enumerate all group elements, modulo (Z/cyc[1])^* */
456
static GEN
457
cyc2elts_normal(GEN cyc, long maxord, GEN ORD)
458
{
459
long i, n, o, N, j = 1;
460
GEN z, vcoprime;
461
462
if (typ(cyc) != t_VECSMALL) cyc = gtovecsmall(cyc);
463
n = lg(cyc)-1;
464
if (n == 0) return cgetg(1, t_VEC);
465
N = zv_prod(cyc);
466
z = cgetg(N+1, t_VEC);
467
if (1 <= maxord && (!ORD|| zv_search(ORD,1)))
468
gel(z,j++) = zero_zv(n);
469
vcoprime = coprime_tables(cyc[1]);
470
for (i = n; i > 0; i--)
471
{
472
GEN cyc0 = vecslice(cyc,i+1,n), pre = zero_zv(i);
473
GEN D = divisorsu(cyc[i]), C = cyc2elts(cyc0);
474
long s, t, lD = lg(D), nC = lg(C)-1; /* remove last element */
475
for (s = 1; s < lD-1; s++)
476
{
477
long o0 = D[lD-s]; /* cyc[i] / D[s] */
478
if (o0 > maxord) continue;
479
pre[i] = D[s];
480
if (!ORD || zv_search(ORD,o0))
481
{
482
GEN c = vecsmall_concat(pre, zero_zv(n-i));
483
gel(z,j++) = c;
484
}
485
for (t = 1; t < nC; t++)
486
{
487
GEN chi0 = gel(C,t);
488
o = lcmuu(o0, zv_charorder(cyc0,chi0));
489
if (o <= maxord && (!ORD || zv_search(ORD,o)))
490
{
491
GEN c = vecsmall_concat(pre, chi0);
492
if (zv_cyc_minimal(cyc, c, gel(vcoprime,o))) gel(z,j++) = c;
493
}
494
}
495
}
496
}
497
setlg(z,j); return z;
498
}
499
500
GEN
501
chargalois(GEN G, GEN ORD)
502
{
503
pari_sp av = avma;
504
long maxord, i, l;
505
GEN v, cyc = (typ(G) == t_VEC && RgV_is_ZVpos(G))? G: member_cyc(G);
506
if (lg(cyc) == 1) retmkvec(cgetg(1,t_VEC));
507
maxord = itou(cyc_get_expo(cyc));
508
if (ORD && gequal0(ORD)) ORD = NULL;
509
if (ORD)
510
switch(typ(ORD))
511
{
512
long l;
513
case t_VEC:
514
ORD = ZV_to_zv(ORD);
515
case t_VECSMALL:
516
ORD = leafcopy(ORD);
517
vecsmall_sort(ORD);
518
l = lg(ORD);
519
if (l == 1) return cgetg(1, t_VECSMALL);
520
maxord = minss(maxord, ORD[l-1]);
521
break;
522
case t_INT:
523
maxord = minss(maxord, itos(ORD));
524
ORD = NULL;
525
break;
526
default: pari_err_TYPE("chargalois", ORD);
527
}
528
v = cyc2elts_normal(cyc, maxord, ORD); l = lg(v);
529
for(i = 1; i < l; i++) gel(v,i) = zv_to_ZV(gel(v,i));
530
return gerepileupto(av, v);
531
}
532
533
/*********************************************************************/
534
/** **/
535
/** (Z/NZ)^* AND DIRICHLET CHARACTERS **/
536
/** **/
537
/*********************************************************************/
538
539
GEN
540
znstar0(GEN N, long flag)
541
{
542
GEN F = NULL, P, E, cyc, gen, mod, G;
543
long i, i0, l, nbprimes;
544
pari_sp av = avma;
545
546
if (flag && flag != 1) pari_err_FLAG("znstar");
547
if ((F = check_arith_all(N,"znstar")))
548
{
549
F = clean_Z_factor(F);
550
N = typ(N) == t_VEC? gel(N,1): factorback(F);
551
}
552
if (!signe(N))
553
{
554
if (flag) pari_err_IMPL("znstar(0,1)");
555
set_avma(av);
556
retmkvec3(gen_2, mkvec(gen_2), mkvec(gen_m1));
557
}
558
N = absi_shallow(N);
559
if (abscmpiu(N,2) <= 0)
560
{
561
G = mkvec3(gen_1, cgetg(1,t_VEC), cgetg(1,t_VEC));
562
if (flag)
563
{
564
GEN v = const_vec(6,cgetg(1,t_VEC));
565
gel(v,3) = cgetg(1,t_MAT);
566
F = equali1(N)? mkvec2(cgetg(1,t_COL),cgetg(1,t_VECSMALL))
567
: mkvec2(mkcol(gen_2), mkvecsmall(1));
568
G = mkvec5(mkvec2(N,mkvec(gen_0)), G, F, v, cgetg(1,t_MAT));
569
}
570
return gerepilecopy(av,G);
571
}
572
if (!F) F = Z_factor(N);
573
P = gel(F,1); nbprimes = lg(P)-1;
574
E = ZV_to_nv( gel(F,2) );
575
switch(mod8(N))
576
{
577
case 0:
578
P = shallowconcat(gen_2,P);
579
E = vecsmall_prepend(E, E[1]); /* add a copy of p=2 row */
580
i = 2; /* 2 generators at 2 */
581
break;
582
case 4:
583
i = 1; /* 1 generator at 2 */
584
break;
585
case 2: case 6:
586
P = vecsplice(P,1);
587
E = vecsplice(E,1); /* remove 2 */
588
i = 0; /* no generator at 2 */
589
break;
590
default:
591
i = 0; /* no generator at 2 */
592
break;
593
}
594
l = lg(P);
595
cyc = cgetg(l,t_VEC);
596
gen = cgetg(l,t_VEC);
597
mod = cgetg(l,t_VEC);
598
/* treat p=2 first */
599
if (i == 2)
600
{
601
long v2 = E[1];
602
GEN q = int2n(v2);
603
gel(cyc,1) = gen_2;
604
gel(gen,1) = subiu(q,1); /* -1 */
605
gel(mod,1) = q;
606
gel(cyc,2) = int2n(v2-2);
607
gel(gen,2) = utoipos(5); /* Conrey normalization */
608
gel(mod,2) = q;
609
i0 = 3;
610
}
611
else if (i == 1)
612
{
613
gel(cyc,1) = gen_2;
614
gel(gen,1) = utoipos(3);
615
gel(mod,1) = utoipos(4);
616
i0 = 2;
617
}
618
else
619
i0 = 1;
620
/* odd primes, fill remaining entries */
621
for (i = i0; i < l; i++)
622
{
623
long e = E[i];
624
GEN p = gel(P,i), q = powiu(p, e-1), Q = mulii(p, q);
625
gel(cyc,i) = subii(Q, q); /* phi(p^e) */
626
gel(gen,i) = pgener_Zp(p);/* Conrey normalization, for e = 1 also */
627
gel(mod,i) = Q;
628
}
629
/* gen[i] has order cyc[i] and generates (Z/mod[i]Z)^* */
630
if (nbprimes > 1) /* lift generators to (Z/NZ)^*, = 1 mod N/mod[i] */
631
for (i=1; i<l; i++)
632
{
633
GEN Q = gel(mod,i), g = gel(gen,i), qinv = Fp_inv(Q, diviiexact(N,Q));
634
g = addii(g, mulii(mulii(subsi(1,g),qinv),Q));
635
gel(gen,i) = modii(g, N);
636
}
637
638
/* cyc[i] > 1 and remain so in the loop, gen[i] = 1 mod (N/mod[i]) */
639
if (!flag)
640
{ /* update generators in place; about twice faster */
641
G = gen;
642
for (i=l-1; i>=2; i--)
643
{
644
GEN ci = gel(cyc,i), gi = gel(G,i);
645
long j;
646
for (j=i-1; j>=1; j--) /* we want cyc[i] | cyc[j] */
647
{
648
GEN cj = gel(cyc,j), gj, qj, v, d;
649
650
d = bezout(ci,cj,NULL,&v); /* > 1 */
651
if (absequalii(ci, d)) continue; /* ci | cj */
652
if (absequalii(cj, d)) { /* cj | ci */
653
swap(gel(G,j),gel(G,i));
654
gi = gel(G,i);
655
swap(gel(cyc,j),gel(cyc,i));
656
ci = gel(cyc,i); continue;
657
}
658
659
qj = diviiexact(cj,d);
660
gel(cyc,j) = mulii(ci,qj);
661
gel(cyc,i) = d;
662
663
/* [1,v*cj/d; 0,1]*[1,0;-1,1]*diag(cj,ci)*[ci/d,-v; cj/d,u]
664
* = diag(lcm,gcd), with u ci + v cj = d */
665
gj = gel(G,j);
666
/* (gj, gi) *= [1,0; -1,1]^-1 */
667
gj = Fp_mul(gj, gi, N); /* order ci*qj = lcm(ci,cj) */
668
/* (gj,gi) *= [1,v*qj; 0,1]^-1 */
669
togglesign_safe(&v);
670
if (signe(v) < 0) v = modii(v,ci); /* >= 0 to avoid inversions */
671
gel(G,i) = gi = Fp_mul(gi, Fp_pow(gj, mulii(qj, v), N), N);
672
gel(G,j) = gj;
673
ci = d; if (absequaliu(ci, 2)) break;
674
}
675
}
676
G = mkvec3(ZV_prod(cyc), cyc, FpV_to_mod(G,N));
677
}
678
else
679
{ /* keep matrices between generators, return an 'init' structure */
680
GEN D, U, Ui, fao = cgetg(l, t_VEC), lo = cgetg(l, t_VEC);
681
F = mkvec2(P, E);
682
D = ZV_snf_group(cyc,&U,&Ui);
683
for (i = 1; i < l; i++)
684
{
685
GEN t = gen_0, p = gel(P,i), p_1 = subiu(p,1);
686
long e = E[i];
687
gel(fao,i) = get_arith_ZZM(p_1);
688
if (e >= 2 && !absequaliu(p,2))
689
{
690
GEN q = gel(mod,i), g = Fp_pow(gel(gen,i),p_1,q);
691
if (e == 2)
692
t = Fp_inv(diviiexact(subiu(g,1), p), p);
693
else
694
t = ginv(Qp_log(cvtop(g,p,e)));
695
}
696
gel(lo,i) = t;
697
}
698
G = cgetg(l, t_VEC);
699
for (i = 1; i < l; i++) gel(G,i) = FpV_factorback(gen, gel(Ui,i), N);
700
G = mkvec3(ZV_prod(D), D, G);
701
G = mkvec5(mkvec2(N,mkvec(gen_0)), G, F,
702
mkvecn(6,mod,fao,Ui,gen,cyc,lo), U);
703
}
704
return gerepilecopy(av, G);
705
}
706
GEN
707
znstar(GEN N) { return znstar0(N, 0); }
708
709
/* g has order 2^(e-2), g,h = 1 (mod 4); return x s.t. g^x = h (mod 2^e) */
710
static GEN
711
Zideallog_2k(GEN h, GEN g, long e, GEN pe)
712
{
713
GEN a = Fp_log(h, g, int2n(e-2), pe);
714
if (typ(a) != t_INT) return NULL;
715
return a;
716
}
717
718
/* ord = get_arith_ZZM(p-1), simplified form of znlog_rec: g is known
719
* to be a primitive root mod p^e; lo = 1/log_p(g^(p-1)) */
720
static GEN
721
Zideallog_pk(GEN h, GEN g, GEN p, long e, GEN pe, GEN ord, GEN lo)
722
{
723
GEN gp = (e == 1)? g: modii(g, p);
724
GEN hp = (e == 1)? h: modii(h, p);
725
GEN a = Fp_log(hp, gp, ord, p);
726
if (typ(a) != t_INT) return NULL;
727
if (e > 1)
728
{ /* find a s.t. g^a = h (mod p^e), p odd prime, e > 0, (h,p) = 1 */
729
/* use p-adic log: O(log p + e) mul*/
730
GEN b, p_1 = gel(ord,1);
731
h = Fp_mul(h, Fp_pow(g, negi(a), pe), pe);
732
/* g,h = 1 mod p; compute b s.t. h = g^b */
733
if (e == 2) /* simpler */
734
b = Fp_mul(diviiexact(subiu(h,1), p), lo, p);
735
else
736
b = padic_to_Q(gmul(Qp_log(cvtop(h, p, e)), lo));
737
a = addii(a, mulii(p_1, b));
738
}
739
return a;
740
}
741
742
int
743
znconrey_check(GEN cyc, GEN chi)
744
{ return typ(chi) == t_COL && lg(chi) == lg(cyc) && RgV_is_ZV(chi); }
745
746
int
747
zncharcheck(GEN G, GEN chi)
748
{
749
switch(typ(chi))
750
{
751
case t_INT: return 1;
752
case t_COL: return znconrey_check(znstar_get_conreycyc(G), chi);
753
case t_VEC: return char_check(znstar_get_cyc(G), chi);
754
}
755
return 0;
756
}
757
758
GEN
759
znconreyfromchar_normalized(GEN bid, GEN chi)
760
{
761
GEN nchi, U = znstar_get_U(bid);
762
long l = lg(chi);
763
if (l == 1) retmkvec2(gen_1,cgetg(1,t_VEC));
764
if (!RgV_is_ZV(chi) || lgcols(U) != l) pari_err_TYPE("lfunchiZ", chi);
765
nchi = char_normalize(chi, cyc_normalize(znstar_get_cyc(bid)));
766
gel(nchi,2) = ZV_ZM_mul(gel(nchi,2),U); return nchi;
767
}
768
769
GEN
770
znconreyfromchar(GEN bid, GEN chi)
771
{
772
GEN nchi = znconreyfromchar_normalized(bid, chi);
773
GEN v = char_denormalize(znstar_get_conreycyc(bid), gel(nchi,1), gel(nchi,2));
774
settyp(v, t_COL); return v;
775
}
776
777
/* discrete log on canonical "primitive root" generators
778
* Allow log(x) instead of x [usual discrete log on bid's generators] */
779
GEN
780
znconreylog(GEN bid, GEN x)
781
{
782
pari_sp av = avma;
783
GEN N, L, F, P,E, y, pe, fao, gen, lo, cycg;
784
long i, l;
785
if (!checkznstar_i(bid)) pari_err_TYPE("znconreylog", bid);
786
N = znstar_get_N(bid);
787
if (typ(N) != t_INT) pari_err_TYPE("znconreylog", N);
788
if (abscmpiu(N, 2) <= 0) return cgetg(1, t_COL);
789
cycg = znstar_get_conreycyc(bid);
790
switch(typ(x))
791
{
792
GEN Ui;
793
case t_INT:
794
if (!signe(x)) pari_err_COPRIME("znconreylog", x, N);
795
break;
796
case t_COL: /* log_bid(x) */
797
Ui = znstar_get_Ui(bid);
798
if (!RgV_is_ZV(x) || lg(x) != lg(Ui)) pari_err_TYPE("znconreylog", x);
799
return gerepileupto(av, vecmodii(ZM_ZC_mul(Ui,x), cycg));
800
case t_VEC:
801
return gerepilecopy(av, znconreyfromchar(bid, x));
802
default: pari_err_TYPE("znconreylog", x);
803
}
804
F = znstar_get_faN(bid); /* factor(N) */
805
P = gel(F, 1); /* prime divisors of N */
806
E = gel(F, 2); /* exponents */
807
L = gel(bid,4);
808
pe = znstar_get_pe(bid);
809
fao = gel(L,2);
810
gen = znstar_get_conreygen(bid); /* local generators of (Z/p^k)^* */
811
lo = gel(L,6); /* 1/log_p((g_i)^(p_i-1)) */
812
813
l = lg(gen); i = 1;
814
y = cgetg(l, t_COL);
815
if (!mod2(N) && !mod2(x)) pari_err_COPRIME("znconreylog", x, N);
816
if (absequaliu(gel(P,1), 2) && E[1] >= 2)
817
{
818
if (E[1] == 2)
819
gel(y,i++) = mod4(x) == 1? gen_0: gen_1;
820
else
821
{
822
GEN a, x2, q2 = gel(pe,1);
823
x2 = modii(x, q2);
824
if (mod4(x) == 1) /* 1 or 5 mod 8*/
825
gel(y,i++) = gen_0;
826
else /* 3 or 7 */
827
{ gel(y,i++) = gen_1; x2 = subii(q2, x2); }
828
/* x2 = 5^x mod q */
829
a = Zideallog_2k(x2, gel(gen,i), E[1], q2);
830
if (!a) pari_err_COPRIME("znconreylog", x, N);
831
gel(y, i++) = a;
832
}
833
}
834
while (i < l)
835
{
836
GEN p = gel(P,i), q = gel(pe,i), xpe = modii(x, q);
837
GEN a = Zideallog_pk(xpe, gel(gen,i), p, E[i], q, gel(fao,i), gel(lo,i));
838
if (!a) pari_err_COPRIME("znconreylog", x, N);
839
gel(y, i++) = a;
840
}
841
return gerepilecopy(av, y);
842
}
843
GEN
844
Zideallog(GEN bid, GEN x)
845
{
846
pari_sp av = avma;
847
GEN y = znconreylog(bid, x), U = znstar_get_U(bid);
848
return gerepileupto(av, ZM_ZC_mul(U, y));
849
}
850
GEN
851
znlog0(GEN h, GEN g, GEN o)
852
{
853
if (typ(g) == t_VEC)
854
{
855
GEN N;
856
if (o) pari_err_TYPE("znlog [with znstar]", o);
857
if (!checkznstar_i(g)) pari_err_TYPE("znlog", g);
858
N = znstar_get_N(g);
859
h = Rg_to_Fp(h,N);
860
return Zideallog(g, h);
861
}
862
return znlog(h, g, o);
863
}
864
865
GEN
866
znconreyexp(GEN bid, GEN x)
867
{
868
pari_sp av = avma;
869
long i, l;
870
GEN N, pe, gen, cycg, v, vmod;
871
int e2;
872
if (!checkznstar_i(bid)) pari_err_TYPE("znconreyexp", bid);
873
cycg = znstar_get_conreycyc(bid);
874
switch(typ(x))
875
{
876
case t_VEC:
877
x = znconreylog(bid, x);
878
break;
879
case t_COL:
880
if (RgV_is_ZV(x) && lg(x) == lg(cycg)) break;
881
default: pari_err_TYPE("znconreyexp",x);
882
}
883
pe = znstar_get_pe(bid);
884
gen = znstar_get_conreygen(bid); /* local generators of (Z/p^k)^* */
885
cycg = znstar_get_conreycyc(bid);
886
l = lg(x); v = cgetg(l, t_VEC);
887
N = znstar_get_N(bid);
888
e2 = !mod8(N); /* 2 generators at p = 2 */
889
for (i = 1; i < l; i++)
890
{
891
GEN q, g, m;
892
if (i == 1 && e2) { gel(v,1) = NULL; continue; }
893
q = gel(pe,i);
894
g = gel(gen,i);
895
m = modii(gel(x,i), gel(cycg,i));
896
m = Fp_pow(g, m, q);
897
if (i == 2 && e2 && signe(gel(x,1))) m = Fp_neg(m, q);
898
gel(v,i) = mkintmod(m, q);
899
}
900
if (e2) v = vecsplice(v, 1);
901
v = chinese1_coprime_Z(v);
902
vmod = gel(v,1);
903
v = gel(v,2);
904
if (mpodd(v) || mpodd(N)) return gerepilecopy(av, v);
905
/* handle N = 2 mod 4 */
906
return gerepileuptoint(av, addii(v, vmod));
907
}
908
909
/* Return Dirichlet character \chi_q(m,.), where bid = znstar(q);
910
* m is either a t_INT, or a t_COL [Conrey logarithm] */
911
GEN
912
znconreychar(GEN bid, GEN m)
913
{
914
pari_sp av = avma;
915
GEN c, d, nchi;
916
917
if (!checkznstar_i(bid)) pari_err_TYPE("znconreychar", bid);
918
switch(typ(m))
919
{
920
case t_COL:
921
case t_INT:
922
nchi = znconrey_normalized(bid,m); /* images of primroot gens */
923
break;
924
default:
925
pari_err_TYPE("znconreychar",m);
926
return NULL;/*LCOV_EXCL_LINE*/
927
}
928
d = gel(nchi,1);
929
c = ZV_ZM_mul(gel(nchi,2), znstar_get_Ui(bid)); /* images of bid gens */
930
return gerepilecopy(av, char_denormalize(znstar_get_cyc(bid),d,c));
931
}
932
933
/* chi a t_INT or Conrey log describing a character. Return conductor, as an
934
* integer if primitive; as a t_VEC [N,factor(N)] if not. Set *pm=m to the
935
* attached primitive character: chi(g_i) = m[i]/ord(g_i)
936
* Caller should use znconreylog_normalize(BID, m), once BID(conductor) is
937
* computed (wasteful to do it here since BID is shared by many characters) */
938
GEN
939
znconreyconductor(GEN bid, GEN chi, GEN *pm)
940
{
941
pari_sp av = avma;
942
GEN q, m, F, P, E;
943
long i, j, l;
944
int e2, primitive = 1;
945
946
if (!checkznstar_i(bid)) pari_err_TYPE("znconreyconductor", bid);
947
if (typ(chi) == t_COL)
948
{
949
if (!znconrey_check(znstar_get_conreycyc(bid), chi))
950
pari_err_TYPE("znconreyconductor",chi);
951
}
952
else
953
chi = znconreylog(bid, chi);
954
l = lg(chi);
955
F = znstar_get_faN(bid);
956
P = gel(F,1);
957
E = gel(F,2);
958
if (l == 1)
959
{
960
set_avma(av);
961
if (pm) *pm = cgetg(1,t_COL);
962
if (lg(P) == 1) return gen_1;
963
retmkvec2(gen_1, trivial_fact());
964
}
965
P = leafcopy(P);
966
E = leafcopy(E);
967
m = cgetg(l, t_COL);
968
e2 = (E[1] >= 3 && absequaliu(gel(P,1),2));
969
i = j = 1;
970
if (e2)
971
{ /* two generators at p=2 */
972
GEN a1 = gel(chi,1), a = gel(chi,2);
973
i = 3;
974
if (!signe(a))
975
{
976
e2 = primitive = 0;
977
if (signe(a1))
978
{ /* lose one generator */
979
E[1] = 2;
980
gel(m,1) = a1;
981
j = 2;
982
}
983
/* else lose both */
984
}
985
else
986
{
987
long v = Z_pvalrem(a, gen_2, &a);
988
if (v) { E[1] -= v; E[2] = E[1]; primitive = 0; }
989
gel(m,1) = a1;
990
gel(m,2) = a;
991
j = 3;
992
}
993
}
994
l = lg(P);
995
for (; i < l; i++)
996
{
997
GEN p = gel(P,i), a = gel(chi,i);
998
/* image of g_i in Q/Z is a/cycg[i], cycg[i] = order(g_i) */
999
if (!signe(a)) primitive = 0;
1000
else
1001
{
1002
long v = Z_pvalrem(a, p, &a);
1003
E[j] = E[i]; if (v) { E[j] -= v; primitive = 0; }
1004
gel(P,j) = gel(P,i);
1005
gel(m,j) = a; j++;
1006
}
1007
}
1008
setlg(m,j);
1009
setlg(P,j);
1010
setlg(E,j);
1011
if (pm) *pm = m; /* attached primitive character */
1012
if (primitive)
1013
{
1014
q = znstar_get_N(bid);
1015
if (mod4(q) == 2) primitive = 0;
1016
}
1017
if (!primitive)
1018
{
1019
if (e2)
1020
{ /* remove duplicate p=2 row from factorization */
1021
P = vecsplice(P,1);
1022
E = vecsplice(E,1);
1023
}
1024
E = zc_to_ZC(E);
1025
q = mkvec2(factorback2(P,E), mkmat2(P,E));
1026
}
1027
gerepileall(av, pm? 2: 1, &q, pm);
1028
return q;
1029
}
1030
1031
GEN
1032
zncharinduce(GEN G, GEN chi, GEN N)
1033
{
1034
pari_sp av = avma;
1035
GEN q, faq, P, E, Pq, Eq, CHI;
1036
long i, j, l;
1037
int e2;
1038
1039
if (!checkznstar_i(G)) pari_err_TYPE("zncharinduce", G);
1040
if (!zncharcheck(G, chi)) pari_err_TYPE("zncharinduce", chi);
1041
q = znstar_get_N(G);
1042
if (typ(chi) != t_COL) chi = znconreylog(G, chi);
1043
if (checkznstar_i(N))
1044
{
1045
GEN faN = znstar_get_faN(N);
1046
P = gel(faN,1); l = lg(P);
1047
E = gel(faN,2);
1048
N = znstar_get_N(N);
1049
if (l > 2 && equalii(gel(P,1),gel(P,2)))
1050
{ /* remove duplicate 2 */
1051
l--;
1052
P = vecsplice(P,1);
1053
E = vecsplice(E,1);
1054
}
1055
}
1056
else
1057
{
1058
GEN faN = check_arith_pos(N, "zncharinduce");
1059
if (!faN) faN = Z_factor(N);
1060
else
1061
N = (typ(N) == t_VEC)? gel(N,1): factorback(faN);
1062
P = gel(faN,1);
1063
E = gel(faN,2);
1064
}
1065
if (!dvdii(N,q)) pari_err_DOMAIN("zncharinduce", "N % q", "!=", gen_0, N);
1066
if (mod4(N) == 2)
1067
{ /* remove 2 */
1068
if (lg(P) > 1 && absequaliu(gel(P,1), 2))
1069
{
1070
P = vecsplice(P,1);
1071
E = vecsplice(E,1);
1072
}
1073
N = shifti(N,-1);
1074
}
1075
l = lg(P);
1076
/* q = N or q = 2N, N odd */
1077
if (cmpii(N,q) <= 0) return gerepilecopy(av, chi);
1078
/* N > 1 => l > 1*/
1079
if (typ(E) != t_VECSMALL) E = ZV_to_zv(E);
1080
e2 = (E[1] >= 3 && absequaliu(gel(P,1),2)); /* 2 generators at 2 mod N */
1081
if (ZV_equal0(chi))
1082
{
1083
set_avma(av);
1084
return equali1(N)? cgetg(1, t_COL): zerocol(l+e2 - 1);
1085
}
1086
1087
faq = znstar_get_faN(G);
1088
Pq = gel(faq,1);
1089
Eq = gel(faq,2);
1090
CHI = cgetg(l+e2, t_COL);
1091
i = j = 1;
1092
if (e2)
1093
{
1094
i = 2; j = 3;
1095
if (absequaliu(gel(Pq,1), 2))
1096
{
1097
if (Eq[1] >= 3)
1098
{ /* 2 generators at 2 mod q */
1099
gel(CHI,1) = gel(chi,1);
1100
gel(CHI,2) = shifti(gel(chi,2), E[1]-Eq[1]);
1101
}
1102
else if (Eq[1] == 2)
1103
{ /* 1 generator at 2 mod q */
1104
gel(CHI,1) = gel(chi,1);
1105
gel(CHI,2) = gen_0;
1106
}
1107
else
1108
gel(CHI,1) = gel(CHI,2) = gen_0;
1109
}
1110
else
1111
gel(CHI,1) = gel(CHI,2) = gen_0;
1112
}
1113
for (; i < l; i++,j++)
1114
{
1115
GEN p = gel(P,i);
1116
long k = ZV_search(Pq, p);
1117
gel(CHI,j) = k? mulii(gel(chi,k), powiu(p, E[i]-Eq[k])): gen_0;
1118
}
1119
return gerepilecopy(av, CHI);
1120
}
1121
1122
/* m a Conrey log [on the canonical primitive roots], cycg the primitive
1123
* roots orders */
1124
GEN
1125
znconreylog_normalize(GEN G, GEN m)
1126
{
1127
GEN cycg = znstar_get_conreycyc(G);
1128
long i, l;
1129
GEN d, M = cgetg_copy(m, &l);
1130
if (typ(cycg) != t_VEC || lg(cycg) != l)
1131
pari_err_TYPE("znconreylog_normalize",mkvec2(m,cycg));
1132
for (i = 1; i < l; i++) gel(M,i) = gdiv(gel(m,i), gel(cycg,i));
1133
/* m[i]: image of primroot generators g_i in Q/Z */
1134
M = Q_remove_denom(M, &d);
1135
return mkvec2(d? d: gen_1, M);
1136
}
1137
1138
/* return normalized character on Conrey generators attached to chi: Conrey
1139
* label (t_INT), char on (SNF) G.gen* (t_VEC), or Conrey log (t_COL) */
1140
GEN
1141
znconrey_normalized(GEN G, GEN chi)
1142
{
1143
switch(typ(chi))
1144
{
1145
case t_INT: /* Conrey label */
1146
return znconreylog_normalize(G, znconreylog(G, chi));
1147
case t_COL: /* Conrey log */
1148
if (!RgV_is_ZV(chi)) break;
1149
return znconreylog_normalize(G, chi);
1150
case t_VEC: /* char on G.gen */
1151
if (!RgV_is_ZV(chi)) break;
1152
return znconreyfromchar_normalized(G, chi);
1153
}
1154
pari_err_TYPE("znchareval",chi);
1155
return NULL;/* LCOV_EXCL_LINE */
1156
}
1157
1158
/* return 1 iff chi(-1) = -1, and 0 otherwise */
1159
long
1160
zncharisodd(GEN G, GEN chi)
1161
{
1162
long i, l, s;
1163
GEN N;
1164
if (!checkznstar_i(G)) pari_err_TYPE("zncharisodd", G);
1165
if (!zncharcheck(G, chi)) pari_err_TYPE("zncharisodd", chi);
1166
if (typ(chi) != t_COL) chi = znconreylog(G, chi);
1167
N = znstar_get_N(G);
1168
l = lg(chi);
1169
s = 0;
1170
if (!mod8(N))
1171
{
1172
s = mpodd(gel(chi,1));
1173
i = 3;
1174
}
1175
else
1176
i = 1;
1177
for (; i < l; i++) s += mpodd(gel(chi,i));
1178
return odd(s);
1179
}
1180
1181
GEN
1182
znchartokronecker(GEN G, GEN chi, long flag)
1183
{
1184
pari_sp av = avma;
1185
long s;
1186
GEN F, o;
1187
1188
if (flag && flag != 1) pari_err_FLAG("znchartokronecker");
1189
s = zncharisodd(G, chi)? -1: 1;
1190
if (typ(chi) != t_COL) chi = znconreylog(G, chi);
1191
o = zncharorder(G, chi);
1192
if (abscmpiu(o,2) > 0) { set_avma(av); return gen_0; }
1193
F = znconreyconductor(G, chi, NULL);
1194
if (typ(F) == t_INT)
1195
{
1196
if (s < 0) F = negi(F);
1197
return gerepileuptoint(av, F);
1198
}
1199
F = gel(F,1);
1200
F = (s < 0)? negi(F): icopy(F);
1201
if (!flag)
1202
{
1203
GEN MF = znstar_get_faN(G), P = gel(MF,1);
1204
long i, l = lg(P);
1205
for (i = 1; i < l; i++)
1206
{
1207
GEN p = gel(P,i);
1208
if (!dvdii(F,p)) F = mulii(F,sqri(p));
1209
}
1210
}
1211
return gerepileuptoint(av, F);
1212
}
1213
1214
/* (D/.) as a character mod N; assume |D| divides N and D = 0,1 mod 4*/
1215
GEN
1216
znchar_quad(GEN G, GEN D)
1217
{
1218
GEN cyc = znstar_get_conreycyc(G);
1219
GEN gen = znstar_get_conreygen(G);
1220
long i, l = lg(cyc);
1221
GEN chi = cgetg(l, t_COL);
1222
for (i = 1; i < l; i++)
1223
{
1224
long k = kronecker(D, gel(gen,i));
1225
gel(chi,i) = (k==1)? gen_0: shifti(gel(cyc,i), -1);
1226
}
1227
return chi;
1228
}
1229
1230
GEN
1231
znchar(GEN D)
1232
{
1233
pari_sp av = avma;
1234
GEN G, chi;
1235
switch(typ(D))
1236
{
1237
case t_INT:
1238
if (!signe(D) || Mod4(D) > 1) pari_err_TYPE("znchar", D);
1239
G = znstar0(D,1);
1240
chi = mkvec2(G, znchar_quad(G,D));
1241
break;
1242
case t_INTMOD:
1243
G = znstar0(gel(D,1), 1);
1244
chi = mkvec2(G, znconreylog(G, gel(D,2)));
1245
break;
1246
case t_VEC:
1247
if (checkMF_i(D)) { chi = vecslice(MF_get_CHI(D),1,2); break; }
1248
else if (checkmf_i(D)) { chi = vecslice(mf_get_CHI(D),1,2); break; }
1249
if (lg(D) != 3) pari_err_TYPE("znchar", D);
1250
G = gel(D,1);
1251
if (!checkznstar_i(G)) pari_err_TYPE("znchar", D);
1252
chi = gel(D,2);
1253
if (typ(chi) == t_VEC && lg(chi) == 3 && is_vec_t(typ(gel(chi,2))))
1254
{ /* normalized character */
1255
GEN n = gel(chi,1), chic = gel(chi,2);
1256
GEN cyc = typ(chic)==t_VEC? znstar_get_cyc(G): znstar_get_conreycyc(G);
1257
if (!char_check(cyc, chic)) pari_err_TYPE("znchar",D);
1258
chi = char_denormalize(cyc, n, chic);
1259
}
1260
if (!zncharcheck(G, chi)) pari_err_TYPE("znchar", D);
1261
chi = mkvec2(G,chi); break;
1262
default:
1263
pari_err_TYPE("znchar", D);
1264
return NULL; /*LCOV_EXCL_LINE*/
1265
}
1266
return gerepilecopy(av, chi);
1267
}
1268
1269
/* G a znstar, not stack clean */
1270
GEN
1271
znchareval(GEN G, GEN chi, GEN n, GEN z)
1272
{
1273
GEN nchi, N = znstar_get_N(G);
1274
/* avoid division by 0 */
1275
if (typ(n) == t_FRAC && !equali1(gcdii(gel(n,2), N))) return not_coprime(z);
1276
n = Rg_to_Fp(n, N);
1277
if (!equali1(gcdii(n, N))) return not_coprime(z);
1278
/* nchi: normalized character on Conrey generators */
1279
nchi = znconrey_normalized(G, chi);
1280
return chareval_i(nchi, znconreylog(G,n), z);
1281
}
1282
1283
/* G is a znstar, chi a Dirichlet character */
1284
GEN
1285
zncharconj(GEN G, GEN chi)
1286
{
1287
switch(typ(chi))
1288
{
1289
case t_INT: chi = znconreylog(G, chi); /* fall through */
1290
case t_COL: return charconj(znstar_get_conreycyc(G), chi);
1291
case t_VEC: return charconj(znstar_get_cyc(G), chi);
1292
}
1293
pari_err_TYPE("zncharconj",chi);
1294
return NULL; /*LCOV_EXCL_LINE*/
1295
}
1296
1297
/* G is a znstar, chi a Dirichlet character */
1298
GEN
1299
zncharorder(GEN G, GEN chi)
1300
{
1301
switch(typ(chi))
1302
{
1303
case t_INT: chi = znconreylog(G, chi); /*fall through*/
1304
case t_COL: return charorder(znstar_get_conreycyc(G), chi);
1305
case t_VEC: return charorder(znstar_get_cyc(G), chi);
1306
default: pari_err_TYPE("zncharorder",chi);
1307
return NULL; /* LCOV_EXCL_LINE */
1308
}
1309
}
1310
1311
/* G is a znstar, chi a Dirichlet character */
1312
GEN
1313
zncharker(GEN G, GEN chi)
1314
{
1315
if (typ(chi) != t_VEC) chi = znconreychar(G, chi);
1316
return charker(znstar_get_cyc(G), chi);
1317
}
1318
1319
/* G is a znstar, 'a' is a Dirichlet character */
1320
GEN
1321
zncharpow(GEN G, GEN a, GEN n)
1322
{
1323
switch(typ(a))
1324
{
1325
case t_INT: return Fp_pow(a, n, znstar_get_N(G));
1326
case t_VEC: return charpow(znstar_get_cyc(G), a, n);
1327
case t_COL: return charpow(znstar_get_conreycyc(G), a, n);
1328
default: pari_err_TYPE("znchapow",a);
1329
return NULL; /* LCOV_EXCL_LINE */
1330
}
1331
}
1332
/* G is a znstar, 'a' and 'b' are Dirichlet character */
1333
GEN
1334
zncharmul(GEN G, GEN a, GEN b)
1335
{
1336
long ta = typ(a), tb = typ(b);
1337
if (ta == tb) switch(ta)
1338
{
1339
case t_INT: return Fp_mul(a, b, znstar_get_N(G));
1340
case t_VEC: return charmul(znstar_get_cyc(G), a, b);
1341
case t_COL: return charmul(znstar_get_conreycyc(G), a, b);
1342
default: pari_err_TYPE("zncharmul",a);
1343
return NULL; /* LCOV_EXCL_LINE */
1344
}
1345
if (ta != t_COL) a = znconreylog(G, a);
1346
if (tb != t_COL) b = znconreylog(G, b);
1347
return charmul(znstar_get_conreycyc(G), a, b);
1348
}
1349
1350
/* G is a znstar, 'a' and 'b' are Dirichlet character */
1351
GEN
1352
znchardiv(GEN G, GEN a, GEN b)
1353
{
1354
long ta = typ(a), tb = typ(b);
1355
if (ta == tb) switch(ta)
1356
{
1357
case t_INT: return Fp_div(a, b, znstar_get_N(G));
1358
case t_VEC: return chardiv(znstar_get_cyc(G), a, b);
1359
case t_COL: return chardiv(znstar_get_conreycyc(G), a, b);
1360
default: pari_err_TYPE("znchardiv",a);
1361
return NULL; /* LCOV_EXCL_LINE */
1362
}
1363
if (ta != t_COL) a = znconreylog(G, a);
1364
if (tb != t_COL) b = znconreylog(G, b);
1365
return chardiv(znstar_get_conreycyc(G), a, b);
1366
}
1367
1368
/* CHI mod N = \prod_p p^e; let CHI = \prod CHI_p, CHI_p mod p^e
1369
* return \prod_{p | (Q,N)} CHI_p. E.g if Q = p, return chi_p */
1370
GEN
1371
znchardecompose(GEN G, GEN chi, GEN Q)
1372
{
1373
GEN c, P, E, F;
1374
long l, lP, i;
1375
1376
if (!checkznstar_i(G)) pari_err_TYPE("znchardecompose", G);
1377
if (typ(Q) != t_INT) pari_err_TYPE("znchardecompose", Q);
1378
if (typ(chi) == t_COL)
1379
{ if (!zncharcheck(G, chi)) pari_err_TYPE("znchardecompose", chi); }
1380
else
1381
chi = znconreylog(G, chi);
1382
l = lg(chi);
1383
F = znstar_get_faN(G);
1384
c = zerocol(l-1);
1385
P = gel(F,1); /* prime divisors of N */
1386
lP = lg(P);
1387
E = gel(F,2); /* exponents */
1388
for (i = 1; i < lP; i++)
1389
{
1390
GEN p = gel(P,i);
1391
if (i == 1 && equaliu(p,2) && E[1] >= 3)
1392
{
1393
if (!mpodd(Q))
1394
{
1395
gel(c,1) = icopy(gel(chi,1));
1396
gel(c,2) = icopy(gel(chi,2));
1397
}
1398
i = 2; /* skip P[2] = P[1] = 2 */
1399
}
1400
else
1401
if (dvdii(Q, p)) gel(c,i) = icopy(gel(chi,i));
1402
}
1403
return c;
1404
}
1405
1406
GEN
1407
zncharconductor(GEN G, GEN chi)
1408
{
1409
pari_sp av = avma;
1410
GEN F = znconreyconductor(G, chi, NULL);
1411
if (typ(F) == t_INT) return F;
1412
return gerepilecopy(av, gel(F,1));
1413
}
1414
GEN
1415
znchartoprimitive(GEN G, GEN chi)
1416
{
1417
pari_sp av = avma;
1418
GEN chi0, F = znconreyconductor(G, chi, &chi0);
1419
if (typ(F) == t_INT)
1420
chi = mkvec2(G,chi);
1421
else
1422
chi = mkvec2(znstar0(F,1), chi0);
1423
return gerepilecopy(av, chi);
1424
}
1425
1426