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 3870182 : checkznstar_i(GEN G)
25 : {
26 3869965 : return (typ(G) == t_VEC && lg(G) == 6
27 3869587 : && typ(znstar_get_N(G)) == t_INT
28 3869580 : && typ(znstar_get_faN(G)) == t_VEC
29 7740147 : && typ(gel(G,1)) == t_VEC && lg(gel(G,1)) == 3);
30 : }
31 :
32 : int
33 120057 : char_check(GEN cyc, GEN chi)
34 120057 : { 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 252637 : cyc_normalize(GEN d)
39 : {
40 252637 : long i, l = lg(d);
41 : GEN C, D;
42 252637 : if (l == 1) return mkvec(gen_1);
43 252616 : D = cgetg(l, t_VEC); gel(D,1) = C = gel(d,1);
44 597408 : for (i = 2; i < l; i++) gel(D,i) = diviiexact(C, gel(d,i));
45 252616 : 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 293804 : char_simplify(GEN D, GEN C)
52 : {
53 293804 : GEN d = D;
54 293804 : if (lg(C) == 1) d = gen_1;
55 : else
56 : {
57 293258 : GEN t = gcdii(d, ZV_content(C));
58 293258 : if (!equali1(t))
59 : {
60 204001 : long tc = typ(C);
61 204001 : C = ZC_Z_divexact(C, t); settyp(C, tc);
62 204001 : d = diviiexact(d, t);
63 : }
64 : }
65 293804 : 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 292901 : char_normalize(GEN chi, GEN ncyc)
73 : {
74 292901 : long i, l = lg(chi);
75 292901 : GEN c = cgetg(l, t_VEC);
76 292901 : if (l > 1) {
77 292880 : gel(c,1) = gel(chi,1);
78 739004 : for (i = 2; i < l; i++) gel(c,i) = mulii(gel(chi,i), gel(ncyc,i));
79 : }
80 292901 : 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 532 : get_cyc(GEN x, GEN chi, const char *s)
88 : {
89 532 : switch(nftyp(x))
90 : {
91 448 : case typ_BIDZ:
92 448 : if (!zncharcheck(x, chi)) pari_err_TYPE(s, chi);
93 448 : 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 84 : default:
100 84 : if (typ(x) != t_VEC || !RgV_is_ZV(x)) x = member_cyc(x);
101 84 : if (!char_check(x, chi)) pari_err_TYPE(s, chi);
102 84 : return x;
103 : }
104 : }
105 :
106 : /* conjugate character [ZV/ZC] */
107 : GEN
108 6664 : charconj(GEN cyc, GEN chi)
109 : {
110 : long i, l;
111 6664 : GEN z = cgetg_copy(chi, &l);
112 11998 : for (i = 1; i < l; i++)
113 : {
114 5334 : GEN c = gel(chi,i);
115 5334 : gel(z,i) = signe(c)? subii(gel(cyc,i), c): gen_0;
116 : }
117 6664 : return z;
118 : }
119 : GEN
120 28 : charconj0(GEN x, GEN chi)
121 : {
122 28 : GEN cyc = get_cyc(x, chi, "charconj");
123 28 : return cyc? charconj(cyc, chi): zncharconj(x, chi);
124 : }
125 :
126 : GEN
127 1382311 : charorder(GEN cyc, GEN x)
128 : {
129 1382311 : pari_sp av = avma;
130 1382311 : long i, l = lg(cyc);
131 1382311 : GEN f = gen_1;
132 3613456 : for (i = 1; i < l; i++)
133 2231145 : if (signe(gel(x,i)))
134 : {
135 1274462 : GEN c, o = gel(cyc,i);
136 1274462 : if (!signe(o))
137 0 : return gerepileupto(av,mkoo());
138 1274462 : c = gcdii(o, gel(x,i));
139 1274462 : if (!is_pm1(c)) o = diviiexact(o,c);
140 1274462 : f = lcmii(f, o);
141 : }
142 1382311 : return gerepileuptoint(av, f);
143 : }
144 : GEN
145 210 : charorder0(GEN x, GEN chi)
146 : {
147 210 : GEN cyc = get_cyc(x, chi, "charorder");
148 210 : 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 97881 : charker(GEN cyc, GEN chi)
155 : {
156 97881 : long i, l = lg(cyc);
157 : GEN nchi, ncyc, m, U;
158 :
159 97881 : if (l == 1) return cgetg(1,t_MAT); /* trivial subgroup */
160 97832 : ncyc = cyc_normalize(cyc);
161 97832 : nchi = char_normalize(chi, ncyc);
162 97832 : m = shallowconcat(gel(nchi,2), gel(nchi,1));
163 97832 : U = gel(ZV_extgcd(m), 2); setlg(U,l);
164 267526 : for (i = 1; i < l; i++) setlg(U[i], l);
165 97832 : return hnfmodid(U, gel(ncyc,1));
166 : }
167 : GEN
168 35 : charker0(GEN x, GEN chi)
169 : {
170 35 : GEN cyc = get_cyc(x, chi, "charker");
171 35 : return cyc? charker(cyc, chi): zncharker(x, chi);
172 : }
173 :
174 : GEN
175 189 : charpow(GEN cyc, GEN a, GEN N)
176 : {
177 : long i, l;
178 189 : GEN v = cgetg_copy(a, &l);
179 350 : for (i = 1; i < l; i++) gel(v,i) = Fp_mul(gel(a,i), N, gel(cyc,i));
180 189 : return v;
181 : }
182 : GEN
183 302008 : charmul(GEN cyc, GEN a, GEN b)
184 : {
185 : long i, l;
186 302008 : GEN v = cgetg_copy(a, &l);
187 1350328 : for (i = 1; i < l; i++) gel(v,i) = Fp_add(gel(a,i), gel(b,i), gel(cyc,i));
188 302008 : return v;
189 : }
190 : GEN
191 5544 : chardiv(GEN cyc, GEN a, GEN b)
192 : {
193 : long i, l;
194 5544 : GEN v = cgetg_copy(a, &l);
195 11991 : for (i = 1; i < l; i++) gel(v,i) = Fp_sub(gel(a,i), gel(b,i), gel(cyc,i));
196 5544 : return v;
197 : }
198 : GEN
199 63 : charpow0(GEN x, GEN a, GEN N)
200 : {
201 63 : GEN cyc = get_cyc(x, a, "charpow");
202 63 : return cyc? charpow(cyc, a, N): zncharpow(x, a, N);
203 : }
204 : GEN
205 154 : charmul0(GEN x, GEN a, GEN b)
206 : {
207 154 : const char *s = "charmul";
208 154 : GEN cyc = get_cyc(x, a, s);
209 154 : if (!cyc)
210 : {
211 154 : if (!zncharcheck(x, b)) pari_err_TYPE(s, b);
212 154 : 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 42 : chardiv0(GEN x, GEN a, GEN b)
222 : {
223 42 : const char *s = "chardiv";
224 42 : GEN cyc = get_cyc(x, a, s);
225 42 : if (!cyc)
226 : {
227 42 : if (!zncharcheck(x, b)) pari_err_TYPE(s, b);
228 42 : 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 2520910 : chareval_i(GEN nchi, GEN dlog, GEN z)
239 : {
240 2520910 : GEN o, q, r, b = gel(nchi,1);
241 2520910 : GEN a = FpV_dotproduct(gel(nchi,2), dlog, b);
242 : /* image is a/b in Q/Z */
243 2520910 : if (!z) return gdiv(a,b);
244 2520532 : if (typ(z) == t_INT)
245 : {
246 2509136 : q = dvmdii(z, b, &r);
247 2509136 : if (signe(r)) pari_err_TYPE("chareval", z);
248 2509136 : return mulii(a, q);
249 : }
250 : /* return z^(a*o/b), assuming z^o = 1 and b | o */
251 11396 : if (typ(z) != t_VEC || lg(z) != 3) pari_err_TYPE("chareval", z);
252 11396 : o = gel(z,2); if (typ(o) != t_INT) pari_err_TYPE("chareval", z);
253 11396 : q = dvmdii(o, b, &r); if (signe(r)) pari_err_TYPE("chareval", z);
254 11396 : q = mulii(a, q); /* in [0, o[ since a is reduced mod b */
255 11396 : z = gel(z,1);
256 11396 : if (typ(z) == t_VEC)
257 : {
258 10080 : if (itos_or_0(o) != lg(z)-1) pari_err_TYPE("chareval", z);
259 10080 : return gcopy(gel(z, itos(q)+1));
260 : }
261 : else
262 1316 : return gpow(z, q, DEFAULTPREC);
263 : }
264 :
265 : static GEN
266 1855 : not_coprime(GEN z)
267 1855 : { return (!z || typ(z) == t_INT)? gen_m1: gen_0; }
268 :
269 : static GEN
270 35 : get_chi(GEN cyc, GEN chi)
271 : {
272 35 : if (!char_check(cyc,chi)) pari_err_TYPE("chareval", chi);
273 35 : 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 42 : bnr_coprime(GEN G, GEN x)
278 : {
279 42 : GEN t, N = gel(bnr_get_mod(G), 1);
280 42 : if (typ(x) == t_INT) /* shortcut */
281 : {
282 14 : t = gcdii(gcoeff(N,1,1), x);
283 14 : if (equali1(t)) return 1;
284 0 : t = idealadd(G, N, x);
285 0 : return equali1(gcoeff(t,1,1));
286 : }
287 28 : x = idealnumden(G, x);
288 28 : t = idealadd(G, N, gel(x,1));
289 28 : if (!equali1(gcoeff(t,1,1))) return 0;
290 21 : t = idealadd(G, N, gel(x,2));
291 21 : return equali1(gcoeff(t,1,1));
292 : }
293 : GEN
294 3605 : chareval(GEN G, GEN chi, GEN x, GEN z)
295 : {
296 3605 : pari_sp av = avma;
297 : GEN nchi, L;
298 :
299 3605 : switch(nftyp(G))
300 : {
301 42 : case typ_BNR:
302 42 : if (!bnr_coprime(G, x)) return not_coprime(z);
303 28 : L = isprincipalray(G, x);
304 28 : nchi = get_chi(bnr_get_cyc(G), chi);
305 28 : break;
306 7 : case typ_BNF:
307 7 : L = isprincipal(G, x);
308 7 : nchi = get_chi(bnf_get_cyc(G), chi);
309 7 : break;
310 3542 : case typ_BIDZ:
311 3542 : 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 7 : pari_err_TYPE("chareval [use gchareval to evaluate a grossencharacter]", G);
315 7 : default:
316 7 : pari_err_TYPE("chareval", G);
317 : return NULL;/* LCOV_EXCL_LINE */
318 : }
319 35 : 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 37191 : ncharvecexpo(GEN G, GEN nchi)
327 : {
328 37191 : 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 37191 : GEN D = gel(nchi,2), v = const_vecsmall(N,-1);
331 37191 : pari_sp av = avma;
332 37191 : if (typ(D) == t_COL) {
333 37191 : cyc = znstar_get_conreycyc(G);
334 37191 : gen = znstar_get_conreygen(G);
335 : } else {
336 0 : cyc = znstar_get_cyc(G);
337 0 : gen = znstar_get_gen(G);
338 : }
339 37191 : l = lg(cyc);
340 37191 : e = u = cgetg(N+1,t_VECSMALL);
341 37191 : d = t = cgetg(N+1,t_VECSMALL);
342 37191 : *++d = 1;
343 37191 : *++e = 0; v[*d] = *e;
344 78449 : for (i = 1; i < l; i++)
345 : {
346 41258 : ulong g = itou(gel(gen,i)), c = itou(gel(cyc,i)), x = itou(gel(D,i));
347 551404 : for (t1=t,u1=u,j=c-1; j; j--,t1=t2,u1=u2)
348 1132124 : for (t2=d,u2=e, t3=t1,u3=u1; t3<t2; )
349 : {
350 621978 : *++d = Fl_mul(*++t3, g, N);
351 621978 : *++e = Fl_add(*++u3, x, ord); v[*d] = *e;
352 : }
353 : }
354 37191 : set_avma(av); return v;
355 : }
356 :
357 : /*****************************************************************************/
358 :
359 : static ulong
360 257075 : lcmuu(ulong a, ulong b) { return (a/ugcd(a,b)) * b; }
361 : static ulong
362 101248 : zv_charorder(GEN cyc, GEN x)
363 : {
364 101248 : long i, l = lg(cyc);
365 101248 : ulong f = 1;
366 332115 : for (i = 1; i < l; i++)
367 230867 : if (x[i])
368 : {
369 155827 : ulong o = cyc[i];
370 155827 : f = lcmuu(f, o / ugcd(o, x[i]));
371 : }
372 101248 : return f;
373 : }
374 :
375 : /* N > 0 */
376 : GEN
377 549969 : coprimes_zv(ulong N)
378 : {
379 549969 : GEN v = const_vecsmall(N,1);
380 549969 : pari_sp av = avma;
381 549969 : GEN P = gel(factoru(N),1);
382 549969 : long i, l = lg(P);
383 1282309 : for (i = 1; i < l; i++)
384 : {
385 732340 : ulong p = P[i], j;
386 3414453 : for (j = p; j <= N; j += p) v[j] = 0;
387 : }
388 549969 : set_avma(av); return v;
389 : }
390 : /* cf zv_cyc_minimal: return k such that g*k is minimal (wrt lex) */
391 : long
392 46627 : zv_cyc_minimize(GEN cyc, GEN g, GEN coprime)
393 : {
394 46627 : pari_sp av = avma;
395 46627 : long d, k, e, i, maxi, k0, bestk, l = lg(g), o = lg(coprime)-1;
396 : GEN best, gk, gd;
397 : ulong t;
398 46627 : if (o == 1) return 1;
399 54187 : for (i = 1; i < l; i++)
400 54187 : if (g[i]) break;
401 46627 : if (g[i] == 1) return 1;
402 38423 : k0 = Fl_invgen(g[i], cyc[i], &t);
403 38423 : d = cyc[i] / (long)t;
404 38423 : if (k0 > 1) g = vecmoduu(Flv_Fl_mul(g, k0, cyc[i]), cyc);
405 50785 : for (i++; i < l; i++)
406 44751 : if (g[i]) break;
407 38423 : if (i == l) return k0;
408 32389 : cyc = vecslice(cyc,i,l-1);
409 32389 : g = vecslice(g, i,l-1);
410 32389 : e = cyc[1];
411 32389 : gd = Flv_Fl_mul(g, d, e);
412 32389 : bestk = 1; best = g; maxi = e/ugcd(d,e);
413 48643 : for (gk = g, k = d+1, i = 1; i < maxi; k += d, i++)
414 : {
415 16254 : long ko = k % o;
416 16254 : gk = Flv_add(gk, gd, e); if (!ko || !coprime[ko]) continue;
417 7357 : gk = vecmoduu(gk, cyc);
418 7357 : if (vecsmall_lexcmp(gk, best) < 0) { best = gk; bestk = k; }
419 : }
420 32389 : 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 100800 : zv_cyc_minimal(GEN cyc, GEN g, GEN coprime)
427 : {
428 100800 : pari_sp av = avma;
429 100800 : long i, maxi, d, k, e, l = lg(g), o = lg(coprime)-1; /* elt order */
430 : GEN gd, gk;
431 100800 : if (o == 1) return 1;
432 106407 : for (k = 1; k < l; k++)
433 106407 : if (g[k]) break;
434 100800 : if (g[k] == 1) return 1;
435 80332 : if (cyc[k] % g[k]) return 0;
436 80332 : d = cyc[k] / g[k]; /* > 1 */
437 97069 : for (k++; k < l; k++) /* skip following 0s */
438 97069 : if (g[k]) break;
439 80332 : if (k == l) return 1;
440 80332 : cyc = vecslice(cyc,k,l-1);
441 80332 : g = vecslice(g, k,l-1);
442 80332 : 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 80332 : gd = Flv_Fl_mul(g, d, e); maxi = e/ugcd(d,e);
446 138159 : for (gk = g, k = d+1, i = 1; i < maxi; i++, k += d)
447 : {
448 67823 : long ko = k % o;
449 67823 : gk = Flv_add(gk, gd, e); if (!coprime[ko]) continue;
450 36141 : gk = vecmoduu(gk, cyc);
451 36141 : if (vecsmall_lexcmp(gk, g) < 0) return gc_long(av,0);
452 : }
453 70336 : return gc_long(av,1);
454 : }
455 :
456 : static GEN
457 8008 : coprime_tables(long N)
458 : {
459 8008 : GEN D = divisorsu(N), v = const_vec(N, NULL);
460 8008 : long i, l = lg(D);
461 47481 : for (i = 1; i < l; i++) gel(v, D[i]) = coprimes_zv(D[i]);
462 8008 : return v;
463 : }
464 : /* enumerate all group elements, modulo (Z/cyc[1])^* */
465 : static GEN
466 8036 : cyc2elts_normal(GEN cyc, long maxord, GEN ORD)
467 : {
468 8036 : long i, n, o, N, j = 1;
469 : GEN z, vcoprime;
470 :
471 8036 : if (typ(cyc) != t_VECSMALL) cyc = vec_to_vecsmall(cyc);
472 8036 : n = lg(cyc)-1;
473 8036 : N = zv_prod(cyc);
474 8036 : z = cgetg(N+1, t_VEC);
475 8036 : if (1 <= maxord && (!ORD|| zv_search(ORD,1)))
476 7651 : gel(z,j++) = zero_zv(n);
477 8036 : if (n == 0) { setlg(z, j); return z; }
478 8008 : vcoprime = coprime_tables(cyc[1]);
479 23184 : for (i = n; i > 0; i--)
480 : {
481 15176 : GEN cyc0 = vecslice(cyc,i+1,n), pre = zero_zv(i);
482 15176 : GEN D = divisorsu(cyc[i]), C = cyc2elts(cyc0);
483 15176 : long s, t, lD = lg(D), nC = lg(C)-1; /* remove last element */
484 54810 : for (s = 1; s < lD-1; s++)
485 : {
486 39634 : long o0 = D[lD-s]; /* cyc[i] / D[s] */
487 39634 : if (o0 > maxord) continue;
488 38143 : pre[i] = D[s];
489 38143 : if (!ORD || zv_search(ORD,o0))
490 : {
491 37842 : GEN c = vecsmall_concat(pre, zero_zv(n-i));
492 37842 : gel(z,j++) = c;
493 : }
494 139391 : for (t = 1; t < nC; t++)
495 : {
496 101248 : GEN chi0 = gel(C,t);
497 101248 : o = lcmuu(o0, zv_charorder(cyc0,chi0));
498 101248 : if (o <= maxord && (!ORD || zv_search(ORD,o)))
499 : {
500 100800 : GEN c = vecsmall_concat(pre, chi0);
501 100800 : if (zv_cyc_minimal(cyc, c, gel(vcoprime,o))) gel(z,j++) = c;
502 : }
503 : }
504 : }
505 : }
506 8008 : setlg(z,j); return z;
507 : }
508 :
509 : GEN
510 10479 : chargalois(GEN G, GEN ORD)
511 : {
512 10479 : pari_sp av = avma;
513 : long maxord, i, l;
514 10479 : GEN v, cyc = (typ(G) == t_VEC && RgV_is_ZVpos(G))? G: member_cyc(G);
515 10479 : if (lg(cyc) == 1 && !ORD) retmkvec(cgetg(1,t_VEC));
516 8043 : maxord = itou(cyc_get_expo(cyc));
517 8043 : if (ORD)
518 441 : switch(typ(ORD))
519 : {
520 : long l;
521 42 : case t_VEC:
522 42 : ORD = ZV_to_zv(ORD);
523 406 : case t_VECSMALL:
524 406 : l = lg(ORD);
525 406 : if (l > 2)
526 : {
527 371 : ORD = leafcopy(ORD);
528 371 : vecsmall_sort(ORD);
529 : }
530 406 : if (l == 1) { set_avma(av); return cgetg(1, t_VEC); }
531 399 : maxord = minss(maxord, ORD[l-1]);
532 399 : break;
533 35 : case t_INT:
534 35 : maxord = minss(maxord, itos(ORD));
535 35 : ORD = NULL;
536 35 : break;
537 0 : default: pari_err_TYPE("chargalois", ORD);
538 : }
539 8036 : v = cyc2elts_normal(cyc, maxord, ORD); l = lg(v);
540 144333 : for(i = 1; i < l; i++) gel(v,i) = zv_to_ZV(gel(v,i));
541 8036 : return gerepileupto(av, v);
542 : }
543 :
544 : /*********************************************************************/
545 : /** **/
546 : /** (Z/NZ)^* AND DIRICHLET CHARACTERS **/
547 : /** **/
548 : /*********************************************************************/
549 :
550 : GEN
551 130996 : znstar0(GEN N, long flag)
552 : {
553 130996 : GEN F = NULL, P, E, cyc, gen, mod, G;
554 : long i, i0, l, nbprimes;
555 130996 : pari_sp av = avma;
556 :
557 130996 : if (flag && flag != 1) pari_err_FLAG("znstar");
558 130996 : if ((F = check_arith_all(N,"znstar")))
559 : {
560 10052 : F = clean_Z_factor(F);
561 10052 : N = typ(N) == t_VEC? gel(N,1): factorback(F);
562 : }
563 130996 : if (!signe(N))
564 : {
565 21 : if (flag) pari_err_IMPL("znstar(0,1)");
566 14 : set_avma(av);
567 14 : retmkvec3(gen_2, mkvec(gen_2), mkvec(gen_m1));
568 : }
569 130975 : N = absi_shallow(N);
570 130975 : if (abscmpiu(N,2) <= 0)
571 : {
572 10577 : G = mkvec3(gen_1, cgetg(1,t_VEC), cgetg(1,t_VEC));
573 10577 : if (flag)
574 : {
575 10514 : GEN v = const_vec(6,cgetg(1,t_VEC));
576 10514 : gel(v,3) = cgetg(1,t_MAT);
577 20993 : F = equali1(N)? mkvec2(cgetg(1,t_COL),cgetg(1,t_VECSMALL))
578 10514 : : mkvec2(mkcol(gen_2), mkvecsmall(1));
579 10514 : G = mkvec5(mkvec2(N,mkvec(gen_0)), G, F, v, cgetg(1,t_MAT));
580 : }
581 10577 : return gerepilecopy(av,G);
582 : }
583 120398 : if (!F) F = Z_factor(N);
584 120398 : P = gel(F,1); nbprimes = lg(P)-1;
585 120398 : E = ZV_to_nv( gel(F,2) );
586 120398 : switch(mod8(N))
587 : {
588 20354 : case 0:
589 20354 : P = shallowconcat(gen_2,P);
590 20354 : E = vecsmall_prepend(E, E[1]); /* add a copy of p=2 row */
591 20354 : i = 2; /* 2 generators at 2 */
592 20354 : break;
593 19235 : case 4:
594 19235 : i = 1; /* 1 generator at 2 */
595 19235 : break;
596 7014 : case 2: case 6:
597 7014 : P = vecsplice(P,1);
598 7014 : E = vecsplice(E,1); /* remove 2 */
599 7014 : i = 0; /* no generator at 2 */
600 7014 : break;
601 73795 : default:
602 73795 : i = 0; /* no generator at 2 */
603 73795 : break;
604 : }
605 120398 : l = lg(P);
606 120398 : cyc = cgetg(l,t_VEC);
607 120398 : gen = cgetg(l,t_VEC);
608 120398 : mod = cgetg(l,t_VEC);
609 : /* treat p=2 first */
610 120398 : if (i == 2)
611 : {
612 20354 : long v2 = E[1];
613 20354 : GEN q = int2n(v2);
614 20354 : gel(cyc,1) = gen_2;
615 20354 : gel(gen,1) = subiu(q,1); /* -1 */
616 20354 : gel(mod,1) = q;
617 20354 : gel(cyc,2) = int2n(v2-2);
618 20354 : gel(gen,2) = utoipos(5); /* Conrey normalization */
619 20354 : gel(mod,2) = q;
620 20354 : i0 = 3;
621 : }
622 100044 : else if (i == 1)
623 : {
624 19235 : gel(cyc,1) = gen_2;
625 19235 : gel(gen,1) = utoipos(3);
626 19235 : gel(mod,1) = utoipos(4);
627 19235 : i0 = 2;
628 : }
629 : else
630 80809 : i0 = 1;
631 : /* odd primes, fill remaining entries */
632 290974 : for (i = i0; i < l; i++)
633 : {
634 170576 : long e = E[i];
635 170576 : GEN p = gel(P,i), q = powiu(p, e-1), Q = mulii(p, q);
636 170576 : gel(cyc,i) = subii(Q, q); /* phi(p^e) */
637 170576 : gel(gen,i) = pgener_Zp(p);/* Conrey normalization, for e = 1 also */
638 170576 : gel(mod,i) = Q;
639 : }
640 : /* gen[i] has order cyc[i] and generates (Z/mod[i]Z)^* */
641 120398 : if (nbprimes > 1) /* lift generators to (Z/NZ)^*, = 1 mod N/mod[i] */
642 243907 : for (i=1; i<l; i++)
643 : {
644 175614 : GEN Q = gel(mod,i), g = gel(gen,i), qinv = Fp_inv(Q, diviiexact(N,Q));
645 175614 : g = addii(g, mulii(mulii(subsi(1,g),qinv),Q));
646 175614 : 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 120398 : if (!flag)
651 : { /* update generators in place; about twice faster */
652 35802 : G = gen;
653 36019 : for (i=l-1; i>=2; i--)
654 : {
655 217 : GEN ci = gel(cyc,i), gi = gel(G,i);
656 : long j;
657 518 : for (j=i-1; j>=1; j--) /* we want cyc[i] | cyc[j] */
658 : {
659 301 : GEN cj = gel(cyc,j), gj, qj, v, d;
660 :
661 301 : d = bezout(ci,cj,NULL,&v); /* > 1 */
662 455 : if (absequalii(ci, d)) continue; /* ci | cj */
663 189 : if (absequalii(cj, d)) { /* cj | ci */
664 154 : swap(gel(G,j),gel(G,i));
665 154 : gi = gel(G,i);
666 154 : swap(gel(cyc,j),gel(cyc,i));
667 154 : ci = gel(cyc,i); continue;
668 : }
669 :
670 35 : qj = diviiexact(cj,d);
671 35 : gel(cyc,j) = mulii(ci,qj);
672 35 : 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 35 : gj = gel(G,j);
677 : /* (gj, gi) *= [1,0; -1,1]^-1 */
678 35 : gj = Fp_mul(gj, gi, N); /* order ci*qj = lcm(ci,cj) */
679 : /* (gj,gi) *= [1,v*qj; 0,1]^-1 */
680 35 : togglesign_safe(&v);
681 35 : if (signe(v) < 0) v = modii(v,ci); /* >= 0 to avoid inversions */
682 35 : gel(G,i) = gi = Fp_mul(gi, Fp_pow(gj, mulii(qj, v), N), N);
683 35 : gel(G,j) = gj;
684 35 : ci = d; if (absequaliu(ci, 2)) break;
685 : }
686 : }
687 35802 : G = mkvec3(ZV_prod(cyc), cyc, FpV_to_mod(G,N));
688 : }
689 : else
690 : { /* keep matrices between generators, return an 'init' structure */
691 84596 : GEN D, U, Ui, fao = cgetg(l, t_VEC), lo = cgetg(l, t_VEC);
692 84596 : F = mkvec2(P, E);
693 84596 : D = ZV_snf_group(cyc,&U,&Ui);
694 279096 : for (i = 1; i < l; i++)
695 : {
696 194500 : GEN t = gen_0, p = gel(P,i), p_1 = subiu(p,1);
697 194500 : long e = E[i];
698 194500 : gel(fao,i) = get_arith_ZZM(p_1);
699 194500 : if (e >= 2 && !absequaliu(p,2))
700 : {
701 12937 : GEN q = gel(mod,i), g = Fp_pow(gel(gen,i),p_1,q);
702 12937 : if (e == 2)
703 10557 : t = Fp_inv(diviiexact(subiu(g,1), p), p);
704 : else
705 2380 : t = ginv(Qp_log(cvtop(g,p,e)));
706 : }
707 194500 : gel(lo,i) = t;
708 : }
709 84596 : G = cgetg(l, t_VEC);
710 279096 : for (i = 1; i < l; i++) gel(G,i) = FpV_factorback(gen, gel(Ui,i), N);
711 84596 : G = mkvec3(ZV_prod(D), D, G);
712 84596 : G = mkvec5(mkvec2(N,mkvec(gen_0)), G, F,
713 : mkvecn(6,mod,fao,Ui,gen,cyc,lo), U);
714 : }
715 120398 : return gerepilecopy(av, G);
716 : }
717 : GEN
718 35788 : 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 949576 : Zideallog_2k(GEN h, GEN g, long e, GEN pe)
723 : {
724 949576 : GEN a = Fp_log(h, g, int2n(e-2), pe);
725 949576 : if (typ(a) != t_INT) return NULL;
726 949576 : 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 2000666 : Zideallog_pk(GEN h, GEN g, GEN p, long e, GEN pe, GEN ord, GEN lo)
733 : {
734 2000666 : GEN gp = (e == 1)? g: modii(g, p);
735 2000666 : GEN hp = (e == 1)? h: modii(h, p);
736 2000666 : GEN a = Fp_log(hp, gp, ord, p);
737 2000666 : if (typ(a) != t_INT) return NULL;
738 2000659 : 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 53558 : GEN b, p_1 = gel(ord,1);
742 53558 : 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 53558 : if (e == 2) /* simpler */
745 46131 : b = Fp_mul(diviiexact(subiu(h,1), p), lo, p);
746 : else
747 7427 : b = padic_to_Q(gmul(Qp_log(cvtop(h, p, e)), lo));
748 53558 : a = addii(a, mulii(p_1, b));
749 : }
750 2000659 : return a;
751 : }
752 :
753 : int
754 903168 : znconrey_check(GEN cyc, GEN chi)
755 903168 : { return typ(chi) == t_COL && lg(chi) == lg(cyc) && RgV_is_ZV(chi); }
756 :
757 : int
758 207158 : zncharcheck(GEN G, GEN chi)
759 : {
760 207158 : switch(typ(chi))
761 : {
762 875 : case t_INT: return 1;
763 197785 : case t_COL: return znconrey_check(znstar_get_conreycyc(G), chi);
764 8498 : case t_VEC: return char_check(znstar_get_cyc(G), chi);
765 : }
766 0 : return 0;
767 : }
768 :
769 : GEN
770 153055 : znconreyfromchar_normalized(GEN bid, GEN chi)
771 : {
772 153055 : GEN nchi, U = znstar_get_U(bid);
773 153055 : long l = lg(chi);
774 153055 : if (l == 1) retmkvec2(gen_1,cgetg(1,t_VEC));
775 150612 : if (!RgV_is_ZV(chi) || lgcols(U) != l) pari_err_TYPE("lfunchiZ", chi);
776 150605 : nchi = char_normalize(chi, cyc_normalize(znstar_get_cyc(bid)));
777 150605 : gel(nchi,2) = ZV_ZM_mul(gel(nchi,2),U); return nchi;
778 : }
779 :
780 : GEN
781 142919 : znconreyfromchar(GEN bid, GEN chi)
782 : {
783 142919 : GEN nchi = znconreyfromchar_normalized(bid, chi);
784 142912 : GEN v = char_denormalize(znstar_get_conreycyc(bid), gel(nchi,1), gel(nchi,2));
785 142912 : 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 2606500 : znconreylog(GEN bid, GEN x)
792 : {
793 2606500 : pari_sp av = avma;
794 : GEN N, L, F, P,E, y, pe, fao, gen, lo, cycg;
795 : long i, l;
796 2606500 : if (!checkznstar_i(bid)) pari_err_TYPE("znconreylog", bid);
797 2606493 : N = znstar_get_N(bid);
798 2606493 : if (abscmpiu(N, 2) <= 0)
799 : {
800 12376 : switch(typ(x))
801 : {
802 2674 : case t_INT: break;
803 7 : case t_INTMOD:
804 7 : if (!equalii(N, gel(x,1))) pari_err_TYPE("znconreylog", x);
805 0 : x = gel(x,2); break;
806 9688 : case t_COL:
807 : case t_VEC:
808 9688 : if (lg(x) != 1) pari_err_TYPE("znconreylog", x);
809 9674 : break;
810 7 : default: pari_err_TYPE("znconreylog", x);
811 : }
812 12348 : return cgetg(1, t_COL);
813 : }
814 2594117 : cycg = znstar_get_conreycyc(bid);
815 2594117 : 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 2559999 : case t_INT:
822 2559999 : if (!signe(x)) pari_err_COPRIME("znconreylog", x, N);
823 2559992 : break;
824 35 : case t_COL: /* log_bid(x) */
825 35 : Ui = znstar_get_Ui(bid);
826 35 : if (!RgV_is_ZV(x) || lg(x) != lg(Ui)) pari_err_TYPE("znconreylog", x);
827 35 : return gerepileupto(av, ZV_ZV_mod(ZM_ZC_mul(Ui,x), cycg));
828 34083 : case t_VEC:
829 34083 : return gerepilecopy(av, znconreyfromchar(bid, x));
830 0 : default: pari_err_TYPE("znconreylog", x);
831 : }
832 2559992 : F = znstar_get_faN(bid); /* factor(N) */
833 2559992 : P = gel(F, 1); /* prime divisors of N */
834 2559992 : E = gel(F, 2); /* exponents */
835 2559992 : L = gel(bid,4);
836 2559992 : pe = znstar_get_pe(bid);
837 2559992 : fao = gel(L,2);
838 2559992 : gen = znstar_get_conreygen(bid); /* local generators of (Z/p^k)^* */
839 2559992 : lo = gel(L,6); /* 1/log_p((g_i)^(p_i-1)) */
840 :
841 2559992 : l = lg(gen); i = 1;
842 2559992 : y = cgetg(l, t_COL);
843 2559992 : if (!mod2(N) && !mod2(x)) pari_err_COPRIME("znconreylog", x, N);
844 2559978 : if (absequaliu(gel(P,1), 2) && E[1] >= 2)
845 : {
846 1259759 : if (E[1] == 2)
847 310183 : gel(y,i++) = mod4(x) == 1? gen_0: gen_1;
848 : else
849 : {
850 949576 : GEN a, x2, q2 = gel(pe,1);
851 949576 : x2 = modii(x, q2);
852 949576 : if (mod4(x) == 1) /* 1 or 5 mod 8*/
853 592362 : gel(y,i++) = gen_0;
854 : else /* 3 or 7 */
855 357214 : { gel(y,i++) = gen_1; x2 = subii(q2, x2); }
856 : /* x2 = 5^x mod q */
857 949576 : a = Zideallog_2k(x2, gel(gen,i), E[1], q2);
858 949576 : if (!a) pari_err_COPRIME("znconreylog", x, N);
859 949576 : gel(y, i++) = a;
860 : }
861 : }
862 4560637 : while (i < l)
863 : {
864 2000666 : GEN p = gel(P,i), q = gel(pe,i), xpe = modii(x, q);
865 2000666 : GEN a = Zideallog_pk(xpe, gel(gen,i), p, E[i], q, gel(fao,i), gel(lo,i));
866 2000666 : if (!a) pari_err_COPRIME("znconreylog", x, N);
867 2000659 : gel(y, i++) = a;
868 : }
869 2559971 : return gerepilecopy(av, y);
870 : }
871 : GEN
872 23024 : Zideallog(GEN bid, GEN x)
873 : {
874 23024 : pari_sp av = avma;
875 23024 : GEN y = znconreylog(bid, x), U = znstar_get_U(bid);
876 22996 : return gerepileupto(av, ZM_ZC_mul(U, y));
877 : }
878 : GEN
879 294 : znlog0(GEN h, GEN g, GEN o)
880 : {
881 294 : if (typ(g) == t_VEC)
882 : {
883 : GEN N;
884 56 : if (o) pari_err_TYPE("znlog [with znstar]", o);
885 56 : if (!checkznstar_i(g)) pari_err_TYPE("znlog", g);
886 56 : N = znstar_get_N(g);
887 56 : h = Rg_to_Fp(h,N);
888 49 : return Zideallog(g, h);
889 : }
890 238 : return znlog(h, g, o);
891 : }
892 :
893 : GEN
894 260778 : znconreyexp(GEN bid, GEN x)
895 : {
896 260778 : pari_sp av = avma;
897 : long i, l;
898 : GEN N, pe, gen, cycg, v, vmod;
899 : int e2;
900 260778 : if (!checkznstar_i(bid)) pari_err_TYPE("znconreyexp", bid);
901 260778 : cycg = znstar_get_conreycyc(bid);
902 260778 : switch(typ(x))
903 : {
904 21 : case t_VEC:
905 21 : x = znconreylog(bid, x);
906 21 : break;
907 260757 : case t_COL:
908 260757 : if (RgV_is_ZV(x) && lg(x) == lg(cycg)) break;
909 7 : default: pari_err_TYPE("znconreyexp",x);
910 : }
911 260771 : pe = znstar_get_pe(bid);
912 260771 : gen = znstar_get_conreygen(bid); /* local generators of (Z/p^k)^* */
913 260771 : cycg = znstar_get_conreycyc(bid);
914 260771 : l = lg(x); v = cgetg(l, t_VEC);
915 260771 : N = znstar_get_N(bid);
916 260771 : e2 = !mod8(N); /* 2 generators at p = 2 */
917 805693 : for (i = 1; i < l; i++)
918 : {
919 : GEN q, g, m;
920 544922 : if (i == 1 && e2) { gel(v,1) = NULL; continue; }
921 512638 : q = gel(pe,i);
922 512638 : g = gel(gen,i);
923 512638 : m = modii(gel(x,i), gel(cycg,i));
924 512638 : m = Fp_pow(g, m, q);
925 512638 : if (i == 2 && e2 && signe(gel(x,1))) m = Fp_neg(m, q);
926 512638 : gel(v,i) = mkintmod(m, q);
927 : }
928 260771 : if (e2) v = vecsplice(v, 1);
929 260771 : v = chinese1_coprime_Z(v);
930 260771 : vmod = gel(v,1);
931 260771 : v = gel(v,2);
932 260771 : if (mpodd(v) || mpodd(N)) return gerepilecopy(av, v);
933 : /* handle N = 2 mod 4 */
934 231 : 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 46767 : znconreychar(GEN bid, GEN m)
941 : {
942 46767 : pari_sp av = avma;
943 : GEN c, d, nchi;
944 :
945 46767 : if (!checkznstar_i(bid)) pari_err_TYPE("znconreychar", bid);
946 46760 : 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 46760 : case t_INT:
953 : case t_COL:
954 46760 : nchi = znconrey_normalized(bid,m); /* images of primroot gens */
955 46753 : break;
956 0 : default:
957 0 : pari_err_TYPE("znconreychar",m);
958 : return NULL;/*LCOV_EXCL_LINE*/
959 : }
960 46753 : d = gel(nchi,1);
961 46753 : c = ZV_ZM_mul(gel(nchi,2), znstar_get_Ui(bid)); /* images of bid gens */
962 46753 : 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 735924 : znconreyconductor(GEN bid, GEN chi, GEN *pm)
972 : {
973 735924 : pari_sp av = avma;
974 : GEN q, m, F, P, E;
975 : long i, j, l;
976 735924 : int e2, primitive = 1;
977 :
978 735924 : if (!checkznstar_i(bid)) pari_err_TYPE("znconreyconductor", bid);
979 735924 : if (typ(chi) == t_COL)
980 : {
981 705383 : if (!znconrey_check(znstar_get_conreycyc(bid), chi))
982 0 : pari_err_TYPE("znconreyconductor",chi);
983 : }
984 : else
985 30541 : chi = znconreylog(bid, chi);
986 735917 : l = lg(chi);
987 735917 : F = znstar_get_faN(bid);
988 735917 : P = gel(F,1);
989 735917 : E = gel(F,2);
990 735917 : if (l == 1)
991 : {
992 105007 : set_avma(av);
993 105007 : if (pm) *pm = cgetg(1,t_COL);
994 105007 : if (lg(P) == 1) return gen_1;
995 14 : retmkvec2(gen_1, trivial_fact());
996 : }
997 630910 : P = leafcopy(P);
998 630910 : E = leafcopy(E);
999 630910 : m = cgetg(l, t_COL);
1000 630910 : e2 = (E[1] >= 3 && absequaliu(gel(P,1),2));
1001 630910 : i = j = 1;
1002 630910 : if (e2)
1003 : { /* two generators at p=2 */
1004 286153 : GEN a1 = gel(chi,1), a = gel(chi,2);
1005 286153 : i = 3;
1006 286153 : if (!signe(a))
1007 : {
1008 98014 : e2 = primitive = 0;
1009 98014 : if (signe(a1))
1010 : { /* lose one generator */
1011 45507 : E[1] = 2;
1012 45507 : gel(m,1) = a1;
1013 45507 : j = 2;
1014 : }
1015 : /* else lose both */
1016 : }
1017 : else
1018 : {
1019 188139 : long v = Z_pvalrem(a, gen_2, &a);
1020 188139 : if (v) { E[1] -= v; E[2] = E[1]; primitive = 0; }
1021 188139 : gel(m,1) = a1;
1022 188139 : gel(m,2) = a;
1023 188139 : j = 3;
1024 : }
1025 : }
1026 630910 : l = lg(P);
1027 1828988 : for (; i < l; i++)
1028 : {
1029 1198078 : 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 1198078 : if (!signe(a)) primitive = 0;
1032 : else
1033 : {
1034 937517 : long v = Z_pvalrem(a, p, &a);
1035 937517 : E[j] = E[i]; if (v) { E[j] -= v; primitive = 0; }
1036 937517 : gel(P,j) = gel(P,i);
1037 937517 : gel(m,j) = a; j++;
1038 : }
1039 : }
1040 630910 : setlg(m,j);
1041 630910 : setlg(P,j);
1042 630910 : setlg(E,j);
1043 630910 : if (pm) *pm = m; /* attached primitive character */
1044 630910 : if (primitive)
1045 : {
1046 294861 : q = znstar_get_N(bid);
1047 294861 : if (mod4(q) == 2) primitive = 0;
1048 : }
1049 630910 : if (!primitive)
1050 : {
1051 336826 : if (e2)
1052 : { /* remove duplicate p=2 row from factorization */
1053 114744 : P = vecsplice(P,1);
1054 114744 : E = vecsplice(E,1);
1055 : }
1056 336826 : E = zc_to_ZC(E);
1057 336826 : q = mkvec2(factorback2(P,E), mkmat2(P,E));
1058 : }
1059 630910 : return gc_all(av, pm? 2: 1, &q, pm);
1060 : }
1061 :
1062 : GEN
1063 8477 : zncharinduce(GEN G, GEN chi, GEN N)
1064 : {
1065 8477 : pari_sp av = avma;
1066 : GEN q, faq, P, E, Pq, Eq, CHI;
1067 : long i, j, l;
1068 : int e2;
1069 :
1070 8477 : if (!checkznstar_i(G)) pari_err_TYPE("zncharinduce", G);
1071 8477 : if (!zncharcheck(G, chi)) pari_err_TYPE("zncharinduce", chi);
1072 8477 : q = znstar_get_N(G);
1073 8477 : if (typ(chi) != t_COL) chi = znconreylog(G, chi);
1074 8477 : if (checkznstar_i(N))
1075 : {
1076 8288 : GEN faN = znstar_get_faN(N);
1077 8288 : P = gel(faN,1); l = lg(P);
1078 8288 : E = gel(faN,2);
1079 8288 : N = znstar_get_N(N);
1080 8288 : if (l > 2 && equalii(gel(P,1),gel(P,2)))
1081 : { /* remove duplicate 2 */
1082 2583 : l--;
1083 2583 : P = vecsplice(P,1);
1084 2583 : E = vecsplice(E,1);
1085 : }
1086 : }
1087 : else
1088 : {
1089 189 : GEN faN = check_arith_pos(N, "zncharinduce");
1090 189 : if (!faN) faN = Z_factor(N);
1091 : else
1092 0 : N = (typ(N) == t_VEC)? gel(N,1): factorback(faN);
1093 189 : P = gel(faN,1);
1094 189 : E = gel(faN,2);
1095 : }
1096 8477 : if (!dvdii(N,q)) pari_err_DOMAIN("zncharinduce", "N % q", "!=", gen_0, N);
1097 8470 : if (mod4(N) == 2)
1098 : { /* remove 2 */
1099 77 : if (lg(P) > 1 && absequaliu(gel(P,1), 2))
1100 : {
1101 35 : P = vecsplice(P,1);
1102 35 : E = vecsplice(E,1);
1103 : }
1104 77 : N = shifti(N,-1);
1105 : }
1106 8470 : l = lg(P);
1107 : /* q = N or q = 2N, N odd */
1108 8470 : if (cmpii(N,q) <= 0) return gerepilecopy(av, chi);
1109 : /* N > 1 => l > 1*/
1110 8344 : if (typ(E) != t_VECSMALL) E = ZV_to_zv(E);
1111 8344 : e2 = (E[1] >= 3 && absequaliu(gel(P,1),2)); /* 2 generators at 2 mod N */
1112 8344 : if (ZV_equal0(chi))
1113 : {
1114 5446 : set_avma(av);
1115 5446 : return equali1(N)? cgetg(1, t_COL): zerocol(l+e2 - 1);
1116 : }
1117 :
1118 2898 : faq = znstar_get_faN(G);
1119 2898 : Pq = gel(faq,1);
1120 2898 : Eq = gel(faq,2);
1121 2898 : CHI = cgetg(l+e2, t_COL);
1122 2898 : i = j = 1;
1123 2898 : if (e2)
1124 : {
1125 1183 : i = 2; j = 3;
1126 1183 : if (absequaliu(gel(Pq,1), 2))
1127 : {
1128 1015 : if (Eq[1] >= 3)
1129 : { /* 2 generators at 2 mod q */
1130 560 : gel(CHI,1) = gel(chi,1);
1131 560 : gel(CHI,2) = shifti(gel(chi,2), E[1]-Eq[1]);
1132 : }
1133 455 : else if (Eq[1] == 2)
1134 : { /* 1 generator at 2 mod q */
1135 455 : gel(CHI,1) = gel(chi,1);
1136 455 : gel(CHI,2) = gen_0;
1137 : }
1138 : else
1139 0 : gel(CHI,1) = gel(CHI,2) = gen_0;
1140 : }
1141 : else
1142 168 : gel(CHI,1) = gel(CHI,2) = gen_0;
1143 : }
1144 7315 : for (; i < l; i++,j++)
1145 : {
1146 4417 : GEN p = gel(P,i);
1147 4417 : long k = ZV_search(Pq, p);
1148 4417 : gel(CHI,j) = k? mulii(gel(chi,k), powiu(p, E[i]-Eq[k])): gen_0;
1149 : }
1150 2898 : 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 2594193 : znconreylog_normalize(GEN G, GEN m)
1157 : {
1158 2594193 : GEN cycg = znstar_get_conreycyc(G);
1159 : long i, l;
1160 2594193 : GEN d, M = cgetg_copy(m, &l);
1161 2594193 : if (typ(cycg) != t_VEC || lg(cycg) != l)
1162 0 : pari_err_TYPE("znconreylog_normalize",mkvec2(m,cycg));
1163 6881518 : 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 2594193 : M = Q_remove_denom(M, &d);
1166 2594193 : 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 2587382 : znconrey_normalized(GEN G, GEN chi)
1173 : {
1174 2587382 : switch(typ(chi))
1175 : {
1176 420 : case t_INT: /* Conrey label */
1177 420 : return znconreylog_normalize(G, znconreylog(G, chi));
1178 2576826 : case t_COL: /* Conrey log */
1179 2576826 : if (!RgV_is_ZV(chi)) break;
1180 2576826 : return znconreylog_normalize(G, chi);
1181 10136 : case t_VEC: /* char on G.gen */
1182 10136 : if (!RgV_is_ZV(chi)) break;
1183 10136 : 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 197449 : zncharisodd(GEN G, GEN chi)
1192 : {
1193 : long i, l, s;
1194 : GEN N;
1195 197449 : if (!checkznstar_i(G)) pari_err_TYPE("zncharisodd", G);
1196 197449 : if (!zncharcheck(G, chi)) pari_err_TYPE("zncharisodd", chi);
1197 197449 : if (typ(chi) != t_COL) chi = znconreylog(G, chi);
1198 197449 : N = znstar_get_N(G);
1199 197449 : l = lg(chi);
1200 197449 : s = 0;
1201 197449 : if (!mod8(N))
1202 : {
1203 91371 : s = mpodd(gel(chi,1));
1204 91371 : i = 3;
1205 : }
1206 : else
1207 106078 : i = 1;
1208 537642 : for (; i < l; i++) s += mpodd(gel(chi,i));
1209 197449 : return odd(s);
1210 : }
1211 :
1212 : GEN
1213 847 : znchartokronecker(GEN G, GEN chi, long flag)
1214 : {
1215 847 : pari_sp av = avma;
1216 : long s;
1217 : GEN F, o;
1218 :
1219 847 : if (flag && flag != 1) pari_err_FLAG("znchartokronecker");
1220 847 : s = zncharisodd(G, chi)? -1: 1;
1221 847 : if (typ(chi) != t_COL) chi = znconreylog(G, chi);
1222 847 : o = zncharorder(G, chi);
1223 847 : if (abscmpiu(o,2) > 0) { set_avma(av); return gen_0; }
1224 581 : F = znconreyconductor(G, chi, NULL);
1225 581 : if (typ(F) == t_INT)
1226 : {
1227 469 : if (s < 0) F = negi(F);
1228 469 : return gerepileuptoint(av, F);
1229 : }
1230 112 : F = gel(F,1);
1231 112 : F = (s < 0)? negi(F): icopy(F);
1232 112 : if (!flag)
1233 : {
1234 49 : GEN MF = znstar_get_faN(G), P = gel(MF,1);
1235 49 : long i, l = lg(P);
1236 140 : for (i = 1; i < l; i++)
1237 : {
1238 91 : GEN p = gel(P,i);
1239 91 : if (!dvdii(F,p)) F = mulii(F,sqri(p));
1240 : }
1241 : }
1242 112 : 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 303331 : znchar_quad(GEN G, GEN D)
1248 : {
1249 303331 : GEN cyc = znstar_get_conreycyc(G);
1250 303331 : GEN gen = znstar_get_conreygen(G);
1251 303331 : long i, l = lg(cyc);
1252 303331 : GEN chi = cgetg(l, t_COL);
1253 1351686 : for (i = 1; i < l; i++)
1254 : {
1255 1048355 : long k = kronecker(D, gel(gen,i));
1256 1048355 : gel(chi,i) = (k==1)? gen_0: shifti(gel(cyc,i), -1);
1257 : }
1258 303331 : return chi;
1259 : }
1260 :
1261 : GEN
1262 3297 : znchar(GEN D)
1263 : {
1264 3297 : pari_sp av = avma;
1265 : GEN G, chi;
1266 3297 : switch(typ(D))
1267 : {
1268 2513 : case t_INT:
1269 2513 : if (!signe(D) || Mod4(D) > 1) pari_err_TYPE("znchar", D);
1270 2492 : G = znstar0(D,1);
1271 2492 : chi = mkvec2(G, znchar_quad(G,D));
1272 2492 : break;
1273 714 : case t_INTMOD:
1274 714 : G = znstar0(gel(D,1), 1);
1275 714 : chi = mkvec2(G, znconreylog(G, gel(D,2)));
1276 714 : break;
1277 56 : case t_VEC:
1278 56 : if (checkMF_i(D)) { chi = vecslice(MF_get_CHI(D),1,2); break; }
1279 49 : else if (checkmf_i(D)) { chi = vecslice(mf_get_CHI(D),1,2); break; }
1280 42 : if (lg(D) != 3) pari_err_TYPE("znchar", D);
1281 35 : G = gel(D,1);
1282 35 : if (!checkznstar_i(G)) pari_err_TYPE("znchar", D);
1283 28 : chi = gel(D,2);
1284 28 : if (typ(chi) == t_VEC && lg(chi) == 3 && is_vec_t(typ(gel(chi,2))))
1285 : { /* normalized character */
1286 7 : GEN n = gel(chi,1), chic = gel(chi,2);
1287 7 : GEN cyc = typ(chic)==t_VEC? znstar_get_cyc(G): znstar_get_conreycyc(G);
1288 7 : if (!char_check(cyc, chic)) pari_err_TYPE("znchar",D);
1289 7 : chi = char_denormalize(cyc, n, chic);
1290 : }
1291 28 : if (!zncharcheck(G, chi)) pari_err_TYPE("znchar", D);
1292 21 : chi = mkvec2(G,chi); break;
1293 14 : default:
1294 14 : pari_err_TYPE("znchar", D);
1295 : return NULL; /*LCOV_EXCL_LINE*/
1296 : }
1297 3241 : return gerepilecopy(av, chi);
1298 : }
1299 :
1300 : /* G a znstar, not stack clean */
1301 : GEN
1302 2522716 : znchareval(GEN G, GEN chi, GEN n, GEN z)
1303 : {
1304 2522716 : GEN nchi, N = znstar_get_N(G);
1305 : /* avoid division by 0 */
1306 2522716 : if (typ(n) == t_FRAC && !equali1(gcdii(gel(n,2), N))) return not_coprime(z);
1307 2522709 : n = Rg_to_Fp(n, N);
1308 2522709 : if (!equali1(gcdii(n, N))) return not_coprime(z);
1309 : /* nchi: normalized character on Conrey generators */
1310 2520875 : nchi = znconrey_normalized(G, chi);
1311 2520875 : return chareval_i(nchi, znconreylog(G,n), z);
1312 : }
1313 :
1314 : /* G is a znstar, chi a Dirichlet character */
1315 : GEN
1316 5810 : zncharconj(GEN G, GEN chi)
1317 : {
1318 5810 : switch(typ(chi))
1319 : {
1320 7 : case t_INT: chi = znconreylog(G, chi); /* fall through */
1321 665 : case t_COL: return charconj(znstar_get_conreycyc(G), chi);
1322 5145 : 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 388633 : zncharorder(GEN G, GEN chi)
1331 : {
1332 388633 : switch(typ(chi))
1333 : {
1334 21 : case t_INT: chi = znconreylog(G, chi); /*fall through*/
1335 383173 : case t_COL: return charorder(znstar_get_conreycyc(G), chi);
1336 5460 : 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 21 : zncharker(GEN G, GEN chi)
1345 : {
1346 21 : if (typ(chi) != t_VEC) chi = znconreychar(G, chi);
1347 21 : return charker(znstar_get_cyc(G), chi);
1348 : }
1349 :
1350 : /* G is a znstar, 'a' is a Dirichlet character */
1351 : GEN
1352 210 : zncharpow(GEN G, GEN a, GEN n)
1353 : {
1354 210 : switch(typ(a))
1355 : {
1356 21 : case t_INT: return Fp_pow(a, n, znstar_get_N(G));
1357 21 : case t_VEC: return charpow(znstar_get_cyc(G), a, n);
1358 168 : 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 302015 : zncharmul(GEN G, GEN a, GEN b)
1366 : {
1367 302015 : long ta = typ(a), tb = typ(b);
1368 302015 : if (ta == tb) switch(ta)
1369 : {
1370 7 : case t_INT: return Fp_mul(a, b, znstar_get_N(G));
1371 7 : case t_VEC: return charmul(znstar_get_cyc(G), a, b);
1372 301980 : 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 21 : if (ta != t_COL) a = znconreylog(G, a);
1377 21 : if (tb != t_COL) b = znconreylog(G, b);
1378 21 : return charmul(znstar_get_conreycyc(G), a, b);
1379 : }
1380 :
1381 : /* G is a znstar, 'a' and 'b' are Dirichlet character */
1382 : GEN
1383 5551 : znchardiv(GEN G, GEN a, GEN b)
1384 : {
1385 5551 : long ta = typ(a), tb = typ(b);
1386 5551 : if (ta == tb) switch(ta)
1387 : {
1388 7 : case t_INT: return Fp_div(a, b, znstar_get_N(G));
1389 7 : case t_VEC: return chardiv(znstar_get_cyc(G), a, b);
1390 5516 : 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 21 : if (ta != t_COL) a = znconreylog(G, a);
1395 21 : if (tb != t_COL) b = znconreylog(G, b);
1396 21 : 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 791 : znchardecompose(GEN G, GEN chi, GEN Q)
1403 : {
1404 : GEN c, P, E, F;
1405 : long l, lP, i;
1406 :
1407 791 : if (!checkznstar_i(G)) pari_err_TYPE("znchardecompose", G);
1408 791 : if (typ(Q) != t_INT) pari_err_TYPE("znchardecompose", Q);
1409 791 : if (typ(chi) == t_COL)
1410 560 : { if (!zncharcheck(G, chi)) pari_err_TYPE("znchardecompose", chi); }
1411 : else
1412 231 : chi = znconreylog(G, chi);
1413 791 : l = lg(chi); if (l == 1) return cgetg(1, t_VEC);
1414 784 : F = znstar_get_faN(G);
1415 784 : c = zerocol(l-1);
1416 784 : P = gel(F,1); /* prime divisors of N */
1417 784 : lP = lg(P);
1418 784 : E = gel(F,2); /* exponents */
1419 2471 : for (i = 1; i < lP; i++)
1420 : {
1421 1687 : GEN p = gel(P,i);
1422 1687 : if (i == 1 && equaliu(p,2) && E[1] >= 3)
1423 : {
1424 567 : if (!mpodd(Q))
1425 : {
1426 203 : gel(c,1) = icopy(gel(chi,1));
1427 203 : gel(c,2) = icopy(gel(chi,2));
1428 : }
1429 567 : i = 2; /* skip P[2] = P[1] = 2 */
1430 : }
1431 : else
1432 1120 : if (dvdii(Q, p)) gel(c,i) = icopy(gel(chi,i));
1433 : }
1434 784 : return c;
1435 : }
1436 :
1437 : GEN
1438 24325 : zncharconductor(GEN G, GEN chi)
1439 : {
1440 24325 : pari_sp av = avma;
1441 24325 : GEN F = znconreyconductor(G, chi, NULL);
1442 24325 : if (typ(F) == t_INT) return F;
1443 12873 : return gerepilecopy(av, gel(F,1));
1444 : }
1445 : GEN
1446 5558 : znchartoprimitive(GEN G, GEN chi)
1447 : {
1448 5558 : pari_sp av = avma;
1449 5558 : GEN chi0, F = znconreyconductor(G, chi, &chi0);
1450 5558 : if (typ(F) == t_INT)
1451 5299 : chi = mkvec2(G,chi);
1452 : else
1453 259 : chi = mkvec2(znstar0(F,1), chi0);
1454 5558 : return gerepilecopy(av, chi);
1455 : }
|
