/*******************************************************************/
/*******************************************************************/
/*                                                                 */
/*             Factorisation dans un corps de nombres              */
/*                  et modulo un ideal premier                     */
/*                                                                 */
/*******************************************************************/
/*******************************************************************/
/* $Id: nffactor.c,v 2.0.0.2 1997/12/14 20:11:49 karim Exp karim $ */
#include "genpari.h"

/* rnfminpoly PAS ENCORE UTILISE */

GEN nfker(GEN nf,GEN Q,GEN prhall);
GEN hensel_lift(GEN pol,GEN fk,GEN fkk,GEN p,long e);

static GEN primehall(GEN nf,GEN pr);
static GEN nf_pol_mul(GEN nf,GEN pol1,GEN pol2);
static GEN nf_pol_sqr(GEN nf,GEN pol1);
static GEN nf_pol_divres(GEN nf,GEN pol1,GEN pol2, GEN *pr);
static GEN nf_pol_subres(GEN nf,GEN pol1,GEN pol2);
static GEN nfmod_pol_reduce(GEN nf,GEN prhall,GEN pol);
static GEN nfmod_pol_mul(GEN nf,GEN prhall,GEN pol1,GEN pol2);
static GEN nfmod_pol_sqr(GEN nf,GEN prhall,GEN pol1);
static GEN nfmod_pol_divres(GEN nf,GEN prhall,GEN pol1,GEN pol2, GEN *pr);
static GEN nfmod_split2(GEN nf,GEN prhall,GEN pmod,GEN pol,GEN exp);
static GEN nfmod_pol_gcd(GEN nf,GEN prhall,GEN pol1,GEN pol2);
static GEN nfmod_pol_pow(GEN nf,GEN prhall,GEN pmod,GEN pol,GEN exp);
static GEN nf_bestlift(GEN id,GEN idinv,GEN elt);
static GEN nf_pol_lift(GEN id,GEN idinv,GEN pol);
static GEN nf_pol_eval(GEN nf,GEN pol,GEN elt);
static GEN nf_init_t2(GEN nf,long prec);
static GEN nfsqff(GEN nf,GEN pol,long fl);
static int nf_combine_factors(GEN nf,long fxn,GEN psf,long dlim,long hint);
static GEN myfactpadic(GEN pol,GEN pr,long e);
static GEN T2_matrix_pow(GEN nf,GEN T2,GEN pr,GEN e, GEN kmax,long prec);

typedef struct Nfcmbf /* for use in nfsqff */
{
  GEN pol, h, hinv, fact, res, lt;
  long nfact, nfactmod;
} Nfcmbf;
static Nfcmbf nfcmbf;

static GEN
unifpol0(GEN nf,GEN pol,long flag)
{
  static long n = 0;
  static GEN vun = NULL;
  GEN f = (GEN) nf[1];
  long i = lgef(f)-3, av, tetpil;
  
  if (i != n)
  {
    n=i; if (vun) free(vun);
    vun = (GEN) gpmalloc((n+1)*sizeof(long));
    vun[0] = evaltyp(t_COL) | evallg(n+1); vun[1]=un;
    for ( ; i>=2; i--) vun[i]=zero;
  }

  av = tetpil = avma;
  switch(typ(pol))
  {
    case t_INT: case t_FRAC: case t_RFRAC: 
      pol = gmul(pol,vun); break;

    case t_POL: 
      pol = gmodulcp(pol,f); /* fall through */
    case t_POLMOD:
      tetpil = avma; pol = algtobasis(nf,pol);
  }
  if (flag) { tetpil = avma; pol = basistoalg(nf,pol); }
  return gerepile(av,tetpil,pol);
}

/* Pour pol un polynome a coefficients dans Z, nf ou l'algebre correspondant
 * renvoie le meme polynome avec pour coefficients:
 *  si flag=0: des vecteurs sur la base d'entiers.
 *  si flag=1: des polymods.
 */
GEN
unifpol(GEN nf,GEN pol,long flag)
{
  if (typ(pol)==t_POL && varn(pol) < varn(nf[1]))
  {
    long i, d = lgef(pol);
    GEN p1 = pol;

    pol=cgetg(d,t_POL); pol[1]=p1[1];
    for (i=2; i<d; i++)
      pol[i] = (long) unifpol0(nf,(GEN) p1[i],flag);

    return pol;
  }
  return unifpol0(nf,(GEN) pol, flag);
}

/* calcule la forme prhall de l'ideal premier pr */
static GEN
primehall(GEN nf,GEN pr)
{
  long av = avma,tetpil;
  GEN prhall,id,p1, p = (GEN) pr[1], epr = (GEN) pr[3];

  if (typ(pr) != t_VEC || lg(pr) != 6) 
    err(talker,"I expected a prime ideal there (primehall)");
  p1 = cgetg(2,t_MAT);
  p1[1] = ldiv(element_pow(nf,(GEN)pr[5],epr), gpuigs(p,itos(epr)-1));
  id = idmat(lgef(nf[1])-3);
  p1 = idealadd(nf,gmul(p,id),idealmul(nf,p1,id));

  tetpil=avma; prhall = cgetg(3,t_VEC);
  prhall[1] = (long) idealmulprime(nf,id,pr);
  prhall[2] = idealaddtoone(nf,pr,p1)[2];
  return gerepile(av,tetpil,prhall);
}

/* cree un polynome unitaire de degre d a entrees au hazard dans Z_nf */
GEN
random_pol(GEN nf,long d)
{
  long i,j, n = lgef(nf[1])-3;
  GEN pl,p;

  pl=cgetg(d+3,t_POL);
  for (i=2; i<d+2; i++)
  {
    p=cgetg(n+1,t_COL); pl[i]=(long)p;
    for (j=1; j<=n; j++)
      p[j] = lstoi(mymyrand()%101 - 50);
  }
  p=cgetg(n+1,t_COL); pl[i]=(long)p;
  p[1]=un; for (i=2; i<=n; i++) p[i]=zero;

  pl[1] = evalsigne(1) | evallgef(d+3) | evalvarn(0);
  return pl;
}

