/* 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));
}
/* g in Z[X] potentially defines a subfield of Q[X]/f. It is a subfield iff A
* (cf subfield) was a block system; then there
* exists h in Q[X] such that f | g o h. listdelta determines h s.t f | g o h
* in Fp[X] (cf chinese_retrieve_pol). Try to lift it; den is a
* multiplicative bound for denominator of lift. */
static GEN
embedding(GEN g, GEN DATA, primedata *S, GEN den, GEN listdelta)
{
GEN TR, w0_Q, w0, w1_Q, w1, wpow, h0, gp, T, q2, q, maxp, a, p = S->p;
long rt;
pari_sp av;
T = gel(DATA,1); rt = brent_kung_optpow(degpol(T), 2);
maxp= gel(DATA,7);
gp = derivpol(g); av = avma;
w0 = chinese_retrieve_pol(DATA, S, listdelta);
w0_Q = centermod(gmul(w0,den), p);
h0 = FpXQ_inv(FpX_FpXQ_compo(gp,w0, T,p), T,p); /* = 1/g'(w0) mod (T,p) */
wpow = NULL; q = sqri(p);
for(;;)
{/* Given g,w0,h0 in Z[x], s.t. h0.g'(w0) = 1 and g(w0) = 0 mod (T,p), find
* [w1,h1] satisfying the same conditions mod p^2, [w1,h1] = [w0,h0] (mod p)
* (cf. Dixon: J. Austral. Math. Soc., Series A, vol.49, 1990, p.445) */
if (DEBUGLEVEL>1)
fprintferr("lifting embedding mod p^k = %Z^%ld\n",p, Z_pval(q,p));
/* w1 := w0 - h0 g(w0) mod (T,q) */
if (wpow)
a = FpX_FpXQV_compo(g,wpow, T,q);
else
a = FpX_FpXQ_compo(g,w0, T,q); /* first time */
/* now, a = 0 (p) */
a = gmul(gneg(h0), gdivexact(a, p));
w1 = gadd(w0, gmul(p, FpX_rem(a, T,p)));
w1_Q = centermod(gmul(w1, remii(den,q)), q);
if (gequal(w1_Q, w0_Q) || cmpii(q,maxp) > 0)
{
GEN G = gcmp1(den)? g: RgX_rescale(g,den);
if (gcmp0(RgX_RgXQ_compo(G, w1_Q, T))) break;
}
if (cmpii(q, maxp) > 0)
{
if (DEBUGLEVEL) fprintferr("coeff too big for embedding\n");
return NULL;
}
gerepileall(av, 5, &w1,&h0,&w1_Q,&q,&p);
q2 = sqri(q);
wpow = FpXQ_powers(w1, rt, T, q2);
/* h0 := h0 * (2 - h0 g'(w1)) mod (T,q)
* = h0 + h0 * (1 - h0 g'(w1)) */
a = gmul(gneg(h0), FpX_FpXQV_compo(gp, FpXV_red(wpow,q),T,q));
a = ZX_Z_add(FpX_rem(a, T,q), gen_1); /* 1 - h0 g'(w1) = 0 (p) */
a = gmul(h0, gdivexact(a, p));
h0 = gadd(h0, gmul(p, FpX_rem(a, T,p)));
w0 = w1; w0_Q = w1_Q; p = q; q = q2;
}
TR = gel(DATA,5);
if (!gcmp0(TR)) w1_Q = translate_pol(w1_Q, TR);
return gdiv(w1_Q,den);
}
/* return P(X + c) using destructive Horner, optimize for c = 1,-1 */
GEN
translate_pol(GEN P, GEN c)
{
pari_sp av = avma, lim;
GEN Q, *R;
long i, k, n;
if (!signe(P) || gcmp0(c)) return gcopy(P);
Q = shallowcopy(P);
R = (GEN*)(Q+2); n = degpol(P);
lim = stack_lim(av, 2);
if (gcmp1(c))
{
for (i=1; i<=n; i++)
{
for (k=n-i; k<n; k++) R[k] = gadd(R[k], R[k+1]);
if (low_stack(lim, stack_lim(av,2)))
{
if(DEBUGMEM>1) pari_warn(warnmem,"TR_POL(1), i = %ld/%ld", i,n);
Q = gerepilecopy(av, Q); R = (GEN*)Q+2;
}
}
}
else if (gcmp_1(c))
{
for (i=1; i<=n; i++)
{
for (k=n-i; k<n; k++) R[k] = gsub(R[k], R[k+1]);
if (low_stack(lim, stack_lim(av,2)))
{
if(DEBUGMEM>1) pari_warn(warnmem,"TR_POL(-1), i = %ld/%ld", i,n);
Q = gerepilecopy(av, Q); R = (GEN*)Q+2;
}
}
}
else
{
for (i=1; i<=n; i++)
{
for (k=n-i; k<n; k++) R[k] = gadd(R[k], gmul(c, R[k+1]));
if (low_stack(lim, stack_lim(av,2)))
{
if(DEBUGMEM>1) pari_warn(warnmem,"TR_POL, i = %ld/%ld", i,n);
Q = gerepilecopy(av, Q); R = (GEN*)Q+2;
}
}
}
return gerepilecopy(av, Q);
}
/* return C in Z[X]/(p,T), C[ D[1] ] = 1, C[ D[i] ] = 0 otherwise. H is the
* list of degree 1 polynomials X - D[i] (come directly from factorization) */
static GEN
interpol(GEN H, GEN T, GEN p)
{
long i, m = lg(H);
GEN X = pol_x[0],d,p1,p2,a;
p1=pol_1[0]; p2=gen_1; a = gneg(constant_term(gel(H,1))); /* = D[1] */
for (i=2; i<m; i++)
{
d = constant_term(gel(H,i)); /* -D[i] */
p1 = FpXQX_mul(p1,gadd(X,d), T,p);
p2 = Fq_mul(p2, gadd(a,d), T,p);
}
return FqX_Fq_mul(p1,Fq_inv(p2, T,p), T,p);
}
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
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;
}
// mMul memory-wise
matrix* mMul(matrix a, matrix b){
int i, j, k;
matrix* resultMatrix;
uint8_t factor;
uint8_t *aVector, *bVector, *resVector;
// Check dimension correctness
if(a.nColumns != b.nRows){
printf("mMul : Error in Matrix dimensions. Cannot continue\n");
exit(1);
}
resultMatrix = mCreate(a.nRows, b.nColumns);
for(i = 0; i < resultMatrix->nRows; i++){
aVector = a.data[i];
resVector = resultMatrix->data[i];
for(j = 0; j < a.nColumns; j++){
factor = aVector[j];
if(factor != 0x00){
bVector = b.data[j];
for(k = 0; k < b.nColumns; k++){
resVector[k] = gadd(resVector[k], gmul(factor, bVector[k]));
}
}
}
}
return resultMatrix;
}
int galoisTest(){
uint8_t a,b,c;
int isOk = true;
// Addition :
a = 0x01; b = 0x0A; c = 0x0B;
if((gadd(a,b) != c)){
printf("Galois addition failed\n");
isOk = false;
}
// Multiplication :
if((gmul(a,b) != b) || (gmul(0x02, 0x02)!=0x04) ){
printf("Galois multiplication failed\n");
isOk = false;
}
// Division :
if((gdiv(b,a) != b) || (gdiv(0x02, 0x02)!=0x01)){
printf("Galois division failed\n");
isOk = false;
}
return isOk;
}
static void
bestlift_init(long a, GEN nf, GEN pr, GEN C, nflift_t *L)
{
const long D = 100;
const double alpha = ((double)D-1) / D; /* LLL parameter */
const long d = degpol(nf[1]);
pari_sp av = avma;
GEN prk, PRK, B, GSmin, pk;
pari_timer ti;
TIMERstart(&ti);
if (!a) a = (long)bestlift_bound(C, d, alpha, pr_norm(pr));
for (;; avma = av, a<<=1)
{
if (DEBUGLEVEL>2) fprintferr("exponent: %ld\n",a);
PRK = prk = idealpows(nf, pr, a);
pk = gcoeff(prk,1,1);
/* reduce size first, "scramble" matrix */
PRK = lllintpartial_ip(PRK);
/* now floating point reduction is fast */
PRK = lllint_fp_ip(PRK, 4);
PRK = lllint_i(PRK, D, 0, NULL, NULL, &B);
if (!PRK) { PRK = prk; GSmin = pk; } /* nf = Q */
else
{
pari_sp av2 = avma;
GEN S = invmat( get_R(PRK) ), BB = GS_norms(B, DEFAULTPREC);
GEN smax = gen_0;
long i, j;
for (i=1; i<=d; i++)
{
GEN s = gen_0;
for (j=1; j<=d; j++)
s = gadd(s, gdiv( gsqr(gcoeff(S,i,j)), gel(BB,j)));
if (gcmp(s, smax) > 0) smax = s;
}
GSmin = gerepileupto(av2, ginv(gmul2n(smax, 2)));
}
if (gcmp(GSmin, C) >= 0) break;
}
if (DEBUGLEVEL>2)
fprintferr("for this exponent, GSmin = %Z\nTime reduction: %ld\n",
GSmin, TIMER(&ti));
L->k = a;
L->den = L->pk = pk;
L->prk = PRK;
L->iprk = ZM_inv(PRK, pk);
L->GSmin= GSmin;
L->prkHNF = prk;
init_proj(L, gel(nf,1), gel(pr,1));
}
/* || L ||_p^p in dimension n (L may be a scalar) */
static GEN
normlp(GEN L, long p, long n)
{
long i,l, t = typ(L);
GEN z;
if (!is_vec_t(t)) return gmulsg(n, gpowgs(L, p));
l = lg(L); z = gen_0;
/* assert(n == l-1); */
for (i=1; i<l; i++)
z = gadd(z, gpowgs(gel(L,i), p));
return z;
}
/* log N_{F_P/Q_p}(x) / deg_F P */
static GEN
vtilde_i(GEN K, GEN x, GEN T, GEN deg, GEN ell, long prec)
{
GEN L, N, cx;
if (typ(x) != t_POL) x = nf_to_scalar_or_alg(K, x);
x = Q_primitive_part(x,&cx);
N = RgXQ_norm(x, T);
L = Qp_log(cvtop(N,ell,prec));
if (cx)
{
Q_pvalrem(cx, ell, &cx);
if (!isint1(cx))
L = gadd(L, gmulsg(degpol(T), Qp_log(cvtop(cx,ell,prec))));
}
return gdiv(L, deg);
}
/* Find h in Fp[X] such that h(a[i]) = listdelta[i] for all modular factors
* ff[i], where a[i] is a fixed root of ff[i] in Fq = Z[Y]/(p,T) [namely the
* first one in FpX_factorff_irred output]. Let f = ff[i], A the given root,
* then h mod f is Tr_Fq/Fp ( h(A) f(X)/(X-A)f'(A) ), most of the expression
* being precomputed. The complete h is recovered via chinese remaindering */
static GEN
chinese_retrieve_pol(GEN DATA, primedata *S, GEN listdelta)
{
GEN interp, bezoutC, h, pol = FpX_red(gel(DATA,1), S->p);
long i, l;
interp = gel(DATA,9);
bezoutC= gel(DATA,6);
h = NULL; l = lg(interp);
for (i=1; i<l; i++)
{ /* h(firstroot[i]) = listdelta[i] */
GEN t = FqX_Fq_mul(gel(interp,i), gel(listdelta,i), S->T,S->p);
t = poltrace(t, (GEN)S->Trk[i], S->p);
t = gmul(t, gel(bezoutC,i));
h = h? gadd(h,t): t;
}
return FpX_rem(FpX_red(h, S->p), pol, S->p);
}
GEN
vecsum(GEN v)
{
pari_sp av = avma;
long i, l;
GEN p;
if (!is_vec_t(typ(v)))
pari_err_TYPE("vecsum", v);
l = lg(v);
if (l == 1) return gen_0;
p = gel(v,1);
if (l == 2) return gcopy(p);
for (i=2; i<l; i++)
{
p = gadd(p, gel(v,i));
if (gc_needed(av, 2))
{
if (DEBUGMEM>1) pari_warn(warnmem,"sum");
p = gerepileupto(av, p);
}
}
return gerepileupto(av, p);
}
void
init_test(void) /* void */
{
GEN p1;
GEN p2; /* vec */
p = pol_x(fetch_user_var("p"));
d = pol_x(fetch_user_var("d"));
f = pol_x(fetch_user_var("f"));
/*allocatemem(800000000); */
p = stoi(65537);
d = gadd(genrand(powis(gen_2, 7)), powis(gen_2, 7));
p1 = gaddgs(d, 1);
{
long x;
p2 = cgetg(gtos(p1)+1, t_VEC);
for (x = 1; gcmpsg(x, p1) <= 0; ++x)
gel(p2, x) = genrand(p);
}
f = p2;
gel(f, 1) = gen_1;
f = gtopoly(f, -1);
return;
}
inline uchar rs_round( void )
{
uchar sum;
sum = gadd(0,gmul(l_shift[0],0));
l_shift[0] = l_shift[1];
sum = gadd(sum,gmul(l_shift[1],1));
l_shift[1] = l_shift[2];
sum = gadd(sum,gmul(l_shift[2],2));
l_shift[2] = l_shift[3];
sum = gadd(sum,gmul(l_shift[3],3));
l_shift[3] = l_shift[4];
sum = gadd(sum,gmul(l_shift[4],4));
l_shift[4] = l_shift[5];
sum = gadd(sum,gmul(l_shift[5],5));
l_shift[5] = l_shift[6];
sum = gadd(sum,gmul(l_shift[6],6));
l_shift[6] = l_shift[7];
sum = gadd(sum,gmul(l_shift[7],7));
l_shift[7] = l_shift[8];
sum = gadd(sum,gmul(l_shift[8],8));
l_shift[8] = l_shift[9];
sum = gadd(sum,gmul(l_shift[9],9));
l_shift[9] = l_shift[10];
sum = gadd(sum,gmul(l_shift[10],10));
l_shift[10] = l_shift[11];
sum = gadd(sum,gmul(l_shift[11],11));
l_shift[11] = l_shift[12];
sum = gadd(sum,gmul(l_shift[12],12));
l_shift[12] = l_shift[13];
sum = gadd(sum,gmul(l_shift[13],13));
l_shift[13] = l_shift[14];
sum = gadd(sum,gmul(l_shift[14],14));
l_shift[14] = l_shift[15];
sum = gadd(sum,gmul(l_shift[15],15));
l_shift[15] = 0;
return sum;
}
GEN gadde(GEN *x, GEN y)
{
*x=gadd(*x,y);
return *x;
}
/* 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;
}