/********************************************************************/
/********************************************************************/
/**                                                                **/
/**                  BIBLIOTHEQUE  MATHEMATIQUE                    **/
/**                     (deuxieme partie)                          **/
/**                                                                **/
/**                     Copyright Babe Cool                        **/
/**                                                                **/
/********************************************************************/
/********************************************************************/
/* $Id: bibli2.c,v 2.0.0.2 1997/12/14 20:11:49 karim Exp karim $ */
#include "genpari.h"

/********************************************************************/
/**                                                                **/
/**                 DEVELOPPEMENTS  LIMITES                        **/
/**                                                                **/
/********************************************************************/

GEN
tayl(GEN x, long v, long precdl)
{
  long tetpil,i,vx = gvar9(x), av=avma;
  GEN p1, y;

  if (v <= vx)
  {
    p1 = cgetg(3,t_SER);
    p1[2] = zero; p1[1] = HIGHVALPBIT + precdl; setvarn(p1,v);
    tetpil = avma; return gerepile(av, tetpil, gadd(p1,x));
  }
  p1=cgetg(v+2,t_VEC);
  for (i=0; i<vx; i++) p1[i+1]=lpolx[i]; p1[vx+1]=lpolx[v];
  for (i=vx+1; i<v; i++) p1[i+1]=lpolx[i]; p1[v+1]=lpolx[vx];
  y = tayl(changevar(x,p1), vx, precdl); tetpil=avma;
  return gerepile(av, tetpil, changevar(y,p1));
}

GEN
grando0(GEN x, long n, long do_clone)
{
  long m, v, tx=typ(x);
  GEN y;

  if (gcmp0(x)) err(talker,"zero argument in O()");
  if (tx == t_INT)
  {
    if (!gcmp1(x)) /* bug 3 + O(1). We suppose x is a truc() */
    {
      y=cgetg(5,t_PADIC); y[3]=un; y[4]=zero;
      y[2] = do_clone? lclone(x): lcopy(x);
      setvalp(y,n); setprecp(y,0); return y;
    }
    v=0; m=0; /* 1 = x^0 */
  }
  else
  {
    if (tx != t_POL && ! is_rfrac_t(tx))
      err(talker,"incorrect argument in O()");
    v=gvar(x); m=n*gval(x,v);
  }
  y=cgetg(3,t_SER); y[1]=HIGHVALPBIT + m;
  y[2]=zero; setvarn(y,v); return y;
}

/*******************************************************************/
/**                                                               **/
/**                      SPECIAL POLYNOMIALS                      **/
/**                                                               **/
/*******************************************************************/

/* Tchebichev polynomial */
/* T0=1; T1=X; T(n)=2*X*T(n-1)-T(n-2) */
GEN
tchebi(long n, long v)
{
  long av,tetpil,lim,m;
  GEN p0,p1,px,q;

  if (n==0) return polun[v];
  if (n==1) return polx[v];

  p0=polun[v]; p1=px=polx[v];
  av=avma; lim=(av+3*bot)>>2;
  for (m=1; m<n-1; m++)
  {
    GEN p2;

    q=gmul(px,gmul2n(p1,1));
    tetpil=avma; p2=gsub(q,p0); p0=p1; p1=p2;
    if (low_stack(lim, (av+3*bot)>>2))
    {
      GEN *gptr[2];
      if(DEBUGMEM>1) err(warnmem,"tchebi");
      p0=gcopy(p0); gptr[0]=&p0; gptr[1]=&p1;
      gerepilemanysp(av,tetpil,gptr,2);
    }
  }
  q=gmul(px,gmul2n(p1,1));
  tetpil=avma; return gerepile(av,tetpil,gsub(q,p0));
}

/* Legendre polynomial */
/* L0=1; L1=X; (n+1)*L(n+1)=(2*n+1)*X*L(n)-n*L(n-1) */
GEN
legendre(long n, long v)
{
  long av,tetpil,m,lim;
  GEN p0,p1,px,q;

  if (n==0) return polun[v];
  if (n==1) return polx[v];

  p0=polun[v]; px=polx[v];
  av=avma; lim=(av+3*bot)>>2;
  p1=gmul2n(px,1);
  for (m=1; m<n; m++)
  {
    GEN p2 = gsub(gmul(px,gmulsg(4*m+2,p1)),gmulsg(4*m,p0));

    p0 = p1; tetpil=avma; p1 = gdivgs(p2,m+1);
    if (low_stack(lim, (av+3*bot)>>2))
    {
      GEN *gptr[2];
      if(DEBUGMEM>1) err(warnmem,"legendre");
      p0=gcopy(p0); gptr[0]=&p0; gptr[1]=&p1;
      gerepilemanysp(av,tetpil,gptr,2);
    }
  }
  q=shifti(gun,n);
  tetpil=avma; return gerepile(av,tetpil,gdiv(p1,q));
}

