[BACK]Return to base5.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib / pari-2.2 / src / basemath

Diff for /OpenXM_contrib/pari-2.2/src/basemath/Attic/base5.c between version 1.1 and 1.2

version 1.1, 2001/10/02 11:17:02 version 1.2, 2002/09/11 07:26:49
Line 20  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
Line 20  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
 /*                                                                 */  /*                                                                 */
 /*******************************************************************/  /*******************************************************************/
 #include "pari.h"  #include "pari.h"
 GEN mat_to_vecpol(GEN x, long v);  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  GEN
 matbasistoalg(GEN nf,GEN x)  matbasistoalg(GEN nf,GEN x)
 {  {
   long i,j,lx,li;    long i, j, li, lx = lg(x);
   GEN p1,z;    GEN p1, z = cgetg(lx,t_MAT);
   
   if (typ(x)!=t_MAT)    if (typ(x) != t_MAT) err(talker,"argument must be a matrix in matbasistoalg");
     err(talker,"argument must be a matrix in matbasistoalg");    if (lx == 1) return z;
   lx=lg(x); z=cgetg(lx,t_MAT); if (lx==1) return z;    li = lg(x[1]);
   
   li=lg(x[1]);  
   for (j=1; j<lx; j++)    for (j=1; j<lx; j++)
   {    {
     p1=cgetg(li,t_COL); z[j]=(long)p1;      p1 = cgetg(li,t_COL); z[j] = (long)p1;
     for (i=1; i<li; i++) p1[i]=(long)basistoalg(nf,gcoeff(x,i,j));      for (i=1; i<li; i++) p1[i] = (long)basistoalg(nf,gcoeff(x,i,j));
   }    }
   return z;    return z;
 }  }
Line 44  matbasistoalg(GEN nf,GEN x)
Line 44  matbasistoalg(GEN nf,GEN x)
 GEN  GEN
 matalgtobasis(GEN nf,GEN x)  matalgtobasis(GEN nf,GEN x)
 {  {
   long i,j,lx,li;    long i, j, li, lx = lg(x);
   GEN p1,z;    GEN p1, c, z = cgetg(lx, t_MAT);
   
   if (typ(x)!=t_MAT)    if (typ(x) != t_MAT) err(talker,"argument must be a matrix in matalgtobasis");
     err(talker,"argument must be a matrix in matalgtobasis");    if (lx == 1) return z;
   lx=lg(x); z=cgetg(lx,t_MAT); if (lx==1) return z;    li = lg(x[1]);
   
   li=lg(x[1]);  
   for (j=1; j<lx; j++)    for (j=1; j<lx; j++)
   {    {
     p1=cgetg(li,t_COL); z[j]=(long)p1;      p1 = cgetg(li,t_COL); z[j] = (long)p1;
     for (i=1; i<li; i++) p1[i]=(long)algtobasis(nf,gcoeff(x,i,j));      for (i=1; i<li; i++)
       {
         c = gcoeff(x,i,j);
         c = typ(c)==t_COL? gcopy(c): algtobasis(nf,c);
         p1[i] = (long)c;
       }
   }    }
   return z;    return z;
 }  }
