/* K a bnf. Compute kernel \tilde{Cl}_K(ell); return cyclic factors.
* Set *pM to (vtilde_S[i](US[j]))_{i,j} */
static GEN
CL_tilde(GEN K, GEN US, GEN ell, GEN T, GEN Ftilde, GEN *pM, long prec)
{
GEN D, M, ellk, vdegS;
long i, j, imin, vmin, k, lD, l = lg(T), lU = lg(US);
*pM = cgetg(1, t_MAT);
if (l == 2) return cgetg(1, t_VEC); /* p = P^e: \tilde{Cl}(l) = (1) */
vdegS = get_vdegS(Ftilde, ell, prec);
imin = 1; vmin = l; /* upper bound */
for (i = 1; i < l; i++)
{
long v = z_pval(Ftilde[i], ell);
if (v < vmin) { vmin = v; imin = i; }
}
M = cgetg(lU, t_MAT);
for (j = 1; j < lU; j++)
{
GEN c = cgetg(l, t_COL), a = gel(US,j);
for (i = 1; i < l; i++)
gel(c,i) = vtilde(K, a, gel(T,i), gel(vdegS,i), ell, prec);
gel(M,j) = c;
}
k = padicprec(M, ell); ellk = powiu(ell, k);
*pM = M = gmod(M, ellk);
M = rowsplice(M, imin);
l--;
if (l == 1) return cgetg(1, t_VEC);
M = ZM_hnfmodid(M, ellk);
D = matsnf0(M, 4); lD = lg(D);
if (lD > 1 && Z_pval(gel(D,1), ell) >= k) return NULL;
return D;
}
/* return Bs: if r a root of sigma_i(P), |r| < Bs[i] */
static GEN
nf_root_bounds(GEN P, GEN T)
{
long lR, i, j, l, prec;
GEN Ps, R, V, nf;
if (RgX_is_rational(P)) return logmax_modulus_bound(P);
T = get_nfpol(T, &nf);
P = Q_primpart(P);
prec = ZXY_get_prec(P);
l = lg(P);
if (nf && nfgetprec(nf) >= prec)
R = gel(nf,6);
else
R = roots(T, prec);
lR = lg(R);
V = cgetg(lR, t_VEC);
Ps = cgetg(l, t_POL); /* sigma (P) */
Ps[1] = P[1];
for (j=1; j<lg(R); j++)
{
GEN r = gel(R,j);
for (i=2; i<l; i++) gel(Ps,i) = poleval(gel(P,i), r);
gel(V,j) = logmax_modulus_bound(Ps);
}
return V;
}
static GEN
F2xqE_dbl_slope(GEN P, GEN a, GEN T, GEN *slope)
{
GEN x, y, Q;
if (ell_is_inf(P)) return ellinf();
x = gel(P,1); y = gel(P,2);
if (typ(a)==t_VECSMALL)
{
GEN a2 = a;
if (!lgpol(gel(P,1))) return ellinf();
*slope = F2x_add(x, F2xq_div(y, x, T));
Q = cgetg(3,t_VEC);
gel(Q, 1) = F2x_add(F2xq_sqr(*slope, T), F2x_add(*slope, a2));
gel(Q, 2) = F2x_add(F2xq_mul(*slope, F2x_add(x, gel(Q, 1)), T), F2x_add(y, gel(Q, 1)));
}
else
{
GEN a3 = gel(a,1), a4 = gel(a,2), a3i = gel(a,3);
*slope = F2xq_mul(F2x_add(a4, F2xq_sqr(x, T)), a3i, T);
Q = cgetg(3,t_VEC);
gel(Q, 1) = F2xq_sqr(*slope, T);
gel(Q, 2) = F2x_add(F2xq_mul(*slope, F2x_add(x, gel(Q, 1)), T), F2x_add(y, a3));
}
return Q;
}
static void
init_primedata(primedata *S)
{
long i, j, l, lff = lg(S->ff), v = fetch_var(), N = degpol(S->pol);
GEN T, p = S->p;
if (S->lcm == degpol(S->ff[lff-1]))
{
T = shallowcopy((GEN)S->ff[lff-1]);
setvarn(T, v);
}
else
T = init_Fq(p, S->lcm, v);
name_var(v,"y");
S->T = T;
S->firstroot = cgetg(lff, t_VECSMALL);
S->interp = cgetg(lff, t_VEC);
S->fk = cgetg(N+1, t_VEC);
for (l=1,j=1; j<lff; j++)
{ /* compute roots and fix ordering (Frobenius cycles) */
GEN F = FpX_factorff_irred(gel(S->ff,j), T, p);
gel(S->interp,j) = interpol(F,T,p);
S->firstroot[j] = l;
for (i=1; i<lg(F); i++,l++) S->fk[l] = F[i];
}
S->Trk = init_traces(S->ff, T,p);
S->bezoutC = get_bezout(S->pol, S->ff, p);
}
static GEN
init_traces(GEN ff, GEN T, GEN p)
{
long N = degpol(T),i,j,k, r = lg(ff);
GEN Frob = FpXQ_matrix_pow(FpXQ_pow(pol_x[varn(T)],p, T,p), N,N, T,p);
GEN y,p1,p2,Trk,pow,pow1;
k = degpol(ff[r-1]); /* largest degree in modular factorization */
pow = cgetg(k+1, t_VEC);
gel(pow,1) = gen_0; /* dummy */
gel(pow,2) = Frob;
pow1= cgetg(k+1, t_VEC); /* 1st line */
for (i=3; i<=k; i++)
gel(pow,i) = FpM_mul(gel(pow,i-1), Frob, p);
gel(pow1,1) = gen_0; /* dummy */
for (i=2; i<=k; i++)
{
p1 = cgetg(N+1, t_VEC);
gel(pow1,i) = p1; p2 = gel(pow,i);
for (j=1; j<=N; j++) gel(p1,j) = gcoeff(p2,1,j);
}
/* Trk[i] = line 1 of x -> x + x^p + ... + x^{p^(i-1)} */
Trk = pow; /* re-use (destroy) pow */
gel(Trk,1) = vec_ei(N,1);
for (i=2; i<=k; i++)
gel(Trk,i) = gadd(gel(Trk,i-1), gel(pow1,i));
y = cgetg(r, t_VEC);
for (i=1; i<r; i++) y[i] = Trk[degpol(ff[i])];
return y;
}
/* K a bnf, compute Cl'(K) = ell-Sylow of Cl(K) / (places above ell).
* Return [D, u, R0, U0, ordS]
* - D: cyclic factors for Cl'(K)
* - u: generators of cyclic factors (all coprime to ell)
* - R0: subgroup isprincipal(<S>) (divides K.cyc)
* - U0: generators of R0 are of the form S . U0
* - ordS[i] = order of S[i] in CL(K) */
static GEN
CL_prime(GEN K, GEN ell, GEN Sell)
{
GEN g, ordS, R0, U0, U, D, u, cyc = bnf_get_cyc(K);
long i, l, lD, lS = lg(Sell);
g = leafcopy(bnf_get_gen(K));
l = lg(g);
for (i = 1; i < l; i++)
{
GEN A = gel(g,i), a = gcoeff(A,1,1);
long v = Z_pvalrem(a, ell, &a);
if (v) gel(g,i) = hnfmodid(A, a); /* make coprime to ell */
}
R0 = cgetg(lS, t_MAT);
ordS = cgetg(lS, t_VEC);
for (i = 1; i < lS; i++)
{
gel(R0,i) = isprincipal(K, gel(Sell,i));
gel(ordS,i) = charorder(cyc, gel(R0,i)); /* order of Sell[i] */
}
R0 = shallowconcat(R0, diagonal_shallow(cyc));
/* R0 = subgroup generated by S in Cl(K) [ divides diagonal(K.cyc) ]*/
R0 = ZM_hnfall(R0, &U0, 2); /* [S | cyc] * U0 = R0 in HNF */
D = ZM_snfall(R0, &U,NULL);
D = RgM_diagonal_shallow(D);
lD = lg(D);
u = ZM_inv(U, gen_1); settyp(u, t_VEC);
for (i = 1; i < lD; i++) gel(u,i) = idealfactorback(K,g,gel(u,i),1);
setlg(U0, l);
U0 = rowslice(U0,1,lS-1); /* restrict to 'S' part */
return mkvec5(D, u, R0, U0, ordS);
}
/* return a bound for T_2(P), P | polbase in C[X]
* NB: Mignotte bound: A | S ==>
* |a_i| <= binom(d-1, i-1) || S ||_2 + binom(d-1, i) lc(S)
*
* Apply to sigma(S) for all embeddings sigma, then take the L_2 norm over
* sigma, then take the sup over i.
**/
static GEN
nf_Mignotte_bound(GEN nf, GEN polbase)
{
GEN G = gmael(nf,5,2), lS = leading_term(polbase); /* t_INT */
GEN p1, C, N2, matGS, binlS, bin;
long prec, i, j, d = degpol(polbase), n = degpol(nf[1]), r1 = nf_get_r1(nf);
binlS = bin = vecbinome(d-1);
if (!gcmp1(lS)) binlS = gmul(lS, bin);
N2 = cgetg(n+1, t_VEC);
prec = gprecision(G);
for (;;)
{
nffp_t F;
matGS = cgetg(d+2, t_MAT);
for (j=0; j<=d; j++) gel(matGS,j+1) = arch_for_T2(G, gel(polbase,j+2));
matGS = shallowtrans(matGS);
for (j=1; j <= r1; j++) /* N2[j] = || sigma_j(S) ||_2 */
{
gel(N2,j) = gsqrt( QuickNormL2(gel(matGS,j), DEFAULTPREC), DEFAULTPREC );
if (lg(N2[j]) < DEFAULTPREC) goto PRECPB;
}
for ( ; j <= n; j+=2)
{
GEN q1 = QuickNormL2(gel(matGS,j ), DEFAULTPREC);
GEN q2 = QuickNormL2(gel(matGS,j+1), DEFAULTPREC);
p1 = gmul2n(mpadd(q1, q2), -1);
gel(N2,j) = gel(N2,j+1) = gsqrt( p1, DEFAULTPREC );
if (lg(N2[j]) < DEFAULTPREC) goto PRECPB;
}
if (j > n) break; /* done */
PRECPB:
prec = (prec<<1)-2;
remake_GM(nf, &F, prec); G = F.G;
if (DEBUGLEVEL>1) pari_warn(warnprec, "nf_factor_bound", prec);
}
/* Take sup over 0 <= i <= d of
* sum_sigma | binom(d-1, i-1) ||sigma(S)||_2 + binom(d-1,i) lc(S) |^2 */
/* i = 0: n lc(S)^2 */
C = mulsi(n, sqri(lS));
/* i = d: sum_sigma ||sigma(S)||_2^2 */
p1 = gnorml2(N2); if (gcmp(C, p1) < 0) C = p1;
for (i = 1; i < d; i++)
{
GEN s = gen_0;
for (j = 1; j <= n; j++)
{
p1 = mpadd( mpmul(gel(bin,i), gel(N2,j)), gel(binlS,i+1) );
s = mpadd(s, gsqr(p1));
}
if (gcmp(C, s) < 0) C = s;
}
return C;
}
/* Return a subfield, gen_0 [ change p ] or NULL [ not a subfield ] */
static GEN
subfield(GEN A, blockdata *B)
{
long N, i, j, d, lf, m = lg(A)-1;
GEN M, pe, pol, fhk, g, e, d_1_term, delta, listdelta, whichdelta;
GEN T = B->S->T, p = B->S->p, firstroot = B->S->firstroot;
pol= (GEN)B->DATA[1]; N = degpol(pol); d = N/m; /* m | N */
pe = (GEN)B->DATA[2];
fhk= (GEN)B->DATA[3];
M = (GEN)B->DATA[8];
delta = cgetg(m+1,t_VEC);
whichdelta = cgetg(N+1, t_VECSMALL);
d_1_term = gen_0;
for (i=1; i<=m; i++)
{
GEN Ai = gel(A,i), p1 = (GEN)fhk[Ai[1]];
for (j=2; j<=d; j++)
p1 = Fq_mul(p1, (GEN)fhk[Ai[j]], T, pe);
gel(delta,i) = p1;
if (DEBUGLEVEL>2) fprintferr("delta[%ld] = %Z\n",i,p1);
/* g = prod (X - delta[i])
* if g o h = 0 (pol), we'll have h(Ai[j]) = delta[i] for all j */
/* fk[k] belongs to block number whichdelta[k] */
for (j=1; j<=d; j++) whichdelta[Ai[j]] = i;
if (typ(p1) == t_POL) p1 = constant_term(p1);
d_1_term = addii(d_1_term, p1);
}
d_1_term = centermod(d_1_term, pe); /* Tr(g) */
if (absi_cmp(d_1_term, gel(M,3)) > 0) {
if (DEBUGLEVEL>1) fprintferr("d-1 test failed\n");
return NULL;
}
g = FqV_roots_to_pol(delta, T, pe, 0);
g = centermod(polsimplify(g), pe); /* assume g in Z[X] */
if (DEBUGLEVEL>2) fprintferr("pol. found = %Z\n",g);
if (!ok_coeffs(g,M)) {
if (DEBUGLEVEL>1) fprintferr("coeff too big for pol g(x)\n");
return NULL;
}
if (!FpX_is_squarefree(g, p)) {
if (DEBUGLEVEL>1) fprintferr("changing f(x): p divides disc(g)\n");
compute_data(B);
return subfield(A, B);
}
lf = lg(firstroot); listdelta = cgetg(lf, t_VEC);
for (i=1; i<lf; i++) listdelta[i] = delta[whichdelta[firstroot[i]]];
if (DEBUGLEVEL) fprintferr("candidate = %Z\n", g);
e = embedding(g, B->DATA, B->S, B->PD->den, listdelta);
if (!e) return NULL;
if (DEBUGLEVEL) fprintferr("embedding = %Z\n", e);
return _subfield(g, e);
}
GEN
subfields(GEN nf, GEN d0)
{
pari_sp av = avma;
long N, v0, d = itos(d0);
GEN LSB, pol, G;
poldata PD;
primedata S;
blockdata B;
pol = get_nfpol(nf, &nf); /* in order to treat trivial cases */
v0 = varn(pol); N = degpol(pol);
if (d == N) return gerepilecopy(av, _subfield(pol, pol_x[v0]));
if (d == 1) return gerepilecopy(av, _subfield(pol_x[v0], pol));
if (d < 1 || d > N || N % d) return cgetg(1,t_VEC);
/* much easier if nf is Galois (WSS) */
G = galoisconj4(nf? nf: pol, NULL, 1);
if (typ(G) != t_INT)
{ /* Bingo */
GEN L = galoissubgroups(G), F;
long k,i, l = lg(L), o = N/d;
F = cgetg(l, t_VEC);
k = 1;
for (i=1; i<l; i++)
{
GEN H = gel(L,i);
if (group_order(H) == o)
gel(F,k++) = lift_intern(galoisfixedfield(G, gel(H,1), 0, v0));
}
setlg(F, k);
return gerepilecopy(av, F);
}
subfields_poldata(nf? nf: pol, &PD);
B.PD = &PD;
B.S = &S;
B.N = N;
B.d = d;
B.size = N/d;
choose_prime(&S, PD.pol, PD.dis);
LSB = subfields_of_given_degree(&B);
(void)delete_var(); /* from choose_prime */
avma = av;
if (!LSB) return cgetg(1, t_VEC);
G = gcopy(LSB); gunclone(LSB);
return fix_var(G, v0);
}
static GEN
makepoldeg1(GEN c, GEN d)
{
GEN z;
if (signe(c)) {
z = cgetg(4,t_POL); z[1] = evalsigne(1);
gel(z,2) = d; gel(z,3) = c;
} else if (signe(d)) {
z = cgetg(3,t_POL); z[1] = evalsigne(1);
gel(z,2) = d;
} else {
z = cgetg(2,t_POL); z[1] = evalsigne(0);
}
return z;
}
/* image du block system D par la permutation perm */
static GEN
im_block_by_perm(GEN D,GEN perm)
{
long i,j,lb,lcy;
GEN Dn,cy,p1;
lb=lg(D); Dn=cgetg(lb,t_VEC);
for (i=1; i<lb; i++)
{
cy=gel(D,i); lcy=lg(cy);
gel(Dn,i) = cgetg(lcy,t_VECSMALL); p1=gel(Dn,i);
for (j=1; j<lcy; j++) p1[j] = perm[cy[j]];
}
return Dn;
}
/* S1 * u - P1 * round(P^-1 S u). K non-zero coords in u given by ind */
static GEN
get_trace(GEN ind, trace_data *T)
{
long i, j, l, K = lg(ind)-1;
GEN z, s, v;
s = gel(T->S1, ind[1]);
if (K == 1) return s;
/* compute s = S1 u */
for (j=2; j<=K; j++) s = gadd(s, gel(T->S1, ind[j]));
/* compute v := - round(P^1 S u) */
l = lg(s);
v = cgetg(l, t_VECSMALL);
for (i=1; i<l; i++)
{
double r, t = 0.;
/* quick approximate computation */
for (j=1; j<=K; j++) t += T->PinvSdbl[ ind[j] ][i];
r = floor(t + 0.5);
if (fabs(t + 0.5 - r) < 0.0001)
{ /* dubious, compute exactly */
z = gen_0;
for (j=1; j<=K; j++) z = addii(z, ((GEN**)T->dPinvS)[ ind[j] ][i]);
v[i] = - itos( diviiround(z, T->d) );
}
else
v[i] = - (long)r;
}
return gadd(s, ZM_zc_mul(T->P1, v));
}
static trace_data *
init_trace(trace_data *T, GEN S, nflift_t *L, GEN q)
{
long e = gexpo(S), i,j, l,h;
GEN qgood, S1, invd;
if (e < 0) return NULL; /* S = 0 */
qgood = int2n(e - 32); /* single precision check */
if (cmpii(qgood, q) > 0) q = qgood;
S1 = gdivround(S, q);
if (gcmp0(S1)) return NULL;
invd = ginv(itor(L->den, DEFAULTPREC));
T->dPinvS = gmul(L->iprk, S);
l = lg(S);
h = lg(T->dPinvS[1]);
T->PinvSdbl = (double**)cgetg(l, t_MAT);
init_dalloc();
for (j = 1; j < l; j++)
{
double *t = dalloc(h * sizeof(double));
GEN c = gel(T->dPinvS,j);
pari_sp av = avma;
T->PinvSdbl[j] = t;
for (i=1; i < h; i++) t[i] = rtodbl(mpmul(invd, gel(c,i)));
avma = av;
}
T->d = L->den;
T->P1 = gdivround(L->prk, q);
T->S1 = S1; return T;
}
static GEN
sqrconst(GEN pol, Red *R)
{
GEN z = cgetg(3,t_POL);
gel(z,2) = centermodii(sqri(gel(pol,2)), R->N, R->N2);
z[1] = pol[1]; return z;
}
static GEN
bound_for_coeff(long m, GEN rr, GEN *maxroot)
{
long i,r1, lrr=lg(rr);
GEN p1,b1,b2,B,M, C = matpascal(m-1);
for (r1=1; r1 < lrr; r1++)
if (typ(rr[r1]) != t_REAL) break;
r1--;
rr = gabs(rr,0); *maxroot = vecmax(rr);
for (i=1; i<lrr; i++)
if (gcmp(gel(rr,i), gen_1) < 0) gel(rr,i) = gen_1;
for (b1=gen_1,i=1; i<=r1; i++) b1 = gmul(b1, gel(rr,i));
for (b2=gen_1 ; i<lrr; i++) b2 = gmul(b2, gel(rr,i));
B = gmul(b1, gsqr(b2)); /* Mahler measure */
M = cgetg(m+2, t_VEC); gel(M,1) = gel(M,2) = gen_0; /* unused */
for (i=1; i<m; i++)
{
p1 = gadd(gmul(gcoeff(C, m, i+1), B),/* binom(m-1, i) */
gcoeff(C, m, i)); /* binom(m-1, i-1) */
gel(M,i+2) = ceil_safe(p1);
}
return M;
}
static GEN
zerofact(long v)
{
GEN z = cgetg(3, t_MAT);
gel(z,1) = mkcol(zeropol(v));
gel(z,2) = mkcol(gen_1); return z;
}
/* jac^floor(N/pk) mod (N, polcyclo(pk)), flexible window */
static GEN
_powpolmod(Cache *C, GEN jac, Red *R, GEN (*_sqr)(GEN, Red *))
{
const GEN taba = C->aall;
const GEN tabt = C->tall;
const long efin = lg(taba)-1, lv = R->lv;
GEN L, res = jac, pol2 = _sqr(res, R);
long f;
pari_sp av0 = avma, av;
L = cgetg(lv+1, t_VEC); gel(L,1) = res;
for (f=2; f<=lv; f++) gel(L,f) = _mul(gel(L,f-1), pol2, R);
av = avma;
for (f = efin; f >= 1; f--)
{
GEN t = gel(L, taba[f]);
long tf = tabt[f];
res = (f==efin)? t: _mul(t, res, R);
while (tf--) {
res = _sqr(res, R);
if (gc_needed(av,1)) {
res = gerepilecopy(av, res);
if(DEBUGMEM>1) pari_warn(warnmem,"powpolmod: f = %ld",f);
}
}
}
return gerepilecopy(av0, res);
}
static GEN
F2xqE_add_slope(GEN P, GEN Q, GEN a, GEN T, GEN *slope)
{
GEN Px, Py, Qx, Qy, R;
if (ell_is_inf(P)) return Q;
if (ell_is_inf(Q)) return P;
Px = gel(P,1); Py = gel(P,2);
Qx = gel(Q,1); Qy = gel(Q,2);
if (F2x_equal(Px, Qx))
{
if (F2x_equal(Py, Qy))
return F2xqE_dbl_slope(P, a, T, slope);
else
return ellinf();
}
*slope = F2xq_div(F2x_add(Py, Qy), F2x_add(Px, Qx), T);
R = cgetg(3,t_VEC);
if (typ(a)==t_VECSMALL)
{
GEN a2 = a;
gel(R, 1) = F2x_add(F2x_add(F2x_add(F2x_add(F2xq_sqr(*slope, T), *slope), Px), Qx), a2);
gel(R, 2) = F2x_add(F2xq_mul(*slope, F2x_add(Px, gel(R, 1)), T), F2x_add(Py, gel(R, 1)));
}
else
{
GEN a3 = gel(a,1);
gel(R, 1) = F2x_add(F2x_add(F2xq_sqr(*slope, T), Px), Qx);
gel(R, 2) = F2x_add(F2xq_mul(*slope, F2x_add(Px, gel(R, 1)), T), F2x_add(Py, a3));
}
return R;
}
GEN
chartoGENstr(char c)
{
GEN x = cgetg(2, t_STR);
char *t = GSTR(x);
t[0] = c; t[1] = 0; return x;
}
static void
choose_prime(primedata *S, GEN pol, GEN dpol)
{
byteptr di = diffptr + 1;
long i, j, k, r, lcm, oldlcm, pp, N = degpol(pol), minp = N*N / 4;
GEN Z, p, ff, oldff, n, oldn;
pari_sp av;
if (DEBUGLEVEL) (void)timer2();
p = utoipos(2);
while (p[2] <= minp) NEXT_PRIME_VIADIFF(p[2], di);
oldlcm = 0;
oldff = oldn = NULL; pp = 0; /* gcc -Wall */
av = avma;
for(k = 1; k < 11 || !oldlcm; k++,avma = av)
{
do NEXT_PRIME_VIADIFF(p[2], di); while (!smodis(dpol, p[2]));
if (k > 5 * N) pari_err(talker,"sorry, too many block systems in nfsubfields");
ff = (GEN)FpX_factor(pol, p)[1];
r = lg(ff)-1;
if (r == N || r >= BIL) continue;
n = cgetg(r+1, t_VECSMALL); lcm = n[1] = degpol(ff[1]);
for (j=2; j<=r; j++) { n[j] = degpol(ff[j]); lcm = clcm(lcm, n[j]); }
if (lcm <= oldlcm) continue; /* false when oldlcm = 0 */
if (DEBUGLEVEL) fprintferr("p = %ld,\tlcm = %ld,\torbits: %Z\n",p[2],lcm,n);
pp = p[2];
oldn = n;
oldff = ff;
oldlcm = lcm; if (r == 1) break;
av = avma;
}
if (DEBUGLEVEL) fprintferr("Chosen prime: p = %ld\n", pp);
S->ff = oldff;
S->lcm= oldlcm;
S->p = utoipos(pp);
S->pol = FpX_red(pol, S->p); init_primedata(S);
n = oldn; r = lg(n); Z = cgetg(r,t_VEC);
for (k=0,i=1; i<r; i++)
{
GEN t = cgetg(n[i]+1, t_VECSMALL); gel(Z,i) = t;
for (j=1; j<=n[i]; j++) t[j] = ++k;
}
S->Z = Z;
}
/* v[i] = deg S[i] mod p^prec */
static GEN
get_vdegS(GEN Ftilde, GEN ell, long prec)
{
long i, l = lg(Ftilde);
GEN v = cgetg(l, t_VEC), degell = Qp_log( cvtop(ell1(ell), ell, prec) );
for (i = 1; i < l; i++) gel(v,i) = gmulsg(Ftilde[i], degell);
return v;
}
/* Apply RgXQ_to_mod to all entries. Memory-clean ! */
static GEN
RgXQV_to_mod(GEN V, GEN T)
{
long i, l = lg(V);
GEN z = cgetg(l, t_VEC); T = gcopy(T);
for (i=1;i<l; i++) gel(z,i) = RgXQ_to_mod(gel(V,i), T);
return z;
}
/* T a ZX, z lifted from (Q[Y]/(T(Y)))[X], apply RgXQ_to_mod to all coeffs.
* Not memory clean because T not copied */
static GEN
RgXQX_to_mod(GEN z, GEN T)
{
long i,l = lg(z);
GEN x = cgetg(l,t_POL);
for (i=2; i<l; i++) gel(x,i) = RgXQ_to_mod(gel(z,i), T);
x[1] = z[1]; return normalizepol_i(x,l);
}
static GEN
row_transposecopy(GEN A, long x0)
{
long i, lB = lg(A);
GEN B = cgetg(lB, t_COL);
for (i=1; i<lB; i++) gel(B, i) = gcopy(gcoeff(A, x0, i));
return B;
}
/* return the first n0 chars of s as a GEN [s may not be 0-terminated] */
GEN
strntoGENstr(const char *s, long n0)
{
long n = nchar2nlong(n0+1);
GEN x = cgetg(n+1, t_STR);
char *t = GSTR(x);
strncpy(t, s, n0); t[n0] = 0; return x;
}
GEN
vars_to_RgXV(GEN h)
{
long i, l = lg(h);
GEN z = cgetg(l, t_VEC);
for (i = 1; i < l; i++) gel(z,i) = pol_x(h[i]);
return z;
}
GEN
gtrans(GEN x)
{
long i, dx, lx;
GEN y;
switch(typ(x))
{
case t_VEC: y = gcopy(x); settyp(y,t_COL); break;
case t_COL: y = gcopy(x); settyp(y,t_VEC); break;
case t_MAT:
lx = lg(x); if (lx==1) return cgetg(1,t_MAT);
dx = lgcols(x); y = cgetg(dx,t_MAT);
for (i = 1; i < dx; i++) gel(y,i) = row_transposecopy(x,i);
break;
default: pari_err_TYPE("gtrans",x); return NULL;
}
return y;
}
/* Assume P in nfX form [ unifpol(,t_COL) ], lc(P) != 0 mod p.
* Reduce P to Zp[X]/(T) mod p^a */
static GEN
ZqX(GEN P, GEN pk, GEN T, GEN proj)
{
long i, l = lg(P);
GEN z, pks2 = shifti(pk,-1);
z = cgetg(l,t_POL); z[1] = P[1];
for (i=2; i<l; i++) gel(z,i) = nf_to_Zq(gel(P,i),T,pk,pks2,proj);
return normalizepol(z);
}
/* assume x in Fq[X], return Tr_{Fq[X]/Fp[X]}(x), varn(X) = 0 */
static GEN
poltrace(GEN x, GEN Trq, GEN p)
{
long i,l;
GEN y;
if (typ(x) == t_INT || varn(x) != 0) return trace(x, Trq, p);
l = lg(x); y = cgetg(l,t_POL); y[1]=x[1];
for (i=2; i<l; i++) gel(y,i) = trace(gel(x,i),Trq,p);
return y;
}
/* assume A or B is a t_LIST */
static GEN
listconcat(GEN A, GEN B)
{
long i, l1, lx;
GEN L, z, L1, L2;
if (typ(A) != t_LIST) {
if (list_typ(B)!=t_LIST_RAW) pari_err_TYPE("listconcat",B);
L2 = list_data(B);
if (!L2) return mklistcopy(A);
lx = lg(L2) + 1;
z = listcreate();
list_data(z) = L = cgetg(lx, t_VEC);
for (i = 2; i < lx; i++) gel(L,i) = gcopy(gel(L2,i-1));
gel(L,1) = gcopy(A); return z;
} else if (typ(B) != t_LIST) {
if (list_typ(A)!=t_LIST_RAW) pari_err_TYPE("listconcat",A);
L1 = list_data(A);
if (!L1) return mklistcopy(B);
lx = lg(L1) + 1;
z = listcreate();
list_data(z) = L = cgetg(lx, t_VEC);
for (i = 1; i < lx-1; i++) gel(L,i) = gcopy(gel(L1,i));
gel(L,i) = gcopy(B); return z;
}
/* A, B both t_LISTs */
if (list_typ(A)!=t_LIST_RAW) pari_err_TYPE("listconcat",A);
if (list_typ(B)!=t_LIST_RAW) pari_err_TYPE("listconcat",B);
L1 = list_data(A); if (!L1) return listcopy(B);
L2 = list_data(B); if (!L2) return listcopy(A);
l1 = lg(L1);
lx = l1-1 + lg(L2);
z = cgetg(3, t_LIST);
z[1] = 0UL;
list_data(z) = L = cgetg(lx, t_VEC);
L2 -= l1-1;
for (i=1; i<l1; i++) gel(L,i) = gclone(gel(L1,i));
for ( ; i<lx; i++) gel(L,i) = gclone(gel(L2,i));
return z;
}