/* cyclotomic polynomial */
GEN
cyclo(long n, long v)
{
  long av=avma,tetpil,d,q,m;
  GEN p1,yn,yd;

  if (n<=0) err(arither2);
  d=1; yn=gun; yd=gun;
  while (d*d<=n)
  {
    if (!(n%d))
    {
      q=n/d; m=mu(stoi(q));
      if (m)
      {
	p1=gsub(gpuigs(polx[v],d),gun);
	if (m>0) yn=gmul(yn,p1); else yd=gmul(yd,p1);
      }
      if (q!=d)
      {
	m=mu(stoi(d));
	if (m)
	{
	  p1=gsub(gpuigs(polx[v],q),gun);
	  if (m>0) yn=gmul(yn,p1); else yd=gmul(yd,p1);
	}
      }
    }
    d++;
  }
  tetpil=avma; return gerepile(av,tetpil,gdiv(yn,yd));
}

/********************************************************************/
/**                                                                **/
/**                  HILBERT & PASCAL MATRICES                     **/
/**                                                                **/
/********************************************************************/

GEN
mathilbert(long n) /* Hilbert matrix of order n */
{
  long i,j;
  GEN a,p;
  
  if (n<0) n = 0;
  p = cgetg(n+1,t_MAT);
  for (j=1; j<=n; j++)
  {
    p[j]=lgetg(n+1,t_COL);
    for (i=1; i<=n; i++)
    {
      a=cgetg(3,t_FRAC); a[1]=un; a[2]=lstoi(i+j-1);
      coeff(p,i,j)=(long)a;
    }
  }
  return p;
}

GEN
matpascal(long n) /* matrice triangle de PASCAL d'ordre n */
{
  long i,j;
  GEN p;
  
  if (n<0) n = -1;
  p = cgetg(n+2,t_MAT);
  for (j=1; j<=n+1; j++)  p[j]=lgetg(n+2,t_COL);
  for (i=1; i<=n+1; i++)
  {
    coeff(p,i,1)=un; coeff(p,i,i)=un;
    for (j=2; j<i; j++)
      coeff(p,i,j)=laddii(gcoeff(p,i-1,j),gcoeff(p,i-1,j-1));
    for (j=i+1; j<=n+1; j++)
      coeff(p,i,j)=zero;
  }
  return p;
}

/********************************************************************/
/**                                                                **/
/**                  LAPLACE TRANSFORM (OF A SERIES)               **/
/**                                                                **/
/********************************************************************/

GEN
laplace(GEN x)
{
  long i,l,ec,av,tetpil;
  GEN y,p1;

  if (typ(x)!=t_SER) err(talker,"not a series in laplace");
  if (gcmp0(x)) return gcopy(x);

  av=avma; ec=valp(x);
  if (ec<0) err(talker,"negative valuation in laplace");
  l=lg(x); y=cgetg(l,t_SER);
  p1=mpfact(ec); y[1]=x[1];
  for (i=2; i<l; i++)
  {
    y[i]=lmul(p1,(GEN)x[i]);
    ec++; p1=gmulsg(ec,p1);
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(y));
}

/********************************************************************/
/**                                                                **/
/**              CONVOLUTION PRODUCT (OF TWO SERIES)               **/
/**                                                                **/
/********************************************************************/

GEN
convol(GEN x, GEN y)
{
  long l,l1,i,j,v, lx = lg(x), ly = lg(y), ex = valp(x), ey = valp(y);
  GEN z;

  if (typ(x) != t_SER || typ(y) != t_SER) 
    err(talker,"not a series in convol");
  if (gcmp0(x) || gcmp0(y))
    err(talker,"zero series in convol");
  v=ex; if (ey>v) v=ey;
  l=ex+lx; l1=ey+ly; if (l1<l) l=l1;
  l -= v; if (l<3) err(talker,"non significant result in convol");
  for (i=v+2; i < l+v; i++)
    if (!gcmp0((GEN)x[i-ex]) && !gcmp0((GEN)y[i-ey])) { i++; break; } 
  if (i == l+v)
  {
    z=cgetg(3,t_SER); z[1]=HIGHVALPBIT-2+l+v; z[2]=zero;
  }
  else
  {
    z=cgetg(l-i+3+v,t_SER); z[1]=evalsigne(1)+HIGHVALPBIT-3+i;
    for (j=i-1; j<l+v; j++) z[j-i+3]=lmul((GEN)x[j-ex],(GEN)y[j-ey]);
  }
  return z;
}