/* multiplication de x par y dans nf (x element accepte) */
static GEN
nf_pol_mul(GEN nf,GEN x,GEN y)
{
  long tetpil,av=avma;
  GEN res = gmul(unifpol(nf,x,1), unifpol(nf,y,1));

  tetpil = avma;
  return gerepile(av,tetpil,unifpol(nf,res,0));
}

/* calcule x^2 dans nf (x element accepte) */
static GEN
nf_pol_sqr(GEN nf,GEN x)
{
  long tetpil,av=avma;
  GEN res = gsqr(unifpol(nf,x,1));

  tetpil = avma;
  return gerepile(av,tetpil,unifpol(nf,res,0));
}

/* Reduction modulo phall des coefficients de pol (pol element accepte) */
static GEN
nfmod_pol_reduce(GEN nf,GEN prhall,GEN pol)
{
  long av=avma,tetpil,i;
  GEN p1;

  if (typ(pol)!=t_POL) return nfreducemodpr(nf,pol,prhall);
  pol=unifpol(nf,pol,0);

  tetpil=avma; i=lgef(pol);
  p1=cgetg(i,t_POL); p1[1]=pol[1];
  for (i--; i>=2; i--)
    p1[i] = (long) nfreducemodpr(nf,(GEN)pol[i],prhall);
  return gerepile(av,tetpil, normalizepol(p1));
}

/* x^2 modulo prhall ds nf (x elt accepte) */
static GEN
nfmod_pol_sqr(GEN nf,GEN prhall,GEN x)
{
  long av=avma,tetpil;
  GEN px;

  px = nfmod_pol_reduce(nf,prhall,x);
  px = unifpol(nf,lift(px),1);
  px = unifpol(nf,nf_pol_sqr(nf,px),0);
  tetpil=avma;
  return gerepile(av,tetpil,nfmod_pol_reduce(nf,prhall,px));
}

/* multiplication des polynomes x et y modulo prhall ds nf (x elt accepte) */
static GEN
nfmod_pol_mul(GEN nf,GEN prhall,GEN x,GEN y)
{
  long av=avma,tetpil;
  GEN px,py;

  px = nfmod_pol_reduce(nf,prhall,x); px = unifpol(nf,lift(px),1);
  py = nfmod_pol_reduce(nf,prhall,y); py = unifpol(nf,lift(py),1);
  px = unifpol(nf,nf_pol_mul(nf,px,py),0);
  tetpil=avma;
  return gerepile(av,tetpil,nfmod_pol_reduce(nf,prhall,px));
}

/* division euclidienne du polynome x par le polynome y */
static GEN
nf_pol_divres(GEN nf,GEN x,GEN y,GEN *pr)
{
  long av = avma,tetpil;
  GEN nq = poldivres(unifpol(nf,x,1),unifpol(nf,y,1),pr);
  GEN *gptr[2];

  tetpil=avma; nq=unifpol(nf,nq,0);
  if (pr) *pr = unifpol(nf,*pr,0);
  gptr[0]=&nq; gptr[1]=pr;
  gerepilemanysp(av,tetpil,gptr,pr ? 2:1);
  return nq;
}

/* division euclidienne du polynome x par le polynome y modulo prhall */
static GEN
nfmod_pol_divres(GEN nf,GEN prhall,GEN x,GEN y, GEN *pr)
{
  long av=avma,dx,dy,dz,i,j,k,l,n,tetpil;
  GEN z,p1,p2,p3,px,py;

  py = nfmod_pol_reduce(nf,prhall,y);
  if (gcmp0(py)) 
    err(talker, "division by zero in nfmod_pol_divres");

  tetpil=avma;
  px=nfmod_pol_reduce(nf,prhall,x);
  dx=lgef(px)-3; dy=lgef(py)-3; dz=dx-dy;
  if (dx<dy)
  {
    GEN vzero;

    if (pr) *pr = gerepile(av,tetpil,px);
    else avma = av;

    n=lgef(nf[1])-3;
    vzero = cgetg(n+1,t_COL);
    n=lgef(nf[1])-3;
    for (i=1; i<=n; i++) vzero[i]=zero;

    z=cgetg(3,t_POL); z[2]=(long)vzero;
    z[1]=evallgef(2) | evalvarn(varn(px));
    return z;
  }

  z=cgetg(dz+3,t_POL); z[1]=evalsigne(1) | evallgef(3+dz);
  setvarn(z,varn(px));
  z[dz+2] = (long) element_divmodpr(nf,(GEN)px[dx+2],(GEN)py[dy+2],prhall);
  for (i=dx-1; i>=dy; --i)
  {
    l=avma; p1=nfreducemodpr(nf,(GEN)px[i+2],prhall);
    for (j=i-dy+1; j<=i && j<=dz; j++)
    {
      p2=element_mul(nf,(GEN)z[j+2],(GEN)py[i-j+2]);
      p2=nfreducemodpr(nf,p2,prhall); p1=gsub(p1,p2);
    }
    tetpil=avma; p3=element_divmodpr(nf,p1,(GEN)py[dy+2],prhall);
    z[i-dy+2]=lpile(l,tetpil,p3);
    z[i-dy+2]=(long)nfreducemodpr(nf,(GEN)z[i-dy+2],prhall);
  }
  l=avma;
  for (i=dy-1; i>=0; --i)
  {
    l=avma; p1=((GEN)px[i+2]);
    for (j=0; j<=i && j<=dz; j++)
    {
      p2=element_mul(nf,(GEN)z[j+2],(GEN)py[i-j+2]);
      p2=nfreducemodpr(nf,p2,prhall); tetpil=avma; p1=gsub(p1,p2);
    }
    p1=gerepile(l,tetpil,p1);
    if (!gcmp0(nfreducemodpr(nf,p1,prhall))) break;
  }

  if (!pr) { avma = l; return z; }

  if (i<0)
  { 
    avma=l;
    p3 = cgetg(3,t_POL); p3[2]=zero;
    p3[1] = evallgef(2) | evalvarn(varn(px));
    *pr=p3; return z;
  }

  p3=cgetg(i+3,t_POL);
  p3[1]=evalsigne(1) | evallgef(i+3) | evalvarn(varn(px));
  p3[i+2]=(long)nfreducemodpr(nf,p1,prhall);
  for (k=i-1; k>=0; --k)
  {
    l=avma; p1=((GEN)px[k+2]);
    for (j=0; j<=k && j<=dz; j++)
    {
      p2=element_mul(nf,(GEN)z[j+2],(GEN)py[k-j+2]);
      p2=nfreducemodpr(nf,p2,prhall); tetpil=avma; p1=gsub(p1,p2);
    }
    p3[k+2]=lpile(l,tetpil,nfreducemodpr(nf,p1,prhall));
  }
  *pr=p3; return z;
}

