/*******************************************************************/ /* */ /* BASIC NF OPERATIONS */ /* (continued 2) */ /* */ /*******************************************************************/ /* $Id: base5.c,v 1.1.1.1 1999/09/16 13:47:22 karim Exp $ */ #include "pari.h" GEN mat_to_vecpol(GEN x, long v); GEN matbasistoalg(GEN nf,GEN x) { long i,j,lx,li; GEN p1,z; if (typ(x)!=t_MAT) err(talker,"argument must be a matrix in matbasistoalg"); lx=lg(x); z=cgetg(lx,t_MAT); if (lx==1) return z; li=lg(x[1]); for (j=1; j=vnf) err(talker,"main variable must be of higher priority in rnfinitalg"); RES=cgetg(12,t_VEC); RES[1]=(long)pol; m=lgef(nf[1])-3; degabs=n*m; r1r2=(GEN)nf[2]; r1=itos((GEN)r1r2[1]); r2=itos((GEN)r1r2[2]); sig=cgetg(r1+r2+1,t_VEC); RES[2]=(long)sig; rac=(GEN)nf[6]; liftpol=lift(pol); RAC=cgetg(r1+r2+1,t_VEC); RES[6]=(long)RAC; for (j=1; j<=r1; j++) { p1=gsubst(liftpol,vnf,(GEN)rac[j]); ro=roots(p1,prec); r1j=0; while (r1j>1)); sig[j]=(long)p2; p3=cgetg(r1j+r2j+1,t_VEC); for (i=1; i<=r1j; i++) p3[i]=lreal((GEN)ro[i]); for (; i<=r1j+r2j; i++) p3[i]=(long)ro[(i<<1)-r1j]; RAC[j]=(long)p3; } for (; j<=r1+r2; j++) { p2=cgetg(3,t_VEC); p2[1]=zero; p2[2]=lstoi(n); sig[j]=(long)p2; p1=gsubst(liftpol,vnf,(GEN)rac[j]); RAC[j]=(long)roots(p1,prec); } p1 = rnfpseudobasis(nf,pol); delta = cgetg(3,t_VEC); delta[1]=p1[3]; delta[2]=p1[4]; RES[3]=(long)delta; p2 = matbasistoalg(nf,(GEN)p1[1]); bas = cgetg(3,t_VEC); bas[1]=(long)mat_to_vecpol(p2,vpol); bas[2]=(long)p1[2]; RES[7]=(long)bas; RES[8]=linvmat(p2); f2=idealdiv(nf,discsr(pol),(GEN)p1[3]); fac=idealfactor(nf,f2); fac1=(GEN)fac[1]; fac2=(GEN)fac[2]; lfac=lg(fac1)-1; f=idmat(m); for (i=1; i<=lfac; i++) { if (mpodd((GEN)fac2[i])) err(bugparier,"rnfinitalg (odd exponent)"); f=idealmul(nf,f,idealpow(nf,(GEN)fac1[i],gmul2n((GEN)fac2[i],-1))); } RES[4]=(long)f; RES[10]=(long)nf; RES[5]=(long)rnfmakematrices(RES); if (DEBUGLEVEL>1) msgtimer("matrices"); RES[9]=lgetg(1,t_VEC); /* table de multiplication */ p2=cgetg(6,t_VEC); RES[11]=(long)p2; p1=rnfequation2(nf,pol); for (i=1; i<=3; i++) p2[i]=p1[i]; p4=cgetg(degabs+1,t_MAT); for (i=1; i<=n; i++) { /* removing denominators speeds up multiplication */ GEN cop3,com, om = rnfelementreltoabs(RES,gmael(bas,1,i)); if (DEBUGLEVEL>1) msgtimer("i = %ld",i); com = content(om); om = gdiv(om,com); id=gmael(bas,2,i); for (j=1; j<=m; j++) { p5=cgetg(degabs+1,t_COL); p4[(i-1)*m+j]=(long)p5; p1=gmul((GEN)nf[7],(GEN)id[j]); p3 = gsubst(p1,varn(nf[1]), (GEN)p2[2]); cop3 = content(p3); p3 = gdiv(p3,cop3); p3 = gmul(gmul(com,cop3), lift_intern(gmul(om,p3))); for (k=1; k1) msgtimer("p4"); p3=denom(p4); if (gcmp1(p3)) p3=NULL; else p4=gmul(p3,p4); p4=hnfmod(p4,detint(p4)); if (DEBUGLEVEL>1) msgtimer("hnfmod"); for (j=degabs-1; j>0; j--) if (cmpis(gcoeff(p4,j,j),2) > 0) { p1=shifti(gcoeff(p4,j,j),-1); for (k=j+1; k<=degabs; k++) if (cmpii(gcoeff(p4,j,k),p1) > 0) for (i=1; i<=j; i++) coeff(p4,i,k)=lsubii(gcoeff(p4,i,k),gcoeff(p4,i,j)); } if (p3) p4=gdiv(p4,p3); p2[4]=(long)mat_to_vecpol(p4,vpol); p2[5]=linvmat(p4); tetpil=avma; return gerepile(av,tetpil,gcopy(RES)); } GEN rnfbasistoalg(GEN rnf,GEN x) { long tx=typ(x),lx=lg(x),av=avma,tetpil,i,n; GEN p1,z,nf; checkrnf(rnf); nf=(GEN)rnf[10]; switch(tx) { case t_VEC: x=gtrans(x); /* fall through */ case t_COL: n=lg(x)-1; p1=cgetg(n+1,t_COL); for (i=1; i<=n; i++) { if (typ(x[i])==t_COL) p1[i]=(long)basistoalg(nf,(GEN)x[i]); else p1[i]=x[i]; } p1=gmul(gmael(rnf,7,1),p1); tetpil=avma; return gerepile(av,tetpil,gmodulcp(p1,(GEN)rnf[1])); case t_MAT: z=cgetg(lx,tx); for (i=1; i= N) x=gmod(x,(GEN)rnf[1]); z=cgetg(N+1,t_COL); for (i=1; i<=N; i++) z[i]=(long)truecoeff(x,i-1); tetpil=avma; return gerepile(av,tetpil,gmul((GEN)rnf[8],z)); } return gscalcol(x, lgef(rnf[1])-3); } /* x doit etre un polymod ou un polynome ou un vecteur de tels objets... */ GEN rnfelementreltoabs(GEN rnf,GEN x) { long av=avma,tx,i,lx,va,tp3; GEN z,p1,p2,p3,polabs,teta,alpha,s,k; checkrnf(rnf); tx=typ(x); lx=lg(x); va=varn((GEN)rnf[1]); switch(tx) { case t_VEC: case t_COL: case t_MAT: z=cgetg(lx,tx); for (i=1; i va) { if (gcmp0(x)) {x=cgetg(2,t_POL); x[1]=evalvarn(va) | evallgef(2);} else { p1=cgetg(3,t_POL); p1[1]=evalvarn(va) | evallgef(3) | evalsigne(1); p1[2]=(long)x; x=p1; } } p1=(GEN)rnf[11]; polabs=(GEN)p1[1]; alpha=(GEN)p1[2]; k=(GEN)p1[3]; teta=gmodulcp(gsub(polx[va],gmul(k,(GEN)alpha[2])),polabs); s=gzero; for (i=lgef(x)-1; i>1; i--) { p3=(GEN)x[i]; tp3=typ(p3); if (is_const_t(tp3)) p2 = p3; else switch(tp3) { case t_POLMOD: p3 = (GEN)p3[2]; /* fall through */ case t_POL: p2 = poleval(p3,alpha); } s=gadd(p2,gmul(teta,s)); } return gerepileupto(av,s); default: return gcopy(x); } } GEN rnfelementabstorel(GEN rnf,GEN x) { long av=avma,tx,i,lx; GEN z,p1,s,tetap,k,nf; checkrnf(rnf); tx=typ(x); lx=lg(x); switch(tx) { case t_VEC: case t_COL: case t_MAT: z=cgetg(lx,tx); for (i=1; i1; i--) s=gadd((GEN)x[i],gmul(tetap,s)); return gerepileupto(av,s); default: return gcopy(x); } } /* x doit etre un polymod ou un polynome ou un vecteur de tels objets... */ GEN rnfelementup(GEN rnf,GEN x) { long i,lx,tx; GEN z; checkrnf(rnf); tx=typ(x); lx=lg(x); switch(tx) { case t_VEC: case t_COL: case t_MAT: z=cgetg(lx,tx); for (i=1; ivarn(rnf[1])) { tetpil=avma; return gerepile(av,tetpil,gcopy(p1)); } if (lgef(p1)==3) { tetpil=avma; return gerepile(av,tetpil,gcopy((GEN)p1[2])); } err(talker,"element is not in the base field in rnfelementdown"); default: return gcopy(x); } } /* x est exprime sur la base relative */ static GEN rnfprincipaltohermite(GEN rnf,GEN x) { long av=avma,tetpil; GEN nf,bas,bas1,p1,z; x=rnfbasistoalg(rnf,x); nf=(GEN)rnf[10]; bas=(GEN)rnf[7]; bas1=(GEN)bas[1]; p1=rnfalgtobasis(rnf,gmul(x,gmodulcp(bas1,(GEN)rnf[1]))); z=cgetg(3,t_VEC); z[2]=bas[2]; settyp(p1,t_MAT); z[1]=(long)matalgtobasis(nf,p1); tetpil=avma; return gerepile(av,tetpil,nfhermite(nf,z)); } GEN rnfidealhermite(GEN rnf,GEN x) { long tx=typ(x),lx=lg(x),av=avma,tetpil,i,j,n,m; GEN z,p1,p2,x1,x2,x1j,nf,bas,unnf,zeronf; checkrnf(rnf); n=lgef(rnf[1])-3; nf=(GEN)rnf[10]; bas=(GEN)rnf[7]; switch(tx) { case t_INT: case t_FRAC: case t_FRACN: z=cgetg(3,t_VEC); m=lgef(nf[1])-3; zeronf=gscalcol_i(gzero,m); unnf=gscalcol_i(gun,m); p1=cgetg(n+1,t_MAT); z[1]=(long)p1; for (j=1; j<=n; j++) { p2=cgetg(n+1,t_COL); p1[j]=(long)p2; for (i=1; i<=n; i++) p2[i]=(i==j)?(long)unnf:(long)zeronf; } z[2]=lmul(x,(GEN)bas[2]); return z; case t_POLMOD: case t_POL: p1=rnfalgtobasis(rnf,x); tetpil=avma; return gerepile(av,tetpil,rnfprincipaltohermite(rnf,p1)); case t_VEC: switch(lx) { case 3: x1=(GEN)x[1]; if (typ(x1)!=t_MAT || lg(x1) < n+1 || lg(x1[1]) != n+1) err(talker,"incorrect type in rnfidealhermite"); p1=cgetg(n+1,t_MAT); for (j=1; j<=n; j++) { p2=cgetg(n+1,t_COL); p1[j]=(long)p2; x1j=(GEN)x1[j]; for (i=1; i<=n; i++) { tx = typ(x1j[i]); if (is_const_t(tx)) p2[i] = x1j[i]; else switch(tx) { case t_POLMOD: case t_POL: p2[i]=(long)algtobasis(nf,(GEN)x1j[i]); break; case t_COL: p2[i]=x1j[i]; break; default: err(talker,"incorrect type in rnfidealhermite"); } } } x2=(GEN)x[2]; if (typ(x2)!=t_VEC || lg(x2)!=lg(x1)) err(talker,"incorrect type in rnfidealhermite"); tetpil=avma; z=cgetg(3,t_VEC); z[1]=lcopy(p1); z[2]=lcopy(x2); z=gerepile(av,tetpil,nfhermite(nf,z)); if (lg(z[1]) != n+1) err(talker,"not an ideal in rnfidealhermite"); return z; case 6: err(impl,"rnfidealhermite for prime ideals"); default: err(typeer,"rnfidealhermite"); } case t_COL: if (lx!=(n+1)) err(typeer,"rnfidealhermite"); return rnfprincipaltohermite(rnf,x); case t_MAT: return rnfidealabstorel(rnf,x); } err(typeer,"rnfidealhermite"); return NULL; /* not reached */ } GEN rnfidealnormrel(GEN rnf,GEN id) { long av=avma,i,n; GEN z,id2,nf; checkrnf(rnf); id=rnfidealhermite(rnf,id); id2=(GEN)id[2]; n=lgef(rnf[1])-3; nf=(GEN)rnf[10]; if (n==1) { avma=av; return idmat(lgef(nf[1]-3)); } z=(GEN)id2[1]; for (i=2; i<=n; i++) z=idealmul(nf,z,(GEN)id2[i]); return gerepileupto(av,z); } GEN rnfidealnormabs(GEN rnf,GEN id) { long av=avma,i,n; GEN z,id2; checkrnf(rnf); id=rnfidealhermite(rnf,id); id2=(GEN)id[2]; n=lgef(rnf[1])-3; z=gun; for (i=1; i<=n; i++) z=gmul(z,dethnf((GEN)id2[i])); return gerepileupto(av,z); } GEN rnfidealreltoabs(GEN rnf,GEN x) { long av=avma,tetpil,i,j,k,n,m; GEN nf,basinv,om,id,p1,p2,p3,p4,p5; checkrnf(rnf); x=rnfidealhermite(rnf,x); n=lgef(rnf[1])-3; nf=(GEN)rnf[10]; m=lgef(nf[1])-3; basinv=(GEN)((GEN)rnf[11])[5]; p3=cgetg(n*m+1,t_MAT); p2=gmael(rnf,11,2); for (i=1; i<=n; i++) { om=rnfbasistoalg(rnf,gmael(x,1,i)); id=gmael(x,2,i); om=rnfelementreltoabs(rnf,om); for (j=1; j<=m; j++) { p1=gmul((GEN)nf[7],(GEN)id[j]); p4=lift_intern(gmul(om,gsubst(p1,varn(nf[1]),p2))); p5=cgetg(n*m+1,t_COL); for (k=0; k vector of 2 generators (relative polymods) */ GEN rnfidealtwoelement(GEN rnf,GEN x) { long av=avma,tetpil,j; GEN p1,p2,p3,res,polabs,nfabs,z; res=(GEN)rnf[11]; polabs=(GEN)res[1]; nfabs=cgetg(10,t_VEC); nfabs[1]=(long)polabs; for (j=2; j<=9; j++) nfabs[j]=zero; nfabs[7]=(long)lift((GEN)res[4]); nfabs[8]=res[5]; p1=rnfidealreltoabs(rnf,x); p2=ideal_two_elt(nfabs,p1); p3=rnfelementabstorel(rnf,gmul((GEN)res[4],(GEN)p2[2])); tetpil=avma; z=cgetg(3,t_VEC); z[1]=lcopy((GEN)p2[1]); z[2]=(long)rnfalgtobasis(rnf,p3); return gerepile(av,tetpil,z); } GEN rnfidealmul(GEN rnf,GEN x,GEN y) /* x et y sous HNF relative uniquement */ { long av=avma,tetpil,i,j,n; GEN z,nf,x1,x2,p1,p2,p3,p4,p5,res; z=rnfidealtwoelement(rnf,y); nf=(GEN)rnf[10]; n=lgef(rnf[1])-3; x=rnfidealhermite(rnf,x); x1=gmodulcp(gmul(gmael(rnf,7,1),matbasistoalg(nf,(GEN)x[1])),(GEN) rnf[1]); x2=(GEN)x[2]; p1=gmul((GEN)z[1],(GEN)x[1]); p2=lift_intern(gmul(rnfbasistoalg(rnf,(GEN)z[2]),x1)); p3=cgetg(n+1,t_MAT); for (j=1; j<=n; j++) { p4=cgetg(n+1,t_COL); p3[j]=(long)p4; p5=(GEN)p2[j]; for (i=1; i<=n; i++) p4[i]=(long)algtobasis(nf,truecoeff((GEN)p5,i-1)); } res=cgetg(3,t_VEC); res[1]=(long)concatsp(p1,p3); res[2]=(long)concatsp(x2,x2); tetpil=avma; return gerepile(av,tetpil,nfhermite(nf,res)); } /*********************************************************************/ /** **/ /** LIBRARY FOR POLYNOMIALS WITH COEFFS. IN Z_K/P **/ /** An element in Z_K/P is a t_COL with degree(nf[1]) components. **/ /** These are integers modulo the prime p under prime ideal P **/ /** (only f(P/p) elements are non zero). These components are **/ /** given on the integer basis of K. **/ /** **/ /*********************************************************************/ /* K.B: What follows is not meant to work (yet?) */ GEN polnfmulscal(GEN nf,GEN s,GEN x) { long i,lx=lgef(x); GEN z; if (lx<3) return gcopy(x); if (gcmp0(s)) { z=cgetg(2,t_POL); z[1]=evallgef(2) | evalvarn(varn(x)); return z; } z=cgetg(lx,t_POL); z[1]=x[1]; for (i=2; i=2; d--) { z[d]=x[d+ly-3]; for (i=d; i