/******************************************************************/
/**                                                              **/
/**                       PRECISION CHANGES                      **/
/**                                                              **/
/******************************************************************/

GEN
gprec(GEN x, long l)
{
  long tx=typ(x),lx=lg(x),i,pr;
  GEN y;

  if (l<=0) err(talker,"precision<=0 in gprec");
  switch(tx)
  {
    case t_REAL:
      pr = (long) (l*pariK1+3); y=cgetr(pr); affrr(x,y); break;

    case t_PADIC:
      y=cgetg(lx,tx); y[2] = lcopy((GEN) x[2]);
      if (!signe(x[4]))
      {
	l+=precp(x); y[1]=evalvalp(l)+evalprecp(0);
	y[3]=un; y[4]=zero; return y;
      }
      y[1]=x[1]; setprecp(y,l);
      y[3]=lpuigs((GEN)x[2],l);
      y[4]=lmodii((GEN)x[4],(GEN)y[3]);
      break;

    case t_SER:
      if (gcmp0(x))
      {
	y=cgetg(3,t_SER); y[1]=HIGHVALPBIT+l; setvarn(y,varn(x));
	return y;
      }
      y=cgetg(l+2,t_SER); y[1]=x[1]; l++; i=l;
      if (l>=lx)
      {
	for ( ; i>=lx; i--) y[i]=zero;
      }
      for ( ; i>=2; i--) y[i]=lcopy((GEN)x[i]);
      break;

    case t_POL:
      lx=lgef(x); y=cgetg(lx,tx); y[1]=x[1];
      for (i=2; i<lx; i++) y[i]=lprec((GEN)x[i],l);
      break;

    case t_COMPLEX: case t_POLMOD: case t_RFRAC: case t_RFRACN:
    case t_VEC: case t_COL: case t_MAT:
      y=cgetg(lx,tx);
      for (i=1; i<lx; i++) y[i]=lprec((GEN)x[i],l);
      break;
    default: y=gcopy(x);
  }
  return y;
}

/*******************************************************************/
/**                                                               **/
/**                     RECIPROCAL POLYNOMIAL                     **/
/**                                                               **/
/*******************************************************************/

GEN
polrecip(GEN x)
{
  GEN y;
  long lx=lgef(x),i;

  if (typ(x) != t_POL) err(typeer,"polrecip");
  y=cgetg(lx,t_POL); y[1]=x[1];
  for (i=2; i<lx; i++) y[i]=lcopy((GEN)x[lx+1-i]);
  return normalizepol(y);
}

/*******************************************************************/
/**                                                               **/
/**                      BINOMIAL COEFFICIENTS                    **/
/**                                                               **/
/*******************************************************************/

GEN
binome(GEN x, long k)
{
  GEN y,p1;
  long av,tetpil,i;

  if (k<0) return gzero;
  if (!k) return gun;
  if (k==1) return gcopy(x);
  av=avma; y=x;
  for (i=k; i>=2; i--)
  {
    p1=gmul(y,gaddgs(x,i-1-k));
    tetpil=avma; y=gdivgs(p1,i);
  }
  return gerepile(av,tetpil,y);
}

/********************************************************************/
/**                                                                **/
/**                  POLYNOMIAL INTERPOLATION                      **/
/**                                                                **/
/********************************************************************/