/* PGCD des polynomes x et y, par l'algorithme du sub-resultant */
static GEN
nf_pol_subres(GEN nf,GEN x,GEN y)
{
  long av=avma,tetpil;
  GEN s = srgcd(unifpol(nf,x,1), unifpol(nf,y,1));

  tetpil=avma; return gerepile(av,tetpil,unifpol(nf,s,1));
}

/* PGCD des polynomes x et y modulo prhall */
static GEN
nfmod_pol_gcd(GEN nf,GEN prhall,GEN x,GEN y)
{
  long av=avma;
  GEN p1,p2;

  if (lgef(x)<lgef(y)) { p1=y; y=x; x=p1; }
  p1=nfmod_pol_reduce(nf,prhall,x);
  p2=nfmod_pol_reduce(nf,prhall,y);
  while (!isexactzero(p2))
  { 
    GEN p3;

    nfmod_pol_divres(nf,prhall,p1,p2,&p3);
    p1=p2; p2=p3;
  }
  return gerepileupto(av,p1);
}

/* Calcul pol^e modulo prhall et le polynome pmod */
static GEN
nfmod_pol_pow(GEN nf,GEN prhall,GEN pmod,GEN pol,GEN e)
{
  long i, av = avma, n = lgef(nf[1])-3;
  GEN p1,p2,vun;
 
  vun=cgetg(n+1,t_COL); vun[1]=un; for (i=2; i<=n; i++) vun[i]=zero;
  p1=gcopy(polun[varn(pol)]); p1[2]=(long)vun;
  if (gcmp0(e)) return p1;

  p2=nfmod_pol_reduce(nf,prhall,pol);
  for(;;)
  {
    if (!vali(e))
    {
      p1=nfmod_pol_mul(nf,prhall,p1,p2);
      nfmod_pol_divres(nf,prhall,p1,pmod,&p1);
    }
    if (gcmp1(e)) break;

    e=shifti(e,-1);
    p2=nfmod_pol_sqr(nf,prhall,p2);
    nfmod_pol_divres(nf,prhall,p2,pmod,&p2);
  }
  return gerepileupto(av,p1);
}

