Testing latest pari + WASM + node.js... and it works?! Wow.
License: GPL3
ubuntu2004
/* Copyright (C) 2000 The PARI group.12This file is part of the PARI/GP package.34PARI/GP is free software; you can redistribute it and/or modify it under the5terms of the GNU General Public License as published by the Free Software6Foundation; either version 2 of the License, or (at your option) any later7version. It is distributed in the hope that it will be useful, but WITHOUT8ANY WARRANTY WHATSOEVER.910Check the License for details. You should have received a copy of it, along11with the package; see the file 'COPYING'. If not, write to the Free Software12Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */13#include "pari.h"14#include "paripriv.h"1516/*********************************************************************/17/** **/18/** GENERIC ABELIAN CHARACTERS **/19/** **/20/*********************************************************************/21/* check whether G is a znstar */22int23checkznstar_i(GEN G)24{25return (typ(G) == t_VEC && lg(G) == 626&& typ(znstar_get_faN(G)) == t_VEC27&& typ(gel(G,1)) == t_VEC && lg(gel(G,1)) == 3);28}2930int31char_check(GEN cyc, GEN chi)32{ return typ(chi) == t_VEC && lg(chi) == lg(cyc) && RgV_is_ZV(chi); }3334/* Shallow; return [ d[1], d[1]/d[2],...,d[1]/d[n] ] */35GEN36cyc_normalize(GEN d)37{38long i, l = lg(d);39GEN C, D;40if (l == 1) return mkvec(gen_1);41D = cgetg(l, t_VEC); gel(D,1) = C = gel(d,1);42for (i = 2; i < l; i++) gel(D,i) = diviiexact(C, gel(d,i));43return D;44}4546/* chi character [D,C] given by chi(g_i) = \zeta_D^C[i] for all i, return47* [d,c] such that chi(g_i) = \zeta_d^c[i] for all i and d minimal */48GEN49char_simplify(GEN D, GEN C)50{51GEN d = D;52if (lg(C) == 1) d = gen_1;53else54{55GEN t = gcdii(d, ZV_content(C));56if (!equali1(t))57{58long tc = typ(C);59C = ZC_Z_divexact(C, t); settyp(C, tc);60d = diviiexact(d, t);61}62}63return mkvec2(d,C);64}6566/* Shallow; ncyc from cyc_normalize(): ncyc[1] = cyc[1],67* ncyc[i] = cyc[i]/cyc[1] for i > 1; chi character on G ~ cyc.68* Return [d,c] such that: chi( g_i ) = e(chi[i] / cyc[i]) = e(c[i]/ d) */69GEN70char_normalize(GEN chi, GEN ncyc)71{72long i, l = lg(chi);73GEN c = cgetg(l, t_VEC);74if (l > 1) {75gel(c,1) = gel(chi,1);76for (i = 2; i < l; i++) gel(c,i) = mulii(gel(chi,i), gel(ncyc,i));77}78return char_simplify(gel(ncyc,1), c);79}8081/* Called by function 's'. x is a group object affording ".cyc" method, and82* chi an abelian character. Return NULL if the group is (Z/nZ)^* [special83* case more character types allowed] and x.cyc otherwise */84static GEN85get_cyc(GEN x, GEN chi, const char *s)86{87if (nftyp(x) == typ_BIDZ)88{89if (!zncharcheck(x, chi)) pari_err_TYPE(s, chi);90return NULL;91}92else93{94if (typ(x) != t_VEC || !RgV_is_ZV(x)) x = member_cyc(x);95if (!char_check(x, chi)) pari_err_TYPE(s, chi);96return x;97}98}99100/* conjugate character [ZV/ZC] */101GEN102charconj(GEN cyc, GEN chi)103{104long i, l;105GEN z = cgetg_copy(chi, &l);106for (i = 1; i < l; i++)107{108GEN c = gel(chi,i);109gel(z,i) = signe(c)? subii(gel(cyc,i), c): gen_0;110}111return z;112}113GEN114charconj0(GEN x, GEN chi)115{116GEN cyc = get_cyc(x, chi, "charconj");117return cyc? charconj(cyc, chi): zncharconj(x, chi);118}119120GEN121charorder(GEN cyc, GEN x)122{123pari_sp av = avma;124long i, l = lg(cyc);125GEN f = gen_1;126for (i = 1; i < l; i++)127if (signe(gel(x,i)))128{129GEN c, o = gel(cyc,i);130c = gcdii(o, gel(x,i));131if (!is_pm1(c)) o = diviiexact(o,c);132f = lcmii(f, o);133}134return gerepileuptoint(av, f);135}136GEN137charorder0(GEN x, GEN chi)138{139GEN cyc = get_cyc(x, chi, "charorder");140return cyc? charorder(cyc, chi): zncharorder(x, chi);141}142143/* chi character of abelian G: chi[i] = chi(z_i), where G = \oplus Z/cyc[i] z_i.144* Return Ker chi */145GEN146charker(GEN cyc, GEN chi)147{148long i, l = lg(cyc);149GEN nchi, ncyc, m, U;150151if (l == 1) return cgetg(1,t_MAT); /* trivial subgroup */152ncyc = cyc_normalize(cyc);153nchi = char_normalize(chi, ncyc);154m = shallowconcat(gel(nchi,2), gel(nchi,1));155U = gel(ZV_extgcd(m), 2); setlg(U,l);156for (i = 1; i < l; i++) setlg(U[i], l);157return hnfmodid(U, gel(ncyc,1));158}159GEN160charker0(GEN x, GEN chi)161{162GEN cyc = get_cyc(x, chi, "charker");163return cyc? charker(cyc, chi): zncharker(x, chi);164}165166GEN167charpow(GEN cyc, GEN a, GEN N)168{169long i, l;170GEN v = cgetg_copy(a, &l);171for (i = 1; i < l; i++) gel(v,i) = Fp_mul(gel(a,i), N, gel(cyc,i));172return v;173}174GEN175charmul(GEN cyc, GEN a, GEN b)176{177long i, l;178GEN v = cgetg_copy(a, &l);179for (i = 1; i < l; i++) gel(v,i) = Fp_add(gel(a,i), gel(b,i), gel(cyc,i));180return v;181}182GEN183chardiv(GEN cyc, GEN a, GEN b)184{185long i, l;186GEN v = cgetg_copy(a, &l);187for (i = 1; i < l; i++) gel(v,i) = Fp_sub(gel(a,i), gel(b,i), gel(cyc,i));188return v;189}190GEN191charpow0(GEN x, GEN a, GEN N)192{193GEN cyc = get_cyc(x, a, "charpow");194return cyc? charpow(cyc, a, N): zncharpow(x, a, N);195}196GEN197charmul0(GEN x, GEN a, GEN b)198{199const char *s = "charmul";200GEN cyc = get_cyc(x, a, s);201if (!cyc)202{203if (!zncharcheck(x, b)) pari_err_TYPE(s, b);204return zncharmul(x, a, b);205}206else207{208if (!char_check(cyc, b)) pari_err_TYPE(s, b);209return charmul(cyc, a, b);210}211}212GEN213chardiv0(GEN x, GEN a, GEN b)214{215const char *s = "chardiv";216GEN cyc = get_cyc(x, a, s);217if (!cyc)218{219if (!zncharcheck(x, b)) pari_err_TYPE(s, b);220return znchardiv(x, a, b);221}222else223{224if (!char_check(cyc, b)) pari_err_TYPE(s, b);225return chardiv(cyc, a, b);226}227}228229static GEN230chareval_i(GEN nchi, GEN dlog, GEN z)231{232GEN o, q, r, b = gel(nchi,1);233GEN a = FpV_dotproduct(gel(nchi,2), dlog, b);234/* image is a/b in Q/Z */235if (!z) return gdiv(a,b);236if (typ(z) == t_INT)237{238q = dvmdii(z, b, &r);239if (signe(r)) pari_err_TYPE("chareval", z);240return mulii(a, q);241}242/* return z^(a*o/b), assuming z^o = 1 and b | o */243if (typ(z) != t_VEC || lg(z) != 3) pari_err_TYPE("chareval", z);244o = gel(z,2); if (typ(o) != t_INT) pari_err_TYPE("chareval", z);245q = dvmdii(o, b, &r); if (signe(r)) pari_err_TYPE("chareval", z);246q = mulii(a, q); /* in [0, o[ since a is reduced mod b */247z = gel(z,1);248if (typ(z) == t_VEC)249{250if (itos_or_0(o) != lg(z)-1) pari_err_TYPE("chareval", z);251return gcopy(gel(z, itos(q)+1));252}253else254return gpow(z, q, DEFAULTPREC);255}256257static GEN258not_coprime(GEN z)259{ return (!z || typ(z) == t_INT)? gen_m1: gen_0; }260261static GEN262get_chi(GEN cyc, GEN chi)263{264if (!char_check(cyc,chi)) pari_err_TYPE("chareval", chi);265return char_normalize(chi, cyc_normalize(cyc));266}267/* G a bnr. FIXME: horribly inefficient to check that (x,N)=1, what to do ? */268static int269bnr_coprime(GEN G, GEN x)270{271GEN t, N = gel(bnr_get_mod(G), 1);272if (typ(x) == t_INT) /* shortcut */273{274t = gcdii(gcoeff(N,1,1), x);275if (equali1(t)) return 1;276t = idealadd(G, N, x);277return equali1(gcoeff(t,1,1));278}279x = idealnumden(G, x);280t = idealadd(G, N, gel(x,1));281if (!equali1(gcoeff(t,1,1))) return 0;282t = idealadd(G, N, gel(x,2));283return equali1(gcoeff(t,1,1));284}285GEN286chareval(GEN G, GEN chi, GEN x, GEN z)287{288pari_sp av = avma;289GEN nchi, L;290291switch(nftyp(G))292{293case typ_BNR:294if (!bnr_coprime(G, x)) return not_coprime(z);295L = isprincipalray(G, x);296nchi = get_chi(bnr_get_cyc(G), chi);297break;298case typ_BNF:299L = isprincipal(G, x);300nchi = get_chi(bnf_get_cyc(G), chi);301break;302case typ_BIDZ:303if (checkznstar_i(G)) return gerepileupto(av, znchareval(G, chi, x, z));304/* don't implement chars on general bid: need an nf... */305default:306pari_err_TYPE("chareval", G);307return NULL;/* LCOV_EXCL_LINE */308}309return gerepileupto(av, chareval_i(nchi, L, z));310}311312/* nchi = [ord,D] a quasi-normalized character (ord may be a multiple of313* the character order); return v such that v[n] = -1 if (n,N) > 1 else314* chi(n) = e(v[n]/ord), 1 <= n <= N */315GEN316ncharvecexpo(GEN G, GEN nchi)317{318long N = itou(znstar_get_N(G)), ord = itou(gel(nchi,1)), i, j, l;319GEN cyc, gen, d, t, t1, t2, t3, e, u, u1, u2, u3;320GEN D = gel(nchi,2), v = const_vecsmall(N,-1);321pari_sp av = avma;322if (typ(D) == t_COL) {323cyc = znstar_get_conreycyc(G);324gen = znstar_get_conreygen(G);325} else {326cyc = znstar_get_cyc(G);327gen = znstar_get_gen(G);328}329l = lg(cyc);330e = u = cgetg(N+1,t_VECSMALL);331d = t = cgetg(N+1,t_VECSMALL);332*++d = 1;333*++e = 0; v[*d] = *e;334for (i = 1; i < l; i++)335{336ulong g = itou(gel(gen,i)), c = itou(gel(cyc,i)), x = itou(gel(D,i));337for (t1=t,u1=u,j=c-1; j; j--,t1=t2,u1=u2)338for (t2=d,u2=e, t3=t1,u3=u1; t3<t2; )339{340*++d = Fl_mul(*++t3, g, N);341*++e = Fl_add(*++u3, x, ord); v[*d] = *e;342}343}344set_avma(av); return v;345}346347/*****************************************************************************/348349static ulong350lcmuu(ulong a, ulong b) { return (a/ugcd(a,b)) * b; }351static ulong352zv_charorder(GEN cyc, GEN x)353{354long i, l = lg(cyc);355ulong f = 1;356for (i = 1; i < l; i++)357if (x[i])358{359ulong o = cyc[i];360f = lcmuu(f, o / ugcd(o, x[i]));361}362return f;363}364365/* N > 0 */366GEN367coprimes_zv(ulong N)368{369GEN v = const_vecsmall(N,1);370pari_sp av = avma;371GEN P = gel(factoru(N),1);372long i, l = lg(P);373for (i = 1; i < l; i++)374{375ulong p = P[i], j;376for (j = p; j <= N; j += p) v[j] = 0;377}378set_avma(av); return v;379}380/* cf zv_cyc_minimal: return k such that g*k is minimal (wrt lex) */381long382zv_cyc_minimize(GEN cyc, GEN g, GEN coprime)383{384pari_sp av = avma;385long d, k, e, i, maxi, k0, bestk, l = lg(g), o = lg(coprime)-1;386GEN best, gk, gd;387ulong t;388if (o == 1) return 1;389for (i = 1; i < l; i++)390if (g[i]) break;391if (g[i] == 1) return 1;392k0 = Fl_invgen(g[i], cyc[i], &t);393d = cyc[i] / (long)t;394if (k0 > 1) g = vecmoduu(Flv_Fl_mul(g, k0, cyc[i]), cyc);395for (i++; i < l; i++)396if (g[i]) break;397if (i == l) return k0;398cyc = vecslice(cyc,i,l-1);399g = vecslice(g, i,l-1);400e = cyc[1];401gd = Flv_Fl_mul(g, d, e);402bestk = 1; best = g; maxi = e/ugcd(d,e);403for (gk = g, k = d+1, i = 1; i < maxi; k += d, i++)404{405long ko = k % o;406gk = Flv_add(gk, gd, e); if (!ko || !coprime[ko]) continue;407gk = vecmoduu(gk, cyc);408if (vecsmall_lexcmp(gk, best) < 0) { best = gk; bestk = k; }409}410return gc_long(av, bestk == 1? k0: (long) Fl_mul(k0, bestk, o));411}412/* g of order o in abelian group G attached to cyc. Is g a minimal generator413* [wrt lex order] of the cyclic subgroup it generates;414* coprime = coprimes_zv(o) */415long416zv_cyc_minimal(GEN cyc, GEN g, GEN coprime)417{418pari_sp av = avma;419long i, maxi, d, k, e, l = lg(g), o = lg(coprime)-1; /* elt order */420GEN gd, gk;421if (o == 1) return 1;422for (k = 1; k < l; k++)423if (g[k]) break;424if (g[k] == 1) return 1;425if (cyc[k] % g[k]) return 0;426d = cyc[k] / g[k]; /* > 1 */427for (k++; k < l; k++) /* skip following 0s */428if (g[k]) break;429if (k == l) return 1;430cyc = vecslice(cyc,k,l-1);431g = vecslice(g, k,l-1);432e = cyc[1];433/* find k in (Z/e)^* such that g*k mod cyc is lexicographically minimal,434* k = 1 mod d to fix the first nonzero entry */435gd = Flv_Fl_mul(g, d, e); maxi = e/ugcd(d,e);436for (gk = g, k = d+1, i = 1; i < maxi; i++, k += d)437{438long ko = k % o;439gk = Flv_add(gk, gd, e); if (!coprime[ko]) continue;440gk = vecmoduu(gk, cyc);441if (vecsmall_lexcmp(gk, g) < 0) return gc_long(av,0);442}443return gc_long(av,1);444}445446static GEN447coprime_tables(long N)448{449GEN D = divisorsu(N), v = const_vec(N, NULL);450long i, l = lg(D);451for (i = 1; i < l; i++) gel(v, D[i]) = coprimes_zv(D[i]);452return v;453}454/* enumerate all group elements, modulo (Z/cyc[1])^* */455static GEN456cyc2elts_normal(GEN cyc, long maxord, GEN ORD)457{458long i, n, o, N, j = 1;459GEN z, vcoprime;460461if (typ(cyc) != t_VECSMALL) cyc = gtovecsmall(cyc);462n = lg(cyc)-1;463if (n == 0) return cgetg(1, t_VEC);464N = zv_prod(cyc);465z = cgetg(N+1, t_VEC);466if (1 <= maxord && (!ORD|| zv_search(ORD,1)))467gel(z,j++) = zero_zv(n);468vcoprime = coprime_tables(cyc[1]);469for (i = n; i > 0; i--)470{471GEN cyc0 = vecslice(cyc,i+1,n), pre = zero_zv(i);472GEN D = divisorsu(cyc[i]), C = cyc2elts(cyc0);473long s, t, lD = lg(D), nC = lg(C)-1; /* remove last element */474for (s = 1; s < lD-1; s++)475{476long o0 = D[lD-s]; /* cyc[i] / D[s] */477if (o0 > maxord) continue;478pre[i] = D[s];479if (!ORD || zv_search(ORD,o0))480{481GEN c = vecsmall_concat(pre, zero_zv(n-i));482gel(z,j++) = c;483}484for (t = 1; t < nC; t++)485{486GEN chi0 = gel(C,t);487o = lcmuu(o0, zv_charorder(cyc0,chi0));488if (o <= maxord && (!ORD || zv_search(ORD,o)))489{490GEN c = vecsmall_concat(pre, chi0);491if (zv_cyc_minimal(cyc, c, gel(vcoprime,o))) gel(z,j++) = c;492}493}494}495}496setlg(z,j); return z;497}498499GEN500chargalois(GEN G, GEN ORD)501{502pari_sp av = avma;503long maxord, i, l;504GEN v, cyc = (typ(G) == t_VEC && RgV_is_ZVpos(G))? G: member_cyc(G);505if (lg(cyc) == 1) retmkvec(cgetg(1,t_VEC));506maxord = itou(cyc_get_expo(cyc));507if (ORD && gequal0(ORD)) ORD = NULL;508if (ORD)509switch(typ(ORD))510{511long l;512case t_VEC:513ORD = ZV_to_zv(ORD);514case t_VECSMALL:515ORD = leafcopy(ORD);516vecsmall_sort(ORD);517l = lg(ORD);518if (l == 1) return cgetg(1, t_VECSMALL);519maxord = minss(maxord, ORD[l-1]);520break;521case t_INT:522maxord = minss(maxord, itos(ORD));523ORD = NULL;524break;525default: pari_err_TYPE("chargalois", ORD);526}527v = cyc2elts_normal(cyc, maxord, ORD); l = lg(v);528for(i = 1; i < l; i++) gel(v,i) = zv_to_ZV(gel(v,i));529return gerepileupto(av, v);530}531532/*********************************************************************/533/** **/534/** (Z/NZ)^* AND DIRICHLET CHARACTERS **/535/** **/536/*********************************************************************/537538GEN539znstar0(GEN N, long flag)540{541GEN F = NULL, P, E, cyc, gen, mod, G;542long i, i0, l, nbprimes;543pari_sp av = avma;544545if (flag && flag != 1) pari_err_FLAG("znstar");546if ((F = check_arith_all(N,"znstar")))547{548F = clean_Z_factor(F);549N = typ(N) == t_VEC? gel(N,1): factorback(F);550}551if (!signe(N))552{553if (flag) pari_err_IMPL("znstar(0,1)");554set_avma(av);555retmkvec3(gen_2, mkvec(gen_2), mkvec(gen_m1));556}557N = absi_shallow(N);558if (abscmpiu(N,2) <= 0)559{560G = mkvec3(gen_1, cgetg(1,t_VEC), cgetg(1,t_VEC));561if (flag)562{563GEN v = const_vec(6,cgetg(1,t_VEC));564gel(v,3) = cgetg(1,t_MAT);565F = equali1(N)? mkvec2(cgetg(1,t_COL),cgetg(1,t_VECSMALL))566: mkvec2(mkcol(gen_2), mkvecsmall(1));567G = mkvec5(mkvec2(N,mkvec(gen_0)), G, F, v, cgetg(1,t_MAT));568}569return gerepilecopy(av,G);570}571if (!F) F = Z_factor(N);572P = gel(F,1); nbprimes = lg(P)-1;573E = ZV_to_nv( gel(F,2) );574switch(mod8(N))575{576case 0:577P = shallowconcat(gen_2,P);578E = vecsmall_prepend(E, E[1]); /* add a copy of p=2 row */579i = 2; /* 2 generators at 2 */580break;581case 4:582i = 1; /* 1 generator at 2 */583break;584case 2: case 6:585P = vecsplice(P,1);586E = vecsplice(E,1); /* remove 2 */587i = 0; /* no generator at 2 */588break;589default:590i = 0; /* no generator at 2 */591break;592}593l = lg(P);594cyc = cgetg(l,t_VEC);595gen = cgetg(l,t_VEC);596mod = cgetg(l,t_VEC);597/* treat p=2 first */598if (i == 2)599{600long v2 = E[1];601GEN q = int2n(v2);602gel(cyc,1) = gen_2;603gel(gen,1) = subiu(q,1); /* -1 */604gel(mod,1) = q;605gel(cyc,2) = int2n(v2-2);606gel(gen,2) = utoipos(5); /* Conrey normalization */607gel(mod,2) = q;608i0 = 3;609}610else if (i == 1)611{612gel(cyc,1) = gen_2;613gel(gen,1) = utoipos(3);614gel(mod,1) = utoipos(4);615i0 = 2;616}617else618i0 = 1;619/* odd primes, fill remaining entries */620for (i = i0; i < l; i++)621{622long e = E[i];623GEN p = gel(P,i), q = powiu(p, e-1), Q = mulii(p, q);624gel(cyc,i) = subii(Q, q); /* phi(p^e) */625gel(gen,i) = pgener_Zp(p);/* Conrey normalization, for e = 1 also */626gel(mod,i) = Q;627}628/* gen[i] has order cyc[i] and generates (Z/mod[i]Z)^* */629if (nbprimes > 1) /* lift generators to (Z/NZ)^*, = 1 mod N/mod[i] */630for (i=1; i<l; i++)631{632GEN Q = gel(mod,i), g = gel(gen,i), qinv = Fp_inv(Q, diviiexact(N,Q));633g = addii(g, mulii(mulii(subsi(1,g),qinv),Q));634gel(gen,i) = modii(g, N);635}636637/* cyc[i] > 1 and remain so in the loop, gen[i] = 1 mod (N/mod[i]) */638if (!flag)639{ /* update generators in place; about twice faster */640G = gen;641for (i=l-1; i>=2; i--)642{643GEN ci = gel(cyc,i), gi = gel(G,i);644long j;645for (j=i-1; j>=1; j--) /* we want cyc[i] | cyc[j] */646{647GEN cj = gel(cyc,j), gj, qj, v, d;648649d = bezout(ci,cj,NULL,&v); /* > 1 */650if (absequalii(ci, d)) continue; /* ci | cj */651if (absequalii(cj, d)) { /* cj | ci */652swap(gel(G,j),gel(G,i));653gi = gel(G,i);654swap(gel(cyc,j),gel(cyc,i));655ci = gel(cyc,i); continue;656}657658qj = diviiexact(cj,d);659gel(cyc,j) = mulii(ci,qj);660gel(cyc,i) = d;661662/* [1,v*cj/d; 0,1]*[1,0;-1,1]*diag(cj,ci)*[ci/d,-v; cj/d,u]663* = diag(lcm,gcd), with u ci + v cj = d */664gj = gel(G,j);665/* (gj, gi) *= [1,0; -1,1]^-1 */666gj = Fp_mul(gj, gi, N); /* order ci*qj = lcm(ci,cj) */667/* (gj,gi) *= [1,v*qj; 0,1]^-1 */668togglesign_safe(&v);669if (signe(v) < 0) v = modii(v,ci); /* >= 0 to avoid inversions */670gel(G,i) = gi = Fp_mul(gi, Fp_pow(gj, mulii(qj, v), N), N);671gel(G,j) = gj;672ci = d; if (absequaliu(ci, 2)) break;673}674}675G = mkvec3(ZV_prod(cyc), cyc, FpV_to_mod(G,N));676}677else678{ /* keep matrices between generators, return an 'init' structure */679GEN D, U, Ui, fao = cgetg(l, t_VEC), lo = cgetg(l, t_VEC);680F = mkvec2(P, E);681D = ZV_snf_group(cyc,&U,&Ui);682for (i = 1; i < l; i++)683{684GEN t = gen_0, p = gel(P,i), p_1 = subiu(p,1);685long e = E[i];686gel(fao,i) = get_arith_ZZM(p_1);687if (e >= 2 && !absequaliu(p,2))688{689GEN q = gel(mod,i), g = Fp_pow(gel(gen,i),p_1,q);690if (e == 2)691t = Fp_inv(diviiexact(subiu(g,1), p), p);692else693t = ginv(Qp_log(cvtop(g,p,e)));694}695gel(lo,i) = t;696}697G = cgetg(l, t_VEC);698for (i = 1; i < l; i++) gel(G,i) = FpV_factorback(gen, gel(Ui,i), N);699G = mkvec3(ZV_prod(D), D, G);700G = mkvec5(mkvec2(N,mkvec(gen_0)), G, F,701mkvecn(6,mod,fao,Ui,gen,cyc,lo), U);702}703return gerepilecopy(av, G);704}705GEN706znstar(GEN N) { return znstar0(N, 0); }707708/* g has order 2^(e-2), g,h = 1 (mod 4); return x s.t. g^x = h (mod 2^e) */709static GEN710Zideallog_2k(GEN h, GEN g, long e, GEN pe)711{712GEN a = Fp_log(h, g, int2n(e-2), pe);713if (typ(a) != t_INT) return NULL;714return a;715}716717/* ord = get_arith_ZZM(p-1), simplified form of znlog_rec: g is known718* to be a primitive root mod p^e; lo = 1/log_p(g^(p-1)) */719static GEN720Zideallog_pk(GEN h, GEN g, GEN p, long e, GEN pe, GEN ord, GEN lo)721{722GEN gp = (e == 1)? g: modii(g, p);723GEN hp = (e == 1)? h: modii(h, p);724GEN a = Fp_log(hp, gp, ord, p);725if (typ(a) != t_INT) return NULL;726if (e > 1)727{ /* find a s.t. g^a = h (mod p^e), p odd prime, e > 0, (h,p) = 1 */728/* use p-adic log: O(log p + e) mul*/729GEN b, p_1 = gel(ord,1);730h = Fp_mul(h, Fp_pow(g, negi(a), pe), pe);731/* g,h = 1 mod p; compute b s.t. h = g^b */732if (e == 2) /* simpler */733b = Fp_mul(diviiexact(subiu(h,1), p), lo, p);734else735b = padic_to_Q(gmul(Qp_log(cvtop(h, p, e)), lo));736a = addii(a, mulii(p_1, b));737}738return a;739}740741int742znconrey_check(GEN cyc, GEN chi)743{ return typ(chi) == t_COL && lg(chi) == lg(cyc) && RgV_is_ZV(chi); }744745int746zncharcheck(GEN G, GEN chi)747{748switch(typ(chi))749{750case t_INT: return 1;751case t_COL: return znconrey_check(znstar_get_conreycyc(G), chi);752case t_VEC: return char_check(znstar_get_cyc(G), chi);753}754return 0;755}756757GEN758znconreyfromchar_normalized(GEN bid, GEN chi)759{760GEN nchi, U = znstar_get_U(bid);761long l = lg(chi);762if (l == 1) retmkvec2(gen_1,cgetg(1,t_VEC));763if (!RgV_is_ZV(chi) || lgcols(U) != l) pari_err_TYPE("lfunchiZ", chi);764nchi = char_normalize(chi, cyc_normalize(znstar_get_cyc(bid)));765gel(nchi,2) = ZV_ZM_mul(gel(nchi,2),U); return nchi;766}767768GEN769znconreyfromchar(GEN bid, GEN chi)770{771GEN nchi = znconreyfromchar_normalized(bid, chi);772GEN v = char_denormalize(znstar_get_conreycyc(bid), gel(nchi,1), gel(nchi,2));773settyp(v, t_COL); return v;774}775776/* discrete log on canonical "primitive root" generators777* Allow log(x) instead of x [usual discrete log on bid's generators] */778GEN779znconreylog(GEN bid, GEN x)780{781pari_sp av = avma;782GEN N, L, F, P,E, y, pe, fao, gen, lo, cycg;783long i, l;784if (!checkznstar_i(bid)) pari_err_TYPE("znconreylog", bid);785N = znstar_get_N(bid);786if (typ(N) != t_INT) pari_err_TYPE("znconreylog", N);787if (abscmpiu(N, 2) <= 0) return cgetg(1, t_COL);788cycg = znstar_get_conreycyc(bid);789switch(typ(x))790{791GEN Ui;792case t_INT:793if (!signe(x)) pari_err_COPRIME("znconreylog", x, N);794break;795case t_COL: /* log_bid(x) */796Ui = znstar_get_Ui(bid);797if (!RgV_is_ZV(x) || lg(x) != lg(Ui)) pari_err_TYPE("znconreylog", x);798return gerepileupto(av, vecmodii(ZM_ZC_mul(Ui,x), cycg));799case t_VEC:800return gerepilecopy(av, znconreyfromchar(bid, x));801default: pari_err_TYPE("znconreylog", x);802}803F = znstar_get_faN(bid); /* factor(N) */804P = gel(F, 1); /* prime divisors of N */805E = gel(F, 2); /* exponents */806L = gel(bid,4);807pe = znstar_get_pe(bid);808fao = gel(L,2);809gen = znstar_get_conreygen(bid); /* local generators of (Z/p^k)^* */810lo = gel(L,6); /* 1/log_p((g_i)^(p_i-1)) */811812l = lg(gen); i = 1;813y = cgetg(l, t_COL);814if (!mod2(N) && !mod2(x)) pari_err_COPRIME("znconreylog", x, N);815if (absequaliu(gel(P,1), 2) && E[1] >= 2)816{817if (E[1] == 2)818gel(y,i++) = mod4(x) == 1? gen_0: gen_1;819else820{821GEN a, x2, q2 = gel(pe,1);822x2 = modii(x, q2);823if (mod4(x) == 1) /* 1 or 5 mod 8*/824gel(y,i++) = gen_0;825else /* 3 or 7 */826{ gel(y,i++) = gen_1; x2 = subii(q2, x2); }827/* x2 = 5^x mod q */828a = Zideallog_2k(x2, gel(gen,i), E[1], q2);829if (!a) pari_err_COPRIME("znconreylog", x, N);830gel(y, i++) = a;831}832}833while (i < l)834{835GEN p = gel(P,i), q = gel(pe,i), xpe = modii(x, q);836GEN a = Zideallog_pk(xpe, gel(gen,i), p, E[i], q, gel(fao,i), gel(lo,i));837if (!a) pari_err_COPRIME("znconreylog", x, N);838gel(y, i++) = a;839}840return gerepilecopy(av, y);841}842GEN843Zideallog(GEN bid, GEN x)844{845pari_sp av = avma;846GEN y = znconreylog(bid, x), U = znstar_get_U(bid);847return gerepileupto(av, ZM_ZC_mul(U, y));848}849GEN850znlog0(GEN h, GEN g, GEN o)851{852if (typ(g) == t_VEC)853{854GEN N;855if (o) pari_err_TYPE("znlog [with znstar]", o);856if (!checkznstar_i(g)) pari_err_TYPE("znlog", g);857N = znstar_get_N(g);858h = Rg_to_Fp(h,N);859return Zideallog(g, h);860}861return znlog(h, g, o);862}863864GEN865znconreyexp(GEN bid, GEN x)866{867pari_sp av = avma;868long i, l;869GEN N, pe, gen, cycg, v, vmod;870int e2;871if (!checkznstar_i(bid)) pari_err_TYPE("znconreyexp", bid);872cycg = znstar_get_conreycyc(bid);873switch(typ(x))874{875case t_VEC:876x = znconreylog(bid, x);877break;878case t_COL:879if (RgV_is_ZV(x) && lg(x) == lg(cycg)) break;880default: pari_err_TYPE("znconreyexp",x);881}882pe = znstar_get_pe(bid);883gen = znstar_get_conreygen(bid); /* local generators of (Z/p^k)^* */884cycg = znstar_get_conreycyc(bid);885l = lg(x); v = cgetg(l, t_VEC);886N = znstar_get_N(bid);887e2 = !mod8(N); /* 2 generators at p = 2 */888for (i = 1; i < l; i++)889{890GEN q, g, m;891if (i == 1 && e2) { gel(v,1) = NULL; continue; }892q = gel(pe,i);893g = gel(gen,i);894m = modii(gel(x,i), gel(cycg,i));895m = Fp_pow(g, m, q);896if (i == 2 && e2 && signe(gel(x,1))) m = Fp_neg(m, q);897gel(v,i) = mkintmod(m, q);898}899if (e2) v = vecsplice(v, 1);900v = chinese1_coprime_Z(v);901vmod = gel(v,1);902v = gel(v,2);903if (mpodd(v) || mpodd(N)) return gerepilecopy(av, v);904/* handle N = 2 mod 4 */905return gerepileuptoint(av, addii(v, vmod));906}907908/* Return Dirichlet character \chi_q(m,.), where bid = znstar(q);909* m is either a t_INT, or a t_COL [Conrey logarithm] */910GEN911znconreychar(GEN bid, GEN m)912{913pari_sp av = avma;914GEN c, d, nchi;915916if (!checkznstar_i(bid)) pari_err_TYPE("znconreychar", bid);917switch(typ(m))918{919case t_COL:920case t_INT:921nchi = znconrey_normalized(bid,m); /* images of primroot gens */922break;923default:924pari_err_TYPE("znconreychar",m);925return NULL;/*LCOV_EXCL_LINE*/926}927d = gel(nchi,1);928c = ZV_ZM_mul(gel(nchi,2), znstar_get_Ui(bid)); /* images of bid gens */929return gerepilecopy(av, char_denormalize(znstar_get_cyc(bid),d,c));930}931932/* chi a t_INT or Conrey log describing a character. Return conductor, as an933* integer if primitive; as a t_VEC [N,factor(N)] if not. Set *pm=m to the934* attached primitive character: chi(g_i) = m[i]/ord(g_i)935* Caller should use znconreylog_normalize(BID, m), once BID(conductor) is936* computed (wasteful to do it here since BID is shared by many characters) */937GEN938znconreyconductor(GEN bid, GEN chi, GEN *pm)939{940pari_sp av = avma;941GEN q, m, F, P, E;942long i, j, l;943int e2, primitive = 1;944945if (!checkznstar_i(bid)) pari_err_TYPE("znconreyconductor", bid);946if (typ(chi) == t_COL)947{948if (!znconrey_check(znstar_get_conreycyc(bid), chi))949pari_err_TYPE("znconreyconductor",chi);950}951else952chi = znconreylog(bid, chi);953l = lg(chi);954F = znstar_get_faN(bid);955P = gel(F,1);956E = gel(F,2);957if (l == 1)958{959set_avma(av);960if (pm) *pm = cgetg(1,t_COL);961if (lg(P) == 1) return gen_1;962retmkvec2(gen_1, trivial_fact());963}964P = leafcopy(P);965E = leafcopy(E);966m = cgetg(l, t_COL);967e2 = (E[1] >= 3 && absequaliu(gel(P,1),2));968i = j = 1;969if (e2)970{ /* two generators at p=2 */971GEN a1 = gel(chi,1), a = gel(chi,2);972i = 3;973if (!signe(a))974{975e2 = primitive = 0;976if (signe(a1))977{ /* lose one generator */978E[1] = 2;979gel(m,1) = a1;980j = 2;981}982/* else lose both */983}984else985{986long v = Z_pvalrem(a, gen_2, &a);987if (v) { E[1] -= v; E[2] = E[1]; primitive = 0; }988gel(m,1) = a1;989gel(m,2) = a;990j = 3;991}992}993l = lg(P);994for (; i < l; i++)995{996GEN p = gel(P,i), a = gel(chi,i);997/* image of g_i in Q/Z is a/cycg[i], cycg[i] = order(g_i) */998if (!signe(a)) primitive = 0;999else1000{1001long v = Z_pvalrem(a, p, &a);1002E[j] = E[i]; if (v) { E[j] -= v; primitive = 0; }1003gel(P,j) = gel(P,i);1004gel(m,j) = a; j++;1005}1006}1007setlg(m,j);1008setlg(P,j);1009setlg(E,j);1010if (pm) *pm = m; /* attached primitive character */1011if (primitive)1012{1013q = znstar_get_N(bid);1014if (mod4(q) == 2) primitive = 0;1015}1016if (!primitive)1017{1018if (e2)1019{ /* remove duplicate p=2 row from factorization */1020P = vecsplice(P,1);1021E = vecsplice(E,1);1022}1023E = zc_to_ZC(E);1024q = mkvec2(factorback2(P,E), mkmat2(P,E));1025}1026gerepileall(av, pm? 2: 1, &q, pm);1027return q;1028}10291030GEN1031zncharinduce(GEN G, GEN chi, GEN N)1032{1033pari_sp av = avma;1034GEN q, faq, P, E, Pq, Eq, CHI;1035long i, j, l;1036int e2;10371038if (!checkznstar_i(G)) pari_err_TYPE("zncharinduce", G);1039if (!zncharcheck(G, chi)) pari_err_TYPE("zncharinduce", chi);1040q = znstar_get_N(G);1041if (typ(chi) != t_COL) chi = znconreylog(G, chi);1042if (checkznstar_i(N))1043{1044GEN faN = znstar_get_faN(N);1045P = gel(faN,1); l = lg(P);1046E = gel(faN,2);1047N = znstar_get_N(N);1048if (l > 2 && equalii(gel(P,1),gel(P,2)))1049{ /* remove duplicate 2 */1050l--;1051P = vecsplice(P,1);1052E = vecsplice(E,1);1053}1054}1055else1056{1057GEN faN = check_arith_pos(N, "zncharinduce");1058if (!faN) faN = Z_factor(N);1059else1060N = (typ(N) == t_VEC)? gel(N,1): factorback(faN);1061P = gel(faN,1);1062E = gel(faN,2);1063}1064if (!dvdii(N,q)) pari_err_DOMAIN("zncharinduce", "N % q", "!=", gen_0, N);1065if (mod4(N) == 2)1066{ /* remove 2 */1067if (lg(P) > 1 && absequaliu(gel(P,1), 2))1068{1069P = vecsplice(P,1);1070E = vecsplice(E,1);1071}1072N = shifti(N,-1);1073}1074l = lg(P);1075/* q = N or q = 2N, N odd */1076if (cmpii(N,q) <= 0) return gerepilecopy(av, chi);1077/* N > 1 => l > 1*/1078if (typ(E) != t_VECSMALL) E = ZV_to_zv(E);1079e2 = (E[1] >= 3 && absequaliu(gel(P,1),2)); /* 2 generators at 2 mod N */1080if (ZV_equal0(chi))1081{1082set_avma(av);1083return equali1(N)? cgetg(1, t_COL): zerocol(l+e2 - 1);1084}10851086faq = znstar_get_faN(G);1087Pq = gel(faq,1);1088Eq = gel(faq,2);1089CHI = cgetg(l+e2, t_COL);1090i = j = 1;1091if (e2)1092{1093i = 2; j = 3;1094if (absequaliu(gel(Pq,1), 2))1095{1096if (Eq[1] >= 3)1097{ /* 2 generators at 2 mod q */1098gel(CHI,1) = gel(chi,1);1099gel(CHI,2) = shifti(gel(chi,2), E[1]-Eq[1]);1100}1101else if (Eq[1] == 2)1102{ /* 1 generator at 2 mod q */1103gel(CHI,1) = gel(chi,1);1104gel(CHI,2) = gen_0;1105}1106else1107gel(CHI,1) = gel(CHI,2) = gen_0;1108}1109else1110gel(CHI,1) = gel(CHI,2) = gen_0;1111}1112for (; i < l; i++,j++)1113{1114GEN p = gel(P,i);1115long k = ZV_search(Pq, p);1116gel(CHI,j) = k? mulii(gel(chi,k), powiu(p, E[i]-Eq[k])): gen_0;1117}1118return gerepilecopy(av, CHI);1119}11201121/* m a Conrey log [on the canonical primitive roots], cycg the primitive1122* roots orders */1123GEN1124znconreylog_normalize(GEN G, GEN m)1125{1126GEN cycg = znstar_get_conreycyc(G);1127long i, l;1128GEN d, M = cgetg_copy(m, &l);1129if (typ(cycg) != t_VEC || lg(cycg) != l)1130pari_err_TYPE("znconreylog_normalize",mkvec2(m,cycg));1131for (i = 1; i < l; i++) gel(M,i) = gdiv(gel(m,i), gel(cycg,i));1132/* m[i]: image of primroot generators g_i in Q/Z */1133M = Q_remove_denom(M, &d);1134return mkvec2(d? d: gen_1, M);1135}11361137/* return normalized character on Conrey generators attached to chi: Conrey1138* label (t_INT), char on (SNF) G.gen* (t_VEC), or Conrey log (t_COL) */1139GEN1140znconrey_normalized(GEN G, GEN chi)1141{1142switch(typ(chi))1143{1144case t_INT: /* Conrey label */1145return znconreylog_normalize(G, znconreylog(G, chi));1146case t_COL: /* Conrey log */1147if (!RgV_is_ZV(chi)) break;1148return znconreylog_normalize(G, chi);1149case t_VEC: /* char on G.gen */1150if (!RgV_is_ZV(chi)) break;1151return znconreyfromchar_normalized(G, chi);1152}1153pari_err_TYPE("znchareval",chi);1154return NULL;/* LCOV_EXCL_LINE */1155}11561157/* return 1 iff chi(-1) = -1, and 0 otherwise */1158long1159zncharisodd(GEN G, GEN chi)1160{1161long i, l, s;1162GEN N;1163if (!checkznstar_i(G)) pari_err_TYPE("zncharisodd", G);1164if (!zncharcheck(G, chi)) pari_err_TYPE("zncharisodd", chi);1165if (typ(chi) != t_COL) chi = znconreylog(G, chi);1166N = znstar_get_N(G);1167l = lg(chi);1168s = 0;1169if (!mod8(N))1170{1171s = mpodd(gel(chi,1));1172i = 3;1173}1174else1175i = 1;1176for (; i < l; i++) s += mpodd(gel(chi,i));1177return odd(s);1178}11791180GEN1181znchartokronecker(GEN G, GEN chi, long flag)1182{1183pari_sp av = avma;1184long s;1185GEN F, o;11861187if (flag && flag != 1) pari_err_FLAG("znchartokronecker");1188s = zncharisodd(G, chi)? -1: 1;1189if (typ(chi) != t_COL) chi = znconreylog(G, chi);1190o = zncharorder(G, chi);1191if (abscmpiu(o,2) > 0) { set_avma(av); return gen_0; }1192F = znconreyconductor(G, chi, NULL);1193if (typ(F) == t_INT)1194{1195if (s < 0) F = negi(F);1196return gerepileuptoint(av, F);1197}1198F = gel(F,1);1199F = (s < 0)? negi(F): icopy(F);1200if (!flag)1201{1202GEN MF = znstar_get_faN(G), P = gel(MF,1);1203long i, l = lg(P);1204for (i = 1; i < l; i++)1205{1206GEN p = gel(P,i);1207if (!dvdii(F,p)) F = mulii(F,sqri(p));1208}1209}1210return gerepileuptoint(av, F);1211}12121213/* (D/.) as a character mod N; assume |D| divides N and D = 0,1 mod 4*/1214GEN1215znchar_quad(GEN G, GEN D)1216{1217GEN cyc = znstar_get_conreycyc(G);1218GEN gen = znstar_get_conreygen(G);1219long i, l = lg(cyc);1220GEN chi = cgetg(l, t_COL);1221for (i = 1; i < l; i++)1222{1223long k = kronecker(D, gel(gen,i));1224gel(chi,i) = (k==1)? gen_0: shifti(gel(cyc,i), -1);1225}1226return chi;1227}12281229GEN1230znchar(GEN D)1231{1232pari_sp av = avma;1233GEN G, chi;1234switch(typ(D))1235{1236case t_INT:1237if (!signe(D) || Mod4(D) > 1) pari_err_TYPE("znchar", D);1238G = znstar0(D,1);1239chi = mkvec2(G, znchar_quad(G,D));1240break;1241case t_INTMOD:1242G = znstar0(gel(D,1), 1);1243chi = mkvec2(G, znconreylog(G, gel(D,2)));1244break;1245case t_VEC:1246if (checkMF_i(D)) { chi = vecslice(MF_get_CHI(D),1,2); break; }1247else if (checkmf_i(D)) { chi = vecslice(mf_get_CHI(D),1,2); break; }1248if (lg(D) != 3) pari_err_TYPE("znchar", D);1249G = gel(D,1);1250if (!checkznstar_i(G)) pari_err_TYPE("znchar", D);1251chi = gel(D,2);1252if (typ(chi) == t_VEC && lg(chi) == 3 && is_vec_t(typ(gel(chi,2))))1253{ /* normalized character */1254GEN n = gel(chi,1), chic = gel(chi,2);1255GEN cyc = typ(chic)==t_VEC? znstar_get_cyc(G): znstar_get_conreycyc(G);1256if (!char_check(cyc, chic)) pari_err_TYPE("znchar",D);1257chi = char_denormalize(cyc, n, chic);1258}1259if (!zncharcheck(G, chi)) pari_err_TYPE("znchar", D);1260chi = mkvec2(G,chi); break;1261default:1262pari_err_TYPE("znchar", D);1263return NULL; /*LCOV_EXCL_LINE*/1264}1265return gerepilecopy(av, chi);1266}12671268/* G a znstar, not stack clean */1269GEN1270znchareval(GEN G, GEN chi, GEN n, GEN z)1271{1272GEN nchi, N = znstar_get_N(G);1273/* avoid division by 0 */1274if (typ(n) == t_FRAC && !equali1(gcdii(gel(n,2), N))) return not_coprime(z);1275n = Rg_to_Fp(n, N);1276if (!equali1(gcdii(n, N))) return not_coprime(z);1277/* nchi: normalized character on Conrey generators */1278nchi = znconrey_normalized(G, chi);1279return chareval_i(nchi, znconreylog(G,n), z);1280}12811282/* G is a znstar, chi a Dirichlet character */1283GEN1284zncharconj(GEN G, GEN chi)1285{1286switch(typ(chi))1287{1288case t_INT: chi = znconreylog(G, chi); /* fall through */1289case t_COL: return charconj(znstar_get_conreycyc(G), chi);1290case t_VEC: return charconj(znstar_get_cyc(G), chi);1291}1292pari_err_TYPE("zncharconj",chi);1293return NULL; /*LCOV_EXCL_LINE*/1294}12951296/* G is a znstar, chi a Dirichlet character */1297GEN1298zncharorder(GEN G, GEN chi)1299{1300switch(typ(chi))1301{1302case t_INT: chi = znconreylog(G, chi); /*fall through*/1303case t_COL: return charorder(znstar_get_conreycyc(G), chi);1304case t_VEC: return charorder(znstar_get_cyc(G), chi);1305default: pari_err_TYPE("zncharorder",chi);1306return NULL; /* LCOV_EXCL_LINE */1307}1308}13091310/* G is a znstar, chi a Dirichlet character */1311GEN1312zncharker(GEN G, GEN chi)1313{1314if (typ(chi) != t_VEC) chi = znconreychar(G, chi);1315return charker(znstar_get_cyc(G), chi);1316}13171318/* G is a znstar, 'a' is a Dirichlet character */1319GEN1320zncharpow(GEN G, GEN a, GEN n)1321{1322switch(typ(a))1323{1324case t_INT: return Fp_pow(a, n, znstar_get_N(G));1325case t_VEC: return charpow(znstar_get_cyc(G), a, n);1326case t_COL: return charpow(znstar_get_conreycyc(G), a, n);1327default: pari_err_TYPE("znchapow",a);1328return NULL; /* LCOV_EXCL_LINE */1329}1330}1331/* G is a znstar, 'a' and 'b' are Dirichlet character */1332GEN1333zncharmul(GEN G, GEN a, GEN b)1334{1335long ta = typ(a), tb = typ(b);1336if (ta == tb) switch(ta)1337{1338case t_INT: return Fp_mul(a, b, znstar_get_N(G));1339case t_VEC: return charmul(znstar_get_cyc(G), a, b);1340case t_COL: return charmul(znstar_get_conreycyc(G), a, b);1341default: pari_err_TYPE("zncharmul",a);1342return NULL; /* LCOV_EXCL_LINE */1343}1344if (ta != t_COL) a = znconreylog(G, a);1345if (tb != t_COL) b = znconreylog(G, b);1346return charmul(znstar_get_conreycyc(G), a, b);1347}13481349/* G is a znstar, 'a' and 'b' are Dirichlet character */1350GEN1351znchardiv(GEN G, GEN a, GEN b)1352{1353long ta = typ(a), tb = typ(b);1354if (ta == tb) switch(ta)1355{1356case t_INT: return Fp_div(a, b, znstar_get_N(G));1357case t_VEC: return chardiv(znstar_get_cyc(G), a, b);1358case t_COL: return chardiv(znstar_get_conreycyc(G), a, b);1359default: pari_err_TYPE("znchardiv",a);1360return NULL; /* LCOV_EXCL_LINE */1361}1362if (ta != t_COL) a = znconreylog(G, a);1363if (tb != t_COL) b = znconreylog(G, b);1364return chardiv(znstar_get_conreycyc(G), a, b);1365}13661367/* CHI mod N = \prod_p p^e; let CHI = \prod CHI_p, CHI_p mod p^e1368* return \prod_{p | (Q,N)} CHI_p. E.g if Q = p, return chi_p */1369GEN1370znchardecompose(GEN G, GEN chi, GEN Q)1371{1372GEN c, P, E, F;1373long l, lP, i;13741375if (!checkznstar_i(G)) pari_err_TYPE("znchardecompose", G);1376if (typ(Q) != t_INT) pari_err_TYPE("znchardecompose", Q);1377if (typ(chi) == t_COL)1378{ if (!zncharcheck(G, chi)) pari_err_TYPE("znchardecompose", chi); }1379else1380chi = znconreylog(G, chi);1381l = lg(chi);1382F = znstar_get_faN(G);1383c = zerocol(l-1);1384P = gel(F,1); /* prime divisors of N */1385lP = lg(P);1386E = gel(F,2); /* exponents */1387for (i = 1; i < lP; i++)1388{1389GEN p = gel(P,i);1390if (i == 1 && equaliu(p,2) && E[1] >= 3)1391{1392if (!mpodd(Q))1393{1394gel(c,1) = icopy(gel(chi,1));1395gel(c,2) = icopy(gel(chi,2));1396}1397i = 2; /* skip P[2] = P[1] = 2 */1398}1399else1400if (dvdii(Q, p)) gel(c,i) = icopy(gel(chi,i));1401}1402return c;1403}14041405GEN1406zncharconductor(GEN G, GEN chi)1407{1408pari_sp av = avma;1409GEN F = znconreyconductor(G, chi, NULL);1410if (typ(F) == t_INT) return F;1411return gerepilecopy(av, gel(F,1));1412}1413GEN1414znchartoprimitive(GEN G, GEN chi)1415{1416pari_sp av = avma;1417GEN chi0, F = znconreyconductor(G, chi, &chi0);1418if (typ(F) == t_INT)1419chi = mkvec2(G,chi);1420else1421chi = mkvec2(znstar0(F,1), chi0);1422return gerepilecopy(av, chi);1423}142414251426