GEN
polint(GEN xa, GEN ya, GEN x, GEN *dy)
{
  long av,tetpil,i,m,n, ns=1, tx=typ(xa), ty=typ(ya), lx=lg(xa);
  GEN den,dif,dift,ho,hp,w,y,c,d;
  GEN *gptr[2];

  if (! is_vec_t(tx) || ! is_vec_t(ty))
    err(talker,"not vectors in polinterpolate");
  if (lx != lg(ya))
    err(talker,"different lengths in polinterpolate");
  n=lx-1; if (n<=1) { y=gcopy((GEN)ya[1]); *dy=gcopy(y); return y; }
  av=avma; c=cgetg(lx,tx); d=cgetg(lx,tx);
  if (!x) x = polx[0];
  tx = typ(x);
  if (is_scalar_t(tx) && tx != t_INTMOD && tx != t_PADIC && tx != t_POLMOD)
  {
    dif=gabs(gsub(x,(GEN)xa[1]),MEDDEFAULTPREC);
    for (i=1; i<=n; i++)
    {
      dift = gabs(gsub(x,(GEN)xa[i]), MEDDEFAULTPREC);
      if (gcmp(dift,dif)<0) { ns=i; dif=dift; }
    }
  }
  for (i=1; i<=n; i++) c[i] = d[i] = ya[i];
  y=(GEN)ya[ns--];
  for (m=1; m<n; m++)
  {
    for (i=1; i<=n-m; i++)
    {
      ho=gsub((GEN)xa[i],x); hp=gsub((GEN)xa[i+m],x);
      den=gsub(ho,hp);
      if (gcmp0(den)) err(talker,"two abcissas are equal in polint");
      w=gsub((GEN)c[i+1],(GEN)d[i]); den=gdiv(w,den);
      d[i]=lmul(hp,den); c[i]=lmul(ho,den);
    }
    *dy = (2*ns < (n-m))? (GEN)c[ns+1]: (GEN)d[ns--];
    tetpil=avma; y=gadd(y,*dy);
  }
  *dy=gcopy(*dy); gptr[0]=&y; gptr[1]=dy;
  gerepilemanysp(av,tetpil,gptr,2);
  return y;
}

/***********************************************************************/
/*                                                                     */
/*                          SET OPERATIONS                             */
/*                                                                     */
/***********************************************************************/

GEN
gtoset(GEN x)
{
  long i,c,av,tetpil, tx = typ(x), lx = lg(x);
  GEN y;

  if (!is_vec_t(tx))
  {
    if (tx != t_LIST)
      { y=cgetg(2,t_VEC); y[1]=(long)gtostr(x); return y; }
    lx = lgef(x)-1; x++;
  }
  if (lx==1) return cgetg(1,t_VEC);
  av=avma; y=cgetg(lx,t_VEC);
  for (i=1; i<lx; i++) y[i]=(long)gtostr((GEN)x[i]);
  y = sort(y);
  c=1;
  for (i=2; i<lx; i++)
    if (!gegal((GEN)y[i], (GEN)y[c])) y[++c] = y[i];
  tetpil=avma; setlg(y,c+1);
  return gerepile(av,tetpil,gcopy(y));
}

long
setisset(GEN x)
{
  long lx,i;

  if (typ(x)!=t_VEC) return 0;
  lx=lg(x);
  for (i=1; i<lx-1; i++)
    if (gcmp((GEN)x[i+1],(GEN)x[i])<=0) return 0;
  return 1;
}

/* looks if y belongs to the set x and returns the index if yes, 0 if no */
long
setsearch(GEN x, GEN y, long flag)
{
  long av = avma,lx,j,li,ri,fl, tx = typ(x);

  if (tx==t_VEC) lx = lg(x);
  else
  {
    if (tx!=t_LIST) err(talker,"not a set in setsearch");
    lx=lgef(x)-1; x++;
  }
  if (lx==1) return flag? 1: 0;

  li=1; ri=lx-1;
  if (typ(y) != t_STR) y = gtostr(y);
  while (ri>=li)
  {
    j = (ri+li)>>1; fl = gcmp((GEN)x[j],y);
    if (!fl) { avma=av; return flag? 0: j; }
    if (fl<0) li=j+1; else ri=j-1;
  }
  avma=av; if (!flag) return 0;
  return (fl<0)? j+1: j;
}

GEN
setunion(GEN x, GEN y)
{
  long av=avma,tetpil;
  GEN z;

  if (typ(x) != t_VEC || typ(y) != t_VEC) err(talker,"not a set in setunion");
  z=concatsp(x,y); tetpil=avma; return gerepile(av,tetpil,gtoset(z));
}

GEN
setintersect(GEN x, GEN y)
{
  long av=avma,tetpil,i,lx,c;
  GEN z;

  if (!setisset(x) || !setisset(y)) err(talker,"not a set in setintersect");
  lx=lg(x); z=cgetg(lx,t_VEC); c=1;
  for (i=1; i<lx; i++)
    if (setsearch(y, (GEN)x[i], 0)) z[c++] = x[i];
  tetpil=avma; setlg(z,c);
  return gerepile(av,tetpil,gcopy(z));
}

GEN
setminus(GEN x, GEN y)
{
  long av=avma,tetpil,i,lx,c;
  GEN z;

  if (!setisset(x) || !setisset(y)) err(talker,"not a set in setminus");
  lx=lg(x); z=cgetg(lx,t_VEC); c=1;
  for (i=1; i<lx; i++)
    if (setsearch(y, (GEN)x[i], 1)) z[c++] = x[i];
  tetpil=avma; setlg(z,c);
  return gerepile(av,tetpil,gcopy(z));
}