/* factorisation du polynome x modulo pr */
GEN
nffactormod(GEN nf,GEN pol,GEN pr)
{
  long N,n,i,j,k,d,e,vf,r,kk,expos[100];
  long lb,nbfact,av=avma,tetpil,psim;
  GEN y,t[100],f1,f2,f3,df1,g1,polb,pold,polu,vker;
  GEN Q,f,x,u,v,v2,v3,vz,q,vun,vzero,prhall;

  nf=checknf(nf);
  if (typ(pol)!=t_POL) err(typeer,"nffactormod");
  if (varn(pol) >= varn(nf[1]))
    err(talker,"polynomial variable must have highest priority in nffactormod");
  
  prhall=primehall(nf,pr); n=lgef(nf[1])-3; vun=cgetg(n+1,t_COL);
  vzero=cgetg(n+1,t_COL); vun[1]=un; vzero[1]=zero;
  for (i=2; i<=n; i++){ vun[i] = vzero[i] = zero; }

  f=unifpol(nf,pol,0); f=nfmod_pol_reduce(nf,prhall,f);
  d=lgef(f)-3; vf=varn(f);
  x=gcopy(polx[vf]); x[3]=(long)vun; x[2]=(long)vzero;
  if (d<=1) { nbfact=2; t[1] = f; expos[1]=1; }
  else
  {
    /*  1ere etape : trouver les facteurs square-free produit
	des facteurs premiers de meme multiplicite    */

    q=gpuigs((GEN)pr[1],itos((GEN)pr[4])); psim=itos((GEN)pr[1]);
    f1=f; e=1; nbfact=1;
    while (lgef(f1)>3)
    {
      df1=deriv(f1,vf); f2=nfmod_pol_gcd(nf,prhall,f1,df1);
      g1=nfmod_pol_divres(nf,prhall,f1,f2,NULL); k=0;
      while (lgef(g1)>3)
      {
	k++;
	if (k%psim == 0)
	{
	  k++; f2=nfmod_pol_divres(nf,prhall,f2,g1,NULL);
	}
	f3=nfmod_pol_gcd(nf,prhall,f2,g1);
	u = nfmod_pol_divres(nf,prhall,g1,f3,NULL);
	f2= nfmod_pol_divres(nf,prhall,f2,f3,NULL);
	g1=f3;
	if (lgef(u)>3)
	{
	  N=lgef(u)-3; Q=cgetg(N+1,t_MAT);
	  v3=cgetg(N+1,t_COL); Q[1]=(long)v3;
	  v3[1]=(long)vun; for (i=2; i<=N; i++) v3[i]=(long)vzero;
	  
	  v2 = v = nfmod_pol_pow(nf,prhall,u,x,q);
	  for (j=2; j<=N; j++)
	  {
	    v3=cgetg(N+1,t_COL); Q[j]=(long)v3;
	    for (i=1; i<=lgef(v2)-2; i++) v3[i]=v2[i+1];
	    for (; i<=N; i++) v3[i]=(long)vzero;
	    if (j<N)
	    {
	      v2=nfmod_pol_mul(nf,prhall,v2,v);
	      nfmod_pol_divres(nf,prhall,v2,u,&v2);
	    }
	  }
	  for (i=1; i<=N; i++)
	    coeff(Q,i,i)=lsub((GEN)coeff(Q,i,i),vun);
	  v2=nfker(nf,Q,prhall); r=lg(v2)-1; t[nbfact]=gcopy(u); kk=1;
	  if (r>1)
	  {
	    vker=cgetg(r+1,t_COL);
	    for (i=1; i<=r; i++)
	    {
	      v3=cgetg(N+2,t_POL);
	      v3[1]=evalsigne(1)+evallgef(2+N); setvarn(v3,vf);
	      vker[i]=(long)v3; for (j=1; j<=N; j++) v3[j+1]=coeff(v2,j,i);
	      normalizepol(v3);
	    }
	  }
	  while (kk<r)
	  {
	    v=gcopy(polun[vf]); v[2]=(long)vzero;
	    for (i=1; i<=r; i++)
	    {
	      vz=cgetg(n+1,t_COL);
	      for (j=1; j<=n; j++)
		vz[j] = lmodsi(mymyrand()>>8, q);
	      vz=nfreducemodpr(nf,vz,prhall);
	      v=gadd(v,nfmod_pol_mul(nf,prhall,vz,(GEN)vker[i]));
	    }
	    for (i=1; i<=kk && kk<r; i++)
	    {
	      polb=t[nbfact+i-1]; lb=lgef(polb);
	      if (lb>4)
	      {
		if(psim==2)
		{
		  polu=nfmod_split2(nf,prhall,polb,v,q);
		  pold=nfmod_pol_gcd(nf,prhall,polb,polu);
		}
		else
		{
		  polu=nfmod_pol_pow(nf,prhall,polb,v,shifti(q,-1));
		  pold=nfmod_pol_gcd(nf,prhall,polb,gsub(polu,vun));
		}
		if (lgef(pold)>3 && lgef(pold)<lb)
		{
		  t[nbfact+i-1]=pold; kk++;
		  t[nbfact+kk-1]=nfmod_pol_divres(nf,prhall,polb,pold,NULL);
		}
	      }
	    }
	  }
	  for (i=nbfact; i<nbfact+r; i++) expos[i]=e*k;
	  nbfact+=r;
	}
      }
      e*=psim; j=(lgef(f2)-3)/psim+3; f1=cgetg(j,t_POL);
      f1[1] = evalsigne(1) | evallgef(j) | evalvarn(vf);
      for (i=2; i<j; i++)
	f1[i]=(long)element_powmodpr(nf,(GEN)f2[psim*(i-2)+2],
				     gdiv(q,(GEN)pr[1]),prhall); 
    }
  }
  v=element_divmodpr(nf,vun,gmael(t,1,lgef(t[1])-1),prhall);
  t[1]=unifpol(nf,nfmod_pol_mul(nf,prhall,v,(GEN)t[1]),1);
  for (j=2; j<nbfact; j++)
    if (expos[j])
    {
      v=element_divmodpr(nf,vun,gmael(t,j,lgef(t[j])-1),prhall);
      t[j]=unifpol(nf,nfmod_pol_mul(nf,prhall,v,(GEN)t[j]),1);
    }

  tetpil=avma;
  y=cgetg(3,t_MAT); u=cgetg(nbfact,t_COL); y[1]=(long)u;
  v=cgetg(nbfact,t_COL); y[2]=(long)v;
  for (j=1,k=0; j<nbfact; j++)
    if (expos[j]) 
      { k++; u[k]=lcopy((GEN)t[j]); v[k]=lstoi(expos[j]); }
  return gerepile(av,tetpil,y);
}

/* Calcule pol + pol^2 + ... + pol^(q/2) modulo prhall et le polynome pmod */ 
static GEN
nfmod_split2(GEN nf,GEN prhall,GEN pmod,GEN pol,GEN exp)
{
  long av = avma;
  GEN p1,p2,q;

  if (cmpis(exp,2)<=0) return pol;
  p2=p1=pol; q=shifti(exp,-1);
  while (!gcmp1(q))
  {
    p2=nfmod_pol_sqr(nf,prhall,p2);
    nfmod_pol_divres(nf,prhall,p2,pmod,&p2);
    q=shifti(q,-1); p1=gadd(p1,p2);
  }
  return gerepileupto(av,p1);
}

/* If p doesn't divide either a or b and has a divisor of degree 1, return it.
 * Return NULL otherwise.
 */
static GEN
p_ok(GEN nf, long p, GEN a, GEN b)
{
  long av,m,i;
  GEN dec;

  if (!smodis(a,p) || !smodis(b,p)) return NULL;
  av = avma; dec = primedec(nf,stoi(p)); m=lg(dec);
  for (i=1; i<m; i++)
  {
    GEN pr = (GEN)dec[i];
    if (is_pm1(pr[4]))
    {
      if (DEBUGLEVEL>=4)
        fprintferr("Premier choisi pour decomposition: %Z", (long)pr);
      return pr;
    }
  }	
  avma = av; return NULL;
}

static GEN
choose_prime(GEN nf, GEN disc, GEN dk, long lim)
{
  byteptr ptr = diffptr;
  GEN pr = NULL;
  long p;

  for (p=0; p<lim; p += *ptr++)
    if (! *ptr) break;
  for (   ; *ptr ; p += *ptr++)
    if ((pr = p_ok(nf,p,disc,dk))) break;
  if (! pr)
  { 
    for (  ; p; p -= *ptr--)
      if ((pr = p_ok(nf,p,disc,dk))) break;
    if (!pr) err(primer1);
  }
  return pr;
}

