/* $Id: base4.c,v 1.70 2001/10/01 12:11:29 karim Exp $ Copyright (C) 2000 The PARI group. This file is part of the PARI/GP package. PARI/GP is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation. It is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY WHATSOEVER. Check the License for details. You should have received a copy of it, along with the package; see the file 'COPYING'. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ /*******************************************************************/ /* */ /* BASIC NF OPERATIONS */ /* (continued) */ /* */ /*******************************************************************/ #include "pari.h" #include "parinf.h" #define principalideal_aux(nf,x) (principalideal0((nf),(x),0)) extern GEN element_muli(GEN nf, GEN x, GEN y); extern GEN colreducemodmat(GEN x, GEN y, GEN *Q); static GEN nfbezout(GEN nf, GEN a, GEN b, GEN ida, GEN idb, GEN *u, GEN *v, GEN *w, GEN *di); /*******************************************************************/ /* */ /* IDEAL OPERATIONS */ /* */ /*******************************************************************/ /* A valid ideal is either principal (valid nf_element), or prime, or a matrix * on the integer basis (preferably HNF). * A prime ideal is of the form [p,a,e,f,b], where the ideal is p.Z_K+a.Z_K, * p is a rational prime, a belongs to Z_K, e=e(P/p), f=f(P/p), and b * Lenstra constant (p.P^(-1)= p Z_K + b Z_K). * * An idele is a couple[I,V] where I is a valid ideal and V a row vector * with r1+r2 components (real or complex). For instance, if M=(a), V * contains the complex logarithms of the first r1+r2 conjugates of a * (depends on the chosen generator a). All subroutines work with either * ideles or ideals (an omitted V is assumed to be 0). * * All the output ideals will be in HNF form. */ /* types and conversions */ static long idealtyp(GEN *ideal, GEN *arch) { GEN x = *ideal; long t,lx,tx = typ(x); if (tx==t_VEC && lg(x)==3) { *arch = (GEN)x[2]; x = (GEN)x[1]; tx = typ(x); } else *arch = NULL; switch(tx) { case t_MAT: lx = lg(x); if (lx>2) t = id_MAT; else { t = id_PRINCIPAL; x = (lx==2)? (GEN)x[1]: gzero; } break; case t_VEC: if (lg(x)!=6) err(idealer2); t = id_PRIME; break; case t_POL: case t_POLMOD: case t_COL: t = id_PRINCIPAL; break; default: if (tx!=t_INT && !is_frac_t(tx)) err(idealer2); t = id_PRINCIPAL; } *ideal = x; return t; } /* Assume ideal in HNF form */ long ideal_is_zk(GEN ideal,long N) { long i,j, lx = lg(ideal); if (typ(ideal) != t_MAT || lx==1) return 0; N++; if (lx != N || lg(ideal[1]) != N) return 0; for (i=1; i= N) m = x; else { m=cgetg(rx*N + 1,t_MAT); for (i=1; i<=rx; i++) for (j=1; j<=N; j++) m[(i-1)*N + j] = (long) element_mulid(nf,(GEN)x[i],j); } x = hnfmod(m,detint(m)); return dx? gdiv(x,dx): x; } int ishnfall(GEN x) { long i,j, lx = lg(x); for (i=2; i 0); } GEN idealhermite_aux(GEN nf, GEN x) { long N,tx,lx; GEN z; tx = idealtyp(&x,&z); if (tx == id_PRIME) return prime_to_ideal_aux(nf,x); if (tx == id_PRINCIPAL) { x = principalideal(nf,x); return idealmat_to_hnf(nf,x); } N=degpol(nf[1]); lx = lg(x); if (lg(x[1]) != N+1) err(idealer2); if (lx == N+1 && ishnfall(x)) return x; if (lx <= N) return idealmat_to_hnf(nf,x); z=denom(x); if (gcmp1(z)) z=NULL; else x = gmul(z,x); x = hnfmod(x,detint(x)); return z? gdiv(x,z): x; } GEN idealhermite(GEN nf, GEN x) { long av=avma; GEN p1; nf = checknf(nf); p1 = idealhermite_aux(nf,x); if (p1==x || p1==(GEN)x[1]) return gcopy(p1); return gerepileupto(av,p1); } static GEN principalideal0(GEN nf, GEN x, long copy) { GEN z = cgetg(2,t_MAT); switch(typ(x)) { case t_INT: case t_FRAC: case t_FRACN: if (copy) x = gcopy(x); x = gscalcol_i(x, degpol(nf[1])); break; case t_POLMOD: x = checknfelt_mod(nf,x,"principalideal"); /* fall through */ case t_POL: x = copy? algtobasis(nf,x): algtobasis_intern(nf,x); break; case t_MAT: if (lg(x)!=2) err(typeer,"principalideal"); x = (GEN)x[1]; case t_COL: if (lg(x)==lgef(nf[1])-2) { if (copy) x = gcopy(x); break; } default: err(typeer,"principalideal"); } z[1]=(long)x; return z; } GEN principalideal(GEN nf, GEN x) { nf = checknf(nf); return principalideal0(nf,x,1); } static GEN mylog(GEN x, long prec) { if (gcmp0(x)) err(precer,"get_arch"); return glog(x,prec); } /* for internal use */ GEN get_arch(GEN nf,GEN x,long prec) { long i,R1,RU; GEN v,p1,p2; R1=itos(gmael(nf,2,1)); RU = R1+itos(gmael(nf,2,2)); if (typ(x)!=t_COL) x = algtobasis_intern(nf,x); v = cgetg(RU+1,t_VEC); if (isnfscalar(x)) /* rational number */ { p1 = glog((GEN)x[1],prec); p2 = (RU > R1)? gmul2n(p1,1): NULL; for (i=1; i<=R1; i++) v[i]=(long)p1; for ( ; i<=RU; i++) v[i]=(long)p2; } else { x = gmul(gmael(nf,5,1),x); for (i=1; i<=R1; i++) v[i] = (long)mylog((GEN)x[i],prec); for ( ; i<=RU; i++) v[i] = lmul2n(mylog((GEN)x[i],prec),1); } return v; } /* as above but return NULL if precision problem, and set *emb to the * embeddings of x */ GEN get_arch_real(GEN nf,GEN x,GEN *emb,long prec) { long i,R1,RU; GEN v,p1,p2; R1=itos(gmael(nf,2,1)); RU = R1+itos(gmael(nf,2,2)); if (typ(x)!=t_COL) x = algtobasis_intern(nf,x); v = cgetg(RU+1,t_COL); if (isnfscalar(x)) /* rational number */ { GEN u = (GEN)x[1]; i = signe(u); if (!i) err(talker,"0 in get_arch_real"); p1= (i > 0)? glog(u,prec): gzero; p2 = (RU > R1)? gmul2n(p1,1): NULL; for (i=1; i<=R1; i++) v[i]=(long)p1; for ( ; i<=RU; i++) v[i]=(long)p2; } else { GEN t; x = gmul(gmael(nf,5,1),x); for (i=1; i<=R1; i++) { t = gabs((GEN)x[i],prec); if (gcmp0(t)) return NULL; v[i] = llog(t,prec); } for ( ; i<=RU; i++) { t = gnorm((GEN)x[i]); if (gcmp0(t)) return NULL; v[i] = llog(t,prec); } } *emb = x; return v; } GEN principalidele(GEN nf, GEN x, long prec) { GEN p1,y = cgetg(3,t_VEC); long av; nf = checknf(nf); p1 = principalideal0(nf,x,1); y[1] = (long)p1; av =avma; p1 = get_arch(nf,(GEN)p1[1],prec); y[2] = lpileupto(av,p1); return y; } /* GP functions */ GEN ideal_two_elt0(GEN nf, GEN x, GEN a) { if (!a) return ideal_two_elt(nf,x); return ideal_two_elt2(nf,x,a); } GEN idealpow0(GEN nf, GEN x, GEN n, long flag, long prec) { if (flag) return idealpowred(nf,x,n,prec); return idealpow(nf,x,n); } GEN idealmul0(GEN nf, GEN x, GEN y, long flag, long prec) { if (flag) return idealmulred(nf,x,y,prec); return idealmul(nf,x,y); } GEN idealdiv0(GEN nf, GEN x, GEN y, long flag) { switch(flag) { case 0: return idealdiv(nf,x,y); case 1: return idealdivexact(nf,x,y); default: err(flagerr,"idealdiv"); } return NULL; /* not reached */ } GEN idealaddtoone0(GEN nf, GEN arg1, GEN arg2) { if (!arg2) return idealaddmultoone(nf,arg1); return idealaddtoone(nf,arg1,arg2); } static GEN two_to_hnf(GEN nf, GEN a, GEN b) { a = principalideal_aux(nf,a); b = principalideal_aux(nf,b); a = concatsp(a,b); if (lgef(nf[1])==5) /* quadratic field: a has to be turned into idealmat */ a = idealmul(nf,idmat(2),a); return idealmat_to_hnf(nf, a); } GEN idealhnf0(GEN nf, GEN a, GEN b) { long av; if (!b) return idealhermite(nf,a); /* HNF of aZ_K+bZ_K */ av = avma; nf=checknf(nf); return gerepileupto(av, two_to_hnf(nf,a,b)); } GEN idealhermite2(GEN nf, GEN a, GEN b) { return idealhnf0(nf,a,b); } static int ok_elt(GEN x, GEN xZ, GEN y) { ulong av = avma; int r = gegal(x, hnfmodid(y, xZ)); avma = av; return r; } static void setprec(GEN x, long prec) { long i,j, n=lg(x); for (i=1;i> TWOPOTBITS_IN_LONG); if (typ(nf[5]) != t_VEC) return x; if ((prec<<1) < nfprec) prec = (prec+nfprec) >> 1; a = qf_base_change(gmael(nf,5,3),x,1); setprec(a,prec); b = lllgramintern(a,4,1,prec); if (!b) { if (DEBUGLEVEL) err(warner, "precision too low in ideal_better_basis (1)"); if (nfprec > prec) { setprec(a,nfprec); b = lllgramintern(a,4,1,nfprec); } } if (!b) { if (DEBUGLEVEL) err(warner, "precision too low in ideal_better_basis (2)"); b = lllint(x); /* better than nothing */ } return gmul(x, b); } static GEN addmul_col(GEN a, long s, GEN b) { long i,l; if (!s) return a? dummycopy(a): a; if (!a) return gmulsg(s,b); l = lg(a); for (i=1; iN) { GEN z = cgetg(lm, t_VECSMALL); ulong av1, c = 0; setlg(mul, lm); setlg(beta,lm); if (DEBUGLEVEL>3) fprintferr("ideal_two_elt, hard case: "); for(av1=avma;;avma=av1) { if (DEBUGLEVEL>3) fprintferr("%ld ", ++c); for (a=NULL,i=1; i> (BITS_IN_RANDOM-5)) - 7; /* in [-7,8] */ z[i] = t; a = addmul_mat(a, t, (GEN)mul[i]); } /* a = matrix (NOT HNF) of ideal generated by beta.z in O/xZ */ if (a && ok_elt(x,xZ, a)) break; } for (a=NULL,i=1; i3) fprintferr("\n"); } a = centermod(a, xZ); tetpil=avma; y[1] = lmul(xZ,cx); y[2] = lmul(a, cx); gerepilemanyvec(av,tetpil,y+1,2); return y; } /* Etant donne un ideal ix, ressort un vecteur [a,alpha] a deux composantes * tel que a soit rationnel et ix=aZ_K+alpha Z_K, alpha etant un vecteur * colonne sur la base d'entiers. On peut avoir a=0 ou alpha=0, mais on ne * cherche pas a determiner si ix est principal. */ GEN ideal_two_elt(GEN nf, GEN x) { GEN z; long N, tx = idealtyp(&x,&z); nf=checknf(nf); if (tx==id_MAT) return mat_ideal_two_elt(nf,x); N=degpol(nf[1]); z=cgetg(3,t_VEC); if (tx == id_PRINCIPAL) { switch(typ(x)) { case t_INT: case t_FRAC: case t_FRACN: z[1]=lcopy(x); z[2]=(long)zerocol(N); return z; case t_POLMOD: x = checknfelt_mod(nf, x, "ideal_two_elt"); /* fall through */ case t_POL: z[1]=zero; z[2]=(long)algtobasis(nf,x); return z; case t_COL: if (lg(x)==N+1) { z[1]=zero; z[2]=lcopy(x); return z; } } } else if (tx == id_PRIME) { z[1]=lcopy((GEN)x[1]); z[2]=lcopy((GEN)x[2]); return z; } err(typeer,"ideal_two_elt"); return NULL; /* not reached */ } /* factorization */ /* x integral ideal in HNF, return v_p(Nx), *vz = v_p(x \cap Z) * Use x[i,i] | x[1,1], i > 0 */ long val_norm(GEN x, GEN p, long *vz) { long i,l = lg(x), v; *vz = v = pvaluation(gcoeff(x,1,1), p, NULL); if (!v) return 0; for (i=2; i v_P <= e * v_p */ j = k * e; v = min(i,j); /* v_P(ix) <= v */ vd = ggval(cx,p) * e; if (!v) { avma = av; return vd; } mul = cgetg(N+1,t_MAT); bp=(GEN)P[5]; mat = cgetg(N+1,t_MAT); for (j=1; j<=N; j++) { mul[j] = (long)element_mulid(nf,bp,j); x = (GEN)ix[j]; y = cgetg(N+1, t_COL); mat[j] = (long)y; for (i=1; i<=N; i++) { /* compute (x.b)_i, ix in HNF ==> x[j+1..N] = 0 */ a = mulii((GEN)x[1], gcoeff(mul,i,1)); for (k=2; k<=j; k++) a = addii(a, mulii((GEN)x[k], gcoeff(mul,i,k))); /* is it divisible by p ? */ y[i] = ldvmdii(a,p,&r); if (signe(r)) { avma = av; return vd; } } } pk = gpowgs(p, v-1); av1 = avma; lim=stack_lim(av1,3); y = cgetg(N+1,t_COL); /* can compute mod p^(v-w) */ for (w=1; w lgefint(pk)) y[i] = lresii((GEN)y[i], pk); } r=x; mat[j]=(long)y; y=r; if (low_stack(lim,stack_lim(av1,3))) { GEN *gptr[3]; gptr[0]=&y; gptr[1]=&mat; gptr[2]=&pk; if(DEBUGMEM>1) err(warnmem,"idealval"); gerepilemany(av1,gptr,3); } } pk = gdivexact(pk,p); } avma = av; return w + vd; } /* gcd and generalized Bezout */ GEN idealadd(GEN nf, GEN x, GEN y) { long av=avma,N,tx,ty; GEN z,p1,dx,dy,dz; int modid; tx = idealtyp(&x,&z); ty = idealtyp(&y,&z); nf=checknf(nf); N=degpol(nf[1]); z = cgetg(N+1, t_MAT); if (tx != id_MAT || lg(x)!=N+1) x = idealhermite_aux(nf,x); if (ty != id_MAT || lg(y)!=N+1) y = idealhermite_aux(nf,y); if (lg(x) == 1) return gerepileupto(av,y); if (lg(y) == 1) return gerepileupto(av,x); /* check for 0 ideal */ dx=denom(x); dy=denom(y); dz=mulii(dx,dy); if (gcmp1(dz)) dz = NULL; else { x=gmul(x,dz); y=gmul(y,dz); } if (isnfscalar((GEN)x[1]) && isnfscalar((GEN)y[1])) { p1 = mppgcd(gcoeff(x,1,1),gcoeff(y,1,1)); modid = 1; } else { p1 = mppgcd(detint(x),detint(y)); modid = 0; } if (gcmp1(p1)) { long i,j; if (!dz) { avma=av; return idmat(N); } avma = (long)dz; dz = gerepileupto((long)z, ginv(dz)); for (i=1; i<=N; i++) { z[i]=lgetg(N+1,t_COL); for (j=1; j<=N; j++) coeff(z,j,i) = (i==j)? (long)dz: zero; } return z; } z = concatsp(x,y); z = modid? hnfmodid(z,p1): hnfmod(z, p1); if (dz) z=gdiv(z,dz); return gerepileupto(av,z); } static GEN get_p1(GEN nf, GEN x, GEN y,long fl) { GEN u,v,v1,v2,v3,v4; long i,j,N; switch(fl) { case 1: v1 = gcoeff(x,1,1); v2 = gcoeff(y,1,1); if (typ(v1)!=t_INT || typ(v2)!=t_INT) err(talker,"ideals don't sum to Z_K in idealaddtoone"); if (gcmp1(bezout(v1,v2,&u,&v))) return gmul(u,(GEN)x[1]); default: v=hnfperm(concatsp(x,y)); v1=(GEN)v[1]; v2=(GEN)v[2]; v3=(GEN)v[3]; j=0; N = degpol(nf[1]); for (i=1; i<=N; i++) { if (!gcmp1(gcoeff(v1,i,i))) err(talker,"ideals don't sum to Z_K in idealaddtoone"); if (gcmp1((GEN)v3[i])) j=i; } v4=(GEN)v2[N+j]; setlg(v4,N+1); return gmul(x,v4); } } GEN idealaddtoone_i(GEN nf, GEN x, GEN y) { long t, fl = 1; GEN p1,xh,yh; if (DEBUGLEVEL>4) { fprintferr(" entering idealaddtoone:\n"); fprintferr(" x = %Z\n",x); fprintferr(" y = %Z\n",y); } t = idealtyp(&x,&p1); if (t != id_MAT || lg(x) > 1 || lg(x) != lg(x[1])) xh = idealhermite_aux(nf,x); else { xh=x; fl = isnfscalar((GEN)x[1]); } t = idealtyp(&y,&p1); if (t != id_MAT || lg(y) == 1 || lg(y) != lg(y[1])) yh = idealhermite_aux(nf,y); else { yh=y; if (fl) fl = isnfscalar((GEN)y[1]); } if (lg(xh) == 1) { if (lg(yh) == 1 || !gcmp1(gabs(gcoeff(yh,1,1),0))) err(talker,"ideals don't sum to Z_K in idealaddtoone"); return algtobasis(nf, gzero); } if (lg(yh) == 1) { p1 = gcoeff(xh,1,1); if (!gcmp1(gabs(p1,0))) err(talker,"ideals don't sum to Z_K in idealaddtoone"); return algtobasis(nf, gneg(p1)); } p1 = get_p1(nf,xh,yh,fl); p1 = element_reduce(nf,p1, idealmullll(nf,x,y)); if (DEBUGLEVEL>4 && !gcmp0(p1)) fprintferr(" leaving idealaddtoone: %Z\n",p1); return p1; } /* ideal should be an idele (not mandatory). For internal use. */ GEN ideleaddone_aux(GEN nf,GEN x,GEN ideal) { long i,nba,R1; GEN p1,p2,p3,arch; (void)idealtyp(&ideal,&arch); if (!arch) return idealaddtoone_i(nf,x,ideal); R1=itos(gmael(nf,2,1)); if (typ(arch)!=t_VEC && lg(arch)!=R1+1) err(talker,"incorrect idele in idealaddtoone"); for (nba=0,i=1; i4) { fprintferr(" entree dans element_invmodideal() :\n"); fprintferr(" x = "); outerr(x); fprintferr(" y = "); outerr(y); } i = lg(y); if (typ(y)!=t_MAT || i==1 || i != lg(y[1])) yh=idealhermite_aux(nf,y); else { yh=y; fl = isnfscalar((GEN)y[1]); } switch (typ(x)) { case t_POL: case t_POLMOD: case t_COL: xh = idealhermite_aux(nf,x); break; default: err(typeer,"element_invmodideal"); return NULL; /* not reached */ } p1 = get_p1(nf,xh,yh,fl); p1 = element_div(nf,p1,x); v = gerepileupto(av, nfreducemodideal(nf,p1,y)); if (DEBUGLEVEL>2) { fprintferr(" sortie de element_invmodideal : v = "); outerr(v); } return v; } GEN idealaddmultoone(GEN nf, GEN list) { long av=avma,tetpil,N,i,i1,j,k; GEN z,v,v1,v2,v3,p1; nf=checknf(nf); N=degpol(nf[1]); if (DEBUGLEVEL>4) { fprintferr(" entree dans idealaddmultoone() :\n"); fprintferr(" list = "); outerr(list); } if (typ(list)!=t_VEC && typ(list)!=t_COL) err(talker,"not a list in idealaddmultoone"); k=lg(list); z=cgetg(1,t_MAT); list = dummycopy(list); if (k==1) err(talker,"ideals don't sum to Z_K in idealaddmultoone"); for (i=1; i2) { fprintferr(" sortie de idealaddmultoone v = "); outerr(v); } return gerepile(av,tetpil,v); } /* multiplication */ /* x integral ideal (without archimedean component) in HNF form * [a,alpha,n] corresponds to the ideal aZ_K+alpha Z_K (a is a * rational integer). Multiply them */ static GEN idealmulspec(GEN nf, GEN x, GEN a, GEN alpha) { long i, N=lg(x)-1; GEN m, mod; if (isnfscalar(alpha)) return gmul(mppgcd(a,(GEN)alpha[1]),x); mod = mulii(a, gcoeff(x,1,1)); m = cgetg((N<<1)+1,t_MAT); for (i=1; i<=N; i++) m[i]=(long)element_muli(nf,alpha,(GEN)x[i]); for (i=1; i<=N; i++) m[i+N]=lmul(a,(GEN)x[i]); return hnfmodid(m,mod); } /* x ideal (matrix form,maximal rank), vp prime ideal (primedec). Output the * product. Can be used for arbitrary vp of the form [p,a,e,f,b], IF vp * =pZ_K+aZ_K, p is an integer, and norm(vp) = p^f; e and b are not used. * For internal use. */ GEN idealmulprime(GEN nf, GEN x, GEN vp) { GEN denx = denom(x); if (gcmp1(denx)) denx = NULL; else x = gmul(denx,x); x = idealmulspec(nf,x, (GEN)vp[1], (GEN)vp[2]); return denx? gdiv(x,denx): x; } /* Assume ix and iy are integral in HNF form (or ideles of the same form). * HACK: ideal in iy can be of the form [a,b], a in Z, b in Z_K * For internal use. */ GEN idealmulh(GEN nf, GEN ix, GEN iy) { long f = 0; GEN res,x,y; if (typ(ix)==t_VEC) {f=1; x=(GEN)ix[1];} else x=ix; if (typ(iy)==t_VEC && typ(iy[1]) != t_INT) {f+=2; y=(GEN)iy[1];} else y=iy; res = f? cgetg(3,t_VEC): NULL; if (typ(y) != t_VEC) y = ideal_two_elt(nf,y); y = idealmulspec(nf,x,(GEN)y[1],(GEN)y[2]); if (!f) return y; res[1]=(long)y; if (f==3) y = gadd((GEN)ix[2],(GEN)iy[2]); else { y = (f==2)? (GEN)iy[2]: (GEN)ix[2]; y = gcopy(y); } res[2]=(long)y; return res; } /* x and y are ideals in matrix form */ static GEN idealmat_mul(GEN nf, GEN x, GEN y) { long i,j, rx=lg(x)-1, ry=lg(y)-1; GEN dx,dy,m; dx=denom(x); if (!gcmp1(dx)) x=gmul(dx,x); dy=denom(y); if (!gcmp1(dy)) y=gmul(dy,y); dx = mulii(dx,dy); if (rx<=2 || ry<=2) { m=cgetg(rx*ry+1,t_MAT); for (i=1; i<=rx; i++) for (j=1; j<=ry; j++) m[(i-1)*ry+j]=(long)element_muli(nf,(GEN)x[i],(GEN)y[j]); if (isnfscalar((GEN)x[1]) && isnfscalar((GEN)y[1])) { GEN p1 = mulii(gcoeff(x,1,1),gcoeff(y,1,1)); y = hnfmodid(m, p1); } else y=hnfmod(m, detint(m)); } else { x=idealmat_to_hnf(nf,x); y=idealmat_to_hnf(nf,y); y=idealmulh(nf,x,y); } return gcmp1(dx)? y: gdiv(y,dx); } #if 0 /* y is principal */ static GEN add_arch(GEN nf, GEN ax, GEN y) { long tetpil, av=avma, prec=precision(ax); y = get_arch(nf,y,prec); tetpil=avma; return gerepile(av,tetpil,gadd(ax,y)); } #endif /* add x^1 to factorisation f */ static GEN famat_add(GEN f, GEN x) { GEN t,h = cgetg(3,t_MAT); if (lg(f) == 1) { t=cgetg(2,t_COL); h[1]=(long)t; t[1]=lcopy(x); t=cgetg(2,t_COL); h[2]=(long)t; t[1]=un; } else { h[1] = (long)concat((GEN)f[1], x); h[2] = (long)concat((GEN)f[2], gun); } return h; } /* cf merge_factor_i */ static GEN famat_mul(GEN f, GEN g) { GEN h; if (typ(g) != t_MAT) return famat_add(f, g); if (lg(f) == 1) return gcopy(g); if (lg(g) == 1) return gcopy(f); h = cgetg(3,t_MAT); h[1] = (long)concat((GEN)f[1], (GEN)g[1]); h[2] = (long)concat((GEN)f[2], (GEN)g[2]); return h; } static GEN famat_sqr(GEN f) { GEN h; if (lg(f) == 1) return cgetg(1,t_MAT); h = cgetg(3,t_MAT); h[1] = lcopy((GEN)f[1]); h[2] = lmul2n((GEN)f[2],1); return h; } static GEN famat_inv(GEN f) { GEN h; if (lg(f) == 1) return cgetg(1,t_MAT); h = cgetg(3,t_MAT); h[1] = lcopy((GEN)f[1]); h[2] = lneg((GEN)f[2]); return h; } static GEN famat_pow(GEN f, GEN n) { GEN h; if (lg(f) == 1) return cgetg(1,t_MAT); h = cgetg(3,t_MAT); h[1] = lcopy((GEN)f[1]); h[2] = lmul((GEN)f[2],n); return h; } GEN famat_to_nf(GEN nf, GEN f) { GEN t, *x, *e; long i; if (lg(f) == 1) return gun; x = (GEN*)f[1]; e = (GEN*)f[2]; t = element_pow(nf, x[1], e[1]); for (i=lg(x)-1; i>1; i--) t = element_mul(nf, t, element_pow(nf, x[i], e[i])); return t; } GEN to_famat(GEN g, GEN e) { GEN h = cgetg(3,t_MAT); h[1] = (long)g; h[2] = (long)e; return h; } GEN to_famat_all(GEN x, GEN y) { return to_famat(_col(x), _col(y)); } /* assume (num(g[i]), id) = 1 and for all i. return prod g[i]^e[i] mod id */ GEN famat_to_nf_modideal_coprime(GEN nf, GEN g, GEN e, GEN id) { GEN t = NULL, ch,h,n,z,idZ = gcoeff(id,1,1); long i, lx = lg(g); if (is_pm1(idZ)) lx = 1; /* id = Z_K */ for (i=1; i x * (b/p)^v_pr(x) / z^k u, where z = b^e/p^(e-1) * b/p = vp^(-1) times something prime to p; both numerator and denominator * are integral and coprime to pr. Globally, we multiply by (b/p)^v_pr(t) = 1. * * EX = exponent of (O_K / pr^k)^* used to reduce the product in case the * e[i] are large */ static GEN famat_makecoprime(GEN nf, GEN g, GEN e, GEN pr, GEN prn, GEN EX) { long i,k, l = lg(g), N = degpol(nf[1]); GEN prnZ,cx,x,u,z, zpow = gzero, p = (GEN)pr[1], b = (GEN)pr[5]; GEN mul = cgetg(N+1,t_MAT); GEN newg = cgetg(l+1, t_VEC); /* room for z */ prnZ = gcoeff(prn, 1,1); z = gmod(special_anti_uniformizer(nf, pr), prnZ); for (i=1; i<=N; i++) mul[i] = (long)element_mulid(nf,b,i); for (i=1; i < l; i++) { x = (GEN)g[i]; if (typ(x) != t_COL) x = algtobasis(nf, x); cx = denom(x); x = gmul(x,cx); k = pvaluation(cx, p, &u); if (!gcmp1(u)) /* could avoid the inversion, but prnZ is small--> cheap */ x = gmul(x, mpinvmod(u, prnZ)); if (k) zpow = addii(zpow, mulsi(k, (GEN)e[i])); (void)int_elt_val(nf, x, p, mul, &x, VERYBIGINT); newg[i] = (long)colreducemodmat(x, prn, NULL); } if (zpow == gzero) setlg(newg, l); else { newg[i] = (long)z; e = concatsp(e, negi(zpow)); } e = gmod(e, EX); return famat_to_nf_modideal_coprime(nf, newg, e, prn); } GEN famat_ideallog(GEN nf, GEN g, GEN e, GEN bid) { ulong av = avma; GEN vp = gmael(bid, 3,1), ep = gmael(bid, 3,2), arch = gmael(bid,1,2); GEN cyc = gmael(bid,2,2), list_set = (GEN)bid[4], U = (GEN)bid[5]; GEN p1,y0,x,y, psigne; long i; if (lg(cyc) == 1) return cgetg(1,t_COL); y0 = y = cgetg(lg(U), t_COL); psigne = zsigne(nf, to_famat(g,e), arch); for (i=1; ity) { res=ax; ax=ay; ay=res; res=x; x=y; y=res; f=tx; tx=ty; ty=f; } f = (ax||ay); res = f? cgetg(3,t_VEC): NULL; /* product is an idele */ nf=checknf(nf); av=avma; switch(tx) { case id_PRINCIPAL: switch(ty) { case id_PRINCIPAL: p1 = idealhermite_aux(nf, element_mul(nf,x,y)); break; case id_PRIME: p1 = gmul((GEN)y[1],x); p1 = two_to_hnf(nf,p1, element_mul(nf,(GEN)y[2],x)); break; default: /* id_MAT */ p1 = idealmat_mul(nf,y, principalideal_aux(nf,x)); }break; case id_PRIME: p1 = (ty==id_PRIME)? prime_to_ideal_aux(nf,y) : idealmat_to_hnf(nf,y); p1 = idealmulprime(nf,p1,x); break; default: /* id_MAT */ p1 = idealmat_mul(nf,x,y); } p1 = gerepileupto(av,p1); if (!f) return p1; if (ax && ay) ax = arch_mul(ax, ay); else ax = gcopy(ax? ax: ay); res[1]=(long)p1; res[2]=(long)ax; return res; } /* norm of an ideal */ GEN idealnorm(GEN nf, GEN x) { long av = avma,tetpil; GEN y; nf = checknf(nf); switch(idealtyp(&x,&y)) { case id_PRIME: return powgi((GEN)x[1],(GEN)x[4]); case id_PRINCIPAL: x = gnorm(basistoalg(nf,x)); break; default: if (lg(x) != lgef(nf[1])-2) x = idealhermite_aux(nf,x); x = dethnf(x); } tetpil=avma; return gerepile(av,tetpil,gabs(x,0)); } /* inverse */ extern GEN gauss_triangle_i(GEN A, GEN B,GEN t); /* rewritten from original code by P.M & M.H. * * I^(-1) = { x \in K, Tr(x D^(-1) I) \in Z }, D different of K/Q * * nf[5][6] = d_K * D^(-1) is integral = d_K T^(-1), T = (Tr(wi wj)) * nf[5][7] = same in 2-elt form */ static GEN hnfideal_inv(GEN nf, GEN I) { GEN J, dI = denom(I), IZ,dual; if (gcmp1(dI)) dI = NULL; else I = gmul(I,dI); if (lg(I)==1) err(talker, "cannot invert zero ideal"); IZ = gcoeff(I,1,1); /* I \cap Z */ if (!signe(IZ)) err(talker, "cannot invert zero ideal"); J = idealmulh(nf,I, gmael(nf,5,7)); /* I in HNF, hence easily inverted; multiply by IZ to get integer coeffs * d_K cancels while solving the linear equations. */ dual = gtrans( gauss_triangle_i(J, gmael(nf,5,6), IZ) ); dual = hnfmodid(dual, IZ); if (dI) IZ = gdiv(IZ,dI); return gdiv(dual,IZ); } /* return p * P^(-1) [integral] */ GEN pidealprimeinv(GEN nf, GEN x) { GEN y=cgetg(6,t_VEC); y[1]=x[1]; y[2]=x[5]; y[3]=y[5]=zero; y[4]=lsubsi(degpol(nf[1]), (GEN)x[4]); return prime_to_ideal_aux(nf,y); } /* Calcule le dual de mat_id pour la forme trace */ GEN idealinv(GEN nf, GEN x) { GEN res,ax; long av=avma, tx = idealtyp(&x,&ax); res = ax? cgetg(3,t_VEC): NULL; nf=checknf(nf); av=avma; switch (tx) { case id_MAT: if (lg(x) != lg(x[1])) x = idealmat_to_hnf(nf,x); if (lg(x)-1 != degpol(nf[1])) err(consister,"idealinv"); x = hnfideal_inv(nf,x); break; case id_PRINCIPAL: tx = typ(x); if (is_const_t(tx)) x = ginv(x); else { switch(tx) { case t_COL: x = gmul((GEN)nf[7],x); break; case t_POLMOD: x = (GEN)x[2]; break; } x = ginvmod(x,(GEN)nf[1]); } x = idealhermite_aux(nf,x); break; case id_PRIME: x = gdiv(pidealprimeinv(nf,x), (GEN)x[1]); } x = gerepileupto(av,x); if (!ax) return x; res[1]=(long)x; res[2]=(long)arch_inv(ax); return res; } /* return x such that vp^n = x/d */ static GEN idealpowprime_spec(GEN nf, GEN vp, GEN n, GEN *d) { GEN n1, x, r; long s = signe(n); if (s == 0) err(talker, "0th power in idealpowprime_spec"); if (s < 0) n = negi(n); /* now n > 0 */ x = dummycopy(vp); n1 = dvmdii(n, (GEN)x[3], &r); if (signe(r)) n1 = addis(n1,1); /* n1 = ceil(n/e) */ x[1] = (long)powgi((GEN)x[1],n1); if (s < 0) { x[2] = ldiv(element_pow(nf,(GEN)x[5],n), powgi((GEN)vp[1],subii(n,n1))); *d = (GEN)x[1]; } else { x[2] = (long)element_pow(nf,(GEN)x[2],n); *d = NULL; } return x; } static GEN idealpowprime(GEN nf, GEN vp, GEN n) { GEN x, d; long s = signe(n); nf = checknf(nf); if (s == 0) return idmat(degpol(nf[1])); x = idealpowprime_spec(nf, vp, n, &d); x = prime_to_ideal_aux(nf,x); if (d) x = gdiv(x, d); return x; } /* x * vp^n */ GEN idealmulpowprime(GEN nf, GEN x, GEN vp, GEN n) { GEN denx,y,d; if (!signe(n)) return x; nf = checknf(nf); y = idealpowprime_spec(nf, vp, n, &d); denx = denom(x); if (gcmp1(denx)) denx = d; else { x = gmul(denx,x); if (d) denx = mulii(d,denx); } x = idealmulspec(nf,x, (GEN)y[1], (GEN)y[2]); return denx? gdiv(x,denx): x; } /* raise the ideal x to the power n (in Z) */ GEN idealpow(GEN nf, GEN x, GEN n) { long tx,N,av,s,i; GEN res,ax,m,cx,n1,a,alpha; if (typ(n) != t_INT) err(talker,"non-integral exponent in idealpow"); tx = idealtyp(&x,&ax); res = ax? cgetg(3,t_VEC): NULL; nf = checknf(nf); av=avma; N=degpol(nf[1]); s=signe(n); if (!s) x = idmat(N); else switch(tx) { case id_PRINCIPAL: tx = typ(x); if (!is_const_t(tx)) switch(tx) { case t_COL: x = gmul((GEN)nf[7],x); case t_POL: x = gmodulcp(x,(GEN)nf[1]); } x = powgi(x,n); x = idealhermite_aux(nf,x); break; case id_PRIME: x = idealpowprime(nf,x,n); break; default: n1 = (s<0)? negi(n): n; cx = content(x); if (gcmp1(cx)) cx = NULL; else x = gdiv(x,cx); a=ideal_two_elt(nf,x); alpha=(GEN)a[2]; a=(GEN)a[1]; m = cgetg(N+1,t_MAT); a = powgi(a,n1); alpha = element_pow(nf,alpha,n1); for (i=1; i<=N; i++) m[i]=(long)element_mulid(nf,alpha,i); x = hnfmodid(m, a); if (s<0) x = hnfideal_inv(nf,x); if (cx) x = gmul(x, powgi(cx,n)); } x = gerepileupto(av, x); if (!ax) return x; ax = arch_pow(ax, n); res[1]=(long)x; res[2]=(long)ax; return res; } /* Return ideal^e in number field nf. e is a C integer. */ GEN idealpows(GEN nf, GEN ideal, long e) { long court[] = {evaltyp(t_INT) | m_evallg(3),0,0}; affsi(e,court); return idealpow(nf,ideal,court); } GEN init_idele(GEN nf) { GEN x = cgetg(3,t_VEC); long RU; nf = checknf(nf); RU = lg(nf[6])-1; x[2] = (long)zerovec(RU); return x; } /* compute x^n (x ideal, n integer), reducing along the way */ GEN idealpowred(GEN nf, GEN x, GEN n, long prec) { long i,j,m,av=avma, s = signe(n); GEN y, p1; if (typ(n) != t_INT) err(talker,"non-integral exponent in idealpowred"); if (signe(n) == 0) return idealpow(nf,x,n); p1 = n+2; m = *p1; y = x; j=1+bfffo(m); m<<=j; j = BITS_IN_LONG-j; for (i=lgefint(n)-2;;) { for (; j; m<<=1,j--) { y = idealmul(nf,y,y); if (m < 0) y = idealmul(nf,y,x); y = ideallllred(nf,y,NULL,prec); } if (--i == 0) break; m = *++p1; j = BITS_IN_LONG; } if (s < 0) y = idealinv(nf,y); if (y == x) y = ideallllred(nf,x,NULL,prec); return gerepileupto(av,y); } GEN idealmulred(GEN nf, GEN x, GEN y, long prec) { long av=avma; x = idealmul(nf,x,y); return gerepileupto(av, ideallllred(nf,x,NULL,prec)); } long isideal(GEN nf,GEN x) { long N,av,i,j,k,tx=typ(x),lx; GEN p1,minv; nf=checknf(nf); lx=lg(x); if (tx==t_VEC && lx==3) { x=(GEN)x[1]; tx=typ(x); lx=lg(x); } if (is_scalar_t(tx)) return (tx==t_INT || tx==t_FRAC || tx==t_FRACN || tx==t_POL || (tx==t_POLMOD && gegal((GEN)nf[1],(GEN)x[1]))); if (typ(x)==t_VEC) return (lx==6); if (typ(x)!=t_MAT) return 0; if (lx == 1) return 1; N=lgef(nf[1])-2; if (lg(x[1]) != N) return 0; av=avma; if (lx != N) x = idealmat_to_hnf(nf,x); x = gdiv(x,content(x)); minv=ginv(x); for (i=1; i= v_p(x). * Hence v_p (x + Nx/Nz) = v_p(x). Likewise for the denominators. QED. * * Peter Montgomery. July, 1994. */ GEN idealdivexact(GEN nf, GEN x0, GEN y0) { ulong av = avma; GEN x,y,Nx,Ny,Nz, cy = content(y0); nf = checknf(nf); if (gcmp0(cy)) err(talker, "cannot invert zero ideal"); x = gdiv(x0,cy); Nx = idealnorm(nf,x); if (gcmp0(Nx)) { avma = av; return gcopy(x0); } /* numerator is zero */ y = gdiv(y0,cy); Ny = idealnorm(nf,y); if (!gcmp1(denom(x)) || !divise(Nx,Ny)) err(talker, "quotient not integral in idealdivexact"); /* Find a norm Nz | Ny such that gcd(Nx/Nz, Nz) = 1 */ for (Nz = Ny;;) { GEN p1 = mppgcd(Nz, divii(Nx,Nz)); if (is_pm1(p1)) break; Nz = divii(Nz,p1); } /* Replace x/y by x+(Nx/Nz) / y+(Ny/Nz) */ x = idealhermite_aux(nf, x); x = hnfmodid(x, divii(Nx,Nz)); /* y reduced to unit ideal ? */ if (Nz == Ny) return gerepileupto(av, x); y = idealhermite_aux(nf, y); y = hnfmodid(y, divii(Ny,Nz)); y = hnfideal_inv(nf,y); return gerepileupto(av, idealmat_mul(nf,x,y)); } GEN idealintersect(GEN nf, GEN x, GEN y) { long av=avma,lz,i,N; GEN z,dx,dy; nf=checknf(nf); N=degpol(nf[1]); if (idealtyp(&x,&z)!=t_MAT || lg(x)!=N+1) x=idealhermite_aux(nf,x); if (idealtyp(&y,&z)!=t_MAT || lg(y)!=N+1) y=idealhermite_aux(nf,y); if (lg(x) == 1 || lg(y) == 1) { avma = av; return cgetg(1, t_MAT); } dx=denom(x); if (!gcmp1(dx)) y = gmul(y,dx); dy=denom(y); if (!gcmp1(dy)) { x = gmul(x,dy); dx = mulii(dx,dy); } z = kerint(concatsp(x,y)); lz=lg(z); for (i=1; i>TWOPOTBITS_IN_LONG); if (e < 0) e = 0; u = lllgramintern(y,100,1, e + prec); if (u) break; if (i == MAXITERPOL) err(accurer,"ideallllred"); prec = (prec<<1)-2; if (DEBUGLEVEL) err(warnprec,"ideallllred",prec); nf = nfnewprec(nf, (e>>1)+prec); } *ptprec = prec; *ptnf = nf; return gmul(I, (GEN)u[1]); /* small elt in I */ } GEN ideallllred_elt(GEN nf, GEN I) { long prec = DEFAULTPREC; return ideallllred_elt_i(&nf, I, NULL, &prec); } GEN ideallllred(GEN nf, GEN I, GEN vdir, long prec) { ulong av = avma; long N,i,nfprec; GEN J,I0,Ired,res,aI,y,x,Nx,b,c1,c,pol; nf = checknf(nf); nfprec = nfgetprec(nf); if (prec <= 0) prec = nfprec; pol = (GEN)nf[1]; N = degpol(pol); Nx = x = c = c1 = NULL; if (idealtyp(&I,&aI) == id_PRINCIPAL) { if (gcmp0(I)) { y=gun; I=cgetg(1,t_MAT); } else { y=I; I=idmat(N); } goto END; } if (DEBUGLEVEL>5) msgtimer("entering idealllred"); I0 = I; if (typ(I) != id_MAT || lg(I) != N+1) I = idealhermite_aux(nf,I); c1 = content(I); if (gcmp1(c1)) c1 = NULL; else I = gdiv(I,c1); if (2 * expi(gcoeff(I,1,1)) >= bit_accuracy(nfprec)) Ired = gmul(I, lllintpartial(I)); else Ired = I; y = ideallllred_elt_i(&nf, Ired, chk_vdir(nf,vdir), &prec); if (isnfscalar(y)) { /* already reduced */ if (!aI) I = gcopy(I); y = NULL; goto END; } if (DEBUGLEVEL>5) msgtimer("LLL reduction"); x = gmul((GEN)nf[7], y); Nx = subres(pol,x); b = gmul(Nx, ginvmod(x,pol)); b = algtobasis_intern(nf,b); J = cgetg(N+1,t_MAT); /* = I Nx / x integral */ for (i=1; i<=N; i++) J[i] = (long)element_muli(nf,b,(GEN)Ired[i]); c = content(J); if (!gcmp1(c)) J = gdiv(J,c); /* c = content (I Nx / x) = Nx / den(I/x) --> d = den(I/x) = Nx / c * J = (d I / x); I[1,1] = I \cap Z --> d I[1,1] belongs to J and Z */ if (isnfscalar((GEN)I[1])) b = mulii(gcoeff(I,1,1), divii(Nx, c)); else b = detint(J); I = hnfmodid(J,b); if (DEBUGLEVEL>5) msgtimer("new ideal"); END: if (!aI) return gerepileupto(av, I); switch(typ(aI)) { case t_POLMOD: case t_MAT: /* compute y, I0 = J y */ if (!Nx) y = c1; else { if (c1) c = gmul(c,c1); y = gmul(x, gdiv(c,Nx)); } break; case t_COL: if (y) y = vecinv(gmul(gmael(nf,5,1), y)); break; default: if (y) y = gneg_i(get_arch(nf,y,prec)); break; } if (y) aI = arch_mul(aI,y); res = cgetg(3,t_VEC); res[1] = (long)I; res[2] = (long)aI; return gerepilecopy(av, res); } GEN minideal(GEN nf, GEN x, GEN vdir, long prec) { long av = avma, N, tx; GEN p1,y; nf = checknf(nf); vdir = chk_vdir(nf,vdir); N = degpol(nf[1]); tx = idealtyp(&x,&y); if (tx == id_PRINCIPAL) return gcopy(x); if (tx != id_MAT || lg(x) != N+1) x = idealhermite_aux(nf,x); p1 = computet2twist(nf,vdir); y = qf_base_change(p1,x,0); y = gmul(x, (GEN)lllgram(y,prec)[1]); return gerepileupto(av, principalidele(nf,y,prec)); } static GEN appr_reduce(GEN s, GEN y, long N) { GEN p1,u,z = cgetg(N+2,t_MAT); long i; s=gmod(s,gcoeff(y,1,1)); y=gmul(y,lllint(y)); for (i=1; i<=N; i++) z[i]=y[i]; z[N+1]=(long)s; u=(GEN)ker(z)[1]; p1 = denom(u); if (!gcmp1(p1)) u=gmul(u,p1); p1=(GEN)u[N+1]; setlg(u,N+1); for (i=1; i<=N; i++) u[i]=lround(gdiv((GEN)u[i],p1)); return gadd(s, gmul(y,u)); } /* Given a fractional ideal x (if fl=0) or a prime ideal factorization * with possibly zero or negative exponents (if fl=1), gives a b such that * v_p(b)=v_p(x) for all prime ideals p dividing x (or in the factorization) * and v_p(b)>=0 for all other p, using the (standard) proof given in GTM 138. * Certainly not the most efficient, but sure. */ GEN idealappr0(GEN nf, GEN x, long fl) { long av=avma,tetpil,i,j,k,l,N,r,r2; GEN fact,fact2,list,ep,ep1,ep2,y,z,v,p1,p2,p3,p4,s,pr,alpha,beta,den; if (DEBUGLEVEL>4) { fprintferr(" entree dans idealappr0() :\n"); fprintferr(" x = "); outerr(x); } nf=checknf(nf); N=degpol(nf[1]); if (fl) { if (typ(x)!=t_MAT || lg(x)!=3) err(talker,"not a prime ideal factorization in idealappr0"); fact=x; list=(GEN)fact[1]; ep=(GEN)fact[2]; r=lg(list); if (r==1) return gscalcol_i(gun,N); for (i=1; i=0)? zero: lnegi((GEN)ep[i]); fact[2]=(long)ep1; beta=idealappr0(nf,fact,1); fact2=idealfactor(nf,beta); p1=(GEN)fact2[1]; r2=lg(p1); ep2=(GEN)fact2[2]; l=r+r2-1; z=cgetg(l,t_VEC); for (i=1; i2) { fprintferr(" alpha = "); outerr(alpha); fprintferr(" beta = "); outerr(beta); } return gerepile(av,tetpil,element_div(nf,alpha,beta)); } y=idmat(N); for (i=1; i2) { fprintferr(" alpha = "); outerr(alpha); } tetpil=avma; return gerepile(av,tetpil,gdiv(alpha,den)); } y=x; for (i=1; i2) { fprintferr(" sortie de idealappr0 p3 = "); outerr(p3); } return gerepileupto(av,p3); } /* Given a prime ideal factorization x with possibly zero or negative exponents, * and a vector y of elements of nf, gives a b such that * v_p(b-y_p)>=v_p(x) for all prime ideals p in the ideal factorization * and v_p(b)>=0 for all other p, using the (standard) proof given in GTM 138. * Certainly not the most efficient, but sure. */ GEN idealchinese(GEN nf, GEN x, GEN y) { long ty=typ(y),av=avma,i,j,k,l,N,r,r2; GEN fact,fact2,list,ep,ep1,ep2,z,t,v,p1,p2,p3,p4,s,pr,den; if (DEBUGLEVEL>4) { fprintferr(" entree dans idealchinese() :\n"); fprintferr(" x = "); outerr(x); fprintferr(" y = "); outerr(y); } nf=checknf(nf); N=degpol(nf[1]); if (typ(x)!=t_MAT ||(lg(x)!=3)) err(talker,"not a prime ideal factorization in idealchinese"); fact=x; list=(GEN)fact[1]; ep=(GEN)fact[2]; r=lg(list); if (!is_vec_t(ty) || lg(y)!=r) err(talker,"not a suitable vector of elements in idealchinese"); if (r==1) return gscalcol_i(gun,N); den=denom(y); if (!gcmp1(den)) { fact2=idealfactor(nf,den); p1=(GEN)fact2[1]; r2=lg(p1); ep2=(GEN)fact2[2]; l=r+r2-1; z=cgetg(l,t_VEC); for (i=1; i2) { fprintferr(" sortie de idealchinese() : p3 = "); outerr(p3); } return gerepileupto(av,p3); } GEN idealappr(GEN nf, GEN x) { return idealappr0(nf,x,0); } GEN idealapprfact(GEN nf, GEN x) { return idealappr0(nf,x,1); } /* Given an integral ideal x and a in x, gives a b such that * x=aZ_K+bZ_K using a different algorithm than ideal_two_elt */ GEN ideal_two_elt2(GEN nf, GEN x, GEN a) { long ta=typ(a), av=avma,tetpil,i,r; GEN con,ep,b,list,fact; nf = checknf(nf); if (!is_extscalar_t(ta) && typ(a)!=t_COL) err(typeer,"ideal_two_elt2"); x = idealhermite_aux(nf,x); if (gcmp0(x)) { if (!gcmp0(a)) err(talker,"element not in ideal in ideal_two_elt2"); avma=av; return gcopy(a); } con = content(x); if (gcmp1(con)) con = NULL; else { x = gdiv(x,con); a = gdiv(a,con); } a = principalideal(nf,a); if (!gcmp1(denom(gauss(x,a)))) err(talker,"element does not belong to ideal in ideal_two_elt2"); fact=idealfactor(nf,a); list=(GEN)fact[1]; r=lg(list); ep = (GEN)fact[2]; for (i=1; i4) { fprintferr(" entree dans idealcoprime() :\n"); fprintferr(" x = "); outerr(x); fprintferr(" y = "); outerr(y); } fact=idealfactor(nf,y); list=(GEN)fact[1]; r=lg(list); ep = (GEN)fact[2]; for (i=1; i4) { fprintferr(" sortie de idealcoprime() : p2 = "); outerr(p2); } return gerepile(av,tetpil,p2); } /* returns the first index i<=n such that x=v[i] if it exits, 0 otherwise */ long isinvector(GEN v, GEN x, long n) { long i; for (i=1; i<=n; i++) if (gegal((GEN)v[i],x)) return i; return 0; } GEN elt_mul_get_table(GEN nf, GEN x) { long i,lx = lg(x); GEN mul=cgetg(lx,t_MAT); /* assume w_1 = 1 */ mul[1]=(long)x; for (i=2; i=1; i--) { GEN den,p4,p5,p6,u,v,newid, invnewid = NULL; def--; j=def; while (j>=1 && gcmp0(gcoeff(A,i,j))) j--; if (!j) err(talker,"not a matrix of maximal rank in nfhermite"); if (j==def) j--; else { p1=(GEN)A[j]; A[j]=A[def]; A[def]=(long)p1; p1=(GEN)I[j]; I[j]=I[def]; I[def]=(long)p1; } p1=gcoeff(A,i,def); p2=element_inv(nf,p1); A[def]=(long)element_mulvec(nf,p2,(GEN)A[def]); I[def]=(long)idealmul(nf,p1,(GEN)I[def]); for ( ; j; j--) { p1=gcoeff(A,i,j); if (gcmp0(p1)) continue; p2=idealmul(nf,p1,(GEN)I[j]); newid = idealadd(nf,p2,(GEN)I[def]); invnewid = hnfideal_inv(nf,newid); p4 = idealmul(nf, p2, invnewid); p5 = idealmul(nf,(GEN)I[def],invnewid); y = idealaddtoone(nf,p4,p5); u=element_div(nf,(GEN)y[1],p1); v=(GEN)y[2]; p6=gsub((GEN)A[j],element_mulvec(nf,p1,(GEN)A[def])); A[def]=ladd(element_mulvec(nf,u,(GEN)A[j]), element_mulvec(nf,v,(GEN)A[def])); A[j]=(long)p6; I[j]=(long)idealmul(nf,idealmul(nf,(GEN)I[j],(GEN)I[def]),invnewid); I[def]=(long)newid; den=denom((GEN)I[j]); if (!gcmp1(den)) { I[j]=lmul(den,(GEN)I[j]); A[j]=ldiv((GEN)A[j],den); } } if (!invnewid) invnewid = hnfideal_inv(nf,(GEN)I[def]); p1=(GEN)I[def]; J[def]=(long)invnewid; for (j=def+1; j<=k; j++) { p2 = gsub(element_reduce(nf,gcoeff(A,i,j),idealmul(nf,p1,(GEN)J[j])), gcoeff(A,i,j)); A[j] = ladd((GEN)A[j],element_mulvec(nf,p2,(GEN)A[def])); } if (low_stack(lim, stack_lim(av1,1))) { GEN *gptr[3]; if(DEBUGMEM>1) err(warnmem,"nfhermite, i = %ld", i); gptr[0]=&A; gptr[1]=&I; gptr[2]=&J; gerepilemany(av,gptr,3); } } y = cgetg(3,t_VEC); p1 = cgetg(m+1,t_MAT); y[1] = (long)p1; p2 = cgetg(m+1,t_VEC); y[2] = (long)p2; for (j=1; j<=m; j++) p1[j] = lcopy((GEN)A[j+k-m]); for (j=1; j<=m; j++) p2[j] = lcopy((GEN)I[j+k-m]); return gerepileupto(av0, y); } /* A torsion module M over Z_K will be given by a row vector [A,I,J] with * three components. I=[b_1,...,b_n] is a row vector of k fractional ideals * given in HNF, J=[a_1,...,a_n] is a row vector of n fractional ideals in * HNF. A is an nxn matrix (same n) such that if A_j is the j-th column of A * and e_n is the canonical basis of K^n, then * M=(b_1e_1+...+b_ne_n)/(a_1A_1+...a_nA_n) */ /* We input a torsion module x=[A,I,J] as above, and output the * smith normal form as K=[\c_1,...,\c_n] such that x=Z_K/\c_1+...+Z_K/\c_n. */ GEN nfsmith(GEN nf, GEN x) { long av,tetpil,i,j,k,l,lim,c,n,m,N; GEN p1,p2,p3,p4,z,b,u,v,w,d,dinv,unnf,A,I,J; nf=checknf(nf); N=degpol(nf[1]); if (typ(x)!=t_VEC || lg(x)!=4) err(talker,"not a module in nfsmith"); A=(GEN)x[1]; I=(GEN)x[2]; J=(GEN)x[3]; if (typ(A)!=t_MAT) err(talker,"not a matrix in nfsmith"); n=lg(A)-1; if (typ(I)!=t_VEC || lg(I)!=n+1 || typ(J)!=t_VEC || lg(J)!=n+1) err(talker,"not a correct ideal list in nfsmith"); if (!n) err(talker,"not a matrix of maximal rank in nfsmith"); m=lg(A[1])-1; if (nm) err(impl,"nfsmith for non square matrices"); av=avma; lim=stack_lim(av,1); p1 = cgetg(n+1,t_MAT); for (j=1; j<=n; j++) p1[j]=A[j]; A = p1; I = dummycopy(I); J=dummycopy(J); for (j=1; j<=n; j++) if (typ(I[j])!=t_MAT) I[j]=(long)idealhermite_aux(nf,(GEN)I[j]); for (j=1; j<=n; j++) if (typ(J[j])!=t_MAT) J[j]=(long)idealhermite_aux(nf,(GEN)J[j]); for (i=n; i>=2; i--) { do { c=0; for (j=i-1; j>=1; j--) { p1=gcoeff(A,i,j); if (!gcmp0(p1)) { p2=gcoeff(A,i,i); d=nfbezout(nf,p2,p1,(GEN)J[i],(GEN)J[j],&u,&v,&w,&dinv); if (!gcmp0(u)) { if (!gcmp0(v)) b=gadd(element_mulvec(nf,u,(GEN)A[i]), element_mulvec(nf,v,(GEN)A[j])); else b=element_mulvec(nf,u,(GEN)A[i]); } else b=element_mulvec(nf,v,(GEN)A[j]); A[j]=lsub(element_mulvec(nf,p2,(GEN)A[j]), element_mulvec(nf,p1,(GEN)A[i])); A[i]=(long)b; J[j]=(long)w; J[i]=(long)d; } } for (j=i-1; j>=1; j--) { p1=gcoeff(A,j,i); if (!gcmp0(p1)) { p2=gcoeff(A,i,i); d=nfbezout(nf,p2,p1,(GEN)I[i],(GEN)I[j],&u,&v,&w,&dinv); if (gcmp0(u)) b=element_mulvecrow(nf,v,A,j,i); else { if (gcmp0(v)) b=element_mulvecrow(nf,u,A,i,i); else b=gadd(element_mulvecrow(nf,u,A,i,i), element_mulvecrow(nf,v,A,j,i)); } p3=gsub(element_mulvecrow(nf,p2,A,j,i), element_mulvecrow(nf,p1,A,i,i)); for (k=1; k<=i; k++) { coeff(A,j,k)=p3[k]; coeff(A,i,k)=b[k]; } I[j]=(long)w; I[i]=(long)d; c++; } } if (!c) { b=gcoeff(A,i,i); if (gcmp0(b)) break; b=idealmul(nf,b,idealmul(nf,(GEN)J[i],(GEN)I[i])); for (k=1; kN) err(talker,"bug2 in nfsmith"); p3=element_mulvecrow(nf,(GEN)b[l],A,k,i); for (l=1; l<=i; l++) coeff(A,i,l) = ladd(gcoeff(A,i,l),(GEN)p3[l]); k = l = i; c = 1; } } } } if (low_stack(lim, stack_lim(av,1))) { GEN *gptr[3]; if(DEBUGMEM>1) err(warnmem,"nfsmith"); gptr[0]=&A; gptr[1]=&I; gptr[2]=&J; gerepilemany(av,gptr,3); } } while (c); } unnf=gscalcol_i(gun,N); p1=gcoeff(A,1,1); coeff(A,1,1)=(long)unnf; J[1]=(long)idealmul(nf,p1,(GEN)J[1]); for (i=2; i<=n; i++) if (!gegal(gcoeff(A,i,i),unnf)) err(talker,"bug in nfsmith"); tetpil=avma; z=cgetg(n+1,t_VEC); for (i=1; i<=n; i++) z[i]=(long)idealmul(nf,(GEN)I[i],(GEN)J[i]); return gerepile(av,tetpil,z); } /*******************************************************************/ /* */ /* ALGEBRE LINEAIRE DANS LES CORPS DE NOMBRES */ /* */ /*******************************************************************/ #define trivlift(x) ((typ(x)==t_POLMOD)? (GEN)x[2]: lift_intern(x)) GEN element_mulmodpr2(GEN nf, GEN x, GEN y, GEN prhall) { long av=avma; GEN p1; nf=checknf(nf); checkprhall(prhall); p1 = element_mul(nf,x,y); return gerepileupto(av,nfreducemodpr(nf,p1,prhall)); } /* On ne peut PAS definir ca comme les autres par * #define element_divmodpr() nfreducemodpr(element_div()) * car le element_div ne marche pas en general */ GEN element_divmodpr(GEN nf, GEN x, GEN y, GEN prhall) { long av=avma; GEN p1; nf=checknf(nf); checkprhall(prhall); p1=lift_intern(gdiv(gmodulcp(gmul((GEN)nf[7],trivlift(x)), (GEN)nf[1]), gmodulcp(gmul((GEN)nf[7],trivlift(y)), (GEN)nf[1]))); p1=algtobasis_intern(nf,p1); return gerepileupto(av,nfreducemodpr(nf,p1,prhall)); } GEN element_invmodpr(GEN nf, GEN y, GEN prhall) { long av=avma; GEN p1; p1=ginvmod(gmul((GEN)nf[7],trivlift(y)), (GEN)nf[1]); p1=algtobasis_intern(nf,p1); return gerepileupto(av,nfreducemodpr(nf,p1,prhall)); } GEN element_powmodpr(GEN nf,GEN x,GEN k,GEN prhall) { long av=avma,N,s; GEN y,z; nf=checknf(nf); checkprhall(prhall); N=degpol(nf[1]); s=signe(k); k=(s>=0)?k:negi(k); z=x; y = gscalcol_i(gun,N); for(;;) { if (mpodd(k)) y=element_mulmodpr(nf,z,y,prhall); k=shifti(k,-1); if (signe(k)) z=element_sqrmodpr(nf,z,prhall); else { cgiv(k); if (s<0) y = element_invmodpr(nf,y,prhall); return gerepileupto(av,y); } } } /* x est une matrice dont les coefficients sont des vecteurs dans la base * d'entiers modulo un ideal premier prhall, sous forme reduite modulo prhall. */ GEN nfkermodpr(GEN nf, GEN x, GEN prhall) { ulong av0,av,av1,lim; long i,j,k,r,t,n,m,N; GEN c,d,y,unnf,munnf,zeromodp,zeronf,p,pp,prh; nf=checknf(nf); checkprhall(prhall); if (typ(x)!=t_MAT) err(typeer,"nfkermodpr"); n=lg(x)-1; if (!n) return cgetg(1,t_MAT); prh=(GEN)prhall[1]; av0=avma; N=degpol(nf[1]); pp=gcoeff(prh,1,1); zeromodp=gmodulsg(0,pp); unnf=cgetg(N+1,t_COL); unnf[1]=(long)gmodulsg(1,pp); zeronf=cgetg(N+1,t_COL); zeronf[1]=(long)zeromodp; av=avma; munnf=cgetg(N+1,t_COL); munnf[1]=(long)gmodulsg(-1,pp); for (i=2; i<=N; i++) zeronf[i] = munnf[i] = unnf[i] = (long)zeromodp; m=lg(x[1])-1; x=dummycopy(x); r=0; c=new_chunk(m+1); for (k=1; k<=m; k++) c[k]=0; d=new_chunk(n+1); av1=avma; lim=stack_lim(av1,1); for (k=1; k<=n; k++) { j=1; while (j<=m && (c[j] || gcmp0(gcoeff(x,j,k)))) j++; if (j > m) { r++; d[k]=0; continue; } p=element_divmodpr(nf,munnf,gcoeff(x,j,k),prhall); c[j]=k; d[k]=j; coeff(x,j,k)=(long)munnf; for (i=k+1; i<=n; i++) coeff(x,j,i)=(long)element_mulmodpr(nf,p,gcoeff(x,j,i),prhall); for (t=1; t<=m; t++) if (t!=j) { p = gcoeff(x,t,k); if (gcmp0(p)) continue; coeff(x,t,k) = (long)zeronf; for (i=k+1; i<=n; i++) coeff(x,t,i)=ladd(gcoeff(x,t,i), element_mulmodpr(nf,p,gcoeff(x,j,i),prhall)); if (low_stack(lim, stack_lim(av1,1))) { if (DEBUGMEM>1) err(warnmem,"nfkermodpr, k = %ld / %ld",k,n); x=gerepilecopy(av1,x); } } } if (!r) { avma=av0; return cgetg(1,t_MAT); } av1=avma; y=cgetg(r+1,t_MAT); for (j=k=1; j<=r; j++,k++) { p=cgetg(n+1,t_COL); y[j]=(long)p; while (d[k]) k++; for (i=1; inbco) err(matinv1); for (j=i; j<=nbco; j++) { u=gcoeff(aa,i,j); coeff(aa,i,j)=coeff(aa,k,j); coeff(aa,k,j)=(long)u; } u=(GEN)x[i]; x[i]=x[k]; x[k]=(long)u; p=gcoeff(aa,i,i); } for (k=i+1; k<=nbli; k++) { m=gcoeff(aa,k,i); if (!gcmp0(m)) { m=element_divmodpr(nf,m,p,prhall); for (j=i+1; j<=nbco; j++) coeff(aa,k,j)=lsub(gcoeff(aa,k,j), element_mulmodpr(nf,m,gcoeff(aa,i,j),prhall)); x[k]=lsub((GEN)x[k],element_mulmodpr(nf,m,(GEN)x[i],prhall)); } } } /* Resolution systeme triangularise */ p=gcoeff(aa,nbli,nbco); if (gcmp0(p)) err(matinv1); x[nbli]=(long)element_divmodpr(nf,(GEN)x[nbli],p,prhall); for (i=nbli-1; i>0; i--) { m=(GEN)x[i]; for (j=i+1; j<=nbco; j++) m=gsub(m,element_mulmodpr(nf,gcoeff(aa,i,j),(GEN)x[j],prhall)); x[i]=(long)element_divmodpr(nf,m,gcoeff(aa,i,i),prhall); } return gerepilecopy(av,x); } GEN nfsuppl(GEN nf, GEN x, long n, GEN prhall) { long av=avma,av2,k,s,t,N,lx=lg(x); GEN y,p1,p2,p,unmodp,zeromodp,unnf,zeronf,prh; stackzone *zone; k=lx-1; if (k>n) err(suppler2); if (k && lg(x[1])!=n+1) err(talker,"incorrect dimension in nfsupl"); N=degpol(nf[1]); prh=(GEN)prhall[1]; p=gcoeff(prh,1,1); zone = switch_stack(NULL, 2*(3 + 2*lg(p) + N+1) + (n+3)*(n+1)); switch_stack(zone,1); unmodp=gmodulsg(1,p); zeromodp=gmodulsg(0,p); unnf=gscalcol_proto(unmodp,zeromodp,N); zeronf=gscalcol_proto(zeromodp,zeromodp,N); y = idmat_intern(n,unnf,zeronf); switch_stack(zone,0); av2=avma; for (s=1; s<=k; s++) { p1=nfsolvemodpr(nf,y,(GEN)x[s],prhall); t=s; while (t<=n && gcmp0((GEN)p1[t])) t++; avma=av2; if (t>n) err(suppler2); p2=(GEN)y[s]; y[s]=x[s]; if (s!=t) y[t]=(long)p2; } avma=av; y=gcopy(y); free(zone); return y; } /* Given two fractional ideals a and b, gives x in a, y in b, z in b^-1, t in a^-1 such that xt-yz=1. In the present version, z is in Z. */ GEN nfidealdet1(GEN nf, GEN a, GEN b) { long av=avma; GEN x,p1,res,da,db; a = idealinv(nf,a); da = denom(a); if (!gcmp1(da)) a = gmul(da,a); db = denom(b); if (!gcmp1(db)) b = gmul(db,b); x = idealcoprime(nf,a,b); p1 = idealaddtoone(nf, idealmul(nf,x,a), b); res = cgetg(5,t_VEC); res[1] = lmul(x,da); res[2] = ldiv((GEN)p1[2],db); res[3] = lnegi(db); res[4] = (long) element_div(nf,(GEN)p1[1],(GEN)res[1]); return gerepileupto(av,res); } /* Given a pseudo-basis pseudo, outputs a multiple of its ideal determinant */ GEN nfdetint(GEN nf,GEN pseudo) { GEN pass,c,v,det1,piv,pivprec,vi,p1,x,I,unnf,zeronf,id,idprod; long i,j,k,rg,n,n1,m,m1,av=avma,av1,tetpil,lim,cm=0,N; nf=checknf(nf); N=degpol(nf[1]); if (typ(pseudo)!=t_VEC || lg(pseudo)!=3) err(talker,"not a module in nfdetint"); x=(GEN)pseudo[1]; I=(GEN)pseudo[2]; if (typ(x)!=t_MAT) err(talker,"not a matrix in nfdetint"); n1=lg(x); n=n1-1; if (!n) return gun; m1=lg(x[1]); m=m1-1; if (typ(I)!=t_VEC || lg(I)!=n1) err(talker,"not a correct ideal list in nfdetint"); unnf=gscalcol_i(gun,N); zeronf=zerocol(N); id=idmat(N); c=new_chunk(m1); for (k=1; k<=m; k++) c[k]=0; piv = pivprec = unnf; av1=avma; lim=stack_lim(av1,1); det1=idprod=gzero; /* dummy for gerepilemany */ pass=cgetg(m1,t_MAT); v=cgetg(m1,t_COL); for (j=1; j<=m; j++) { v[j] = zero; /* dummy */ p1=cgetg(m1,t_COL); pass[j]=(long)p1; for (i=1; i<=m; i++) p1[i]=(long)zeronf; } for (rg=0,k=1; k<=n; k++) { long t = 0; for (i=1; i<=m; i++) if (!c[i]) { vi=element_mul(nf,piv,gcoeff(x,i,k)); for (j=1; j<=m; j++) if (c[j]) vi=gadd(vi,element_mul(nf,gcoeff(pass,i,j),gcoeff(x,j,k))); v[i]=(long)vi; if (!t && !gcmp0(vi)) t=i; } if (t) { pivprec = piv; if (rg == m-1) { if (!cm) { cm=1; idprod = id; for (i=1; i<=m; i++) if (i!=t) idprod = (idprod==id)? (GEN)I[c[i]] : idealmul(nf,idprod,(GEN)I[c[i]]); } p1 = idealmul(nf,(GEN)v[t],(GEN)I[k]); c[t]=0; det1 = (typ(det1)==t_INT)? p1: idealadd(nf,p1,det1); } else { rg++; piv=(GEN)v[t]; c[t]=k; for (i=1; i<=m; i++) if (!c[i]) { for (j=1; j<=m; j++) if (c[j] && j!=t) { p1=gsub(element_mul(nf,piv,gcoeff(pass,i,j)), element_mul(nf,(GEN)v[i],gcoeff(pass,t,j))); coeff(pass,i,j) = rg>1? (long) element_div(nf,p1,pivprec) : (long) p1; } coeff(pass,i,t)=lneg((GEN)v[i]); } } } if (low_stack(lim, stack_lim(av1,1))) { GEN *gptr[6]; if(DEBUGMEM>1) err(warnmem,"nfdetint"); gptr[0]=&det1; gptr[1]=ϖ gptr[2]=&pivprec; gptr[3]=&pass; gptr[4]=&v; gptr[5]=&idprod; gerepilemany(av1,gptr,6); } } if (!cm) { avma=av; return gscalmat(gzero,N); } tetpil=avma; return gerepile(av,tetpil,idealmul(nf,idprod,det1)); } /* clean in place (destroy x) */ static void nfcleanmod(GEN nf, GEN x, long lim, GEN detmat) { long lx=lg(x),i; if (lim<=0 || lim>=lx) lim=lx-1; for (i=1; i<=lim; i++) x[i]=(long)element_reduce(nf,(GEN)x[i],detmat); } static GEN zero_nfbezout(GEN nf,GEN b, GEN A,GEN B,GEN *u,GEN *v,GEN *w,GEN *di) { long av, tetpil; GEN pab,d; d=idealmulelt(nf,b,B); *di=idealinv(nf,idealmat_to_hnf(nf,d)); av=avma; pab=idealmul(nf,A,B); tetpil=avma; *w=gerepile(av,tetpil, idealmul(nf,pab,*di)); *v=element_inv(nf,b); *u=gzero; return d; } /* Given elements a,b and ideals A, B, outputs d = a.A+b.B and gives * di=d^-1, w=A.B.di, u, v such that au+bv=1 and u in A.di, v in * B.di. Assume A, B non-zero, but a or b can be zero (not both) */ static GEN nfbezout(GEN nf,GEN a,GEN b, GEN A,GEN B, GEN *u,GEN *v,GEN *w,GEN *di) { GEN pab,pu,pv,pw,uv,d,dinv,pa,pb,pa1,pb1, *gptr[5]; long av,tetpil; if (gcmp0(a)) { if (gcmp0(b)) err(talker,"both elements zero in nfbezout"); return zero_nfbezout(nf,b,A,B,u,v,w,di); } if (gcmp0(b)) return zero_nfbezout(nf,a,B,A,v,u,w,di); av = avma; pa=idealmulelt(nf,a,A); pb=idealmulelt(nf,b,B); d=idealadd(nf,pa,pb); dinv=idealinv(nf,d); pa1=idealmullll(nf,pa,dinv); pb1=idealmullll(nf,pb,dinv); uv=idealaddtoone(nf,pa1,pb1); pab=idealmul(nf,A,B); tetpil=avma; pu=element_div(nf,(GEN)uv[1],a); pv=element_div(nf,(GEN)uv[2],b); d=gcopy(d); dinv=gcopy(dinv); pw=idealmul(nf,pab,dinv); *u=pu; *v=pv; *w=pw; *di=dinv; gptr[0]=u; gptr[1]=v; gptr[2]=w; gptr[3]=di; gptr[4]=&d; gerepilemanysp(av,tetpil,gptr,5); return d; } /* A usage interne. Pas de verifs ni gestion de pile */ GEN idealoplll(GEN op(GEN,GEN,GEN), GEN nf, GEN x, GEN y) { GEN z = op(nf,x,y), den = denom(z); if (gcmp1(den)) den = NULL; else z=gmul(den,z); z=gmul(z,lllintpartial(z)); return den? gdiv(z,den): z; } /* A usage interne. Pas de verifs ni gestion de pile */ GEN idealmulelt(GEN nf, GEN elt, GEN x) { long t = typ(elt); GEN z; if (t == t_POL || t == t_POLMOD) elt = algtobasis(nf,elt); if (isnfscalar(elt)) elt = (GEN)elt[1]; z = element_mulvec(nf, elt, x); settyp(z, t_MAT); return z; } GEN nfhermitemod(GEN nf, GEN pseudo, GEN detmat) { long av0=avma,li,co,av,tetpil,i,j,jm1,def,ldef,lim,N; GEN b,q,w,p1,p2,d,u,v,den,x,I,J,dinv,unnf,wh; nf=checknf(nf); N=degpol(nf[1]); if (typ(pseudo)!=t_VEC || lg(pseudo)!=3) err(talker,"not a module in nfhermitemod"); x=(GEN)pseudo[1]; I=(GEN)pseudo[2]; if (typ(x)!=t_MAT) err(talker,"not a matrix in nfhermitemod"); co=lg(x); if (typ(I)!=t_VEC || lg(I)!=co) err(talker,"not a correct ideal list in nfhermitemod"); if (co==1) return cgetg(1,t_MAT); li=lg(x[1]); x=dummycopy(x); I=dummycopy(I); unnf=gscalcol_i(gun,N); for (j=1; jco)?li-co+1:1; for (i=li-1; i>=ldef; i--) { def--; j=def-1; while (j && gcmp0(gcoeff(x,i,j))) j--; while (j) { jm1=j-1; if (!jm1) jm1=def; d=nfbezout(nf,gcoeff(x,i,j),gcoeff(x,i,jm1),(GEN)I[j],(GEN)I[jm1], &u,&v,&w,&dinv); if (gcmp0(u)) p1 = element_mulvec(nf,v,(GEN)x[jm1]); else { p1 = element_mulvec(nf,u,(GEN)x[j]); if (!gcmp0(v)) p1=gadd(p1, element_mulvec(nf,v,(GEN)x[jm1])); } x[j]=lsub(element_mulvec(nf,gcoeff(x,i,j),(GEN)x[jm1]), element_mulvec(nf,gcoeff(x,i,jm1),(GEN)x[j])); nfcleanmod(nf,(GEN)x[j],i,idealdivlll(nf,detmat,w)); nfcleanmod(nf,p1,i,idealmullll(nf,detmat,dinv)); x[jm1]=(long)p1; I[j]=(long)w; I[jm1]=(long)d; j--; while (j && gcmp0(gcoeff(x,i,j))) j--; } if (low_stack(lim, stack_lim(av,1))) { GEN *gptr[2]; if(DEBUGMEM>1) err(warnmem,"[1]: nfhermitemod"); gptr[0]=&x; gptr[1]=&I; gerepilemany(av,gptr,2); } } b=detmat; wh=cgetg(li,t_MAT); def--; for (i=li-1; i>=1; i--) { d = nfbezout(nf,gcoeff(x,i,i+def),unnf,(GEN)I[i+def],b,&u,&v,&w,&dinv); p1 = element_mulvec(nf,u,(GEN)x[i+def]); nfcleanmod(nf,p1,i,idealmullll(nf,b,dinv)); wh[i]=(long)p1; coeff(wh,i,i)=(long)unnf; I[i+def]=(long)d; if (i>1) b=idealmul(nf,b,dinv); } J=cgetg(li,t_VEC); J[1]=zero; for (j=2; j=1; i--) { for (j=i+1; j1) err(warnmem,"[2]: nfhermitemod"); gptr[0]=&wh; gptr[1]=&I; gptr[2]=&J; gerepilemany(av,gptr,3); } } tetpil=avma; p1=cgetg(3,t_VEC); p1[1]=lcopy(wh); p2=cgetg(li,t_VEC); p1[2]=(long)p2; for (j=1; j