/***********************************************************************/
/*                                                                     */
/*               OPERATIONS ON DIRICHLET SERIES                        */
/*                                                                     */
/***********************************************************************/

/* Addition, subtraction and scalar multiplication of Dirichlet series
   are done on the corresponding vectors */

static long
dirval(GEN x)
{
  long i=1,lx=lg(x);
  while (i<lx && gcmp0((GEN)x[i])) i++;
  return i;
}

GEN
dirmul(GEN x, GEN y)
{
  long lx,ly,lz,dx,dy,av,tetpil,i,j;
  GEN z,p1;

  if (typ(x)!=t_VEC || typ(y)!=t_VEC) err(talker,"not a dirseries in dirmul");
  av=avma; dx=dirval(x); dy=dirval(y); lx=lg(x); ly=lg(y);
  if (ly-dy<lx-dx) { z=y; y=x; x=z; lz=ly; ly=lx; lx=lz; lz=dy; dy=dx; dx=lz; }
  lz=min(lx*dy,ly*dx);
  z=cgetg(lz,t_VEC); for (i=1; i<lz; i++) z[i]=zero;
  for (j=dx; j<lx; j++)
  {
    p1=(GEN)x[j];
    if (!gcmp0(p1))
    {
      if (gcmp1(p1))
	for (i=j*dy; i<lz; i+=j) z[i]=ladd((GEN)z[i],(GEN)y[i/j]);
      else
      {
	if (gcmp_1(p1))
	  for (i=j*dy; i<lz; i+=j) z[i]=lsub((GEN)z[i],(GEN)y[i/j]);
	else
	  for (i=j*dy; i<lz; i+=j) z[i]=ladd((GEN)z[i],gmul(p1,(GEN)y[i/j]));
      }
    }
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(z));
}

GEN
dirdiv(GEN x, GEN y)
{
  long lx,ly,lz,dx,dy,av,tetpil,i,j;
  GEN z,p1;

  if (typ(x)!=t_VEC || typ(y)!=t_VEC) err(talker,"not a dirseries in dirmul");
  av=avma; dx=dirval(x); dy=dirval(y); lx=lg(x); ly=lg(y);
  if (dy!=1) err(talker,"not an invertible dirseries in dirdiv");
  lz=min(lx,ly*dx); p1=(GEN)y[1];
  if (!gcmp1(p1)) { y=gdiv(y,p1); x=gdiv(x,p1); }
  else x=gcopy(x);
  z=cgetg(lz,t_VEC); for (i=1; i<dx; i++) z[i]=zero;
  for (j=dx; j<lz; j++)
  {
    p1=(GEN)x[j]; z[j]=(long)p1;
    if (!gcmp0(p1))
    {
      if (gcmp1(p1))
	for (i=j+j; i<lz; i+=j) x[i]=lsub((GEN)x[i],(GEN)y[i/j]);
      else
      {
	if (gcmp_1(p1))
	  for (i=j+j; i<lz; i+=j) x[i]=ladd((GEN)x[i],(GEN)y[i/j]);
	else
	  for (i=j+j; i<lz; i+=j) x[i]=lsub((GEN)x[i],gmul(p1,(GEN)y[i/j]));
      }
    }
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(z));
}

/*************************************************************************/
/**									**/
/**			         RANDOM					**/
/**									**/
/*************************************************************************/

/* BSD rand gives this: seed = 1103515245*seed + 12345 */
long
mymyrand()
{
#ifdef LONG_IS_64BIT
  if (BITS_IN_RANDOM==64)
    pari_randseed = 1000000000000654397*pari_randseed + 12347;
  else
    pari_randseed = (1000276549*pari_randseed + 12347) % 2147483648;
#else
  pari_randseed = 1000276549*pari_randseed + 12347;
  if (pari_randseed<0) pari_randseed &= (~HIGHBIT);
#endif
  return pari_randseed;
}

GEN
genrand(GEN N)
{ 
  long av,tetpil;

  if (!N) return stoi(mymyrand());
  if (typ(N)!=t_INT || signe(N)<=0 || N[2]>=HIGHBIT)
    err(talker,"invalid bound in random");

  av = avma; N = mulis(N, mymyrand()); tetpil = avma;
  return gerepile(av,tetpil, shifti(N, -(BITS_IN_RANDOM-1)));
}