/* Renvoie les racines de pol contenues dans nf */
GEN
nfroots(GEN nf,GEN pol)
{
  long av=avma,tetpil,i,d=lgef(pol);
  GEN p1,polbase,polmod,den,disc;

  nf=checknf(nf);
  if (typ(pol)!=t_POL) err(talker,"not a polynomial in nfroots");
  if (varn(pol) >= varn(nf[1]))
    err(talker,"polynomial variable must have highest priority in nfroots");

  polbase=unifpol(nf,pol,0);

  if (d==3)
  {
    tetpil=avma; p1=cgetg(1,t_VEC);
    return gerepile(av,tetpil,p1);
  }

  if (d==4)
  {
    tetpil=avma; p1=cgetg(2,t_VEC);
    p1[1] = (long)basistoalg(nf,gneg(
      element_div(nf,(GEN)polbase[2],(GEN)polbase[3])));
    return gerepile(av,tetpil,p1);
  }

  den=gun;
  for (i=2; i<d; i++)
    if (! gcmp0((GEN)polbase[i]))
      den = glcm(den,denom((GEN)polbase[i]));
  if (! gcmp1(absi(den)))
    for (i=2; i<d; i++)
      polbase[i] = lmul(den,(GEN)polbase[i]);

  polmod=unifpol(nf,polbase,1);
  disc=gnorm(discsr(polmod));
  if (gcmp0(disc))
  {
    if (DEBUGLEVEL>=4)
      { fprintferr("Le polynome est rendu square-free "); flusherr(); }

    p1=deriv(polmod,varn(polmod)); p1=nf_pol_subres(nf,polmod,p1);
    polmod=nf_pol_divres(nf,polmod,p1,NULL);
    polmod=unifpol(nf,polmod,1); /* utile ?? */
  }

  tetpil=avma;
  return gerepile(av,tetpil,nfsqff(nf,polmod,1));
}

/* Relevement de elt modulo id minimal */
static GEN
nf_bestlift(GEN id,GEN idinv,GEN elt)
{ 
  return gsub(elt,gmul(id,ground(gmul(idinv,elt))));
}

/* Releve le polynome pol avec des coeff de norme t2 <= C si possible */
static GEN
nf_pol_lift(GEN id,GEN idinv,GEN pol)
{
  long i, d = lgef(pol);
  GEN p1 = pol;

  pol=cgetg(d,t_POL); pol[1]=p1[1];
  for (i=2; i<d; i++)
    pol[i] = (long) nf_bestlift(id,idinv,(GEN)p1[i]);
  return pol;
}

/* Evalue le polynome pol en elt */
static GEN
nf_pol_eval(GEN nf,GEN pol,GEN elt)
{
  long av=avma,tetpil,i;
  GEN p1;

  i=lgef(pol)-1; if (i==2) return gcopy((GEN)pol[2]);

  p1=element_mul(nf,(GEN)pol[i],elt);
  for (i-- ; i>=3; i--)
    p1=element_mul(nf,elt,gadd((GEN)pol[i],p1));
  tetpil=avma; return gerepile(av,tetpil,gadd(p1,(GEN)pol[2]));
}

/* Calcul la matrice t2 de nf avec la precision prec */
static GEN
nf_init_t2(GEN nf,long prec)
{
  long i,j,n,r1,ru,av=avma,tetpil;
  GEN base,pol,p1,p2,p3,rts;

  pol=(GEN)nf[1]; r1=sturm(pol); n=lgef(pol)-3;
  if (r1==n) return gcopy(gmael(nf,5,4));

  base=gtrans((GEN)nf[7]);
  p1=cgetg(n+1,t_MAT);
  ru=r1+((n-r1)>>1); rts=roots(pol,prec);
  for (j=1; j<=n; j++)
  {
    p2=cgetg(ru+1,t_COL); p1[j]=(long)p2;
    for (i=1; i<=ru; i++)
      p2[i]=lsubst((GEN)base[j],varn(pol),(GEN)rts[max(i,(i<<1)-r1)]);
  }
  p3=cgetg(ru+1,t_MAT);
  for (j=1; j<=ru; j++)
  {
    p2=cgetg(n+1,t_COL); p3[j]=(long)p2;
    for (i=1; i<=n; i++)
      p2[i] = (j<=r1)?        lconj(gcoeff(p1,j,i)):
                       lmul2n(gconj(gcoeff(p1,j,i)),1);
  }
  p1=gmul(p3,p1); tetpil=avma;
  return gerepile(av,tetpil,greal(p1));
}

/* Calcule la factorisation du polynome x dans nf */
GEN
nffactor(GEN nf,GEN pol)
{
  long av=avma,tetpil,i,d;
  GEN y,p1,p2,den,p3,rep,quot;

  nf=checknf(nf);
  if (typ(pol)!=t_POL) err(typeer,"nffactor");
  if (varn(pol) >= varn(nf[1]))
    err(talker,"polynomial variable must have highest priority in nffactor");
  
  d=lgef(pol); rep=cgetg(3,t_MAT);
  if (d==3)
  { 
    rep[1]=lgetg(1,t_COL);
    rep[2]=lgetg(1,t_COL);
    return rep;
  }
  if (d==4)
  {
    p1=cgetg(2,t_COL); rep[1]=(long)p1; p1[1]=lcopy(pol);
    p1=cgetg(2,t_COL); rep[2]=(long)p1; p1[1]=un;
    return rep;
  }

  p1=unifpol(nf,pol,0); den=gun;
  for (i=2; i<d; i++)
    if (! gcmp0((GEN)p1[i]))
      den = glcm(den,denom((GEN)p1[i]));
  if (! gcmp1(absi(den)))
    for (i=2; i<d; i++)
      p1[i] = lmul(den,(GEN)p1[i]);

  p2=cgetg(d,t_POL); p2[1]=p1[1];
  for (i=2; i<d; i++)
    p2[i]=(long)basistoalg(nf,(GEN)p1[i]);
  if (!gcmp0(discsr(p2)))
  {
    tetpil=avma;
    rep=cgetg(3,t_MAT); rep[1]=(long)nfsqff(nf,p1,0);
    rep[2]=zero; /* dummy */
    rep=gerepile(av,tetpil,rep);

    i = nfcmbf.nfact;
    p2=cgetg(i + 1,t_COL); rep[2]=(long)p2;
    for ( ; i>=1; i--) p2[i]=un;
    return rep;
  }

  if (DEBUGLEVEL>=4)
  {
    fprintferr("Le polynome est rendu square-free\n"); flusherr();
  }
  p2=deriv(p1,varn(p1));
  p3=nf_pol_subres(nf,p1,p2);
  p2=nf_pol_divres(nf,p1,p3,NULL);
  d=lgef(p2); den=gun;
  for (i=2; i<d; i++)
    if (!gcmp0((GEN)p2[i]))
      den = glcm(den,denom((GEN)p2[i]));
  if (!gcmp1(absi(den)))
    for (i=2; i<d; i++)
      p2[i] = lmul(den,(GEN)p2[i]);

  y=nfsqff(nf,p2,0);
  i = nfcmbf.nfact;

  quot=nf_pol_divres(nf,p1,p2,NULL);
  rep=cgetg(3,t_MAT); rep[1]=(long)y;
  p3=cgetg(i + 1,t_COL); rep[2]=(long)p3;
  for ( ; i>=1; i--)
  {
    GEN fact=(GEN)y[i], rem;
    long e=0;

    do
    {
      quot = nf_pol_divres(nf,quot,fact,&rem);
      e++;
    }
    while (gcmp0(rem));
    p3[i]=lstoi(e);
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(rep));
}

