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 3810682 : checkznstar_i(GEN G)
25 : {
26 3810465 : return (typ(G) == t_VEC && lg(G) == 6
27 3810087 : && typ(znstar_get_N(G)) == t_INT
28 3810080 : && typ(znstar_get_faN(G)) == t_VEC
29 7621147 : && typ(gel(G,1)) == t_VEC && lg(gel(G,1)) == 3);
30 : }
31 :
32 : int
33 112861 : char_check(GEN cyc, GEN chi)
34 112861 : { 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 234080 : cyc_normalize(GEN d)
39 : {
40 234080 : long i, l = lg(d);
41 : GEN C, D;
42 234080 : if (l == 1) return mkvec(gen_1);
43 234059 : D = cgetg(l, t_VEC); gel(D,1) = C = gel(d,1);
44 578403 : for (i = 2; i < l; i++) gel(D,i) = diviiexact(C, gel(d,i));
45 234059 : 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 275051 : char_simplify(GEN D, GEN C)
52 : {
53 275051 : GEN d = D;
54 275051 : if (lg(C) == 1) d = gen_1;
55 : else
56 : {
57 274526 : GEN t = gcdii(d, ZV_content(C));
58 274526 : if (!equali1(t))
59 : {
60 200221 : long tc = typ(C);
61 200221 : C = ZC_Z_divexact(C, t); settyp(C, tc);
62 200221 : d = diviiexact(d, t);
63 : }
64 : }
65 275051 : 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 274197 : char_normalize(GEN chi, GEN ncyc)
73 : {
74 274197 : long i, l = lg(chi);
75 274197 : GEN c = cgetg(l, t_VEC);
76 274197 : if (l > 1) {
77 274176 : gel(c,1) = gel(chi,1);
78 719852 : for (i = 2; i < l; i++) gel(c,i) = mulii(gel(chi,i), gel(ncyc,i));
79 : }
80 274197 : 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 2345 : charconj(GEN cyc, GEN chi)
109 : {
110 : long i, l;
111 2345 : GEN z = cgetg_copy(chi, &l);
112 5306 : for (i = 1; i < l; i++)
113 : {
114 2961 : GEN c = gel(chi,i);
115 2961 : gel(z,i) = signe(c)? subii(gel(cyc,i), c): gen_0;
116 : }
117 2345 : 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 1370397 : charorder(GEN cyc, GEN x)
128 : {
129 1370397 : pari_sp av = avma;
130 1370397 : long i, l = lg(cyc);
131 1370397 : GEN f = gen_1;
132 3593702 : for (i = 1; i < l; i++)
133 2223305 : if (signe(gel(x,i)))
134 : {
135 1266951 : GEN c, o = gel(cyc,i);
136 1266951 : if (!signe(o))
137 0 : return gerepileupto(av,mkoo());
138 1266951 : c = gcdii(o, gel(x,i));
139 1266951 : if (!is_pm1(c)) o = diviiexact(o,c);
140 1266951 : f = lcmii(f, o);
141 : }
142 1370397 : 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 97552 : charker(GEN cyc, GEN chi)
155 : {
156 97552 : long i, l = lg(cyc);
157 : GEN nchi, ncyc, m, U;
158 :
159 97552 : if (l == 1) return cgetg(1,t_MAT); /* trivial subgroup */
160 97503 : ncyc = cyc_normalize(cyc);
161 97503 : nchi = char_normalize(chi, ncyc);
162 97503 : m = shallowconcat(gel(nchi,2), gel(nchi,1));
163 97503 : U = gel(ZV_extgcd(m), 2); setlg(U,l);
164 266868 : for (i = 1; i < l; i++) setlg(U[i], l);
165 97503 : 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 5348 : chardiv(GEN cyc, GEN a, GEN b)
192 : {
193 : long i, l;
194 5348 : GEN v = cgetg_copy(a, &l);
195 11676 : for (i = 1; i < l; i++) gel(v,i) = Fp_sub(gel(a,i), gel(b,i), gel(cyc,i));
196 5348 : 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 2511467 : chareval_i(GEN nchi, GEN dlog, GEN z)
239 : {
240 2511467 : GEN o, q, r, b = gel(nchi,1);
241 2511467 : GEN a = FpV_dotproduct(gel(nchi,2), dlog, b);
242 : /* image is a/b in Q/Z */
243 2511467 : if (!z) return gdiv(a,b);
244 2511089 : if (typ(z) == t_INT)
245 : {
246 2507911 : q = dvmdii(z, b, &r);
247 2507911 : if (signe(r)) pari_err_TYPE("chareval", z);
248 2507911 : return mulii(a, q);
249 : }
250 : /* return z^(a*o/b), assuming z^o = 1 and b | o */
251 3178 : if (typ(z) != t_VEC || lg(z) != 3) pari_err_TYPE("chareval", z);
252 3178 : o = gel(z,2); if (typ(o) != t_INT) pari_err_TYPE("chareval", z);
253 3178 : q = dvmdii(o, b, &r); if (signe(r)) pari_err_TYPE("chareval", z);
254 3178 : q = mulii(a, q); /* in [0, o[ since a is reduced mod b */
255 3178 : z = gel(z,1);
256 3178 : if (typ(z) == t_VEC)
257 : {
258 1862 : if (itos_or_0(o) != lg(z)-1) pari_err_TYPE("chareval", z);
259 1862 : 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 33691 : ncharvecexpo(GEN G, GEN nchi)
327 : {
328 33691 : 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 33691 : GEN D = gel(nchi,2), v = const_vecsmall(N,-1);
331 33691 : pari_sp av = avma;
332 33691 : if (typ(D) == t_COL) {
333 33691 : cyc = znstar_get_conreycyc(G);
334 33691 : gen = znstar_get_conreygen(G);
335 : } else {
336 0 : cyc = znstar_get_cyc(G);
337 0 : gen = znstar_get_gen(G);
338 : }
339 33691 : l = lg(cyc);
340 33691 : e = u = cgetg(N+1,t_VECSMALL);
341 33691 : d = t = cgetg(N+1,t_VECSMALL);
342 33691 : *++d = 1;
343 33691 : *++e = 0; v[*d] = *e;
344 71792 : for (i = 1; i < l; i++)
345 : {
346 38101 : ulong g = itou(gel(gen,i)), c = itou(gel(cyc,i)), x = itou(gel(D,i));
347 536284 : for (t1=t,u1=u,j=c-1; j; j--,t1=t2,u1=u2)
348 1103319 : for (t2=d,u2=e, t3=t1,u3=u1; t3<t2; )
349 : {
350 605136 : *++d = Fl_mul(*++t3, g, N);
351 605136 : *++e = Fl_add(*++u3, x, ord); v[*d] = *e;
352 : }
353 : }
354 33691 : set_avma(av); return v;
355 : }
356 :
357 : /*****************************************************************************/
358 :
359 : static ulong
360 256991 : lcmuu(ulong a, ulong b) { return (a/ugcd(a,b)) * b; }
361 : static ulong
362 101206 : zv_charorder(GEN cyc, GEN x)
363 : {
364 101206 : long i, l = lg(cyc);
365 101206 : ulong f = 1;
366 332031 : for (i = 1; i < l; i++)
367 230825 : if (x[i])
368 : {
369 155785 : ulong o = cyc[i];
370 155785 : f = lcmuu(f, o / ugcd(o, x[i]));
371 : }
372 101206 : return f;
373 : }
374 :
375 : /* N > 0 */
376 : GEN
377 536011 : coprimes_zv(ulong N)
378 : {
379 536011 : GEN v = const_vecsmall(N,1);
380 536011 : pari_sp av = avma;
381 536011 : GEN P = gel(factoru(N),1);
382 536011 : long i, l = lg(P);
383 1260504 : for (i = 1; i < l; i++)
384 : {
385 724493 : ulong p = P[i], j;
386 3395525 : for (j = p; j <= N; j += p) v[j] = 0;
387 : }
388 536011 : 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 100758 : zv_cyc_minimal(GEN cyc, GEN g, GEN coprime)
427 : {
428 100758 : pari_sp av = avma;
429 100758 : long i, maxi, d, k, e, l = lg(g), o = lg(coprime)-1; /* elt order */
430 : GEN gd, gk;
431 100758 : if (o == 1) return 1;
432 106365 : for (k = 1; k < l; k++)
433 106365 : if (g[k]) break;
434 100758 : 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 5712 : coprime_tables(long N)
458 : {
459 5712 : GEN D = divisorsu(N), v = const_vec(N, NULL);
460 5712 : long i, l = lg(D);
461 38920 : for (i = 1; i < l; i++) gel(v, D[i]) = coprimes_zv(D[i]);
462 5712 : return v;
463 : }
464 : /* enumerate all group elements, modulo (Z/cyc[1])^* */
465 : static GEN
466 5740 : cyc2elts_normal(GEN cyc, long maxord, GEN ORD)
467 : {
468 5740 : long i, n, o, N, j = 1;
469 : GEN z, vcoprime;
470 :
471 5740 : if (typ(cyc) != t_VECSMALL) cyc = vec_to_vecsmall(cyc);
472 5740 : n = lg(cyc)-1;
473 5740 : N = zv_prod(cyc);
474 5740 : z = cgetg(N+1, t_VEC);
475 5740 : if (1 <= maxord && (!ORD|| zv_search(ORD,1)))
476 5355 : gel(z,j++) = zero_zv(n);
477 5740 : if (n == 0) { setlg(z, j); return z; }
478 5712 : vcoprime = coprime_tables(cyc[1]);
479 18550 : for (i = n; i > 0; i--)
480 : {
481 12838 : GEN cyc0 = vecslice(cyc,i+1,n), pre = zero_zv(i);
482 12838 : GEN D = divisorsu(cyc[i]), C = cyc2elts(cyc0);
483 12838 : long s, t, lD = lg(D), nC = lg(C)-1; /* remove last element */
484 48461 : for (s = 1; s < lD-1; s++)
485 : {
486 35623 : long o0 = D[lD-s]; /* cyc[i] / D[s] */
487 35623 : if (o0 > maxord) continue;
488 34132 : pre[i] = D[s];
489 34132 : if (!ORD || zv_search(ORD,o0))
490 : {
491 33831 : GEN c = vecsmall_concat(pre, zero_zv(n-i));
492 33831 : gel(z,j++) = c;
493 : }
494 135338 : for (t = 1; t < nC; t++)
495 : {
496 101206 : GEN chi0 = gel(C,t);
497 101206 : o = lcmuu(o0, zv_charorder(cyc0,chi0));
498 101206 : if (o <= maxord && (!ORD || zv_search(ORD,o)))
499 : {
500 100758 : GEN c = vecsmall_concat(pre, chi0);
501 100758 : if (zv_cyc_minimal(cyc, c, gel(vcoprime,o))) gel(z,j++) = c;
502 : }
503 : }
504 : }
505 : }
506 5712 : setlg(z,j); return z;
507 : }
508 :
509 : GEN
510 6195 : chargalois(GEN G, GEN ORD)
511 : {
512 6195 : pari_sp av = avma;
513 : long maxord, i, l;
514 6195 : GEN v, cyc = (typ(G) == t_VEC && RgV_is_ZVpos(G))? G: member_cyc(G);
515 6195 : if (lg(cyc) == 1 && !ORD) retmkvec(cgetg(1,t_VEC));
516 5747 : maxord = itou(cyc_get_expo(cyc));
517 5747 : 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 5740 : v = cyc2elts_normal(cyc, maxord, ORD); l = lg(v);
540 135688 : for(i = 1; i < l; i++) gel(v,i) = zv_to_ZV(gel(v,i));
541 5740 : return gerepileupto(av, v);
542 : }
543 :
544 : /*********************************************************************/
545 : /** **/
546 : /** (Z/NZ)^* AND DIRICHLET CHARACTERS **/
547 : /** **/
548 : /*********************************************************************/
549 :
550 : GEN
551 126376 : znstar0(GEN N, long flag)
552 : {
553 126376 : GEN F = NULL, P, E, cyc, gen, mod, G;
554 : long i, i0, l, nbprimes;
555 126376 : pari_sp av = avma;
556 :
557 126376 : if (flag && flag != 1) pari_err_FLAG("znstar");
558 126376 : if ((F = check_arith_all(N,"znstar")))
559 : {
560 9975 : F = clean_Z_factor(F);
561 9975 : N = typ(N) == t_VEC? gel(N,1): factorback(F);
562 : }
563 126376 : 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 126355 : N = absi_shallow(N);
570 126355 : if (abscmpiu(N,2) <= 0)
571 : {
572 8400 : G = mkvec3(gen_1, cgetg(1,t_VEC), cgetg(1,t_VEC));
573 8400 : if (flag)
574 : {
575 8365 : GEN v = const_vec(6,cgetg(1,t_VEC));
576 8365 : gel(v,3) = cgetg(1,t_MAT);
577 16695 : F = equali1(N)? mkvec2(cgetg(1,t_COL),cgetg(1,t_VECSMALL))
578 8365 : : mkvec2(mkcol(gen_2), mkvecsmall(1));
579 8365 : G = mkvec5(mkvec2(N,mkvec(gen_0)), G, F, v, cgetg(1,t_MAT));
580 : }
581 8400 : return gerepilecopy(av,G);
582 : }
583 117955 : if (!F) F = Z_factor(N);
584 117955 : P = gel(F,1); nbprimes = lg(P)-1;
585 117955 : E = ZV_to_nv( gel(F,2) );
586 117955 : switch(mod8(N))
587 : {
588 20312 : case 0:
589 20312 : P = shallowconcat(gen_2,P);
590 20312 : E = vecsmall_prepend(E, E[1]); /* add a copy of p=2 row */
591 20312 : i = 2; /* 2 generators at 2 */
592 20312 : break;
593 18843 : case 4:
594 18843 : i = 1; /* 1 generator at 2 */
595 18843 : 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 71786 : default:
602 71786 : i = 0; /* no generator at 2 */
603 71786 : break;
604 : }
605 117955 : l = lg(P);
606 117955 : cyc = cgetg(l,t_VEC);
607 117955 : gen = cgetg(l,t_VEC);
608 117955 : mod = cgetg(l,t_VEC);
609 : /* treat p=2 first */
610 117955 : if (i == 2)
611 : {
612 20312 : long v2 = E[1];
613 20312 : GEN q = int2n(v2);
614 20312 : gel(cyc,1) = gen_2;
615 20312 : gel(gen,1) = subiu(q,1); /* -1 */
616 20312 : gel(mod,1) = q;
617 20312 : gel(cyc,2) = int2n(v2-2);
618 20312 : gel(gen,2) = utoipos(5); /* Conrey normalization */
619 20312 : gel(mod,2) = q;
620 20312 : i0 = 3;
621 : }
622 97643 : else if (i == 1)
623 : {
624 18843 : gel(cyc,1) = gen_2;
625 18843 : gel(gen,1) = utoipos(3);
626 18843 : gel(mod,1) = utoipos(4);
627 18843 : i0 = 2;
628 : }
629 : else
630 78800 : i0 = 1;
631 : /* odd primes, fill remaining entries */
632 286494 : for (i = i0; i < l; i++)
633 : {
634 168539 : long e = E[i];
635 168539 : GEN p = gel(P,i), q = powiu(p, e-1), Q = mulii(p, q);
636 168539 : gel(cyc,i) = subii(Q, q); /* phi(p^e) */
637 168539 : gel(gen,i) = pgener_Zp(p);/* Conrey normalization, for e = 1 also */
638 168539 : gel(mod,i) = Q;
639 : }
640 : /* gen[i] has order cyc[i] and generates (Z/mod[i]Z)^* */
641 117955 : if (nbprimes > 1) /* lift generators to (Z/NZ)^*, = 1 mod N/mod[i] */
642 243837 : for (i=1; i<l; i++)
643 : {
644 175565 : GEN Q = gel(mod,i), g = gel(gen,i), qinv = Fp_inv(Q, diviiexact(N,Q));
645 175565 : g = addii(g, mulii(mulii(subsi(1,g),qinv),Q));
646 175565 : 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 117955 : if (!flag)
651 : { /* update generators in place; about twice faster */
652 35781 : G = gen;
653 35998 : 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 35781 : G = mkvec3(ZV_prod(cyc), cyc, FpV_to_mod(G,N));
688 : }
689 : else
690 : { /* keep matrices between generators, return an 'init' structure */
691 82174 : GEN D, U, Ui, fao = cgetg(l, t_VEC), lo = cgetg(l, t_VEC);
692 82174 : F = mkvec2(P, E);
693 82174 : D = ZV_snf_group(cyc,&U,&Ui);
694 274182 : for (i = 1; i < l; i++)
695 : {
696 192008 : GEN t = gen_0, p = gel(P,i), p_1 = subiu(p,1);
697 192008 : long e = E[i];
698 192008 : gel(fao,i) = get_arith_ZZM(p_1);
699 192008 : if (e >= 2 && !absequaliu(p,2))
700 : {
701 12895 : GEN q = gel(mod,i), g = Fp_pow(gel(gen,i),p_1,q);
702 12895 : if (e == 2)
703 10522 : t = Fp_inv(diviiexact(subiu(g,1), p), p);
704 : else
705 2373 : t = ginv(Qp_log(cvtop(g,p,e)));
706 : }
707 192008 : gel(lo,i) = t;
708 : }
709 82174 : G = cgetg(l, t_VEC);
710 274182 : for (i = 1; i < l; i++) gel(G,i) = FpV_factorback(gen, gel(Ui,i), N);
711 82174 : G = mkvec3(ZV_prod(D), D, G);
712 82174 : G = mkvec5(mkvec2(N,mkvec(gen_0)), G, F,
713 : mkvecn(6,mod,fao,Ui,gen,cyc,lo), U);
714 : }
715 117955 : return gerepilecopy(av, G);
716 : }
717 : GEN
718 35739 : 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 949408 : Zideallog_2k(GEN h, GEN g, long e, GEN pe)
723 : {
724 949408 : GEN a = Fp_log(h, g, int2n(e-2), pe);
725 949408 : if (typ(a) != t_INT) return NULL;
726 949408 : 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 1994352 : Zideallog_pk(GEN h, GEN g, GEN p, long e, GEN pe, GEN ord, GEN lo)
733 : {
734 1994352 : GEN gp = (e == 1)? g: modii(g, p);
735 1994352 : GEN hp = (e == 1)? h: modii(h, p);
736 1994352 : GEN a = Fp_log(hp, gp, ord, p);
737 1994352 : if (typ(a) != t_INT) return NULL;
738 1994345 : 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 53320 : GEN b, p_1 = gel(ord,1);
742 53320 : 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 53320 : if (e == 2) /* simpler */
745 46019 : b = Fp_mul(diviiexact(subiu(h,1), p), lo, p);
746 : else
747 7301 : b = padic_to_Q(gmul(Qp_log(cvtop(h, p, e)), lo));
748 53320 : a = addii(a, mulii(p_1, b));
749 : }
750 1994345 : return a;
751 : }
752 :
753 : int
754 888769 : znconrey_check(GEN cyc, GEN chi)
755 888769 : { return typ(chi) == t_COL && lg(chi) == lg(cyc) && RgV_is_ZV(chi); }
756 :
757 : int
758 193277 : zncharcheck(GEN G, GEN chi)
759 : {
760 193277 : switch(typ(chi))
761 : {
762 875 : case t_INT: return 1;
763 190638 : case t_COL: return znconrey_check(znstar_get_conreycyc(G), chi);
764 1764 : case t_VEC: return char_check(znstar_get_cyc(G), chi);
765 : }
766 0 : return 0;
767 : }
768 :
769 : GEN
770 133035 : znconreyfromchar_normalized(GEN bid, GEN chi)
771 : {
772 133035 : GEN nchi, U = znstar_get_U(bid);
773 133035 : long l = lg(chi);
774 133035 : if (l == 1) retmkvec2(gen_1,cgetg(1,t_VEC));
775 132580 : if (!RgV_is_ZV(chi) || lgcols(U) != l) pari_err_TYPE("lfunchiZ", chi);
776 132573 : nchi = char_normalize(chi, cyc_normalize(znstar_get_cyc(bid)));
777 132573 : gel(nchi,2) = ZV_ZM_mul(gel(nchi,2),U); return nchi;
778 : }
779 :
780 : GEN
781 131117 : znconreyfromchar(GEN bid, GEN chi)
782 : {
783 131117 : GEN nchi = znconreyfromchar_normalized(bid, chi);
784 131110 : GEN v = char_denormalize(znstar_get_conreycyc(bid), gel(nchi,1), gel(nchi,2));
785 131110 : 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 2577058 : znconreylog(GEN bid, GEN x)
792 : {
793 2577058 : pari_sp av = avma;
794 : GEN N, L, F, P,E, y, pe, fao, gen, lo, cycg;
795 : long i, l;
796 2577058 : if (!checkznstar_i(bid)) pari_err_TYPE("znconreylog", bid);
797 2577051 : N = znstar_get_N(bid);
798 2577051 : if (abscmpiu(N, 2) <= 0)
799 : {
800 2436 : switch(typ(x))
801 : {
802 686 : 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 1736 : case t_COL:
807 : case t_VEC:
808 1736 : if (lg(x) != 1) pari_err_TYPE("znconreylog", x);
809 1722 : break;
810 7 : default: pari_err_TYPE("znconreylog", x);
811 : }
812 2408 : return cgetg(1, t_COL);
813 : }
814 2574615 : cycg = znstar_get_conreycyc(bid);
815 2574615 : 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 2552299 : case t_INT:
822 2552299 : if (!signe(x)) pari_err_COPRIME("znconreylog", x, N);
823 2552292 : 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 22281 : case t_VEC:
829 22281 : return gerepilecopy(av, znconreyfromchar(bid, x));
830 0 : default: pari_err_TYPE("znconreylog", x);
831 : }
832 2552292 : F = znstar_get_faN(bid); /* factor(N) */
833 2552292 : P = gel(F, 1); /* prime divisors of N */
834 2552292 : E = gel(F, 2); /* exponents */
835 2552292 : L = gel(bid,4);
836 2552292 : pe = znstar_get_pe(bid);
837 2552292 : fao = gel(L,2);
838 2552292 : gen = znstar_get_conreygen(bid); /* local generators of (Z/p^k)^* */
839 2552292 : lo = gel(L,6); /* 1/log_p((g_i)^(p_i-1)) */
840 :
841 2552292 : l = lg(gen); i = 1;
842 2552292 : y = cgetg(l, t_COL);
843 2552292 : if (!mod2(N) && !mod2(x)) pari_err_COPRIME("znconreylog", x, N);
844 2552278 : if (absequaliu(gel(P,1), 2) && E[1] >= 2)
845 : {
846 1258261 : if (E[1] == 2)
847 308853 : gel(y,i++) = mod4(x) == 1? gen_0: gen_1;
848 : else
849 : {
850 949408 : GEN a, x2, q2 = gel(pe,1);
851 949408 : x2 = modii(x, q2);
852 949408 : if (mod4(x) == 1) /* 1 or 5 mod 8*/
853 592278 : gel(y,i++) = gen_0;
854 : else /* 3 or 7 */
855 357130 : { gel(y,i++) = gen_1; x2 = subii(q2, x2); }
856 : /* x2 = 5^x mod q */
857 949408 : a = Zideallog_2k(x2, gel(gen,i), E[1], q2);
858 949408 : if (!a) pari_err_COPRIME("znconreylog", x, N);
859 949408 : gel(y, i++) = a;
860 : }
861 : }
862 4546623 : while (i < l)
863 : {
864 1994352 : GEN p = gel(P,i), q = gel(pe,i), xpe = modii(x, q);
865 1994352 : GEN a = Zideallog_pk(xpe, gel(gen,i), p, E[i], q, gel(fao,i), gel(lo,i));
866 1994352 : if (!a) pari_err_COPRIME("znconreylog", x, N);
867 1994345 : gel(y, i++) = a;
868 : }
869 2552271 : 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 260764 : znconreyexp(GEN bid, GEN x)
895 : {
896 260764 : pari_sp av = avma;
897 : long i, l;
898 : GEN N, pe, gen, cycg, v, vmod;
899 : int e2;
900 260764 : if (!checkznstar_i(bid)) pari_err_TYPE("znconreyexp", bid);
901 260764 : cycg = znstar_get_conreycyc(bid);
902 260764 : switch(typ(x))
903 : {
904 21 : case t_VEC:
905 21 : x = znconreylog(bid, x);
906 21 : break;
907 260743 : case t_COL:
908 260743 : if (RgV_is_ZV(x) && lg(x) == lg(cycg)) break;
909 7 : default: pari_err_TYPE("znconreyexp",x);
910 : }
911 260757 : pe = znstar_get_pe(bid);
912 260757 : gen = znstar_get_conreygen(bid); /* local generators of (Z/p^k)^* */
913 260757 : cycg = znstar_get_conreycyc(bid);
914 260757 : l = lg(x); v = cgetg(l, t_VEC);
915 260757 : N = znstar_get_N(bid);
916 260757 : e2 = !mod8(N); /* 2 generators at p = 2 */
917 805658 : for (i = 1; i < l; i++)
918 : {
919 : GEN q, g, m;
920 544901 : if (i == 1 && e2) { gel(v,1) = NULL; continue; }
921 512617 : q = gel(pe,i);
922 512617 : g = gel(gen,i);
923 512617 : m = modii(gel(x,i), gel(cycg,i));
924 512617 : m = Fp_pow(g, m, q);
925 512617 : if (i == 2 && e2 && signe(gel(x,1))) m = Fp_neg(m, q);
926 512617 : gel(v,i) = mkintmod(m, q);
927 : }
928 260757 : if (e2) v = vecsplice(v, 1);
929 260757 : v = chinese1_coprime_Z(v);
930 260757 : vmod = gel(v,1);
931 260757 : v = gel(v,2);
932 260757 : 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 719852 : znconreyconductor(GEN bid, GEN chi, GEN *pm)
972 : {
973 719852 : pari_sp av = avma;
974 : GEN q, m, F, P, E;
975 : long i, j, l;
976 719852 : int e2, primitive = 1;
977 :
978 719852 : if (!checkznstar_i(bid)) pari_err_TYPE("znconreyconductor", bid);
979 719852 : if (typ(chi) == t_COL)
980 : {
981 698131 : if (!znconrey_check(znstar_get_conreycyc(bid), chi))
982 0 : pari_err_TYPE("znconreyconductor",chi);
983 : }
984 : else
985 21721 : chi = znconreylog(bid, chi);
986 719845 : l = lg(chi);
987 719845 : F = znstar_get_faN(bid);
988 719845 : P = gel(F,1);
989 719845 : E = gel(F,2);
990 719845 : if (l == 1)
991 : {
992 98756 : set_avma(av);
993 98756 : if (pm) *pm = cgetg(1,t_COL);
994 98756 : if (lg(P) == 1) return gen_1;
995 14 : retmkvec2(gen_1, trivial_fact());
996 : }
997 621089 : P = leafcopy(P);
998 621089 : E = leafcopy(E);
999 621089 : m = cgetg(l, t_COL);
1000 621089 : e2 = (E[1] >= 3 && absequaliu(gel(P,1),2));
1001 621089 : i = j = 1;
1002 621089 : if (e2)
1003 : { /* two generators at p=2 */
1004 285943 : GEN a1 = gel(chi,1), a = gel(chi,2);
1005 285943 : i = 3;
1006 285943 : if (!signe(a))
1007 : {
1008 97972 : e2 = primitive = 0;
1009 97972 : if (signe(a1))
1010 : { /* lose one generator */
1011 45493 : E[1] = 2;
1012 45493 : gel(m,1) = a1;
1013 45493 : j = 2;
1014 : }
1015 : /* else lose both */
1016 : }
1017 : else
1018 : {
1019 187971 : long v = Z_pvalrem(a, gen_2, &a);
1020 187971 : if (v) { E[1] -= v; E[2] = E[1]; primitive = 0; }
1021 187971 : gel(m,1) = a1;
1022 187971 : gel(m,2) = a;
1023 187971 : j = 3;
1024 : }
1025 : }
1026 621089 : l = lg(P);
1027 1809458 : for (; i < l; i++)
1028 : {
1029 1188369 : 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 1188369 : if (!signe(a)) primitive = 0;
1032 : else
1033 : {
1034 928032 : long v = Z_pvalrem(a, p, &a);
1035 928032 : E[j] = E[i]; if (v) { E[j] -= v; primitive = 0; }
1036 928032 : gel(P,j) = gel(P,i);
1037 928032 : gel(m,j) = a; j++;
1038 : }
1039 : }
1040 621089 : setlg(m,j);
1041 621089 : setlg(P,j);
1042 621089 : setlg(E,j);
1043 621089 : if (pm) *pm = m; /* attached primitive character */
1044 621089 : if (primitive)
1045 : {
1046 285334 : q = znstar_get_N(bid);
1047 285334 : if (mod4(q) == 2) primitive = 0;
1048 : }
1049 621089 : if (!primitive)
1050 : {
1051 336532 : if (e2)
1052 : { /* remove duplicate p=2 row from factorization */
1053 114744 : P = vecsplice(P,1);
1054 114744 : E = vecsplice(E,1);
1055 : }
1056 336532 : E = zc_to_ZC(E);
1057 336532 : q = mkvec2(factorback2(P,E), mkmat2(P,E));
1058 : }
1059 621089 : return gc_all(av, pm? 2: 1, &q, pm);
1060 : }
1061 :
1062 : GEN
1063 8386 : zncharinduce(GEN G, GEN chi, GEN N)
1064 : {
1065 8386 : pari_sp av = avma;
1066 : GEN q, faq, P, E, Pq, Eq, CHI;
1067 : long i, j, l;
1068 : int e2;
1069 :
1070 8386 : if (!checkznstar_i(G)) pari_err_TYPE("zncharinduce", G);
1071 8386 : if (!zncharcheck(G, chi)) pari_err_TYPE("zncharinduce", chi);
1072 8386 : q = znstar_get_N(G);
1073 8386 : if (typ(chi) != t_COL) chi = znconreylog(G, chi);
1074 8386 : if (checkznstar_i(N))
1075 : {
1076 8197 : GEN faN = znstar_get_faN(N);
1077 8197 : P = gel(faN,1); l = lg(P);
1078 8197 : E = gel(faN,2);
1079 8197 : N = znstar_get_N(N);
1080 8197 : 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 8386 : if (!dvdii(N,q)) pari_err_DOMAIN("zncharinduce", "N % q", "!=", gen_0, N);
1097 8379 : 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 8379 : l = lg(P);
1107 : /* q = N or q = 2N, N odd */
1108 8379 : if (cmpii(N,q) <= 0) return gerepilecopy(av, chi);
1109 : /* N > 1 => l > 1*/
1110 8253 : if (typ(E) != t_VECSMALL) E = ZV_to_zv(E);
1111 8253 : e2 = (E[1] >= 3 && absequaliu(gel(P,1),2)); /* 2 generators at 2 mod N */
1112 8253 : if (ZV_equal0(chi))
1113 : {
1114 5355 : set_avma(av);
1115 5355 : 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 2589762 : znconreylog_normalize(GEN G, GEN m)
1157 : {
1158 2589762 : GEN cycg = znstar_get_conreycyc(G);
1159 : long i, l;
1160 2589762 : GEN d, M = cgetg_copy(m, &l);
1161 2589762 : if (typ(cycg) != t_VEC || lg(cycg) != l)
1162 0 : pari_err_TYPE("znconreylog_normalize",mkvec2(m,cycg));
1163 6872922 : 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 2589762 : M = Q_remove_denom(M, &d);
1166 2589762 : 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 2577260 : znconrey_normalized(GEN G, GEN chi)
1173 : {
1174 2577260 : switch(typ(chi))
1175 : {
1176 420 : case t_INT: /* Conrey label */
1177 420 : return znconreylog_normalize(G, znconreylog(G, chi));
1178 2574922 : case t_COL: /* Conrey log */
1179 2574922 : if (!RgV_is_ZV(chi)) break;
1180 2574922 : return znconreylog_normalize(G, chi);
1181 1918 : case t_VEC: /* char on G.gen */
1182 1918 : if (!RgV_is_ZV(chi)) break;
1183 1918 : 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 183659 : zncharisodd(GEN G, GEN chi)
1192 : {
1193 : long i, l, s;
1194 : GEN N;
1195 183659 : if (!checkznstar_i(G)) pari_err_TYPE("zncharisodd", G);
1196 183659 : if (!zncharcheck(G, chi)) pari_err_TYPE("zncharisodd", chi);
1197 183659 : if (typ(chi) != t_COL) chi = znconreylog(G, chi);
1198 183659 : N = znstar_get_N(G);
1199 183659 : l = lg(chi);
1200 183659 : s = 0;
1201 183659 : if (!mod8(N))
1202 : {
1203 91133 : s = mpodd(gel(chi,1));
1204 91133 : i = 3;
1205 : }
1206 : else
1207 92526 : i = 1;
1208 512316 : for (; i < l; i++) s += mpodd(gel(chi,i));
1209 183659 : 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 3290 : znchar(GEN D)
1263 : {
1264 3290 : pari_sp av = avma;
1265 : GEN G, chi;
1266 3290 : 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 707 : case t_INTMOD:
1274 707 : G = znstar0(gel(D,1), 1);
1275 707 : chi = mkvec2(G, znconreylog(G, gel(D,2)));
1276 707 : 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 3234 : return gerepilecopy(av, chi);
1298 : }
1299 :
1300 : /* G a znstar, not stack clean */
1301 : GEN
1302 2513273 : znchareval(GEN G, GEN chi, GEN n, GEN z)
1303 : {
1304 2513273 : GEN nchi, N = znstar_get_N(G);
1305 : /* avoid division by 0 */
1306 2513273 : if (typ(n) == t_FRAC && !equali1(gcdii(gel(n,2), N))) return not_coprime(z);
1307 2513266 : n = Rg_to_Fp(n, N);
1308 2513266 : if (!equali1(gcdii(n, N))) return not_coprime(z);
1309 : /* nchi: normalized character on Conrey generators */
1310 2511432 : nchi = znconrey_normalized(G, chi);
1311 2511432 : return chareval_i(nchi, znconreylog(G,n), z);
1312 : }
1313 :
1314 : /* G is a znstar, chi a Dirichlet character */
1315 : GEN
1316 1526 : zncharconj(GEN G, GEN chi)
1317 : {
1318 1526 : 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 861 : 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 377363 : zncharorder(GEN G, GEN chi)
1331 : {
1332 377363 : switch(typ(chi))
1333 : {
1334 21 : case t_INT: chi = znconreylog(G, chi); /*fall through*/
1335 376187 : case t_COL: return charorder(znstar_get_conreycyc(G), chi);
1336 1176 : 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 5355 : znchardiv(GEN G, GEN a, GEN b)
1384 : {
1385 5355 : long ta = typ(a), tb = typ(b);
1386 5355 : 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 5320 : 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 19873 : zncharconductor(GEN G, GEN chi)
1439 : {
1440 19873 : pari_sp av = avma;
1441 19873 : GEN F = znconreyconductor(G, chi, NULL);
1442 19873 : if (typ(F) == t_INT) return F;
1443 12705 : return gerepilecopy(av, gel(F,1));
1444 : }
1445 : GEN
1446 1274 : znchartoprimitive(GEN G, GEN chi)
1447 : {
1448 1274 : pari_sp av = avma;
1449 1274 : GEN chi0, F = znconreyconductor(G, chi, &chi0);
1450 1274 : if (typ(F) == t_INT)
1451 1015 : chi = mkvec2(G,chi);
1452 : else
1453 259 : chi = mkvec2(znstar0(F,1), chi0);
1454 1274 : return gerepilecopy(av, chi);
1455 : }
|