GEN
setrand(long seed) { return stoi(pari_randseed = seed); }

GEN
getrand() { return stoi(pari_randseed); }

GEN
getstack() { return stoi(top-avma); }

GEN
gettime() { return stoi(timer2()); }

/***********************************************************************/
/**							              **/
/**       		     PERMUTATIONS                             **/
/**								      **/
/***********************************************************************/

GEN
permute(long n, GEN x)
{
  long av=avma,tetpil,i,a,r;
  GEN v,w,y;

  v=cgetg(n+1,t_VEC); v[1]=1;
  for (r=2; r<=n; r++)
  {
    x=dvmdis(x,r,&w); a=itos(w);
    for (i=r; i>=a+2; i--) v[i]=v[i-1];
    v[a+1]=r;
  }
  tetpil=avma; y=cgetg(n+1,t_VEC);
  for (i=1; i<=n; i++) y[i]=lstoi(v[i]);
  return gerepile(av,tetpil,y);
}

GEN
permuteInv(GEN x)
{
  long av=avma,tetpil, len=lg(x)-1, ini=len, last, ind;
  GEN ary,res;

  if (typ(x)!=t_VEC && typ(x)!=t_COL) err(talker,"not a vector in permuteInv");
  res=gzero; ary=cgetg(len+1,t_VEC);
  for (ind=1; ind<=len; ind++) ary[ind]=*++x;
  ary++;
  for (last=len; last>0; last--)
  {
    len--; ind=len;
    while (ind>0 && itos((GEN)ary[ind])!=last) ind--;
    res=mulis(res,last); tetpil=avma; res=addis(res,ind);
    while (ind++<len) ary[ind-1]=ary[ind];
  }
  if (!signe(res)) { tetpil=avma; res=mpfact(ini); }
  return gerepile(av,tetpil,res);
}

/********************************************************************/
/**                                                                **/
/**                       MODREVERSE                               **/
/**                                                                **/
/********************************************************************/

GEN
polymodrecip(GEN x)
{
  long v,i,j,n,av,tetpil,lx;
  GEN p1,p2,p3,p,phi,y,col;

  if (typ(x)!=t_POLMOD) err(talker,"not a polymod in polymodrecip");
  p=(GEN)x[1]; phi=(GEN)x[2];
  v=varn(p); n=lgef(p)-3; if (n<=0) return gcopy(x);
  if (n==1)
  {
    y=cgetg(3,t_POLMOD); p1=cgetg(4,t_POL); y[1]=(long)p1;
    p1[1]=p[1]; p1[2]= (typ(phi)==t_POL) ? lneg((GEN)phi[2]) : lneg(phi);
    p1[3]=un; p1=cgetg(3,t_POL); y[2]=(long)p1;
    if (gcmp0((GEN)p[2])) p1[1]=2;
    else
    {
      p1[1]=p[1]-1; av=avma; p2=gdiv((GEN)p[2],(GEN)p[3]);
      tetpil=avma; p1[2]=lpile(av,tetpil,gneg(p2));
    }
    setvarn(p1,v); return y;
  }
  if (gcmp0(phi)) err(talker,"zero polymod in polymodrecip");
  av=avma; y=cgetg(n+1,t_MAT); p1=cgetg(n+1,t_COL);
  y[1]=(long)p1; p1[1]=un; for (i=2; i<=n; i++) p1[i]=zero;
  p2=phi;
  for (j=2; j<=n; j++)
  {
    lx=lgef(p2); p1=cgetg(n+1,t_COL); y[j]=(long)p1;
    for (i=1; i<=lx-2; i++) p1[i]=p2[i+1];
    for (   ; i<=n; i++) p1[i]=zero;
    if (j<n) p2=gmod(gmul(p2,phi),p);
  }
  col=cgetg(n+1,t_COL); col[1]=zero; col[2]=un;
  for (i=3; i<=n; i++) col[i]=zero;
  p1=gauss(y,col); p2=gtopolyrev(p1,v); p3=caract(x,v);
  tetpil=avma; return gerepile(av,tetpil,gmodulcp(p2,p3));
}

/********************************************************************/
/**                                                                **/
/**                       CHANGE OF VARIABLES                      **/
/**                                                                **/
/********************************************************************/
static int var_not_changed; /* can only be altered in reorder() */