/* Renvoie la norme T2 de l'element x */
#define nf_t2(nf,x) qfeval(gmael(nf,5,3),x)

/* Calcule la factorisation du polynome x qui est sans facteurs carres dans nf,
   Le polynome est a coefficients dans Z_k, si fl=1 renvoie seulement les
   racines du polynome contenues dans le corps */
static GEN
nfsqff(GEN nf,GEN pol,long fl)
{
  long d=lgef(pol),i,m,l,n,av=avma,tetpil,newprec,lim;             
  GEN disc,p1,pr,p2,rep,k,C,h,dk,dki,prh,p3,T2,polbase;
  GEN polmod,polred,hinv,lt,maxk=stoi(330);
  
  dk=(GEN)nf[3];
  dki=mulii(dk,(GEN)nf[4]);
  n=lgef(nf[1])-3;

  polbase = unifpol(nf,pol,0);
  polmod  = unifpol(nf,pol,1);
  dki=mulii(dki,gnorm((GEN)polmod[d-1]));
  disc=gnorm(discsr(polmod));
  if (DEBUGLEVEL>=4)
  { 
    fprintferr("La norme du discriminant du polynome est : ");
    outerr(disc);
  }

  C=gzero; 
  for (i=2; i<d; i++)
    C=mpadd(C,nf_t2(nf,(GEN)polbase[i]));
  if (DEBUGLEVEL>=4)
  {
    fprintferr("La norme de ce polynome est : "); outerr(C);
  }
  if (fl)
    C=mpadd(C,nf_t2(nf,(GEN)polbase[d-1]));
  else
  {
    C=mpadd(gmulsg(3,C),nf_t2(nf,(GEN)polbase[d-1]));
    C=mpmul(C,gsqr(binome(stoi(n>>1),n>>2)));
  }
  if (DEBUGLEVEL>=4)
  {
    fprintferr("La borne de la norme des coeff du diviseur est : ");
    outerr(C);
  }
  k=gmul(gaddgs(shifti(mulss(n,n-1),-1),1),dbltor(0.6931));
  k=gceil(mulsr(n,gmul2n(gadd(k,glog(gdivgs(C,n),DEFAULTPREC)),-1)));

  lim=itos(gceil(gexp(shifti(gmin(k,maxk),-4),DEFAULTPREC)));
  if (DEBUGLEVEL>=4)
    fprintferr("borne inf. sur les nombres premiers : %ld \n",lim);
  pr = choose_prime(nf,disc,dki,lim);
  k=gceil(divir(k,glog((GEN)pr[1],DEFAULTPREC)));
  prh=primehall(nf,pr);

  polred=gcopy(polbase);
  lt=(GEN)polbase[d-1];
  for (i=2; i<d; i++)
    polred[i]=element_reduce(nf,element_div(nf,(GEN)polbase[i],lt),
			     (GEN)prh[1])[1];
  rep=simplefactmod(polred,(GEN)pr[1]);
  if (lg(rep)==2)
  {
    if (fl)
      rep=cgetg(1,t_VEC);
    else
    { rep=cgetg(2,t_VEC); rep[1]=(long)polmod; }
    tetpil=avma; return gerepile(av,tetpil,gcopy(rep));
  }
	
  if (DEBUGLEVEL>=4)
    { fprintferr("L'exposant du relevement est : "); outerr(k); }

  p2=mpmul(gsqrt(absi(dk),DEFAULTPREC),gpui((GEN)pr[1],k,0));
  p2=mpmul(dbltor(1.44),mplog(mpabs(p2)));
  newprec=itos(gceil(gmul2n(p2,-TWOPOTBITS_IN_LONG)));
  newprec=max(newprec+3,DEFAULTPREC);
  if (DEBUGLEVEL>=4) fprintferr("nouvelle precision : %ld \n",newprec);

  T2=nf_init_t2(nf,newprec);
  k=gceil(divis(shifti(k,1),3));
  p3=T2_matrix_pow(nf,T2,pr,C,k,newprec);
  h=(GEN)p3[1]; k=(GEN)p3[2];
  if (DEBUGLEVEL>=4) { fprintferr("l'exposant reel est : "); outerr(k); }

  prh=idealpow(nf,pr,k);
  lt=(GEN)polbase[d-1];
  polred[1]=polbase[1];
  for (i=2; i<d; i++)
    polred[i]=element_reduce(nf,element_div(nf,(GEN)polbase[i],lt),prh)[1];

  rep=myfactpadic(polred,(GEN)pr[1],itos(k)+1);
  hinv=gdiv(adj(h),det(h));
 
  if (fl)
  {
    p1=cgetg(lg(rep)+1,t_VEC);
    for (m=1,i=1; i<lg(rep); i++)
    {
      p2=(GEN)rep[i];
      if(lgef(p2)==4)
	p1[m++] = lneg(algtobasis(nf,lift_intern((GEN)p2[2])));
    }
    p2=cgetg(m,t_VEC);
    for (l=1,i=1; i<m; i++)
    {
      p3=element_div(nf,nf_bestlift(h,hinv,element_mul(nf,lt,(GEN)p1[i])),lt);
      if (isexactzero(nf_pol_eval(nf,polbase,p3)))
	p2[l++]=(long)p3;
    }
    tetpil=avma; rep=cgetg(l,t_VEC);
    for (i=1; i<l; i++) rep[i]=(long)basistoalg(nf,(GEN)p2[i]);
    return gerepile(av,tetpil,rep);
  }

  for (i=1; i<lg(rep); i++)
  {
    p2=(GEN)rep[i];
    for (l=2; l<lgef(p2); l++) p2[l]=(long)lift((GEN)p2[l]);
    rep[i]=(long)unifpol(nf,p2,0);
  }

  nfcmbf.pol      = polmod;
  nfcmbf.lt       = (GEN) polmod[d-1];
  nfcmbf.h        = h;
  nfcmbf.hinv     = hinv;
  nfcmbf.fact     = rep;
  nfcmbf.res      = cgetg(lg(rep)+1,t_VEC);
  nfcmbf.nfact    = 0; 
  nfcmbf.nfactmod = lg(rep)-1;
  nf_combine_factors(nf,1,NULL,d-3,1);

  i = nfcmbf.nfact;

  if (lgef(nfcmbf.pol)>3)
  {
    nfcmbf.res[++i] = (long) nf_pol_divres(nf,nfcmbf.pol,nfcmbf.lt,NULL);
    nfcmbf.nfact = i;
  }

  tetpil=avma; rep=cgetg(i+1,t_VEC);
  for (  ; i>=1; i--)
    rep[i]=(long)unifpol(nf,(GEN)nfcmbf.res[i],1);
  return gerepile(av,tetpil,rep);
}