Line 111  rnfmakematrices(GEN rnf)
Line 114  rnfmakematrices(GEN rnf)
 GEN  GEN
 rnfinitalg(GEN nf,GEN pol,long prec)  rnfinitalg(GEN nf,GEN pol,long prec)
 {  {
   ulong av = avma;    gpmem_t av = avma;
   long m,n,r1,r2,vnf,i,j,k,vpol,v1,r1j,r2j,lfac,degabs;    long m,n,r1,r2,vnf,i,j,k,vpol,r1j,r2j,lfac,degabs;
   GEN RES,sig,rac,p1,p2,liftpol,delta,RAC,ro,p3,bas;    GEN RES,sig,rac,p1,p2,liftpol,delta,RAC,ro,p3,bas;
   GEN f,f2,fac,fac1,fac2,id,p4,p5;    GEN f,f2,fac,fac1,fac2,id,p4;
   
   if (typ(pol)!=t_POL) err(notpoler,"rnfinitalg");    if (typ(pol)!=t_POL) err(notpoler,"rnfinitalg");
   nf=checknf(nf); n=degpol(pol); vpol=varn(pol);    nf=checknf(nf); n=degpol(pol); vpol=varn(pol);
   vnf=0;    pol = fix_relative_pol(nf,pol,0);
   for (i=0; i<=n; i++)    vnf = varn(nf[1]);
   {  
     long tp1;  
   
     p1=(GEN)pol[i+2];    if (vpol >= vnf)
     tp1=typ(p1);  
     if (! is_const_t(tp1))  
     {  
       if (tp1!=t_POLMOD) err(typeer,"rnfinitalg");  
       p1 = checknfelt_mod(nf, p1, "rnfinitalg");  
       if (! is_const_t(typ(p1)))  
       {  
         v1=varn(p1);  
         if (vnf && vnf!=v1) err(talker,"different variables in rnfinitalg");  
         if (!vnf) vnf=v1;  
       }  
     }  
   }  
   if (!vnf) vnf=varn(nf[1]);  
   if (vpol>=vnf)  
     err(talker,"main variable must be of higher priority in rnfinitalg");      err(talker,"main variable must be of higher priority in rnfinitalg");
   RES=cgetg(12,t_VEC);    RES=cgetg(12,t_VEC);
   RES[1]=(long)pol;    RES[1]=(long)pol;
   m=degpol(nf[1]); degabs=n*m;    m = degpol(nf[1]); degabs=n*m;
   r1 = nf_get_r1(nf); r2 = (m-r1) >> 1;    r1 = nf_get_r1(nf); r2 = (m-r1) >> 1;
   sig=cgetg(r1+r2+1,t_VEC); RES[2]=(long)sig;    sig=cgetg(r1+r2+1,t_VEC); RES[2]=(long)sig;
   rac=(GEN)nf[6]; liftpol=lift(pol);    rac=(GEN)nf[6]; liftpol=lift(pol);
Line 179  rnfinitalg(GEN nf,GEN pol,long prec)
Line 165  rnfinitalg(GEN nf,GEN pol,long prec)
   RES[7]=(long)bas;    RES[7]=(long)bas;
   RES[8]=linvmat(p2);    RES[8]=linvmat(p2);
   
   f2=idealdiv(nf,discsr(pol),(GEN)p1[3]);    f2 = idealdiv(nf, discsr(pol), (GEN)p1[3]);
   fac=idealfactor(nf,f2);    fac = idealfactor(nf,f2);
   fac1=(GEN)fac[1]; fac2=(GEN)fac[2]; lfac=lg(fac1)-1;    fac1 = (GEN)fac[1];
   f=idmat(m);    fac2 = (GEN)fac[2]; lfac = lg(fac1)-1;
     f = idmat(m);
   for (i=1; i<=lfac; i++)    for (i=1; i<=lfac; i++)
   {    {
     if (mpodd((GEN)fac2[i])) err(bugparier,"rnfinitalg (odd exponent)");      if (mpodd((GEN)fac2[i])) err(bugparier,"rnfinitalg (odd exponent)");
Line 198  rnfinitalg(GEN nf,GEN pol,long prec)
Line 185  rnfinitalg(GEN nf,GEN pol,long prec)
   p4=cgetg(degabs+1,t_MAT);    p4=cgetg(degabs+1,t_MAT);
   for (i=1; i<=n; i++)    for (i=1; i<=n; i++)
   { /* removing denominators speeds up multiplication */    { /* removing denominators speeds up multiplication */
     GEN cop3,com, om = rnfelementreltoabs(RES,gmael(bas,1,i));      GEN c, cop3,com, om = rnfelementreltoabs(RES,gmael(bas,1,i));
   
     if (DEBUGLEVEL>1) msgtimer("i = %ld",i);      if (DEBUGLEVEL>1) msgtimer("i = %ld",i);
     com = content(om); om = gdiv(om,com);      om = primitive_part(om, &com);
     id=gmael(bas,2,i);      id=gmael(bas,2,i);
     for (j=1; j<=m; j++)      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]);
       p1=gmul((GEN)nf[7],(GEN)id[j]);        p3 = gsubst(p1, vnf, (GEN)p2[2]);
       p3 = gsubst(p1,varn(nf[1]), (GEN)p2[2]);        p3 = primitive_part(p3, &cop3);
       cop3 = content(p3); p3 = gdiv(p3,cop3);        c = mul_content(cop3, com);
       p3 = gmul(gmul(com,cop3), lift_intern(gmul(om,p3)));  
   
       for (k=1; k<lgef(p3)-1; k++) p5[k]=p3[k+1];        p3 = lift_intern(gmul(om,p3));
       for (   ; k<=degabs;    k++) p5[k]=zero;        if (c) p3 = gmul(c,p3);
         p4[(i-1)*m+j] = (long)pol_to_vec(p3, degabs);
     }      }
   }    }
   if (DEBUGLEVEL>1) msgtimer("p4");    if (DEBUGLEVEL>1) msgtimer("p4");
   p3 = denom(p4);    p4 = Q_remove_denom(p4, &p3);
   p4 = hnfmodid(gmul(p3,p4), p3);    if (p3) p4 = hnfmodid(p4, p3); else p4 = idmat(degabs);
   if (DEBUGLEVEL>1) msgtimer("hnfmod");    if (DEBUGLEVEL>1) msgtimer("hnfmod");
   for (j=degabs-1; j>0; j--)    for (j=degabs-1; j>0; j--)
     if (cmpis(gcoeff(p4,j,j),2) > 0)      if (cmpis(gcoeff(p4,j,j),2) > 0)