/* Substitution globale des composantes du vecteur y aux variables de x */
GEN
changevar(GEN x, GEN y)
{
  long tx,ty,lx,vx,vy,i,av,tetpil;
  GEN  p1,p2,p3,z;

  if (var_not_changed && y==polvar) return x;
  tx=typ(x); ty=typ(y);
  if (! is_vec_t(ty)) err(changer1);
  if (is_scalar_t(tx))
  {
    if (tx==t_POLMOD)
    {
      av=avma; p1=changevar((GEN)x[1],y); p2=changevar((GEN)x[2],y);
      tetpil=avma; return gerepile(av,tetpil, gmodulcp(p1,p2));
    }
    return gcopy(x);
  }

  if (is_rfrac_t(tx))
  {
    av=avma; p1=changevar((GEN)x[1],y); p2=changevar((GEN)x[2],y);
    tetpil=avma; return gerepile(av,tetpil, gdiv(p1,p2));
  }
  lx=lg(x);

  if (tx == t_POL || tx == t_SER)
  {
    vx=varn(x)+1; if (vx>=lg(y)) return gcopy(x);
    if (!signe(x))
    {
      vy=gvar((GEN)y[vx]); if (vy>MAXVARN) err(changer1);
      z=gcopy(x); setvarn(z,vy); return z;
    }
    av=avma; p1=(GEN)y[vx];

    if (tx==t_POL)
    {
      tetpil=avma; lx=lgef(x);
      p2=changevar((GEN)x[lx-1],y);
      for (i=lx-2; i>=2; i--)
      {
	p2=gmul(p2,p1); p3=changevar((GEN)x[i],y);
	tetpil=avma; p2=gadd(p2,p3);
      }
      return gerepile(av,tetpil,p2);
    }

    /* tx == t_SER */
    p2=changevar((GEN)x[lx-1],y);
    for (i=lx-2; i>=2; i--)
    {
      p2=gmul(p2,p1); p3=changevar((GEN)x[i],y);
      p2=gadd(p2,p3);
    }
    p3=ggrando(p1,lx-2); tetpil=avma;
    z=gadd(p2,p3);
    if (valp(x))
    {
      p2=gpuigs(p1,valp(x)); tetpil=avma;
      return gerepile(av,tetpil,gmul(p2,z));
    }
    return gerepile(av,tetpil,z);
  }
  z=cgetg(lx,tx);
  for (i=1; i<lx; i++) z[i]=lchangevar((GEN)x[i],y);
  return z;
}

static
int compare_int(int *a,int *b)
{
  return *a - *b;
}

GEN
reorder(GEN x)
{
  long tx,lx,i,n, nvar = manage_var(3,NULL);
  int *var,*varsort,*t1;

  if (x == NULL) { var_not_changed=1; return gzero; }
  tx=typ(x); lx=lg(x)-1;
  if (! is_vec_t(tx)) err(typeer,"reorder");
  if (! lx) return polvar;

  varsort = (int *) gpmalloc(lx*sizeof(int));
  var = (int *) gpmalloc(lx*sizeof(int));
  t1 = (int *) gpmalloc(nvar*sizeof(int));

  for (n=0; n<nvar; n++) t1[n] = 0;
  for (n=0; n<lx; n++)
  {
    var[n] = i = gvar((GEN)x[n+1]);
    varsort[n] = ordvar[var[n]]; /* position in polvar */
    if (i >= nvar) err(talker,"variable out of range in reorder");
    /* check if x is a permutation */
    if (t1[i]) err(talker,"duplicated indeterminates in reorder");
    t1[i] = 1;
  }
  qsort(varsort,lx,sizeof(int),(int(*)(ANYARG))compare_int);

  for (n=0; n<lx; n++)
  {
    /* variables are numbered 0,1 etc... while polvar starts at 1. */
    polvar[varsort[n]+1] = lpolx[var[n]];
    ordvar[var[n]] = varsort[n];
  }

  var_not_changed=1;
  for (i=0; i<nvar; i++)
    if (ordvar[i]!=i) { var_not_changed=0; break; }

  free(t1); free(var); free(varsort);
  return polvar;
}

/********************************************************************/
/**                                                                **/
/**                           HEAPSORT                             **/
/**                                                                **/
/********************************************************************/

GEN
vecsort0(GEN x, GEN k)
{
  return k? vecsort(x,k): sort(x);
}

static long
veccmp(GEN x, GEN y, GEN k, long lk)
{
  long i,s;

  for (i=1; i<lk; i++)
  {
    s = gcmp((GEN) x[k[i]], (GEN) y[k[i]]);
    if (s) return s;
  }
  return 0;
}

