/* $Id: base5.c,v 1.30 2002/09/07 13:35:06 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 2) */ /* */ /*******************************************************************/ #include "pari.h" extern GEN mul_content(GEN cx, GEN cy); extern long polegal_spec(GEN x, GEN y); extern GEN mulmat_pol(GEN A, GEN x); GEN matbasistoalg(GEN nf,GEN x) { long i, j, li, lx = lg(x); GEN p1, z = cgetg(lx,t_MAT); if (typ(x) != t_MAT) err(talker,"argument must be a matrix in matbasistoalg"); 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 = degpol(nf[1]); degabs=n*m; r1 = nf_get_r1(nf); r2 = (m-r1) >> 1; 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 c, cop3,com, om = rnfelementreltoabs(RES,gmael(bas,1,i)); if (DEBUGLEVEL>1) msgtimer("i = %ld",i); om = primitive_part(om, &com); id=gmael(bas,2,i); for (j=1; j<=m; j++) { p1 = gmul((GEN)nf[7],(GEN)id[j]); p3 = gsubst(p1, vnf, (GEN)p2[2]); p3 = primitive_part(p3, &cop3); c = mul_content(cop3, com); p3 = lift_intern(gmul(om,p3)); if (c) p3 = gmul(c,p3); p4[(i-1)*m+j] = (long)pol_to_vec(p3, degabs); } } if (DEBUGLEVEL>1) msgtimer("p4"); p4 = Q_remove_denom(p4, &p3); if (p3) p4 = hnfmodid(p4, p3); else p4 = idmat(degabs); 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); return gerepilecopy(av,RES); } GEN rnfbasistoalg(GEN rnf,GEN x) { long tx=typ(x), lx=lg(x), i, n; gpmem_t av=avma, tetpil; 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 = gres(x,P); return gerepileupto(av, mulmat_pol((GEN)rnf[8], x)); } } return gscalcol(x, degpol(rnf[1])); } GEN _checkrnfeq(GEN x) { if (typ(x) == t_VEC) switch(lg(x)) { case 12: /* checkrnf(x); */ return (GEN)x[11]; case 6: /* rnf[11]. FIXME: change the rnf struct */ case 4: return x; } return NULL; } GEN checkrnfeq(GEN x) { x = _checkrnfeq(x); if (!x) err(talker,"please apply rnfequation(,,1)"); return x; } GEN eltreltoabs(GEN rnfeq, GEN x) { long i, k, va; gpmem_t av = avma; GEN polabs, teta, alpha, s; rnfeq = checkrnfeq(rnfeq); polabs= (GEN)rnfeq[1]; alpha = (GEN)rnfeq[2]; k = itos((GEN)rnfeq[3]); va = varn(polabs); if (gvar(x) > va) x = scalarpol(x,va); /* Mod(X + k alpha, polabs(X)), alpha root of the polynomial defining base */ teta = gmodulcp(gsub(polx[va], gmulsg(k,lift_intern(alpha))), polabs); s = gzero; for (i=lgef(x)-1; i>1; i--) { GEN c = (GEN)x[i]; long tc = typ(c); switch(tc) { case t_POLMOD: c = (GEN)c[2]; /* fall through */ case t_POL: c = poleval(c, alpha); break; default: if (!is_const_t(tc)) err(talker, "incorrect data in eltreltoabs"); } s = gadd(c, gmul(teta,s)); } return gerepileupto(av,s); } /* x doit etre un polymod ou un polynome ou un vecteur de tels objets... */ GEN rnfelementreltoabs(GEN rnf,GEN x) { long i, lx, tx = typ(x); GEN z; switch(tx) { case t_VEC: case t_COL: case t_MAT: lx = lg(x); z = cgetg(lx,tx); for (i=1; ivarn(rnf[1])) return gerepilecopy(av,p1); if (lgef(p1)==3) return gerepilecopy(av,(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) { gpmem_t av = avma; 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]))); settyp(p1,t_MAT); z = cgetg(3,t_VEC); z[1] = (long)p1; z[2] = bas[2]; return gerepileupto(av, nfhermite(nf,z)); } static GEN rnfid(long n, long m) { return idmat_intern(n, gscalcol_i(gun,m), zerocol(m)); } GEN rnfidealhermite(GEN rnf,GEN x) { long tx=typ(x), lx=lg(x), i, j, n, m; gpmem_t av=avma, tetpil; GEN z,p1,p2,x1,x2,x1j,nf,bas; checkrnf(rnf); n = degpol(rnf[1]); nf = (GEN)rnf[10]; bas = (GEN)rnf[7]; switch(tx) { case t_INT: case t_FRAC: case t_FRACN: m = degpol(nf[1]); z = cgetg(3,t_VEC); z[1] = (long)rnfid(n, m); z[2] = lmul(x, (GEN)bas[2]); return z; case t_POLMOD: case t_POL: p1 = rnfalgtobasis(rnf,x); return gerepileupto(av, 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 */ } static GEN prodid(GEN nf, GEN I) { long i, l = lg(I); GEN z; if (l == 1) return idmat(degpol(nf[1])); z = (GEN)I[1]; for (i=2; i vector of 2 generators (relative polymods) */ GEN rnfidealtwoelement(GEN rnf,GEN x) { gpmem_t av = avma; long j; GEN p1,p2,p3,res,polabs,nfabs,z; checkrnf(rnf); 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])); z = cgetg(3,t_VEC); z[1] = lcopy((GEN)p2[1]); z[2] = (long)rnfalgtobasis(rnf,p3); return gerepileupto(av, z); } GEN rnfidealmul(GEN rnf,GEN x,GEN y) /* x et y sous HNF relative uniquement */ { long i, j, n; gpmem_t av = avma; GEN z,nf,x1,x2,p1,p2,p3,p4,res; z = rnfidealtwoelement(rnf,y); nf = (GEN)rnf[10]; n = degpol(rnf[1]); 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 = pol_to_vec((GEN)p2[j], n); p3[j] = (long)p4; for (i=1; i<=n; i++) p4[i] = (long)algtobasis(nf,(GEN)p4[i]); } res = cgetg(3,t_VEC); res[1] = (long)concatsp(p1,p3); res[2] = (long)concatsp(x2,x2); return gerepileupto(av, nfhermite(nf,res)); }