GEN
nffactormod(GEN nf, GEN x, GEN pr)
{
long j, l, vx = varn(x), vn;
pari_sp av = avma;
GEN F, E, rep, xrd, modpr, T, p;
nf = checknf(nf);
vn = varn(nf[1]);
if (typ(x)!=t_POL) pari_err(typeer,"nffactormod");
if (varncmp(vx,vn) >= 0)
pari_err(talker,"polynomial variable must have highest priority in nffactormod");
modpr = nf_to_ff_init(nf, &pr, &T, &p);
xrd = modprX(x, nf, modpr);
rep = FqX_factor(xrd,T,p);
settyp(rep, t_MAT);
F = gel(rep,1); l = lg(F);
E = gel(rep,2); settyp(E, t_COL);
for (j = 1; j < l; j++) {
gel(F,j) = modprX_lift(gel(F,j), modpr);
gel(E,j) = stoi(E[j]);
}
return gerepilecopy(av, rep);
}
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);
}
/* Let x be a polynomial with coefficients in Z or nf (vectors or polymods)
* return the same polynomial with coefficients expressed:
* if flag=t_COL: as vectors (on the integral basis).
* if flag=t_POLMOD: as polmods.
*/
GEN
unifpol(GEN nf, GEN x, long flag)
{
if (typ(x)==t_POL && varncmp(varn(x), varn(nf[1])) < 0)
{
long i, d = lg(x);
GEN y = cgetg(d,t_POL); y[1] = x[1];
for (i=2; i<d; i++) gel(y,i) = unifpol0(nf, gel(x,i), flag);
return y;
}
return unifpol0(nf, x, flag);
}
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;
}
static GEN
nf_to_Zq(GEN x, GEN T, GEN pk, GEN pks2, GEN proj)
{
GEN y;
if (typ(x) != t_COL) return centermodii(x, pk, pks2);
y = gmul(proj, x);
if (!T) return centermodii(y, pk, pks2);
y = RgV_to_RgX(y, varn(T));
return centermod_i(FpX_rem(y, T, pk), pk, pks2);
}
/* 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;
}
/* return the characteristic polynomial of alpha over nf, where alpha
is an element of the algebra nf[X]/(T) given as a polynomial in X */
GEN
rnfcharpoly(GEN nf, GEN T, GEN alpha, long v)
{
long vnf, vT, lT;
pari_sp av = avma;
GEN p1;
nf=checknf(nf); vnf = varn(nf[1]);
if (v<0) v = 0;
T = fix_relative_pol(nf,T,1);
if (typ(alpha) == t_POLMOD) alpha = lift_to_pol(alpha);
lT = lg(T);
if (typ(alpha) != t_POL || varn(alpha) == vnf)
return gerepileupto(av, gpowgs(gsub(pol_x[v], alpha), lT - 3));
vT = varn(T);
if (varn(alpha) != vT || varncmp(v, vnf)>=0)
pari_err(talker,"incorrect variables in rnfcharpoly");
if (lg(alpha) >= lT) alpha = RgX_rem(alpha, T);
if (lT <= 4)
return gerepileupto(av, gsub(pol_x[v], alpha));
p1 = caract2(T, unifpol(nf,alpha, t_POLMOD), v);
return gerepileupto(av, unifpol(nf, p1, t_POLMOD));
}
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);
}
/* return the roots of pol in nf */
GEN
nfroots(GEN nf,GEN pol)
{
pari_sp av = avma;
GEN A,g, T;
long d;
if (!nf) return nfrootsQ(pol);
nf = checknf(nf); T = gel(nf,1);
if (typ(pol) != t_POL) pari_err(notpoler,"nfroots");
if (varncmp(varn(pol), varn(T)) >= 0)
pari_err(talker,"polynomial variable must have highest priority in nfroots");
d = degpol(pol);
if (d == 0) return cgetg(1,t_VEC);
if (d == 1)
{
A = gneg_i(gdiv(gel(pol,2),gel(pol,3)));
return gerepilecopy(av, mkvec( basistoalg(nf,A) ));
}
A = fix_relative_pol(nf,pol,0);
A = Q_primpart( lift_intern(A) );
if (DEBUGLEVEL>3) fprintferr("test if polynomial is square-free\n");
g = nfgcd(A, derivpol(A), T, gel(nf,4));
if (degpol(g))
{ /* not squarefree */
g = QXQX_normalize(g, T);
A = RgXQX_div(A,g,T);
}
A = QXQX_normalize(A, T);
A = Q_primpart(A);
A = nfsqff(nf,A,1);
A = RgXQV_to_mod(A, T);
return gerepileupto(av, gen_sort(A, 0, cmp_pol));
}
long
fetch_user_var(const char *s)
{
entree *ep = fetch_entry(s);
long v;
switch (EpVALENCE(ep))
{
case EpVAR: return varn((GEN)initial_value(ep));
case EpNEW: break;
default: pari_err(e_MISC, "%s already exists with incompatible valence", s);
}
v = pari_var_create(ep);
ep->valence = EpVAR;
ep->value = initial_value(ep);
return v;
}
long
pari_var_create(entree *ep)
{
GEN p = (GEN)initial_value(ep);
long v;
if (*p) return varn(p);
if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
v = nvar++;
/* set p = pol_x(v) */
p[0] = evaltyp(t_POL) | _evallg(4);
p[1] = evalsigne(1) | evalvarn(v);
gel(p,2) = gen_0;
gel(p,3) = gen_1;
varentries_set(v, ep);
varpriority[v]= min_priority--;
return v;
}
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;
}
main()
{
FILE *input,*out,*dataf;
int j,ic,n,*index,*index2,k,i,ndata,dd1,dd2;
float *x0,*y0,*x1,*y1;
float *xmed,*ymed,*ytop,*ybot,*y2;
float dx0[90000],dy0[90000],dpval[90000],dnval[90000];
float mean,sdev,skew,kurt,min,max,g1,d1,l1,xi1,nvar,qval;
int ifault,itype1;
char instr[200],outstr[200],datstr[200];
opengfsr();
printf("data file, output file, simulated density file?:");
scanf("%s %s %s",datstr,outstr,instr);
dataf = fopen(datstr,"r");
input = fopen(instr,"r");
out = fopen(outstr,"w");
for(j=0;;++j){
char sdx1[200];
//ic = fscanf(dataf,"%f %f ",&dx0[j],&dy0[j]);
ic = fscanf(dataf,"%f %s ",&dx0[j],sdx1);
if (sdx1[1] == 'a') {
dy0[j] = NAN;
}
else {
sscanf(sdx1, "%f", &dy0[j]);
}
if(ic == EOF)break;
}
ndata = j;
for(j=0;;++j){
ic = fscanf(input,"%f %f ",&dd1,&dd2);
if(ic == EOF)break;
}
NMAX = n = j;
fclose(input);
index = (int *)malloc(NMAX*sizeof(int));
index2 = (int *)malloc(NMAX*sizeof(int));
x0 = (float *)malloc(NMAX*sizeof(float));
y0 = (float *)malloc(NMAX*sizeof(float));
x1 = (float *)malloc(NMAX*sizeof(float));
y1 = (float *)malloc(NMAX*sizeof(float));
xmed = (float *)malloc(NMAX*sizeof(float));
ymed = (float *)malloc(NMAX*sizeof(float));
ytop = (float *)malloc(NMAX*sizeof(float));
ybot = (float *)malloc(NMAX*sizeof(float));
y2 = (float *)malloc(NMAX*sizeof(float));
input = fopen(instr,"r");
for(j=0;j<n;++j){
ic = fscanf(input,"%f %f ",&x0[j],&y0[j]);
}
isort(n,x0,index);
for(j=0;j<n;++j){
x1[j] = x0[index[j]];
y1[j] = y0[index[j]];
}
for(j=0;j<ndata;++j) {
dpval[j] = -100.0;
}
for(k=0; k+WIN-1 < n;k+=WIN){
mom(&y1[k],WIN,&mean,&sdev,&skew,&kurt,&min,&max);
jnsn(&mean,&sdev,&skew,&kurt,&itype1,&g1,&d1,&l1,&xi1,&ifault);
if(ifault!=0){
printf(" jnsn. ifault is %d\n",ifault);
if(ifault != 3)continue;
}
for(j=0;j<ndata;++j) {
if((k==0 && dx0[j] < x1[WIN-1]) ||
(!(k+2*WIN-1 < n) && dx0[j] >= x1[k]) ||
(dx0[j] >= x1[k] && dx0[j] < x1[k+WIN])) {
varn(&dy0[j],&nvar,&itype1,&g1,&d1,&l1,&xi1,&ifault);
if(ifault == 2) {
if(dy0[j] < mean) {
dpval[j] = 0.0;
dnval[j] = -5.0;
}
else {
dpval[j] = 1.0;
dnval[j] = 5.0;
}
}
else {
dpval[j] = pnorm(nvar);
dnval[j] = nvar;
}
}
}
}
for(j=0;j<ndata;++j) {
if (isnan(dy0[j])) {
fprintf(out,"%f nan nan nan\n", dx0[j]);
}
else {
fprintf(out,"%f %f %f %f\n", dx0[j], dy0[j], dnval[j], dpval[j]);
}
}
closegfsr();
}
/* return the factorization of x in nf */
GEN
nffactor(GEN nf,GEN pol)
{
GEN A,g,y,p1,T, rep = cgetg(3, t_MAT);
long l, j, dA;
pari_sp av = avma;
pari_timer ti;
if (DEBUGLEVEL>2) { TIMERstart(&ti); fprintferr("\nEntering nffactor:\n"); }
nf = checknf(nf); T = gel(nf,1);
if (typ(pol) != t_POL) pari_err(notpoler,"nffactor");
if (varncmp(varn(pol), varn(T)) >= 0)
pari_err(talker,"polynomial variable must have highest priority in nffactor");
A = fix_relative_pol(nf,pol,0);
dA = degpol(A);
if (dA <= 0) {
avma = (pari_sp)(rep + 3);
return dA == 0? trivfact(): zerofact(varn(pol));
}
A = Q_primpart( QXQX_normalize(A, T) );
if (dA == 1) {
GEN c;
A = gerepilecopy(av, A); c = gel(A,2);
if (typ(c) == t_POL && degpol(c) > 0) gel(A,2) = mkpolmod(c, gcopy(T));
gel(rep,1) = mkcol(A);
gel(rep,2) = mkcol(gen_1); return rep;
}
if (degpol(T) == 1)
return gerepileupto(av, factpol(Q_primpart(simplify(pol)), 0));
A = Q_primpart( lift_intern(A) );
g = nfgcd(A, derivpol(A), T, gel(nf,4));
A = QXQX_normalize(A, T);
A = Q_primpart(A);
if (DEBUGLEVEL>2) msgTIMER(&ti, "squarefree test");
if (degpol(g))
{ /* not squarefree */
pari_sp av1;
GEN ex;
g = QXQX_normalize(g, T);
A = RgXQX_div(A,g, T);
y = nfsqff(nf,A,0); av1 = avma;
l = lg(y);
ex=(GEN)gpmalloc(l * sizeof(long));
for (j=l-1; j>=1; j--)
{
GEN fact = lift(gel(y,j)), quo = g, q;
long e = 0;
for(e = 1;; e++)
{
q = RgXQX_divrem(quo,fact,T, ONLY_DIVIDES);
if (!q) break;
quo = q;
}
ex[j] = e;
}
avma = av1; y = gerepileupto(av, RgXQXV_to_mod(y,T));
p1 = cgetg(l, t_COL); for (j=l-1; j>=1; j--) gel(p1,j) = utoipos(ex[j]);
free(ex);
}
else
{
y = gerepileupto(av, RgXQXV_to_mod(nfsqff(nf,A,0), T));
l = lg(y);
p1 = cgetg(l, t_COL); for (j=l-1; j>=1; j--) gel(p1,j) = gen_1;
}
if (DEBUGLEVEL>3)
fprintferr("number of factor(s) found: %ld\n", lg(y)-1);
gel(rep,1) = y;
gel(rep,2) = p1; return sort_factor(rep, cmp_pol);
}
/* 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;
}