GEN
vecsort(GEN x, GEN k)
{
  long av,i,j,indxt,ir,l,tx=typ(x),lx=lg(x),lk;
  GEN y,indx,q,kk;

  if (! is_matvec_t(tx)) err(typeer,"vecsort");
  if (lx<=2) return gcopy(x);

  y = cgetg(lx,tx); av = avma; tx = typ(k);
  if (tx==t_INT) { kk=cgetg(2,t_VEC); kk[1]=(long)k; k=kk; }
  else if (! is_vec_t(tx)) err(talker,"incorrect lextype in vecsort");

  l=0; lk=lg(k); kk=cgeti(lk);
  for (i=1; i<lk; i++)
  {
    j=itos((GEN)k[i]); if (j<=0) err(vecsorter2);
    kk[i]=j; l=max(l,j);
  }
  for (j=1; j<lx; j++)
  {
    tx=typ(x[j]);
    if (! is_vec_t(tx)) err(typeer,"vecsort");
    if (lg((GEN)x[j]) <= l) err(vecsorter2);
  }
  indx = (GEN) gpmalloc(lx*sizeof(long));
  for (j=1; j<lx; j++) indx[j]=j; 

  ir=lx-1; l=(lx>>1)+1;
  for(;;)
  {
    if (l>1)
      { l--; indxt = indx[l]; }
    else
    {
      indxt=indx[ir]; indx[ir]=indx[1]; ir--;
      if (ir == 1)
      {
        indx[1]=indxt; avma = av;
        for (i=1; i<lx; i++) y[i]=lcopy((GEN)x[indx[i]]);
        free(indx); return y;
      }
    }
    q = (GEN)x[indxt]; i=l; j=l<<1;
    while (j<=ir)
    {
      if (j<ir && veccmp((GEN)x[indx[j]],(GEN)x[indx[j+1]],kk,lk) < 0) j++;
      if (veccmp(q,(GEN)x[indx[j]],kk,lk) >= 0) break;

      indx[i]=indx[j]; i=j; j = j<<1;
    }
    indx[i]=indxt;
  }
}

/* x= vector of elts. cmp = comparison function.
 * flag = 0 : usual sorting
 * flag = 1 : indirect sorting: return permutation that would sort x
 * flag = 2 : as 1, but return permutation as vector of longs (not GEN)
 */
GEN
gen_sort(GEN x, int cmp(GEN,GEN), int flag)
{
  long i,j,indxt,ir,l,tx=typ(x),lx=lg(x);
  GEN y,indx,q;

  if (!is_vec_t(tx)) err(typeer,"gen_sort");
  y = cgetg(lx, tx);
  if (lx==1) return y;
  if (lx==2)
  {
    switch(flag)
    {
      case 0: y[1]=lcopy((GEN)x[1]); break;
      case 1: y[1]=un; break;
      case 2: y[1]=1; break;
    }
    return y;
  }
  indx = (GEN) gpmalloc(lx*sizeof(long));
  for (j=1; j<lx; j++) indx[j]=j;

  ir=lx-1; l=(ir>>1)+1;
  for(;;)
  {
    if (l>1)
      { l--; indxt = indx[l]; }
    else
    {
      indxt = indx[ir]; indx[ir]=indx[1]; ir--;
      if (ir == 1)
      {
        indx[1]=indxt;
	switch(flag)
	{
	  case 0: for (i=1; i<lx; i++) y[i]=lcopy((GEN)x[indx[i]]); break;
	  case 1: for (i=1; i<lx; i++) y[i]=lstoi(indx[i]); break;
	  case 2: for (i=1; i<lx; i++) y[i]=indx[i]; break;
	}
        free(indx); return y;
      }
    }
    q = (GEN)x[indxt]; i=l;
    for (j=i<<1; j<=ir; j<<=1)
    {
      if (j<ir && cmp((GEN)x[indx[j]],(GEN)x[indx[j+1]])<0) j++;
      if (cmp(q,(GEN)x[indx[j]]) >= 0) break;

      indx[i]=indx[j]; i=j;
    }
    indx[i]=indxt;
  }
}

GEN
indexlexsort(GEN x)
{
  return gen_sort(x,lexcmp,1);
}

GEN
sindexsort(GEN x)
{
  return gen_sort(x,gcmp,2);
}

GEN
sindexlexsort(GEN x)
{
  return gen_sort(x,lexcmp,2);
}

GEN
indexsort(GEN x)
{
  return gen_sort(x,gcmp,1);
}

GEN
sort(GEN x)
{
  return gen_sort(x,gcmp,0);
}

GEN
lexsort(GEN x)
{
  return gen_sort(x,lexcmp,0);
}
