/* 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
nf_combine_factors(nfcmbf_t *T, GEN polred, GEN p, long a, long klim)
{
GEN res, L, listmod, famod = T->fact, nf = T->nf;
long l, maxK = 3, nft = lg(famod)-1;
pari_timer ti;
if (DEBUGLEVEL>2) TIMERstart(&ti);
T->fact = hensel_lift_fact(polred, famod, T->L->Tpk, p, T->L->pk, a);
if (nft < 11) maxK = -1; /* few modular factors: try all posibilities */
if (DEBUGLEVEL>2) msgTIMER(&ti, "Hensel lift");
L = nfcmbf(T, p, a, maxK, klim);
if (DEBUGLEVEL>2) msgTIMER(&ti, "Naive recombination");
res = gel(L,1);
listmod = gel(L,2); l = lg(listmod)-1;
famod = gel(listmod,l);
if (maxK >= 0 && lg(famod)-1 > 2*maxK)
{
if (l > 1)
{
T->pol = gel(res,l);
T->polbase = unifpol(nf, gel(res,l), t_COL);
}
L = nf_LLL_cmbf(T, p, a, maxK);
/* remove last elt, possibly unfactored. Add all new ones. */
setlg(res, l); res = shallowconcat(res, L);
}
return res;
}
static void
append(GEN D, GEN a)
{
long i,l = lg(D), m = lg(a);
GEN x = D + (l-1);
for (i=1; i<m; i++) x[i] = a[i];
setlg(D, l+m-1);
}
/* We want to be able to reconstruct x, |x|^2 < C, from x mod pr^k */
static double
bestlift_bound(GEN C, long d, double alpha, GEN Npr)
{
const double y = 1 / (alpha - 0.25); /* = 2 if alpha = 3/4 */
double t;
if (typ(C) != t_REAL) C = gmul(C, real_1(DEFAULTPREC));
setlg(C, DEFAULTPREC);
t = rtodbl(mplog(gmul2n(divrs(C,d), 4))) * 0.5 + (d-1) * log(1.5 * sqrt(y));
return ceil((t * d) / log(gtodouble(Npr)));
}
static GEN
ellsylow(GEN cyc, GEN ell)
{
long i, l;
GEN d = cgetg_copy(cyc, &l);
for (i = 1; i < l; i++)
{
GEN c = gel(cyc,i), a;
if (!Z_pvalrem(c, ell, &a)) break;
gel(d,i) = diviiexact(c, a);
}
setlg(d, i); return d;
}
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
nf_DDF_roots(GEN pol, GEN polred, GEN nfpol, GEN lt, GEN init_fa, long nbf,
long fl, nflift_t *L)
{
long Cltx_r[] = { evaltyp(t_POL)|_evallg(4), 0,0,0 };
long i, m;
GEN C2ltpol, C = L->topowden;
GEN Clt = mul_content(C, lt);
GEN C2lt = mul_content(C,Clt);
GEN z;
if (L->Tpk)
{
int cof = (degpol(pol) > nbf); /* non trivial cofactor ? */
z = FqX_split_roots(init_fa, L->Tp, L->p, cof? polred: NULL);
z = hensel_lift_fact(polred, z, L->Tpk, L->p, L->pk, L->k);
if (cof) setlg(z, lg(z)-1); /* remove cofactor */
z = roots_from_deg1(z);
}
else
z = rootpadicfast(polred, L->p, L->k);
Cltx_r[1] = evalsigne(1) | evalvarn(varn(pol));
gel(Cltx_r,3) = Clt? Clt: gen_1;
C2ltpol = C2lt? gmul(C2lt, pol): pol;
for (m=1,i=1; i<lg(z); i++)
{
GEN q, r = gel(z,i);
r = nf_bestlift_to_pol(lt? gmul(lt,r): r, NULL, L);
gel(Cltx_r,2) = gneg(r); /* check P(r) == 0 */
q = RgXQX_divrem(C2ltpol, Cltx_r, nfpol, ONLY_DIVIDES); /* integral */
if (q) {
C2ltpol = C2lt? gmul(Clt,q): q;
if (Clt) r = gdiv(r, Clt);
gel(z,m++) = r;
}
else if (fl == 2) return cgetg(1, t_VEC);
}
z[0] = evaltyp(t_VEC) | evallg(m);
return z;
}
void
print_all_user_fun(int member)
{
pari_sp av = avma;
long iL = 0, lL = 1024;
GEN L = cgetg(lL+1, t_VECSMALL);
entree *ep;
int i;
for (i = 0; i < functions_tblsz; i++)
for (ep = functions_hash[i]; ep; ep = ep->next)
{
const char *f;
int is_member;
if (EpVALENCE(ep) != EpVAR || typ((GEN)ep->value)!=t_CLOSURE) continue;
f = ep->name;
is_member = (f[0] == '_' && f[1] == '.');
if (member != is_member) continue;
if (iL >= lL)
{
GEN oL = L;
long j;
lL *= 2; L = cgetg(lL+1, t_VECSMALL);
for (j = 1; j <= iL; j++) gel(L,j) = gel(oL,j);
}
L[++iL] = (long)ep;
}
if (iL)
{
setlg(L, iL+1);
L = gen_sort(L, NULL, &cmp_epname);
for (i = 1; i <= iL; i++)
{
ep = (entree*)L[i];
pari_printf("%s =\n %Ps\n\n", ep->name, ep->value);
}
}
avma = av;
}
/* Naive recombination of modular factors: combine up to maxK modular
* factors, degree <= klim and divisible by hint
*
* target = polynomial we want to factor
* famod = array of modular factors. Product should be congruent to
* target/lc(target) modulo p^a
* For true factors: S1,S2 <= p^b, with b <= a and p^(b-a) < 2^31 */
static GEN
nfcmbf(nfcmbf_t *T, GEN p, long a, long maxK, long klim)
{
GEN pol = T->pol, nf = T->nf, famod = T->fact, dn = T->dn;
GEN bound = T->bound;
GEN nfpol = gel(nf,1);
long K = 1, cnt = 1, i,j,k, curdeg, lfamod = lg(famod)-1, dnf = degpol(nfpol);
GEN res = cgetg(3, t_VEC);
pari_sp av0 = avma;
GEN pk = gpowgs(p,a), pks2 = shifti(pk,-1);
GEN ind = cgetg(lfamod+1, t_VECSMALL);
GEN degpol = cgetg(lfamod+1, t_VECSMALL);
GEN degsofar = cgetg(lfamod+1, t_VECSMALL);
GEN listmod = cgetg(lfamod+1, t_COL);
GEN fa = cgetg(lfamod+1, t_COL);
GEN lc = absi(leading_term(pol)), lt = is_pm1(lc)? NULL: lc;
GEN C2ltpol, C = T->L->topowden, Tpk = T->L->Tpk;
GEN Clt = mul_content(C, lt);
GEN C2lt = mul_content(C,Clt);
const double Bhigh = get_Bhigh(lfamod, dnf);
trace_data _T1, _T2, *T1, *T2;
pari_timer ti;
TIMERstart(&ti);
if (maxK < 0) maxK = lfamod-1;
C2ltpol = C2lt? gmul(C2lt,pol): pol;
{
GEN q = ceil_safe(sqrtr(T->BS_2));
GEN t1,t2, ltdn, lt2dn;
GEN trace1 = cgetg(lfamod+1, t_MAT);
GEN trace2 = cgetg(lfamod+1, t_MAT);
ltdn = mul_content(lt, dn);
lt2dn= mul_content(ltdn, lt);
for (i=1; i <= lfamod; i++)
{
pari_sp av = avma;
GEN P = gel(famod,i);
long d = degpol(P);
degpol[i] = d; P += 2;
t1 = gel(P,d-1);/* = - S_1 */
t2 = gsqr(t1);
if (d > 1) t2 = gsub(t2, gmul2n(gel(P,d-2), 1));
/* t2 = S_2 Newton sum */
t2 = typ(t2)!=t_INT? FpX_rem(t2, Tpk, pk): modii(t2, pk);
if (lt)
{
if (typ(t2)!=t_INT) {
t1 = FpX_red(gmul(ltdn, t1), pk);
t2 = FpX_red(gmul(lt2dn,t2), pk);
} else {
t1 = remii(mulii(ltdn, t1), pk);
t2 = remii(mulii(lt2dn,t2), pk);
}
}
gel(trace1,i) = gclone( nf_bestlift(t1, NULL, T->L) );
gel(trace2,i) = gclone( nf_bestlift(t2, NULL, T->L) ); avma = av;
}
T1 = init_trace(&_T1, trace1, T->L, q);
T2 = init_trace(&_T2, trace2, T->L, q);
for (i=1; i <= lfamod; i++) {
gunclone(gel(trace1,i));
gunclone(gel(trace2,i));
}
}
degsofar[0] = 0; /* sentinel */
/* ind runs through strictly increasing sequences of length K,
* 1 <= ind[i] <= lfamod */
nextK:
if (K > maxK || 2*K > lfamod) goto END;
if (DEBUGLEVEL > 3)
fprintferr("\n### K = %d, %Z combinations\n", K,binomial(utoipos(lfamod), K));
setlg(ind, K+1); ind[1] = 1;
i = 1; curdeg = degpol[ind[1]];
for(;;)
{ /* try all combinations of K factors */
for (j = i; j < K; j++)
{
degsofar[j] = curdeg;
ind[j+1] = ind[j]+1; curdeg += degpol[ind[j+1]];
}
if (curdeg <= klim && curdeg % T->hint == 0) /* trial divide */
{
GEN t, y, q, list;
pari_sp av;
av = avma;
/* d - 1 test */
if (T1)
{
t = get_trace(ind, T1);
if (rtodbl(QuickNormL2(t,DEFAULTPREC)) > Bhigh)
{
if (DEBUGLEVEL>6) fprintferr(".");
avma = av; goto NEXT;
}
}
/* d - 2 test */
if (T2)
{
t = get_trace(ind, T2);
if (rtodbl(QuickNormL2(t,DEFAULTPREC)) > Bhigh)
{
if (DEBUGLEVEL>3) fprintferr("|");
avma = av; goto NEXT;
}
}
avma = av;
y = lt; /* full computation */
for (i=1; i<=K; i++)
{
GEN q = gel(famod, ind[i]);
if (y) q = gmul(y, q);
y = FqX_centermod(q, Tpk, pk, pks2);
}
y = nf_pol_lift(y, bound, T);
if (!y)
{
if (DEBUGLEVEL>3) fprintferr("@");
avma = av; goto NEXT;
}
/* try out the new combination: y is the candidate factor */
q = RgXQX_divrem(C2ltpol, y, nfpol, ONLY_DIVIDES);
if (!q)
{
if (DEBUGLEVEL>3) fprintferr("*");
avma = av; goto NEXT;
}
/* found a factor */
list = cgetg(K+1, t_VEC);
gel(listmod,cnt) = list;
for (i=1; i<=K; i++) list[i] = famod[ind[i]];
y = Q_primpart(y);
gel(fa,cnt++) = QXQX_normalize(y, nfpol);
/* fix up pol */
pol = q;
for (i=j=k=1; i <= lfamod; i++)
{ /* remove used factors */
if (j <= K && i == ind[j]) j++;
else
{
famod[k] = famod[i];
update_trace(T1, k, i);
update_trace(T2, k, i);
degpol[k] = degpol[i]; k++;
}
}
lfamod -= K;
if (lfamod < 2*K) goto END;
i = 1; curdeg = degpol[ind[1]];
if (C2lt) pol = Q_primpart(pol);
if (lt) lt = absi(leading_term(pol));
Clt = mul_content(C, lt);
C2lt = mul_content(C,Clt);
C2ltpol = C2lt? gmul(C2lt,pol): pol;
if (DEBUGLEVEL > 2)
{
fprintferr("\n"); msgTIMER(&ti, "to find factor %Z",y);
fprintferr("remaining modular factor(s): %ld\n", lfamod);
}
continue;
}
NEXT:
for (i = K+1;;)
{
if (--i == 0) { K++; goto nextK; }
if (++ind[i] <= lfamod - K + i)
{
curdeg = degsofar[i-1] + degpol[ind[i]];
if (curdeg <= klim) break;
}
}
}
END:
if (degpol(pol) > 0)
{ /* leftover factor */
if (signe(leading_term(pol)) < 0) pol = gneg_i(pol);
if (C2lt && lfamod < 2*K) pol = QXQX_normalize(Q_primpart(pol), nfpol);
setlg(famod, lfamod+1);
gel(listmod,cnt) = shallowcopy(famod);
gel(fa,cnt++) = pol;
}
if (DEBUGLEVEL>6) fprintferr("\n");
if (cnt == 2) {
avma = av0;
gel(res,1) = mkvec(T->pol);
gel(res,2) = mkvec(T->fact);
}
else
{
setlg(listmod, cnt); setlg(fa, cnt);
gel(res,1) = fa;
gel(res,2) = listmod;
res = gerepilecopy(av0, res);
}
return res;
}
/* return the factorization of the square-free polynomial x.
The coeffs of x are in Z_nf and its leading term is a rational integer.
deg(x) > 1, deg(nfpol) > 1
If fl = 1, return only the roots of x in nf
If fl = 2, as fl=1 if pol splits, [] otherwise */
static GEN
nfsqff(GEN nf, GEN pol, long fl)
{
long n, nbf, dpol = degpol(pol);
GEN pr, C0, polbase, init_fa = NULL;
GEN N2, rep, polmod, polred, lt, nfpol = gel(nf,1);
nfcmbf_t T;
nflift_t L;
pari_timer ti, ti_tot;
if (DEBUGLEVEL>2) { TIMERstart(&ti); TIMERstart(&ti_tot); }
n = degpol(nfpol);
polbase = unifpol(nf, pol, t_COL);
if (typ(polbase) != t_POL) pari_err(typeer, "nfsqff");
polmod = lift_intern( unifpol(nf, pol, t_POLMOD) );
if (dpol == 1) return mkvec(QXQX_normalize(polmod, nfpol));
/* heuristic */
if (dpol*3 < n)
{
GEN z, t;
long i;
if (DEBUGLEVEL>2) fprintferr("Using Trager's method\n");
z = (GEN)polfnf(polmod, nfpol)[1];
if (fl) {
long l = lg(z);
for (i = 1; i < l; i++)
{
t = gel(z,i); if (degpol(t) > 1) break;
gel(z,i) = gneg(gdiv(gel(t,2), gel(t,3)));
}
setlg(z, i);
if (fl == 2 && i != l) return cgetg(1,t_VEC);
}
return z;
}
nbf = nf_pick_prime(5, nf, polbase, fl, <, &init_fa, &pr, &L.Tp);
if (fl == 2 && nbf < dpol) return cgetg(1,t_VEC);
if (nbf <= 1)
{
if (!fl) return mkvec(QXQX_normalize(polmod, nfpol)); /* irreducible */
if (!nbf) return cgetg(1,t_VEC); /* no root */
}
if (DEBUGLEVEL>2) {
msgTIMER(&ti, "choice of a prime ideal");
fprintferr("Prime ideal chosen: %Z\n", pr);
}
pol = simplify_i(lift(polmod));
L.tozk = gel(nf,8);
L.topow= Q_remove_denom(gel(nf,7), &L.topowden);
T.ZC = L2_bound(nf, L.tozk, &(T.dn));
T.Br = nf_root_bounds(pol, nf); if (lt) T.Br = gmul(T.Br, lt);
if (fl) C0 = normlp(T.Br, 2, n);
else C0 = nf_factor_bound(nf, polbase); /* bound for T_2(Q_i), Q | P */
T.bound = mulrr(T.ZC, C0); /* bound for |Q_i|^2 in Z^n on chosen Z-basis */
N2 = mulsr(dpol*dpol, normlp(T.Br, 4, n)); /* bound for T_2(lt * S_2) */
T.BS_2 = mulrr(T.ZC, N2); /* bound for |S_2|^2 on chosen Z-basis */
if (DEBUGLEVEL>2) {
msgTIMER(&ti, "bound computation");
fprintferr(" 1) T_2 bound for %s: %Z\n", fl?"root":"factor", C0);
fprintferr(" 2) Conversion from T_2 --> | |^2 bound : %Z\n", T.ZC);
fprintferr(" 3) Final bound: %Z\n", T.bound);
}
L.p = gel(pr,1);
if (L.Tp && degpol(L.Tp) == 1) L.Tp = NULL;
bestlift_init(0, nf, pr, T.bound, &L);
if (DEBUGLEVEL>2) TIMERstart(&ti);
polred = ZqX_normalize(polbase, lt, &L); /* monic */
if (fl) {
GEN z = nf_DDF_roots(pol, polred, nfpol, lt, init_fa, nbf, fl, &L);
if (lg(z) == 1) return cgetg(1, t_VEC);
return z;
}
{
pari_sp av = avma;
if (L.Tp)
rep = FqX_split_all(init_fa, L.Tp, L.p);
else
{
long d;
rep = cgetg(dpol + 1, t_VEC); gel(rep,1) = FpX_red(polred,L.p);
d = FpX_split_Berlekamp((GEN*)(rep + 1), L.p);
setlg(rep, d + 1);
}
T.fact = gerepilecopy(av, sort_vecpol(rep, &cmp_pol));
}
if (DEBUGLEVEL>2) msgTIMER(&ti, "splitting mod %Z", pr);
T.pr = pr;
T.L = &L;
T.polbase = polbase;
T.pol = pol;
T.nf = nf;
T.hint = 1; /* useless */
rep = nf_combine_factors(&T, polred, L.p, L.k, dpol-1);
if (DEBUGLEVEL>2)
fprintferr("Total Time: %ld\n===========\n", TIMER(&ti_tot));
return rep;
}
static GEN
print_block_system(blockdata *B, GEN Y, GEN SB)
{
long i, j, l, ll, lp, u, v, ns, r = lg(Y), N = B->N;
long *k, *n, **e, *t;
GEN D, De, Z, cyperm, perm, VOID = cgetg(1, t_VECSMALL);
if (DEBUGLEVEL>5) fprintferr("Y = %Z\n",Y);
n = new_chunk(N+1);
D = cget1(N+1, t_VEC);
t = new_chunk(r+1);
k = new_chunk(r+1);
Z = cgetg(r+1, t_VEC);
for (ns=0,i=1; i<r; i++)
{
GEN Yi = gel(Y,i);
long ki = 0, si = lg(Yi)-1;
for (j=1; j<=si; j++) { n[j] = lg(Yi[j])-1; ki += n[j]; }
ki /= B->size;
De = cgetg(ki+1,t_VEC);
for (j=1; j<=ki; j++) gel(De,j) = VOID;
for (j=1; j<=si; j++)
{
GEN cy = gel(Yi,j);
for (l=1,lp=0; l<=n[j]; l++)
{
lp++; if (lp > ki) lp = 1;
gel(De,lp) = vecsmall_append(gel(De,lp), cy[l]);
}
}
append(D, De);
if (si>1 && ki>1)
{
GEN p1 = cgetg(si,t_VEC);
for (j=2; j<=si; j++) p1[j-1] = Yi[j];
ns++;
t[ns] = si-1;
k[ns] = ki-1;
gel(Z,ns) = p1;
}
}
if (DEBUGLEVEL>2) fprintferr("\nns = %ld\n",ns);
if (!ns) return test_block(B, SB, D);
setlg(Z, ns+1);
e = (long**)new_chunk(ns+1);
for (i=1; i<=ns; i++)
{
e[i] = new_chunk(t[i]+1);
for (j=1; j<=t[i]; j++) e[i][j] = 0;
}
cyperm= cgetg(N+1,t_VECSMALL);
perm = cgetg(N+1,t_VECSMALL); i = ns;
do
{
pari_sp av = avma;
for (u=1; u<=N; u++) perm[u] = u;
for (u=1; u<=ns; u++)
for (v=1; v<=t[u]; v++)
perm_mul_i(perm, cycle_power_to_perm(cyperm, gmael(Z,u,v), e[u][v]));
SB = test_block(B, SB, im_block_by_perm(D,perm));
avma = av;
/* i = 1..ns, j = 1..t[i], e[i][j] loop through 0..k[i].
* TODO: flatten to 1-dimensional loop */
if (++e[ns][t[ns]] > k[ns])
{
j = t[ns]-1;
while (j>=1 && e[ns][j] == k[ns]) j--;
if (j >= 1) { e[ns][j]++; for (l=j+1; l<=t[ns]; l++) e[ns][l] = 0; }
else
{
i = ns-1;
while (i>=1)
{
j = t[i];
while (j>=1 && e[i][j] == k[i]) j--;
if (j<1) i--;
else
{
e[i][j]++;
for (l=j+1; l<=t[i]; l++) e[i][l] = 0;
for (ll=i+1; ll<=ns; ll++)
for (l=1; l<=t[ll]; l++) e[ll][l] = 0;
break;
}
}
}
}
}
while (i > 0);
return SB;
}
/* Computation of potential block systems of given size d associated to a
* rational prime p: give a row vector of row vectors containing the
* potential block systems of imprimitivity; a potential block system is a
* vector of row vectors (enumeration of the roots). */
static GEN
calc_block(blockdata *B, GEN Z, GEN Y, GEN SB)
{
long r = lg(Z), lK, i, j, t, tp, T, u, nn, lnon, lY;
GEN K, n, non, pn, pnon, e, Yp, Zp, Zpp;
pari_sp av0 = avma;
if (DEBUGLEVEL>3)
{
fprintferr("lg(Z) = %ld, lg(Y) = %ld\n", r,lg(Y));
if (DEBUGLEVEL > 5)
{
fprintferr("Z = %Z\n",Z);
fprintferr("Y = %Z\n",Y);
}
}
lnon = min(BIL, r);
e = new_chunk(BIL);
n = new_chunk(r);
non = new_chunk(lnon);
pnon = new_chunk(lnon);
pn = new_chunk(lnon);
Zp = cgetg(lnon,t_VEC);
Zpp = cgetg(lnon,t_VEC); nn = 0;
for (i=1; i<r; i++) { n[i] = lg(Z[i])-1; nn += n[i]; }
lY = lg(Y); Yp = cgetg(lY+1,t_VEC);
for (j=1; j<lY; j++) Yp[j] = Y[j];
{
pari_sp av = avma;
long k = nn / B->size;
for (j = 1; j < r; j++)
if (n[j] % k) break;
if (j == r)
{
gel(Yp,lY) = Z;
SB = print_block_system(B, Yp, SB);
avma = av;
}
}
gel(Yp,lY) = Zp;
K = divisors(utoipos(n[1])); lK = lg(K);
for (i=1; i<lK; i++)
{
long ngcd = n[1], k = itos(gel(K,i)), dk = B->size*k, lpn = 0;
for (j=2; j<r; j++)
if (n[j]%k == 0)
{
if (++lpn >= BIL) pari_err(talker,"overflow in calc_block");
pn[lpn] = n[j]; pnon[lpn] = j;
ngcd = cgcd(ngcd, n[j]);
}
if (dk % ngcd) continue;
T = 1<<lpn;
if (lpn == r-2)
{
T--; /* done already above --> print_block_system */
if (!T) continue;
}
if (dk == n[1])
{ /* empty subset, t = 0. Split out for clarity */
Zp[1] = Z[1]; setlg(Zp, 2);
for (u=1,j=2; j<r; j++) Zpp[u++] = Z[j];
setlg(Zpp, u);
SB = calc_block(B, Zpp, Yp, SB);
}
for (t = 1; t < T; t++)
{ /* loop through all non-empty subsets of [1..lpn] */
for (nn=n[1],tp=t, u=1; u<=lpn; u++,tp>>=1)
{
if (tp&1) { nn += pn[u]; e[u] = 1; } else e[u] = 0;
}
if (dk != nn) continue;
for (j=1; j<r; j++) non[j]=0;
Zp[1] = Z[1];
for (u=2,j=1; j<=lpn; j++)
if (e[j]) { Zp[u] = Z[pnon[j]]; non[pnon[j]] = 1; u++; }
setlg(Zp, u);
for (u=1,j=2; j<r; j++)
if (!non[j]) Zpp[u++] = Z[j];
setlg(Zpp, u);
SB = calc_block(B, Zpp, Yp, SB);
}
}
avma = av0; return SB;
}