Line 228  rnfinitalg(GEN nf,GEN pol,long prec)
Line 215  rnfinitalg(GEN nf,GEN pol,long prec)
           for (i=1; i<=j; i++)            for (i=1; i<=j; i++)
             coeff(p4,i,k)=lsubii(gcoeff(p4,i,k),gcoeff(p4,i,j));              coeff(p4,i,k)=lsubii(gcoeff(p4,i,k),gcoeff(p4,i,j));
     }      }
   p4 = gdiv(p4,p3);    if (p3) p4 = gdiv(p4,p3);
   p2[4]=(long)mat_to_vecpol(p4,vpol);    p2[4]=(long)mat_to_vecpol(p4,vpol);
   p2[5]=linvmat(p4);    p2[5]=linvmat(p4);
   return gerepilecopy(av,RES);    return gerepilecopy(av,RES);
Line 237  rnfinitalg(GEN nf,GEN pol,long prec)
Line 224  rnfinitalg(GEN nf,GEN pol,long prec)
 GEN  GEN
 rnfbasistoalg(GEN rnf,GEN x)  rnfbasistoalg(GEN rnf,GEN x)
 {  {
   long tx=typ(x),lx=lg(x),av=avma,tetpil,i,n;    long tx=typ(x), lx=lg(x), i, n;
     gpmem_t av=avma, tetpil;
   GEN p1,z,nf;    GEN p1,z,nf;
   
   checkrnf(rnf); nf=(GEN)rnf[10];    checkrnf(rnf); nf=(GEN)rnf[10];
Line 269  rnfbasistoalg(GEN rnf,GEN x)
Line 257  rnfbasistoalg(GEN rnf,GEN x)
   }    }
 }  }
   
 extern long polegal_spec(GEN x, GEN y);  
   
 /* assume x is a t_POLMOD */  /* assume x is a t_POLMOD */
 GEN  GEN
 lift_to_pol(GEN x)  lift_to_pol(GEN x)
