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
checkznstar_i(GEN G)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
char_check(GEN cyc,GEN chi)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
cyc_normalize(GEN d)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
char_simplify(GEN D,GEN C)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
char_normalize(GEN chi,GEN ncyc)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
get_cyc(GEN x,GEN chi,const char * s)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
charconj(GEN cyc,GEN chi)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
charconj0(GEN x,GEN chi)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
charorder(GEN cyc,GEN x)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
charorder0(GEN x,GEN chi)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
charker(GEN cyc,GEN chi)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
charker0(GEN x,GEN chi)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
charpow(GEN cyc,GEN a,GEN N)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
charmul(GEN cyc,GEN a,GEN b)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
chardiv(GEN cyc,GEN a,GEN b)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
charpow0(GEN x,GEN a,GEN N)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
charmul0(GEN x,GEN a,GEN b)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
chardiv0(GEN x,GEN a,GEN b)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
chareval_i(GEN nchi,GEN dlog,GEN z)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
not_coprime(GEN z)259 not_coprime(GEN z)
260 { return (!z || typ(z) == t_INT)? gen_m1: gen_0; }
261
262 static GEN
get_chi(GEN cyc,GEN chi)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
bnr_coprime(GEN G,GEN x)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
chareval(GEN G,GEN chi,GEN x,GEN z)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
ncharvecexpo(GEN G,GEN nchi)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
lcmuu(ulong a,ulong b)351 lcmuu(ulong a, ulong b) { return (a/ugcd(a,b)) * b; }
352 static ulong
zv_charorder(GEN cyc,GEN x)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
coprimes_zv(ulong N)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
zv_cyc_minimize(GEN cyc,GEN g,GEN coprime)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
zv_cyc_minimal(GEN cyc,GEN g,GEN coprime)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
coprime_tables(long N)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
cyc2elts_normal(GEN cyc,long maxord,GEN ORD)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
chargalois(GEN G,GEN ORD)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
znstar0(GEN N,long flag)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
znstar(GEN N)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
Zideallog_2k(GEN h,GEN g,long e,GEN pe)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
Zideallog_pk(GEN h,GEN g,GEN p,long e,GEN pe,GEN ord,GEN lo)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
znconrey_check(GEN cyc,GEN chi)743 znconrey_check(GEN cyc, GEN chi)
744 { return typ(chi) == t_COL && lg(chi) == lg(cyc) && RgV_is_ZV(chi); }
745
746 int
zncharcheck(GEN G,GEN chi)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
znconreyfromchar_normalized(GEN bid,GEN chi)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
znconreyfromchar(GEN bid,GEN chi)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
znconreylog(GEN bid,GEN x)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
Zideallog(GEN bid,GEN x)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
znlog0(GEN h,GEN g,GEN o)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
znconreyexp(GEN bid,GEN x)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
znconreychar(GEN bid,GEN m)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
znconreyconductor(GEN bid,GEN chi,GEN * pm)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
zncharinduce(GEN G,GEN chi,GEN N)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
znconreylog_normalize(GEN G,GEN m)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
znconrey_normalized(GEN G,GEN chi)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
zncharisodd(GEN G,GEN chi)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
znchartokronecker(GEN G,GEN chi,long flag)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
znchar_quad(GEN G,GEN D)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
znchar(GEN D)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
znchareval(GEN G,GEN chi,GEN n,GEN z)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
zncharconj(GEN G,GEN chi)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
zncharorder(GEN G,GEN chi)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
zncharker(GEN G,GEN chi)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
zncharpow(GEN G,GEN a,GEN n)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
zncharmul(GEN G,GEN a,GEN b)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
znchardiv(GEN G,GEN a,GEN b)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
znchardecompose(GEN G,GEN chi,GEN Q)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
zncharconductor(GEN G,GEN chi)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
znchartoprimitive(GEN G,GEN chi)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