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