Line 279  lift_to_pol(GEN x)
Line 265  lift_to_pol(GEN x)
   return (typ(y) != t_POL)? gtopoly(y,varn(x[1])): y;    return (typ(y) != t_POL)? gtopoly(y,varn(x[1])): y;
 }  }
   
 extern GEN mulmat_pol(GEN A, GEN x);  
   
 GEN  GEN
 rnfalgtobasis(GEN rnf,GEN x)  rnfalgtobasis(GEN rnf,GEN x)
 {  {
   long av=avma,tx=typ(x), i,lx;    long tx=typ(x), i, lx;
     gpmem_t av=avma;
   GEN z;    GEN z;
   
   checkrnf(rnf);    checkrnf(rnf);
Line 300  rnfalgtobasis(GEN rnf,GEN x)
Line 285  rnfalgtobasis(GEN rnf,GEN x)
         err(talker,"not the same number field in rnfalgtobasis");          err(talker,"not the same number field in rnfalgtobasis");
       x = lift_to_pol(x); /* fall through */        x = lift_to_pol(x); /* fall through */
     case t_POL:      case t_POL:
     { /* cf algtobasis_intern */      { /* cf algtobasis_i */
       GEN P = (GEN)rnf[1];        GEN P = (GEN)rnf[1];
       long N = degpol(P);        long N = degpol(P);
       if (degpol(x) >= N) x = gres(x,P);        if (degpol(x) >= N) x = gres(x,P);
Line 310  rnfalgtobasis(GEN rnf,GEN x)
Line 295  rnfalgtobasis(GEN rnf,GEN x)
   return gscalcol(x, degpol(rnf[1]));    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... */  /* x doit etre un polymod ou un polynome ou un vecteur de tels objets... */
 GEN  GEN
 rnfelementreltoabs(GEN rnf,GEN x)  rnfelementreltoabs(GEN rnf,GEN x)
 {  {
   long av=avma,tx,i,lx,va,tp3;    long i, lx, tx = typ(x);
   GEN z,p1,p2,p3,polabs,teta,alpha,s,k;    GEN z;
   
   checkrnf(rnf); tx=typ(x); lx=lg(x); va=varn((GEN)rnf[1]);  
   switch(tx)    switch(tx)
   {    {
     case t_VEC: case t_COL: case t_MAT:      case t_VEC: case t_COL: case t_MAT:
       z=cgetg(lx,tx);        lx = lg(x); z = cgetg(lx,tx);
       for (i=1; i<lx; i++) z[i]=(long)rnfelementreltoabs(rnf,(GEN)x[i]);        for (i=1; i<lx; i++) z[i] = (long)rnfelementreltoabs(rnf, (GEN)x[i]);
       return z;        return z;
   
     case t_POLMOD:      case t_POLMOD: x = lift_to_pol(x); /* fall through */
       x=lift_to_pol(x); /* fall through */      case t_POL: return eltreltoabs(rnf, x);
     case t_POL:  
       if (gvar(x) > va) x = scalarpol(x,va);  
       p1=(GEN)rnf[11]; polabs=(GEN)p1[1]; alpha=(GEN)p1[2]; k=(GEN)p1[3];  
       if (typ(alpha) == t_INT)  
         teta=gmodulcp(gsub(polx[va],gmul(k,alpha)),polabs);  
       else  
         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);  
               break;  
             default: err(talker, "incorrect data in rnfelementreltoabs");  
               return NULL; /* not reached */  
           }  
         s=gadd(p2,gmul(teta,s));  
       }  
       return gerepileupto(av,s);  
   
     default: return gcopy(x);      default: return gcopy(x);
   }    }
 }  }
   
   /* assume x,T,pol t_POL. T defines base field, pol defines rnf over T.
    * x an absolute element of the extension */
 GEN  GEN
   get_theta_abstorel(GEN T, GEN pol, GEN k)
   {
     return gmodulcp(gadd(polx[varn(pol)],
                          gmul(k, gmodulcp(polx[varn(T)],T))), pol);
   }
   GEN
   eltabstorel(GEN x, GEN T, GEN pol, GEN k)
   {
     return poleval(x, get_theta_abstorel(T,pol,k));
   }
   
   GEN
 rnfelementabstorel(GEN rnf,GEN x)  rnfelementabstorel(GEN rnf,GEN x)
 {  {
   long av=avma,tx,i,lx;    long tx, i, lx;
   GEN z,p1,s,tetap,k,nf;    gpmem_t av=avma;
     GEN z,k,nf,T;
   
   checkrnf(rnf); tx=typ(x); lx=lg(x);    checkrnf(rnf); tx=typ(x); lx=lg(x);
   switch(tx)    switch(tx)
Line 373  rnfelementabstorel(GEN rnf,GEN x)
Line 399  rnfelementabstorel(GEN rnf,GEN x)
       return z;        return z;
   
     case t_POLMOD:      case t_POLMOD:
       x=lift_to_pol(x); /* fall through */        x = lift_to_pol(x); /* fall through */
     case t_POL:      case t_POL:
       p1=(GEN)rnf[11]; k=(GEN)p1[3]; nf=(GEN)rnf[10];        k  = (GEN)rnf[11]; k = (GEN)k[3];
       tetap=gmodulcp(gadd(polx[varn(rnf[1])],        nf = (GEN)rnf[10]; T = (GEN)nf[1];
             gmul(k,gmodulcp(polx[varn(nf[1])],(GEN)nf[1]))),(GEN)rnf[1]);        return gerepileupto(av, eltabstorel(x,T,(GEN)rnf[1],k));
       s=gzero;  
       for (i=lgef(x)-1; i>1; i--) s=gadd((GEN)x[i],gmul(tetap,s));  
       return gerepileupto(av,s);  
   
     default: return gcopy(x);      default: return gcopy(x);
   }    }
Line 414  rnfelementup(GEN rnf,GEN x)
Line 437  rnfelementup(GEN rnf,GEN x)
 GEN  GEN
 rnfelementdown(GEN rnf,GEN x)  rnfelementdown(GEN rnf,GEN x)
 {  {
   ulong av = avma;    gpmem_t av = avma;
   long i,lx,tx;    long i,lx,tx;
   GEN p1,z;    GEN p1,z;
   
Line 445  rnfelementdown(GEN rnf,GEN x)
Line 468  rnfelementdown(GEN rnf,GEN x)
 static GEN  static GEN
 rnfprincipaltohermite(GEN rnf,GEN x)  rnfprincipaltohermite(GEN rnf,GEN x)
 {  {
   long av=avma,tetpil;    gpmem_t av = avma;
   GEN nf,bas,bas1,p1,z;    GEN nf,bas,bas1,p1,z;
   
   x=rnfbasistoalg(rnf,x); nf=(GEN)rnf[10];    x = rnfbasistoalg(rnf,x); nf = (GEN)rnf[10];
   bas=(GEN)rnf[7]; bas1=(GEN)bas[1];    bas = (GEN)rnf[7]; bas1 = (GEN)bas[1];
   p1=rnfalgtobasis(rnf,gmul(x,gmodulcp(bas1,(GEN)rnf[1])));    p1 = rnfalgtobasis(rnf, gmul(x,gmodulcp(bas1,(GEN)rnf[1])));
   z=cgetg(3,t_VEC); z[2]=bas[2];    settyp(p1,t_MAT);
   settyp(p1,t_MAT); z[1]=(long)matalgtobasis(nf,p1);  
   
   tetpil=avma;    z = cgetg(3,t_VEC);
   return gerepile(av,tetpil,nfhermite(nf,z));    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  GEN
 rnfidealhermite(GEN rnf,GEN x)  rnfidealhermite(GEN rnf,GEN x)
 {  {
   long tx=typ(x),lx=lg(x),av=avma,tetpil,i,j,n,m;    long tx=typ(x), lx=lg(x), i, j, n, m;
   GEN z,p1,p2,x1,x2,x1j,nf,bas,unnf,zeronf;    gpmem_t av=avma, tetpil;
     GEN z,p1,p2,x1,x2,x1j,nf,bas;
   
   checkrnf(rnf);    checkrnf(rnf);
   n=degpol(rnf[1]); nf=(GEN)rnf[10]; bas=(GEN)rnf[7];    n = degpol(rnf[1]); nf = (GEN)rnf[10]; bas = (GEN)rnf[7];
   
   switch(tx)    switch(tx)
   {    {
     case t_INT: case t_FRAC: case t_FRACN: z=cgetg(3,t_VEC);      case t_INT: case t_FRAC: case t_FRACN:
       m=degpol(nf[1]); zeronf=gscalcol_i(gzero,m); unnf=gscalcol_i(gun,m);        m = degpol(nf[1]);
       p1=cgetg(n+1,t_MAT); z[1]=(long)p1;        z = cgetg(3,t_VEC);
       for (j=1; j<=n; j++)        z[1] = (long)rnfid(n, m);
       {        z[2] = lmul(x, (GEN)bas[2]); return z;
         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:      case t_POLMOD: case t_POL:
       p1=rnfalgtobasis(rnf,x); tetpil=avma;        p1 = rnfalgtobasis(rnf,x);
       return gerepile(av,tetpil,rnfprincipaltohermite(rnf,p1));        return gerepileupto(av, rnfprincipaltohermite(rnf,p1));
   
     case t_VEC:      case t_VEC:
       switch(lx)        switch(lx)
Line 535  rnfidealhermite(GEN rnf,GEN x)
Line 562  rnfidealhermite(GEN rnf,GEN x)
   return NULL; /* not reached */    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<l; i++) z = idealmul(nf, z, (GEN)I[i]);
     return z;
   }
   
   static GEN
   prodidnorm(GEN I)
   {
     long i, l = lg(I);
     GEN z;
   
     if (l == 1) return gun;
     z = dethnf((GEN)I[1]);
     for (i=2; i<l; i++) z = gmul(z, dethnf((GEN)I[i]));
     return z;
   }
   
 GEN  GEN
 rnfidealnormrel(GEN rnf,GEN id)  rnfidealnormrel(GEN rnf,GEN id)
 {  {
   long av=avma,i,n;    gpmem_t av = avma;
   GEN z,id2,nf;    GEN z, t, nf;
     long n;
   
   checkrnf(rnf);    checkrnf(rnf); nf = (GEN)rnf[10];
   id=rnfidealhermite(rnf,id); id2=(GEN)id[2];    n = degpol(rnf[1]);
   n=degpol(rnf[1]); nf=(GEN)rnf[10];    if (n == 1) { avma = av; return idmat(degpol(nf[1])); }
   if (n==1) { avma=av; return idmat(degpol(nf[1])); }  
   z=(GEN)id2[1]; for (i=2; i<=n; i++) z=idealmul(nf,z,(GEN)id2[i]);    id = rnfidealhermite(rnf,id);
   return gerepileupto(av,z);    t = prodid(nf, gmael(rnf,7,2));
     z = prodid(nf, (GEN)id[2]);
     return gerepileupto(av, idealdiv(nf,z,t));
 }  }
   
 GEN  GEN
 rnfidealnormabs(GEN rnf,GEN id)  rnfidealnormabs(GEN rnf,GEN id)
 {  {
   long av=avma,i,n;    gpmem_t av = avma;
   GEN z,id2;    GEN z, t;
     long n;
   
   checkrnf(rnf);    checkrnf(rnf);
   id=rnfidealhermite(rnf,id); id2=(GEN)id[2];    n = degpol(rnf[1]);
   n=degpol(rnf[1]);    if (n == 1) return gun;
   z=gun; for (i=1; i<=n; i++) z=gmul(z,dethnf((GEN)id2[i]));  
   return gerepileupto(av,z);    id = rnfidealhermite(rnf,id);
     z = prodidnorm((GEN)id[2]);
     t = prodidnorm(gmael(rnf,7,2));
     return gerepileupto(av, gdiv(z, t));
 }  }
   
 GEN  GEN
 rnfidealreltoabs(GEN rnf,GEN x)  rnfidealreltoabs(GEN rnf,GEN x)
 {  {
   long av=avma,i,j,k,n,m;    long i, j, n, m;
   GEN nf,basinv,om,id,p1,p2,p3,p4,p5,c;    gpmem_t av = avma;
     GEN nf,basinv,om,id,t,M,p1,p2,c;
   
   checkrnf(rnf);    nf = (GEN)rnf[10];
   x = rnfidealhermite(rnf,x);    x = rnfidealhermite(rnf,x);
   n=degpol(rnf[1]); nf=(GEN)rnf[10]; m=degpol(nf[1]);    n = degpol(rnf[1]);
     m = degpol(nf[1]);
   basinv = gmael(rnf,11,5);    basinv = gmael(rnf,11,5);
   p3=cgetg(n*m+1,t_MAT); p2=gmael(rnf,11,2);    t = gmael(rnf,11,2);
     M = cgetg(n*m+1,t_MAT);
   for (i=1; i<=n; i++)    for (i=1; i<=n; i++)
   {    {
     om=rnfbasistoalg(rnf,gmael(x,1,i)); id=gmael(x,2,i);      om = rnfbasistoalg(rnf,gmael(x,1,i));
     om=rnfelementreltoabs(rnf,om);      om = rnfelementreltoabs(rnf,om);
       id = gmael(x,2,i);
     for (j=1; j<=m; j++)      for (j=1; j<=m; j++)
     {      {
       p1=gmul((GEN)nf[7],(GEN)id[j]);        p1 = gmul((GEN)nf[7],(GEN)id[j]);
       p4=lift_intern(gmul(om,gsubst(p1,varn(nf[1]),p2)));        p2 = lift_intern(gmul(om, poleval(p1, t)));
       p5=cgetg(n*m+1,t_COL);        M[(i-1)*m+j] = (long)pol_to_vec(p2, n*m);
       for (k=0; k<n*m; k++) p5[k+1]=(long)truecoeff(p4,k);  
       p3[(i-1)*m+j]=(long)p5;  
     }      }
   }    }
   p1 = gmul(basinv,p3); c = content(p1);    p1 = primitive_part(gmul(basinv,M), &c);
   p2 = gmael(p1,1,1); /* x \cap Z */    p1 = hnfmodid(p1, gmael(p1,1,1)); /* mod x \cap Z */
   if (is_pm1(c)) c = NULL; else { p1 = gdiv(p1, c); p2 = gdiv(p2, c); }  
   p1 = hnfmodid(p1, p2);  
   if (c) p1 = gmul(p1, c);    if (c) p1 = gmul(p1, c);
   return gerepileupto(av, p1);    return gerepileupto(av, p1);
 }  }
Line 597  rnfidealreltoabs(GEN rnf,GEN x)
Line 655  rnfidealreltoabs(GEN rnf,GEN x)
 GEN  GEN
 rnfidealabstorel(GEN rnf,GEN x)  rnfidealabstorel(GEN rnf,GEN x)
 {  {
   long av=avma,tetpil,n,m,j,k;    long n, m, j;
   GEN nf,basabs,ma,xj,p1,p2,id;    gpmem_t av = avma;
     GEN nf,basabs,M,xj,p1,p2,id;
   
   checkrnf(rnf); n=degpol(rnf[1]); nf=(GEN)rnf[10]; m=degpol(nf[1]);    checkrnf(rnf); nf = (GEN)rnf[10];
   if (typ(x)!=t_MAT || lg(x)!=(n*m+1) || lg(x[1])!=(n*m+1))    n = degpol(rnf[1]);
     m = degpol(nf[1]);
     if (typ(x) != t_MAT || lg(x) != n*m+1 || lg(x[1]) != n*m+1)
     err(impl,"rnfidealabstorel for an ideal not in HNF");      err(impl,"rnfidealabstorel for an ideal not in HNF");
   basabs=gmael(rnf,11,4); ma=cgetg(n*m+1,t_MAT);    basabs = gmael(rnf,11,4);
     M = cgetg(n*m+1,t_MAT);
   for (j=1; j<=n*m; j++)    for (j=1; j<=n*m; j++)
   {    {
     p2=cgetg(n+1,t_COL); ma[j]=(long)p2;      xj = gmul(basabs,(GEN)x[j]);
     xj=gmul(basabs,(GEN)x[j]);      xj = lift_intern(rnfelementabstorel(rnf,xj));
     xj=lift_intern(rnfelementabstorel(rnf,xj));      M[j] = (long)pol_to_vec(xj, n);
     for (k=0; k<n; k++)  
       p2[k+1]=(long)truecoeff(xj,k);  
   }    }
   ma=gmul((GEN)rnf[8],ma);    M = gmul((GEN)rnf[8], M);
   ma=matalgtobasis(nf,ma);    p1 = cgetg(n*m+1,t_VEC); id = idmat(m);
   p1=cgetg(n*m+1,t_VEC); id=idmat(m);    for (j=1; j<=n*m; j++) p1[j] = (long)id;
   for (j=1; j<=n*m; j++) p1[j]=(long)id;    p2 = cgetg(3,t_VEC);
   p2=cgetg(3,t_VEC); p2[1]=(long)ma; p2[2]=(long)p1;    p2[1] = (long)M;
   tetpil=avma; return gerepile(av,tetpil,nfhermite(nf,p2));    p2[2] = (long)p1;
     return gerepileupto(av, nfhermite(nf,p2));
 }  }
   
 GEN  GEN
 rnfidealdown(GEN rnf,GEN x)  rnfidealdown(GEN rnf,GEN x)
 {  {
   long av=avma;    gpmem_t av = avma;
     x = rnfidealhermite(rnf,x);
   checkrnf(rnf); x=rnfidealhermite(rnf,x);  
   return gerepilecopy(av,gmael(x,2,1));    return gerepilecopy(av,gmael(x,2,1));
 }  }
   
Line 633  rnfidealdown(GEN rnf,GEN x)
Line 693  rnfidealdown(GEN rnf,GEN x)
 GEN  GEN
 rnfidealup(GEN rnf,GEN x)  rnfidealup(GEN rnf,GEN x)
 {  {
   long av=avma,tetpil,i,n,m;    gpmem_t av = avma;
   GEN nf,bas,bas2,p1,p2,zeronf,unnf;    long i, n, m;
     GEN nf,bas,bas2,p1,p2;
   
   checkrnf(rnf);    checkrnf(rnf); nf = (GEN)rnf[10];
   bas=(GEN)rnf[7]; bas2=(GEN)bas[2];    n = degpol(rnf[1]);
   n=lg(bas2)-1; nf=(GEN)rnf[10]; m=degpol((GEN)nf[1]);    m = degpol((GEN)nf[1]);
   zeronf=zerocol(m); unnf=gscalcol_i(gun,m);    bas = (GEN)rnf[7]; bas2 = (GEN)bas[2];
   p2=cgetg(3,t_VEC); p1=cgetg(n+1,t_VEC);  
   p2[1]=(long)idmat_intern(n,unnf,zeronf);    p2 = cgetg(3,t_VEC); p1 = cgetg(n+1,t_VEC);
   p2[2]=(long)p1;    p2[1] = (long)rnfid(n, m);
     p2[2] = (long)p1;
   for (i=1; i<=n; i++) p1[i]=(long)idealmul(nf,x,(GEN)bas2[i]);    for (i=1; i<=n; i++) p1[i]=(long)idealmul(nf,x,(GEN)bas2[i]);
   tetpil=avma; return gerepile(av,tetpil,rnfidealreltoabs(rnf,p2));    return gerepileupto(av, rnfidealreltoabs(rnf,p2));
 }  }
   
 /* x a relative HNF ---> vector of 2 generators (relative polymods) */  /* x a relative HNF ---> vector of 2 generators (relative polymods) */
 GEN  GEN
 rnfidealtwoelement(GEN rnf,GEN x)  rnfidealtwoelement(GEN rnf,GEN x)
 {  {
   long av=avma,tetpil,j;    gpmem_t av = avma;
     long j;
   GEN p1,p2,p3,res,polabs,nfabs,z;    GEN p1,p2,p3,res,polabs,nfabs,z;
   
   checkrnf(rnf);    checkrnf(rnf);
   res=(GEN)rnf[11]; polabs=(GEN)res[1];    res=(GEN)rnf[11]; polabs=(GEN)res[1];
   nfabs=cgetg(10,t_VEC); nfabs[1]=(long)polabs;    nfabs = cgetg(10,t_VEC);
   for (j=2; j<=9; j++) nfabs[j]=zero;    nfabs[1] = (long)polabs;
   nfabs[7]=(long)lift((GEN)res[4]); nfabs[8]=res[5];    for (j=2; j<=9; j++) nfabs[j] = zero;
   p1=rnfidealreltoabs(rnf,x);    nfabs[7] = (long)lift((GEN)res[4]);
   p2=ideal_two_elt(nfabs,p1);    nfabs[8] = res[5];
   p3=rnfelementabstorel(rnf,gmul((GEN)res[4],(GEN)p2[2]));    p1 = rnfidealreltoabs(rnf,x);
   tetpil=avma; z=cgetg(3,t_VEC); z[1]=lcopy((GEN)p2[1]);    p2 = ideal_two_elt(nfabs,p1);
   z[2]=(long)rnfalgtobasis(rnf,p3);    p3 = rnfelementabstorel(rnf,gmul((GEN)res[4],(GEN)p2[2]));
   return gerepile(av,tetpil,z);    z = cgetg(3,t_VEC);
     z[1] = lcopy((GEN)p2[1]);
     z[2] = (long)rnfalgtobasis(rnf,p3);
     return gerepileupto(av, z);
 }  }
   
 GEN  GEN
 rnfidealmul(GEN rnf,GEN x,GEN y) /* x et y sous HNF relative uniquement */  rnfidealmul(GEN rnf,GEN x,GEN y) /* x et y sous HNF relative uniquement */
 {  {
   long av=avma,tetpil,i,j,n;    long i, j, n;
   GEN z,nf,x1,x2,p1,p2,p3,p4,p5,res;    gpmem_t av = avma;
     GEN z,nf,x1,x2,p1,p2,p3,p4,res;
   
   z=rnfidealtwoelement(rnf,y);    z = rnfidealtwoelement(rnf,y);
   nf=(GEN)rnf[10]; n=degpol(rnf[1]);    nf = (GEN)rnf[10]; n = degpol(rnf[1]);
   x=rnfidealhermite(rnf,x);    x = rnfidealhermite(rnf,x);
   x1=gmodulcp(gmul(gmael(rnf,7,1),matbasistoalg(nf,(GEN)x[1])),(GEN) rnf[1]);    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]);    x2 = (GEN)x[2];
   p2=lift_intern(gmul(rnfbasistoalg(rnf,(GEN)z[2]),x1));    p1 = gmul((GEN)z[1],(GEN)x[1]);
   p3=cgetg(n+1,t_MAT);    p2 = lift_intern(gmul(rnfbasistoalg(rnf,(GEN)z[2]),x1));
     p3 = cgetg(n+1,t_MAT);
   for (j=1; j<=n; j++)    for (j=1; j<=n; j++)
   {    {
     p4=cgetg(n+1,t_COL); p3[j]=(long)p4; p5=(GEN)p2[j];      p4 = pol_to_vec((GEN)p2[j], n); p3[j] = (long)p4;
     for (i=1; i<=n; i++)      for (i=1; i<=n; i++) p4[i] = (long)algtobasis(nf,(GEN)p4[i]);
       p4[i]=(long)algtobasis(nf,truecoeff((GEN)p5,i-1));  
   }    }
   res=cgetg(3,t_VEC);    res = cgetg(3,t_VEC);
   res[1]=(long)concatsp(p1,p3);    res[1] = (long)concatsp(p1,p3);
   res[2]=(long)concatsp(x2,x2);    res[2] = (long)concatsp(x2,x2);
   tetpil=avma; return gerepile(av,tetpil,nfhermite(nf,res));    return gerepileupto(av, 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<lx; i++) z[i]=(long)element_mul(nf,s,(GEN)x[i]);  
   return z;  
 }  
   
 GEN  
 polnfmul(GEN nf, GEN x, GEN y)  
 {  
   ulong av;  
   long m,i,d,imin,imax,lx,ly,lz;  
   GEN p1,z,zeronf;  
   
   if (gcmp0(x) || gcmp0(y)) return zeropol(varn(x));  
   m=degpol(nf[1]); av=avma;  
   lx=degpol(x); ly=degpol(y); lz=lx+ly;  
   zeronf=gscalcol_i(gzero,m);  
   z=cgetg(lz+3,t_POL);  
   z[1] = evallgef(lz+3) | evalvarn(x) | evalsigne(1);  
   for (d=0; d<=lz; d++)  
   {  
     p1=zeronf; imin=max(0,d-ly); imax=min(d,lx);  
     for (i=imin; i<=imax; i++)  
       p1=gadd(p1,element_mul(nf,(GEN)x[i+2],(GEN)y[d-i+2]));  
     z[d+2]=(long)p1;  
   }  
   return gerepilecopy(av,z);  
 }  
   
 /* division euclidienne */  
 GEN  
 polnfdeuc(GEN nf, GEN x, GEN y, GEN *ptr)  
 {  
   long av=avma,m,i,d,tx,lx,ly,lz,fl;  
   GEN z,unnf,lcy,r;  
   GEN *gptr[2];  
   
   if (gcmp0(y)) err(talker,"division by zero in polnfdiv");  
   lx=lgef(x); ly=lgef(y); lz=lx-ly;  
   if (gcmp0(x) || lz<0) { *ptr=gcopy(x); return zeropol(varn(x)); }  
   
   m=degpol(nf[1]); unnf=gscalcol_i(gun,m);  
   x=dummycopy(x); y=dummycopy(y);  
   for (i=2; i<lx; i++)  
   {  
     tx=typ(x[i]);  
     if (is_intreal_t(tx) || tx == t_INTMOD || is_frac_t(tx))  
       x[i]=lmul((GEN)x[i],unnf);  
   }  
   for (i=2; i<ly; i++)  
   {  
     tx=typ(y[i]);  
     if (is_intreal_t(tx) || tx == t_INTMOD || is_frac_t(tx))  
       y[i]=lmul((GEN)y[i],unnf);  
   }  
   
   lz += 3;  
   z=cgetg(lz,t_POL); z[1]=evallgef(lz) | evalvarn(x) | evalsigne(1);  
   lcy=(GEN)y[ly-1];  
   if (gegal(lift(lcy),unnf)) fl=0;  
   else  
   {  
     fl=1; y=polnfmulscal(nf,element_inv(nf,lcy),y);  
   }  
   for (d=lz-1; d>=2; d--)  
   {  
     z[d]=x[d+ly-3];  
     for (i=d; i<d+ly-3; i++)  
       x[i]=lsub((GEN)x[i],element_mul(nf,(GEN)z[d],(GEN)y[i-d-2]));  
   }  
   if (fl) z=polnfmulscal(nf,lcy,z);  
   
   for(;;)  
   {  
     if (!gcmp0((GEN)x[d]))  
     {  
       r=cgetg(d,t_POL);  
       r[1] = evallgef(d) | evalvarn(varn(x)) | evalsigne(1);  
       for (i=2; i<d; i++) r[i]=x[i];  
       break;  
     }  
     if (d==2) { r = zeropol(varn(x)); break; }  
     d--;  
   }  
   *ptr=r; gptr[0]=ptr; gptr[1]=&z;  
   gerepilemany(av,gptr,2); return z;  
 }  
   
 GEN  
 polnfpow(GEN nf,GEN x,GEN k)  
 {  
   long s,av=avma,m;  
   GEN y,z;  
   
   m=degpol(nf[1]);  
   if (typ(k)!=t_INT) err(talker,"not an integer exponent in nfpow");  
   s=signe(k); if (s<0) err(impl,"polnfpow for negative exponents");  
   
   z=x; y=cgetg(3,t_POL);  
   y[1] = evallgef(3) | evalvarn(varn(x)) | evalsigne(1);  
   y[2] = (long)gscalcol_i(gun,m);  
   for(;;)  
   {  
     if (mpodd(k)) y=polnfmul(nf,z,y);  
     k=shifti(k,-1);  
     if (!signe(k)) { cgiv(k); return gerepileupto(av,y); }  
     z=polnfmul(nf,z,z);  
   }  
 }  }
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>