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