/* 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);
}
static GEN
subfieldsall(GEN nf)
{
pari_sp av = avma;
long N, ld, i, v0;
GEN G, pol, dg, LSB, NLSB;
poldata PD;
primedata S;
blockdata B;
/* much easier if nf is Galois (WSS) */
G = galoisconj4(nf, NULL, 1);
if (typ(G) != t_INT)
{
GEN L, S, p;
long l;
pol = get_nfpol(nf, &nf);
L = lift_intern( galoissubfields(G, 0, varn(pol)) );
l = lg(L);
S = cgetg(l, t_VECSMALL);
for (i=1; i<l; i++) S[i] = lg(gmael(L,i,1));
p = vecsmall_indexsort(S);
return gerepilecopy(av, vecpermute(L, p));
}
subfields_poldata(nf, &PD);
pol = PD.pol;
v0 = varn(pol); N = degpol(pol);
dg = divisors(utoipos(N)); ld = lg(dg)-1;
if (DEBUGLEVEL) fprintferr("\n***** Entering subfields\n\npol = %Z\n",pol);
LSB = _subfield(pol, pol_x[0]);
if (ld > 2)
{
B.PD = &PD;
B.S = &S;
B.N = N;
choose_prime(&S, PD.pol, PD.dis);
for (i=2; i<ld; i++)
{
B.size = itos(gel(dg,i));
B.d = N / B.size;
NLSB = subfields_of_given_degree(&B);
if (NLSB) { LSB = concat(LSB, NLSB); gunclone(NLSB); }
}
(void)delete_var(); /* from choose_prime */
}
LSB = shallowconcat(LSB, _subfield(pol_x[0], pol));
if (DEBUGLEVEL) fprintferr("\n***** Leaving subfields\n\n");
return fix_var(gerepilecopy(av, LSB), v0);
}
/* L list of current subfields, test whether potential block D is a block,
* if so, append corresponding subfield */
static GEN
test_block(blockdata *B, GEN L, GEN D)
{
pari_sp av = avma;
GEN sub = subfield(D, B);
if (sub) {
GEN old = L;
L = gclone( L? shallowconcat(L, sub): sub );
if (old) gunclone(old);
}
avma = av; return L;
}
GEN
shallowconcat1(GEN x)
{
pari_sp av = avma;
long lx, t, i;
GEN z;
switch(typ(x))
{
case t_VEC:
lx = lg(x);
if (lx==1) pari_err_DOMAIN("concat","vector","=",x,x);
break;
case t_LIST:
if (list_typ(x)!=t_LIST_RAW) pari_err_TYPE("concat",x);
if (!list_data(x)) pari_err_DOMAIN("concat","vector","=",x,x);
x = list_data(x); lx = lg(x);
break;
default:
pari_err_TYPE("concat",x);
return NULL; /* not reached */
}
if (lx==2) return gel(x,1);
z = gel(x,1); t = typ(z); i = 2;
if (is_matvec_t(t) || t == t_VECSMALL || t == t_STR)
{ /* detect a "homogeneous" object: catmany is faster */
for (; i<lx; i++)
if (typ(gel(x,i)) != t) break;
z = catmany(x + 1, x + i-1, t);
}
for (; i<lx; i++) {
z = shallowconcat(z, gel(x,i));
if (gc_needed(av,3))
{
if (DEBUGMEM>1) pari_warn(warnmem,"concat: i = %ld", i);
z = gerepilecopy(av, z);
}
}
return z;
}
GEN
shallowconcat(GEN x, GEN y)
{
long tx=typ(x),ty=typ(y),lx=lg(x),ly=lg(y),i;
GEN z,p1;
if (tx==t_STR || ty==t_STR) return strconcat(x,y);
if (tx==t_LIST || ty==t_LIST) return listconcat(x,y);
if (tx==t_MAT && lx==1)
{
if (ty!=t_VEC) return gtomat(y);
if (ly==1) return cgetg(1, t_MAT);
err_cat(x,y);
}
if (ty==t_MAT && ly==1)
{
if (tx!=t_VEC) return gtomat(x);
if (lx==1) return cgetg(1, t_MAT);
err_cat(x,y);
}
if (tx == ty)
{
if (tx == t_MAT)
{ if (lgcols(x) != lgcols(y)) err_cat(x,y); }
else
if (!is_matvec_t(tx) && tx != t_VECSMALL) return mkvec2(x, y);
z=cgetg(lx+ly-1,tx);
for (i=1; i<lx; i++) z[i] = x[i];
for (i=1; i<ly; i++) z[lx+i-1]= y[i];
return z;
}
if (! is_matvec_t(tx))
{
if (! is_matvec_t(ty)) return mkvec2(x, y);
z=cgetg(ly+1,ty);
if (ty != t_MAT) p1 = x;
else
{
if (lgcols(y)!=2) err_cat(x,y);
p1 = mkcol(x);
}
for (i=2; i<=ly; i++) z[i] = y[i-1];
gel(z, 1) = p1; return z;
}
if (! is_matvec_t(ty))
{
z=cgetg(lx+1,tx);
if (tx != t_MAT) p1 = y;
else
{
if (lgcols(x)!=2) err_cat(x,y);
p1 = mkcol(y);
}
for (i=1; i<lx; i++) z[i]=x[i];
gel(z, lx) = p1; return z;
}
switch(tx)
{
case t_VEC:
switch(ty)
{
case t_COL:
if (lx<=2) return (lx==1)? y: shallowconcat(gel(x,1),y);
if (ly>=3) break;
return (ly==1)? x: shallowconcat(x,gel(y,1));
case t_MAT:
z=cgetg(ly,t_MAT); if (lx != ly) break;
for (i=1; i<ly; i++) gel(z,i) = shallowconcat(gel(x,i),gel(y,i));
return z;
}
break;
case t_COL:
switch(ty)
{
case t_VEC:
if (lx<=2) return (lx==1)? y: shallowconcat(gel(x,1), y);
if (ly>=3) break;
return (ly==1)? x: shallowconcat(x, gel(y,1));
case t_MAT:
if (lx != lgcols(y)) break;
z=cgetg(ly+1,t_MAT); gel(z,1) = x;
for (i=2; i<=ly; i++) gel(z,i) = gel(y,i-1);
return z;
}
break;
case t_MAT:
switch(ty)
{
case t_VEC:
z=cgetg(lx, t_MAT); if (ly != lx) break;
for (i=1; i<lx; i++) gel(z,i) = shallowconcat(gel(x,i), gel(y,i));
return z;
case t_COL:
if (ly != lgcols(x)) break;
z=cgetg(lx+1,t_MAT); gel(z,lx) = y;
for (i=1; i<lx; i++) z[i]=x[i];
return z;
}
break;
}
err_cat(x,y);
return NULL; /* not reached */
}
static GEN
nf_LLL_cmbf(nfcmbf_t *T, GEN p, long k, long rec)
{
nflift_t *L = T->L;
GEN pk = L->pk, PRK = L->prk, PRKinv = L->iprk, GSmin = L->GSmin;
GEN Tpk = L->Tpk;
GEN famod = T->fact, nf = T->nf, ZC = T->ZC, Br = T->Br;
GEN Pbase = T->polbase, P = T->pol, dn = T->dn;
GEN nfT = gel(nf,1);
GEN Btra;
long dnf = degpol(nfT), dP = degpol(P);
double BitPerFactor = 0.5; /* nb bits / modular factor */
long i, C, tmax, n0;
GEN lP, Bnorm, Tra, T2, TT, CM_L, m, list, ZERO;
double Bhigh;
pari_sp av, av2, lim;
long ti_LLL = 0, ti_CF = 0;
pari_timer ti2, TI;
lP = absi(leading_term(P));
if (is_pm1(lP)) lP = NULL;
n0 = lg(famod) - 1;
/* Lattice: (S PRK), small vector (vS vP). To find k bound for the image,
* write S = S1 q + S0, P = P1 q + P0
* |S1 vS + P1 vP|^2 <= Bhigh for all (vS,vP) assoc. to true factors */
Btra = mulrr(ZC, mulsr(dP*dP, normlp(Br, 2, dnf)));
Bhigh = get_Bhigh(n0, dnf);
C = (long)ceil(sqrt(Bhigh/n0)) + 1; /* C^2 n0 ~ Bhigh */
Bnorm = dbltor( n0 * C * C + Bhigh );
ZERO = zeromat(n0, dnf);
av = avma; lim = stack_lim(av, 1);
TT = cgetg(n0+1, t_VEC);
Tra = cgetg(n0+1, t_MAT);
for (i=1; i<=n0; i++) TT[i] = 0;
CM_L = gscalsmat(C, n0);
/* tmax = current number of traces used (and computed so far) */
for(tmax = 0;; tmax++)
{
long a, b, bmin, bgood, delta, tnew = tmax + 1, r = lg(CM_L)-1;
GEN oldCM_L, M_L, q, S1, P1, VV;
int first = 1;
/* bound for f . S_k(genuine factor) = ZC * bound for T_2(S_tnew) */
Btra = mulrr(ZC, mulsr(dP*dP, normlp(Br, 2*tnew, dnf)));
bmin = logint(ceil_safe(sqrtr(Btra)), gen_2, NULL);
if (DEBUGLEVEL>2)
fprintferr("\nLLL_cmbf: %ld potential factors (tmax = %ld, bmin = %ld)\n",
r, tmax, bmin);
/* compute Newton sums (possibly relifting first) */
if (gcmp(GSmin, Btra) < 0)
{
nflift_t L1;
GEN polred;
bestlift_init(k<<1, nf, T->pr, Btra, &L1);
polred = ZqX_normalize(Pbase, lP, &L1);
k = L1.k;
pk = L1.pk;
PRK = L1.prk;
PRKinv = L1.iprk;
GSmin = L1.GSmin;
Tpk = L1.Tpk;
famod = hensel_lift_fact(polred, famod, Tpk, p, pk, k);
for (i=1; i<=n0; i++) TT[i] = 0;
}
for (i=1; i<=n0; i++)
{
GEN h, lPpow = lP? gpowgs(lP, tnew): NULL;
GEN z = polsym_gen(gel(famod,i), gel(TT,i), tnew, Tpk, pk);
gel(TT,i) = z;
h = gel(z,tnew+1);
/* make Newton sums integral */
lPpow = mul_content(lPpow, dn);
if (lPpow) h = FpX_red(gmul(h,lPpow), pk);
gel(Tra,i) = nf_bestlift(h, NULL, L); /* S_tnew(famod) */
}
/* compute truncation parameter */
if (DEBUGLEVEL>2) { TIMERstart(&ti2); TIMERstart(&TI); }
oldCM_L = CM_L;
av2 = avma;
b = delta = 0; /* -Wall */
AGAIN:
M_L = Q_div_to_int(CM_L, utoipos(C));
VV = get_V(Tra, M_L, PRK, PRKinv, pk, &a);
if (first)
{ /* initialize lattice, using few p-adic digits for traces */
bgood = (long)(a - max(32, BitPerFactor * r));
b = max(bmin, bgood);
delta = a - b;
}
else
{ /* add more p-adic digits and continue reduction */
if (a < b) b = a;
b = max(b-delta, bmin);
if (b - delta/2 < bmin) b = bmin; /* near there. Go all the way */
}
/* restart with truncated entries */
q = int2n(b);
P1 = gdivround(PRK, q);
S1 = gdivround(Tra, q);
T2 = gsub(gmul(S1, M_L), gmul(P1, VV));
m = vconcat( CM_L, T2 );
if (first)
{
first = 0;
m = shallowconcat( m, vconcat(ZERO, P1) );
/* [ C M_L 0 ]
* m = [ ] square matrix
* [ T2' PRK ] T2' = Tra * M_L truncated
*/
}
CM_L = LLL_check_progress(Bnorm, n0, m, b == bmin, /*dbg:*/ &ti_LLL);
if (DEBUGLEVEL>2)
fprintferr("LLL_cmbf: (a,b) =%4ld,%4ld; r =%3ld -->%3ld, time = %ld\n",
a,b, lg(m)-1, CM_L? lg(CM_L)-1: 1, TIMER(&TI));
if (!CM_L) { list = mkcol(QXQX_normalize(P,nfT)); break; }
if (b > bmin)
{
CM_L = gerepilecopy(av2, CM_L);
goto AGAIN;
}
if (DEBUGLEVEL>2) msgTIMER(&ti2, "for this trace");
i = lg(CM_L) - 1;
if (i == r && gequal(CM_L, oldCM_L))
{
CM_L = oldCM_L;
avma = av2; continue;
}
if (i <= r && i*rec < n0)
{
pari_timer ti;
if (DEBUGLEVEL>2) TIMERstart(&ti);
list = nf_chk_factors(T, P, Q_div_to_int(CM_L,utoipos(C)), famod, pk);
if (DEBUGLEVEL>2) ti_CF += TIMER(&ti);
if (list) break;
CM_L = gerepilecopy(av2, CM_L);
}
if (low_stack(lim, stack_lim(av,1)))
{
if(DEBUGMEM>1) pari_warn(warnmem,"nf_LLL_cmbf");
gerepileall(av, Tpk? 9: 8,
&CM_L,&TT,&Tra,&famod,&pk,&GSmin,&PRK,&PRKinv,&Tpk);
}
}
if (DEBUGLEVEL>2)
fprintferr("* Time LLL: %ld\n* Time Check Factor: %ld\n",ti_LLL,ti_CF);
return list;
}
static GEN
bnflog_i(GEN bnf, GEN ell)
{
long prec0, prec;
GEN nf, US, vdegS, S, T, M, CLp, CLt, Ftilde, vtG, ellk;
GEN D, Ap, cycAp, bnfS;
long i, j, lS, lvAp;
checkbnf(bnf);
nf = checknf(bnf);
S = idealprimedec(nf, ell);
bnfS = bnfsunit0(bnf, S, nf_GENMAT, LOWDEFAULTPREC); /* S-units */
US = leafcopy(gel(bnfS,1));
prec0 = maxss(30, vtilde_prec(nf, US, ell));
US = shallowconcat(bnf_get_fu(bnf), US);
settyp(US, t_COL);
T = padicfact(nf, S, prec0);
lS = lg(S); Ftilde = cgetg(lS, t_VECSMALL);
for (j = 1; j < lS; j++) Ftilde[j] = ftilde(nf, gel(S,j), gel(T,j));
CLp = CL_prime(bnf, ell, S);
cycAp = gel(CLp,1);
Ap = gel(CLp,2);
for(;;)
{
CLt = CL_tilde(nf, US, ell, T, Ftilde, &vtG, prec0);
if (CLt) break;
prec0 <<= 1;
T = padicfact(nf, S, prec0);
}
prec = ellexpo(cycAp, ell) + ellexpo(CLt,ell) + 1;
if (prec == 1) return mkvec3(cgetg(1,t_VEC), cgetg(1,t_VEC), cgetg(1,t_VEC));
vdegS = get_vdegS(Ftilde, ell, prec0);
ellk = powiu(ell, prec);
lvAp = lg(Ap);
if (lvAp > 1)
{
GEN Kcyc = bnf_get_cyc(bnf);
GEN C = zeromatcopy(lvAp-1, lS-1);
GEN Rell = gel(CLp,3), Uell = gel(CLp,4), ordS = gel(CLp,5);
for (i = 1; i < lvAp; i++)
{
GEN a, b, bi, A = gel(Ap,i), d = gel(cycAp,i);
bi = isprincipal(bnf, A);
a = vecmodii(ZC_Z_mul(bi,d), Kcyc);
/* a in subgroup generated by S = Rell; hence b integral */
b = hnf_invimage(Rell, a);
b = vecmodii(ZM_ZC_mul(Uell, ZC_neg(b)), ordS);
A = mkvec2(A, cgetg(1,t_MAT));
A = idealpowred(nf, A, d);
/* find a principal representative of A_i^cycA_i up to elements of S */
a = isprincipalfact(bnf,gel(A,1),S,b,nf_GENMAT|nf_FORCE);
if (!gequal0(gel(a,1))) pari_err_BUG("bnflog");
a = famat_mul_shallow(gel(A,2), gel(a,2)); /* principal part */
if (lg(a) == 1) continue;
for (j = 1; j < lS; j++)
gcoeff(C,i,j) = vtilde(nf, a, gel(T,j), gel(vdegS,j), ell, prec0);
}
C = gmod(gneg(C),ellk);
C = shallowtrans(C);
M = mkmat2(mkcol2(diagonal_shallow(cycAp), C), mkcol2(gen_0, vtG));
M = shallowmatconcat(M); /* relation matrix */
}
else
M = vtG;
M = ZM_hnfmodid(M, ellk);
D = matsnf0(M, 4);
if (lg(D) == 1 || !dvdii(gel(D,1), ellk))
pari_err_BUG("bnflog [missing Z_l component]");
D = vecslice(D,2,lg(D)-1);
return mkvec3(D, CLt, ellsylow(cycAp, ell));
}
/* d = requested degree for subfield. Return DATA, valid for given pol, S and d
* If DATA != NULL, translate pol [ --> pol(X+1) ] and update DATA
* 1: polynomial pol
* 2: p^e (for Hensel lifts) such that p^e > max(M),
* 3: Hensel lift to precision p^e of DATA[4]
* 4: roots of pol in F_(p^S->lcm),
* 5: number of polynomial changes (translations)
* 6: Bezout coefficients associated to the S->ff[i]
* 7: Hadamard bound for coefficients of h(x) such that g o h = 0 mod pol.
* 8: bound M for polynomials defining subfields x PD->den
* 9: *[i] = interpolation polynomial for S->ff[i] [= 1 on the first root
S->firstroot[i], 0 on the others] */
static void
compute_data(blockdata *B)
{
GEN ffL, roo, pe, p1, p2, fk, fhk, MM, maxroot, pol;
primedata *S = B->S;
GEN p = S->p, T = S->T, ff = S->ff, DATA = B->DATA;
long i, j, l, e, N, lff = lg(ff);
if (DEBUGLEVEL>1) fprintferr("Entering compute_data()\n\n");
pol = B->PD->pol; N = degpol(pol);
roo = B->PD->roo;
if (DATA) /* update (translate) an existing DATA */
{
GEN Xm1 = gsub(pol_x[varn(pol)], gen_1);
GEN TR = addis(gel(DATA,5), 1);
GEN mTR = negi(TR), interp, bezoutC;
gel(DATA,5) = TR;
pol = translate_pol(gel(DATA,1), gen_m1);
l = lg(roo); p1 = cgetg(l, t_VEC);
for (i=1; i<l; i++) gel(p1,i) = gadd(TR, gel(roo,i));
roo = p1;
fk = gel(DATA,4); l = lg(fk);
for (i=1; i<l; i++) gel(fk,i) = gsub(Xm1, gel(fk,i));
bezoutC = gel(DATA,6); l = lg(bezoutC);
interp = gel(DATA,9);
for (i=1; i<l; i++)
{
if (degpol(interp[i]) > 0) /* do not turn pol_1[0] into gen_1 */
{
p1 = translate_pol(gel(interp,i), gen_m1);
gel(interp,i) = FpXX_red(p1, p);
}
if (degpol(bezoutC[i]) > 0)
{
p1 = translate_pol(gel(bezoutC,i), gen_m1);
gel(bezoutC,i) = FpXX_red(p1, p);
}
}
ff = cgetg(lff, t_VEC); /* copy, don't overwrite! */
for (i=1; i<lff; i++)
gel(ff,i) = FpX_red(translate_pol((GEN)S->ff[i], mTR), p);
}
else
{
DATA = cgetg(10,t_VEC);
fk = S->fk;
gel(DATA,5) = gen_0;
gel(DATA,6) = shallowcopy(S->bezoutC);
gel(DATA,9) = shallowcopy(S->interp);
}
gel(DATA,1) = pol;
MM = gmul2n(bound_for_coeff(B->d, roo, &maxroot), 1);
gel(DATA,8) = MM;
e = logint(shifti(vecmax(MM),20), p, &pe); /* overlift 2^20 [for d-1 test] */
gel(DATA,2) = pe;
gel(DATA,4) = roots_from_deg1(fk);
/* compute fhk = hensel_lift_fact(pol,fk,T,p,pe,e) in 2 steps
* 1) lift in Zp to precision p^e */
ffL = hensel_lift_fact(pol, ff, NULL, p, pe, e);
fhk = NULL;
for (l=i=1; i<lff; i++)
{ /* 2) lift factorization of ff[i] in Qp[X] / T */
GEN F, L = gel(ffL,i);
long di = degpol(L);
F = cgetg(di+1, t_VEC);
for (j=1; j<=di; j++) F[j] = fk[l++];
L = hensel_lift_fact(L, F, T, p, pe, e);
fhk = fhk? shallowconcat(fhk, L): L;
}
gel(DATA,3) = roots_from_deg1(fhk);
p1 = mulsr(N, gsqrt(gpowgs(utoipos(N-1),N-1),DEFAULTPREC));
p2 = gpowgs(maxroot, B->size + N*(N-1)/2);
p1 = gdiv(gmul(p1,p2), gsqrt(B->PD->dis,DEFAULTPREC));
gel(DATA,7) = mulii(shifti(ceil_safe(p1), 1), B->PD->den);
if (DEBUGLEVEL>1) {
fprintferr("f = %Z\n",DATA[1]);
fprintferr("p = %Z, lift to p^%ld\n", p, e);
fprintferr("2 * Hadamard bound * ind = %Z\n",DATA[7]);
fprintferr("2 * M = %Z\n",DATA[8]);
}
if (B->DATA) {
DATA = gclone(DATA);
if (isclone(B->DATA)) gunclone(B->DATA);
}
B->DATA = DATA;
}