static int
nf_combine_factors(GEN nf,long fxn,GEN psf,long dlim,long hint)
{
  int val=0; /* assume failure */
  GEN newf, newpsf = NULL;
  long newd,ltop,i;

  if (dlim<=0) return 0;
  if (fxn > nfcmbf.nfactmod) return 0;
  /* first, try deeper factors without considering the current one */
  if (fxn != nfcmbf.nfactmod)
  { 
    val=nf_combine_factors(nf,fxn+1,psf,dlim,hint);
    if (val && psf) return 1;
  }

  /* second, try including the current modular factor in the product */
  newf=(GEN)nfcmbf.fact[fxn];
  if (!newf) return val; /* modular factor already used */
  newd=lgef(newf)-3;
  if (newd>dlim) return val; /* degree of new factor is too large */

  if (newd%hint == 0)
  {
    GEN p, quot,rem;

    newpsf = nf_pol_mul(nf, (psf)? psf: nfcmbf.lt, newf);
    newpsf = nf_pol_lift(nfcmbf.h,nfcmbf.hinv,newpsf);
    /* try out the new combination */
    ltop=avma;
    quot=nf_pol_divres(nf,nfcmbf.pol,newpsf,&rem);
    if (gcmp0(rem))  /* found a factor */
    { 
      p = nf_pol_mul(nf,element_inv(nf,leading_term(newpsf)),newpsf);
      nfcmbf.res[++nfcmbf.nfact] = (long) p; /* store factor */
      nfcmbf.fact[fxn]=0;                    /* remove used modular factor */

      /* fix up target */
      p=gun; quot=unifpol(nf,quot,0);
      for (i=2; i<lgef(quot); i++)
	if (!gcmp0((GEN)quot[i]))
	  p = glcm(p, denom((GEN)quot[i]));

      nfcmbf.pol = nf_pol_mul(nf,p,quot);
      nfcmbf.lt  = leading_term(nfcmbf.pol);
      return 1;
    }
    avma=ltop;
  }

  /* newpsf needs more; try for it */
  if (newd==dlim) return val; /* no more room in degree limit */
  if (fxn==nfcmbf.nfactmod) return val; /* no more modular factors to try */

  if (nf_combine_factors(nf,fxn+1,newpsf,dlim-newd,hint))
  {
    nfcmbf.fact[fxn]=0; /* remove used modular factor */
    return 1;
  }
  return val;
}

/* Calcule le polynome caracteristique de alpha sur nf ou alpha est un
   element de l'algebre nf[X]/(T) exprime comme polynome en x */
GEN
rnfcharpoly(GEN nf,GEN T,GEN alpha,int n)
{
  long av=avma,tetpil;
  GEN p1;

  nf=checknf(nf);
  p1 = gmodulcp(unifpol(nf,alpha,1),unifpol(nf,T,1));
  p1 = lift(caradj0(p1,n));
  tetpil=avma; return gerepile(av,tetpil,unifpol(nf,p1,1));
}

/* Calcule le polynome minimal de alpha sur nf ou alpha est un
   element de l'algebre nf[X]/(T) exprime comme polynome en x */
GEN
rnfminpoly(GEN nf,GEN T,GEN alpha,int n)
{
  long av=avma,tetpil;
  GEN p1,p2;

  nf=checknf(nf); p1=rnfcharpoly(nf,T,alpha,n);
  tetpil=avma; p2=nf_pol_subres(nf,p1,deriv(p1,varn(T)));
  if (lgef(p2)==3) { avma=tetpil; return p1; }

  p1 = nf_pol_divres(nf,p1,p2,NULL);
  p2 = element_inv(nf,leading_term(p1));
  tetpil=avma; return gerepile(av,tetpil,unifpol(nf,nf_pol_mul(nf,p2,p1),1));
}

/* relative Dedekind criterion over nf, applied to the order defined by a
 * root of irreducible polynomial T, modulo the prime ideal pr. Returns
 * [flag,basis,val], where basis is a pseudo-basis of the enlarged order,
 * flag is 1 iff this order is pr-maximal, and val is the valuation in pr of
 * the order discriminant
 */
GEN
rnfdedekind(GEN nf,GEN T,GEN pr)
{
  long av=avma,vt,tetpil,r,d,da,n,m,i,j;
  GEN p1,p2,p,tau,g,vecun,veczero,matid;
  GEN prhall,res,h,k,base,Ca;

  nf=checknf(nf); Ca=unifpol(nf,T,0);
  res=cgetg(4,t_VEC); prhall=primehall(nf,pr);
  p=(GEN)pr[1]; tau=gdiv((GEN)pr[5],p);
  n=lgef(nf[1])-3; m=lgef(T)-3;

  vecun=cgetg(n+1,t_COL); vecun[1]=un;
  veczero=cgetg(n+1,t_COL); veczero[1]=zero;
  for (i=2; i<=n; i++) vecun[i] = veczero[i] = zero;
  matid=idmat(n);

  p1=nffactormod(nf,Ca,pr);
  g=lift(gcoeff(p1,1,1));
  r=lg(p1[1]);
  for (i=2; i<r; i++)
    g = nf_pol_mul(nf,g,lift(gcoeff(p1,i,1)));
  h=nfmod_pol_divres(nf,prhall,Ca,g,NULL);
  k=nf_pol_mul(nf,tau,gsub(Ca, nf_pol_mul(nf,lift(g),lift(h))));
  p2=nfmod_pol_gcd(nf,prhall,g,h);
  k= nfmod_pol_gcd(nf,prhall,p2,k);

  d=lgef(k)-3;
  vt = idealval(nf,discsr(T),pr) - 2*d;
  res[3]=lstoi(vt);
  if (!d || vt<=1) res[1]=un; else res[1]=zero;

  base=cgetg(3,t_VEC);
  p1=cgetg(m+d+1,t_MAT); base[1]=(long)p1;
  p2=cgetg(m+d+1,t_VEC); base[2]=(long)p2;
  for (j=1; j<=m; j++)
  {
    p2[j]=(long)matid;
    p1[j]=lgetg(m+1,t_COL);
    for (i=1; i<=m; i++)
      coeff(p1,i,j) = (i==j)?(long)vecun:(long)veczero;
  }

  if (d)
  {
    GEN pal = lift(nfmod_pol_divres(nf,prhall,Ca,k,NULL));
    GEN prinv=idealinv(nf,pr);
    GEN nfx=unifpol(nf,polx[varn(T)],0);

    for (j=m+1; j<=m+d; j++)
    {
      p1[j]=lgetg(m+1,t_COL);
      da=lgef(pal)-3;
      for (i=1; i<=da+1; i++) coeff(p1,i,j)=pal[i+1];
      for (   ; i<=m; i++) coeff(p1,i,j)=(long)veczero;
      p2[j]=(long)prinv;
      nf_pol_divres(nf,nf_pol_mul(nf,pal,nfx),T,&pal);
    }
    base=nfhermite(nf,base);
  }
  res[2]=(long)base; tetpil=avma; return gerepile(av,tetpil,gcopy(res));
}

/* Calcule la factorisation de pol mod p^e */
static GEN
myfactpadic(GEN pol, GEN p, long e)
{
  long av=avma,tetpil;
  GEN fact,y,rep;
  
  fact=(GEN)factmod(pol,p)[1];
  if (lg(fact)==2)
  {
    avma=av; y=cgetg(2,t_VEC);
    y[1]=lcopy(pol); return y;
  }
  rep=hensel_lift(pol,fact,polx[MAXVARN],p,e);
  tetpil=avma; return gerepile(av,tetpil,gcopy(rep));    
}

/* calcule la matrice correspondant a pr^e jusqu'a ce que R(pr^e)>C */
static GEN 
T2_matrix_pow(GEN nf, GEN T2, GEN pr, GEN C, GEN kmax, long prec)
{
  long i,N,k,av=avma,tetpil,av1,lim,DEBUG2=DEBUGLEVEL;
  GEN p1,p3,p,L2,prod,u,min,C2,R,rep;
  
  DEBUGLEVEL=0;
  k=itos(kmax);

  p = (GEN)pr[1];
  N = lgef((GEN)nf[1])-3;
  C2 = gdiv(C,absi((GEN)nf[3]));
  p1 = idealpow(nf,pr,kmax);
  p1 = gmul(p1,lllintpartial(p1));
  
  av1=avma; lim = (av1+3*bot)>>2;
  for (;;)
  {
    if (DEBUG2>=4) fprintferr("exposant considere : %ld \n",k);
    for(;;)
    {
      p3 = qf_base_change(T2,p1);
      if (!signe(gmael(nf,2,2)))
        u = lllgramint(p3);
      else
        u = lllgramintern(p3,1,prec);
      if (u) break;
      prec=(prec<<1)-2;
      if (DEBUGLEVEL>=2) err(warnprec,"nffactor",prec);
      T2=nf_init_t2(nf,prec);
    }
    p3 = qf_base_change(p3,u);
    min = prod = gnorml2((GEN)p3[1]);
    for (i=2; i<=N; i++)
    {
      L2 = gnorml2((GEN)p3[i]);
      prod = gmul(prod,L2);
      if (gcmp(L2,min) < 0) min = L2;
    }
    prod = gsqrt(prod,prec);
    min = gsqrt(min,prec);
    R = gdiv(gmul(min,gpuigs(p,k<<1)),prod);
    if (gcmp(C2,R) < 0) break;

    k = k<<1; p1 = idealmullll(nf,p1,p1);
    if (low_stack(lim, (av1+3*bot)>>2))
    {
      if (DEBUGMEM>1) err(warnmem,"T2_matrix_pow");
      p1 = gerepileupto(av1,p1);
    }
  }
  p1=gmul(p1,u); tetpil=avma;
  rep=cgetg(3,t_VEC);
  rep[1]=lcopy(p1);
  rep[2]=lstoi(k);
  DEBUGLEVEL=DEBUG2;
  return gerepile(av,tetpil,rep);
}



