/********************************************************************/
/********************************************************************/
/**                                                                **/
/**                  BIBLIOTHEQUE  MATHEMATIQUE                    **/
/**                (sommes, produits, iterations)                  **/
/**                                                                **/
/**                     Copyright Babe Cool                        **/
/**                                                                **/
/********************************************************************/
/********************************************************************/
/* $Id: sumiter.c,v 2.0.0.2 1997/12/14 20:11:49 karim Exp karim $ */
#include "genpari.h"
#include "anal.h"

/********************************************************************/
/**                                                                **/
/**                        ITERATIONS                              **/
/**                                                                **/
/********************************************************************/

void
forpari(entree *ep, GEN a, GEN b, char *ch)
{
  long av = avma, lim = (av+bot)>>1;

  push_val(ep, a);
  while (gcmp(a,b) <= 0)
  {
    long av1=avma; lisseq(ch); avma=av1;
    if (check_break_status(DOLOOP,NULL)) break;
    a = (GEN) ep->value;
    if (low_stack(lim, (av+bot)>>1))
    {
      long tetpil=avma; 
      if (DEBUGMEM>1) err(warnmem,"forpari");
      a = gerepile(av,tetpil, gcopy(a));
    }
    a = gadd(a,gun); ep->value = (void*)a;
  }
  pop_val(ep); avma = av;
}

void
forstep(entree *ep, GEN a, GEN b, GEN s, char *ch)
{
  long ss, av = avma, lim = (av+bot)>>1;

  push_val(ep, a); ss = signe(s);
  if (!ss) err(talker, "step equal to zero in forstep");
  if (ss>0)
    while (gcmp(a,b) <= 0)
    {
      long av1=avma; lisseq(ch); avma=av1;
      if (check_break_status(DOLOOP,NULL)) break;
      a = (GEN) ep->value;
      if (low_stack(lim, (av+bot)>>1))
      {
        long tetpil=avma; 
        if (DEBUGMEM>1) err(warnmem,"forstep");
        a = gerepile(av,tetpil, gcopy(a));
      }
      a = gadd(a,s); ep->value = (void*)a;
    }
  else
    while (gcmp(b,a) <= 0)
    {
      long av1=avma; lisseq(ch); avma=av1;
      if (check_break_status(DOLOOP,NULL)) break;
      a = (GEN) ep->value;
      if (low_stack(lim, (av+bot)>>1))
      {
        long tetpil=avma; 
        if (DEBUGMEM>1) err(warnmem,"forstep");
        a = gerepile(av,tetpil, gcopy(a));
      }
      a = gadd(a,s); ep->value = (void*)a;
    }
  pop_val(ep); avma = av;
}

void
forprime(entree *ep, GEN a, GEN b, char *ch)
{
  long av = avma, lim = (av+bot)>>1, prime = 0;
  byteptr p=diffptr;

  while (*p && gcmpgs(a,prime) > 0) prime += *p++;
  a = stoi(prime); push_val(ep, a);
  while (gcmp(a,b)<=0)
  {
    long av1=avma;
    if (!*p) err(primer1);
    lisseq(ch); avma=av1; 
    if (check_break_status(DOLOOP,NULL)) break;
    a = (GEN) ep->value;
    if (low_stack(lim, (av+bot)>>1))
    {
      long tetpil=avma; 
      if (DEBUGMEM>1) err(warnmem,"forprime");
      a = gerepile(av,tetpil, icopy(a));
    }
    a = addsi(*p++,a); ep->value = (void*)a;
  }
  pop_val(ep); avma = av;
}

void
fordiv(GEN a, entree *ep, char *ch)
{
  long i,av2,l, av = avma;
  GEN t = divisors(a);

  push_val(ep, NULL);
  l = lg(t); av2 = avma;
  for (i=1; i<l; i++)
  {
    ep->value = (void*) t[i]; lisseq(ch);
    if (check_break_status(DOLOOP,NULL)) break;
    avma = av2;
  }
  pop_val(ep); avma=av;
}

void
forvec(entree *ep, GEN x, char *ch)
{
  GEN a,A,ainit;
  long n,i,lim,av2, av0 = avma, tx = typ(x);

  if (!is_vec_t(tx)) err(talker,"not a vector in forvec");
  n=lg(x)-1; if (!n) { lisseq(ch); return; }

  ainit = cgetg(n+1,t_VEC);
  a = cgetg(n+1,t_VEC);
  A = cgetg(n+1,t_VEC);
  for (i=1; i<=n; i++)
  {
    GEN c=(GEN)x[i]; 
    tx = typ(c);
    if (! is_vec_t(tx) || lg(c)!=3)
      err(talker,"not a vector of two-component vectors in forvec");
    if (gcmp((GEN)c[1],(GEN)c[2]) > 0) { avma = av0; return; }
    a[i] = ainit[i] = c[1];
    A[i] = c[2];
  }

  av2 = avma; lim = (av2+bot)>>1;
  push_val(ep, a);
  for(;;)
  {
    long av1=avma; lisseq(ch); avma=av1;
    if (check_break_status(DOLOOP,NULL))
      i = 1; /* we exit now */
    else
      i = n+1;
    a = (GEN) ep->value;
    do
    {
      i--; if (!i) { avma = av0; pop_val(ep); return; }
      if (i<n) a[i+1] = ainit[i+1];
      a[i] = ladd((GEN)a[i], gun);

      if (low_stack(lim, (av+bot)>>1))
      {
        long tetpil=avma;
        if (DEBUGMEM>1) err(warnmem,"forvec");
        a = gerepile(av2,tetpil, gcopy(a));
        ep->value = (void*) a;
      }
    }
    while (gcmp((GEN)a[i], (GEN)A[i]) > 0);
  }
}

/********************************************************************/
/**                                                                **/
/**                              SUMS                              **/
/**                                                                **/
/********************************************************************/

GEN
somme(entree *ep, GEN a, GEN b, char *ch, GEN x)
{
  long tetpil, av = avma, lim = (av+bot)>>1;
  GEN p1;

  if (typ(a) != t_INT) err(talker,"non integral index in sum");
  if (gcmp(b,a) < 0) return gcopy(x);

  push_val(ep, a);
  do
  {
    p1 = lisexpr(ch); tetpil = avma;
    if (did_break) err(breaker,"sum");
    x=gadd(x,p1); a = addis(a,1);
    if (low_stack(lim, (av+bot)>>1))
    {
      GEN *gptr[2];
      if (DEBUGMEM>1) err(warnmem,"sum");
      gptr[0] = &x; gptr[1] = &a; gerepilemanysp(av,tetpil,gptr,2);
    }
    ep->value = (void*) a;
  }
  while (gcmp(a,b) <= 0);
  pop_val(ep); cgiv(a); return gerepileupto(av,x);
}

GEN
suminf(entree *ep, GEN a, char *ch, long prec)
{
  long fl,G,tetpil, av = avma, lim = (av+bot)>>1;
  GEN p1,x = cgetr(prec);

  if (typ(a) != t_INT) err(talker,"non integral index in suminf");
  affsr(1,x); push_val(ep, a);
  fl=0; G = bit_accuracy(prec) + 5;
  do
  {
    p1 = lisexpr(ch);
    if (did_break) err(breaker,"suminf");
    x = gadd(x,p1); a = addis(a,1);
    if (gcmp0(p1) || gexpo(p1) <= gexpo(x)-G) fl++; else fl=0;
    if (low_stack(lim, (av+bot)>>1))
    { 
      GEN *gptr[2]; gptr[0]=&x; gptr[1]=&a;
      if (DEBUGMEM>1) err(warnmem,"suminf");
      gerepilemany(av,gptr,2);
    }
    ep->value = (void*)a;
  }
  while (fl<3);
  pop_val(ep); tetpil=avma;
  return gerepile(av,tetpil,gsub(x,gun));
}

GEN
divsum(GEN num, entree *ep, char *ch)
{
  long av=avma,tetpil,d,n,d2;
  GEN y,z, p1 = icopy(gun);

  push_val(ep, p1); n=itos(num); /* provisoire */
  tetpil=avma; y=gzero;
  for (d=d2=1; d2 < n; d++, d2 += d+d-1)
    if (n%d == 0)
    {
      p1[2]=d; y=gadd(y, lisexpr(ch));
      if (did_break) err(breaker,"divsum");
      p1[2]=n/d; z = lisexpr(ch);
      tetpil=avma; y=gadd(y,z);
    }
  if (d2 == n)
  {
    p1[2]=d; z = lisexpr(ch);
    if (did_break) err(breaker,"divsum");
    tetpil=avma; y=gadd(y,z);
  }
  pop_val(ep); return gerepile(av,tetpil,y);
}

/********************************************************************/
/**                                                                **/
/**                           PRODUCTS                             **/
/**                                                                **/
/********************************************************************/

GEN
produit(entree *ep, GEN a, GEN b, char *ch, GEN x)
{
  long tetpil, av = avma, lim = (av+bot)>>1;
  GEN p1;
  
  if (typ(a) != t_INT) err(talker,"non integral index in sum");
  if (gcmp(b,a) < 0) return gcopy(x);

  push_val(ep, a);
  do
  {
    p1 = lisexpr(ch); tetpil = avma;
    if (did_break) err(breaker,"prod");
    x = gmul(x,p1); a = addis(a,1);
    if (low_stack(lim, (av+bot)>>1))
    {
      GEN *gptr[2];
      if (DEBUGMEM>1) err(warnmem,"prod");
      gptr[0] = &x; gptr[1] = &a; gerepilemanysp(av,tetpil,gptr,2);
    }
    ep->value = (void*) a;
  }
  while (gcmp(a,b)<=0);
  pop_val(ep); cgiv(a); return gerepileupto(av,x);
}

GEN
prodinf0(entree *ep, GEN a, char *ch, long flag, long prec)
{
  switch(flag)
  {
    case 0: return prodinf(ep,a,ch,prec);
    case 1: return prodinf1(ep,a,ch,prec);
  }
  err(flagerr);
  return NULL; /* not reached */
}

GEN
prodinf(entree *ep, GEN a, char *ch, long prec)
{
  long fl,G,tetpil, av = avma, lim = (av+bot)>>1;
  GEN p1,x = cgetr(prec);
 
  if (typ(a) != t_INT) err(talker,"non integral index in prodinf");
 
  affsr(1,x); push_val(ep, a);
  fl=0; G = bit_accuracy(prec) + 5;
  do
  {
    p1 = lisexpr(ch);
    if (did_break) err(breaker,"prodinf");
    x=gmul(x,p1); a = addis(a,1);
    if (gexpo(gsubgs(p1,1)) <= -G) fl++; else fl=0; 
    if (low_stack(lim, (av+bot)>>1))
    { 
      GEN *gptr[2]; gptr[0]=&x; gptr[1]=&a;
      if (DEBUGMEM>1) err(warnmem,"prodinf");
      gerepilemany(av,gptr,2);
    }
    ep->value = (void*)a;
  }
  while (fl<3);
  pop_val(ep); tetpil=avma;
  return gerepile(av,tetpil,gcopy(x));
}

GEN
prodinf1(entree *ep, GEN a, char *ch, long prec)
{
  long fl,G,tetpil, av = avma, lim=(av+bot)>>1;
  GEN p1,p2,x = cgetr(prec);
 
  if (typ(a) != t_INT) err(talker,"non integral index in prodinf1");
  affsr(1,x); push_val(ep, a);
  fl=0; G = bit_accuracy(prec) + 5;
  do
  {
    p2 = lisexpr(ch);
    if (did_break) err(breaker,"prodinf1");
    p1 = gadd(gun,p2);
    x=gmul(x,p1); a = addis(a,1);
    if (gcmp0(p1) || gexpo(p2) <= -G) fl++; else fl=0;
    if (low_stack(lim, (av+bot)>>1))
    { 
      GEN *gptr[2]; gptr[0]=&x; gptr[1]=&a;
      if (DEBUGMEM>1) err(warnmem,"prodinf1");
      gerepilemany(av,gptr,2);
    }
    ep->value = (void*)a;
  }
  while (fl<3);
  pop_val(ep); tetpil=avma;
  return gerepile(av,tetpil,gcopy(x));
}

GEN
prodeuler(entree *ep, GEN a, GEN b, char *ch, long prec)
{
  long prime,tetpil, av = avma,lim = (avma+bot)>>1;
  GEN p1,x = cgetr(prec);
  byteptr p=diffptr;

  affsr(1,x); prime = 0;
  while (*p && gcmpgs(a,prime)>0) prime += *p++;
  if (gcmpsg(prime,b)>0)
  {
    if (gcmp1(gsub(a,b))) { avma=av; return x; }
    err(talker,"incorrect indices in prodeuler");
  }
  a = stoi(prime); push_val(ep, a);
  do
  {
    if (!*p) err(primer1);
    p1 = lisexpr(ch);
    if (did_break) err(breaker,"prodeuler");
    x=gmul(x,p1); a = addsi(*p++,a);
    if (low_stack(lim, (av+bot)>>1))
    { 
      GEN *gptr[2]; gptr[0]=&x; gptr[1]=&a;
      if (DEBUGMEM>1) err(warnmem,"prodeuler");
      gerepilemany(av,gptr,2);
    }
    ep->value = (void*)a;
  }
  while (gcmp(a,b)<=0);
  pop_val(ep); tetpil=avma;
  return gerepile(av,tetpil,gcopy(x));
}

GEN
direuler(entree *ep, GEN a, GEN b, char *ch)
{
  GEN p1,x,x1,s,polnum,polden,c0;
  long av0 = avma,av,tetpil,lim = (av0+bot)>>1, prime = 0,q,n,i,j,k,k1,tx,lx;
  byteptr p = diffptr;

  if (typ(a) != t_INT) err(talker,"non integral index in direuler");
  if (gcmpgs(b,2)<0) { x=cgetg(2,t_VEC); x[1]=un; return x; }
  if (gcmpgs(a,2) < 0) a = gdeux;
  if (gcmpgs(b, MAXHALFULONG-1) > 0) b = stoi(MAXHALFULONG-1);
  n = itos(b);

  x1=cgetg(n+1,t_VEC); av=avma; x=cgetg(n+1,t_VEC);
  x[1]=un; for (i=2; i<=n; i++) x[i]=zero;

  while (*p && gcmpgs(a,prime) > 0) prime += *p++;
  a = stoi(prime); push_val(ep, a);
  while (gcmp(a,b)<=0)
  {
    if (!*p) err(primer1);
    p1 = lisexpr(ch);
    if (did_break) err(breaker,"direuler");
    polnum=numer(p1); polden=denom(p1);
    tx = typ(polnum);
    if (is_scalar_t(tx))
    {
      if (!gcmp1(polnum))
	err(talker,"constant term not equal to 1 in direuler");
    }
    else
    {
      if (tx != t_POL) err(typeer,"direuler");
      c0 = truecoeff(polnum,0);
      if (!gcmp1(c0)) err(talker,"constant term not equal to 1 in direuler");
      for (i=1; i<=n; i++) x1[i]=x[i];
      prime=itos(a); q=prime; j=1; lx=lgef(polnum)-3;
      while (q<=n && j<=lx)
      {
	c0=(GEN)polnum[j+2];
	if (!gcmp0(c0))
	  for (k=1,k1=q; k1<=n; k1+=q,k++)
	    x[k1] = ladd((GEN)x[k1], gmul(c0,(GEN)x1[k]));
	q*=prime; j++;
      }
    }
    tx=typ(polden);
    if (is_scalar_t(tx))
    {
      if (!gcmp1(polden))
	err(talker,"constant term not equal to 1 in direuler");
    }
    else
    {
      if (tx != t_POL) err(typeer,"direuler");
      c0 = truecoeff(polden,0);
      if (!gcmp1(c0)) err(talker,"constant term not equal to 1 in direuler");
      prime=itos(a); lx=lgef(polden)-3;
      for (i=prime; i<=n; i+=prime)
      {
	s=gzero; k=i; j=1;
	while (!(k%prime) && j<=lx)
	{
	  c0=(GEN)polden[j+2]; k/=prime; j++;
	  if (!gcmp0(c0)) s=gadd(s,gmul(c0,(GEN)x[k]));
	 }
	x[i]=lsub((GEN)x[i],s);
      }
    }
    if (low_stack(lim, (av+bot)>>1))
    {
      GEN *gptr[2];
      if (DEBUGMEM>1) err(warnmem,"direuler");
      gptr[0] = &x; gptr[1] = &a; gerepilemany(av,gptr,2);
    }
    a = addsi(*p++,a); ep->value = (void*) a;
  }
  pop_val(ep); tetpil=avma;
  return gerepile(av0,tetpil,gcopy(x));
}

/********************************************************************/
/**                                                                **/
/**                       VECTORS & MATRICES                       **/
/**                                                                **/
/********************************************************************/

GEN
vecteur(GEN nmax, entree *ep, char *ch)
{
  GEN y,p1;
  long i,m;
  long c[]={evaltyp(t_INT) | evallg(3), evalsigne(1) | evallgefint(3), 1};

  if (typ(nmax)!=t_INT || signe(nmax) < 0)
    err(talker,"bad number of components in vector");
  if (gcmpgs(nmax,LGBITS) >= 0)
    err(talker,"too many components in vector");
  m=itos(nmax); y=cgetg(m+1,t_VEC);
  push_val(ep, c);
  for (i=1; i<=m; i++)
  {
    c[2]=i; p1 = lisseq(ch);
    if (did_break) err(breaker,"vector");
    y[i] = isonstack(p1)? (long)p1 : (long)forcecopy(p1);
  }
  pop_val(ep); return y;
}

GEN
vvecteur(GEN nmax, entree *ep, char *ch)
{
  GEN y=vecteur(nmax,ep,ch);
  settyp(y,t_COL); return y;
}

GEN
matrice(GEN nlig, GEN ncol,entree *ep1, entree *ep2, char *ch)
{
  GEN y,z,p1;
  long i,j,m,n,s;
  long c1[]={evaltyp(t_INT) | evallg(3), evalsigne(1) | evallgefint(3), 1};
  long c2[]={evaltyp(t_INT) | evallg(3), evalsigne(1) | evallgefint(3), 1};

  s=signe(ncol);
  if (typ(ncol)!=t_INT || s<0) err(talker,"bad number of columns in matrix");
  if (!s) return cgetg(1,t_MAT);

  s=signe(nlig);
  if (typ(nlig)!=t_INT || s<0) err(talker,"bad number of rows in matrix");
  if (gcmpgs(nlig,LGBITS) >= 0) err(talker,"too many rows in matrix");
  if (gcmpgs(ncol,LGBITS) >= 0) err(talker,"too many columns in matrix");
  m=itos(ncol);
  if (!s)
  { 
    y=cgetg(m+1,t_MAT);
    for (i=1; i<=m; i++) y[i]=lgetg(1,t_COL);
    return y;
  }
  n=itos(nlig); y=cgetg(m+1,t_MAT);
  push_val(ep1, c1); push_val(ep2, c2);
  for (i=1; i<=m; i++)
  {
    c2[2]=i; z=cgetg(n+1,t_COL); y[i]=(long)z;
    for (j=1; j<=n; j++)
    {
      c1[2]=j; p1=lisseq(ch);
      if (did_break) err(breaker,"matrix");
      z[j] = isonstack(p1)? (long)p1 : (long)forcecopy(p1);
    }
  }
  pop_val(ep1); pop_val(ep2); return y;
}

/********************************************************************/
/**                                                                **/
/**                    SOMMATION DE SERIES                         **/
/**                                                                **/
/********************************************************************/

GEN
sumalt0(entree *ep, GEN a, char *ch, long flag, long prec)
{
  switch(flag)
  {
    case 0: return sumalt(ep,a,ch,prec);
    case 1: return sumalt2(ep,a,ch,prec);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

GEN
sumpos0(entree *ep, GEN a, char *ch, long flag, long prec)
{
  switch(flag)
  {
    case 0: return sumpos(ep,a,ch,prec);
    case 1: return sumpos2(ep,a,ch,prec);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

GEN
sumalt(entree *ep, GEN a, char *ch, long prec)
{
  long av = avma, tetpil,k,N;
  GEN s,az,c,x,e1,d;

  if (typ(a) != t_INT) err(talker,"non integral index in sumalt");

  push_val(ep, a);
  e1=addsr(3,gsqrt(stoi(8),prec));
  N=(long)(0.4*(bit_accuracy(prec) + 7));
  d=gpuigs(e1,N); d=shiftr(addrr(d,divsr(1,d)),-1);
  az=negi(gun); c=d; s=gzero;
  for (k=0; ; k++)
  {
    x = lisexpr(ch);
    if (did_break) err(breaker,"sumalt");
    c = gadd(az,c); s = gadd(s,gmul(x,c));
    az = divii(mulii(mulss(N-k,N+k),shifti(az,1)),mulss(k+1,k+k+1));
    if (k==N-1) break;
    a = addsi(1,a); ep->value = (void*) a;
  }
  tetpil=avma; pop_val(ep);
  return gerepile(av,tetpil,gdiv(s,d));
}

GEN
sumalt2(entree *ep, GEN a, char *ch, long prec)
{
  long av = avma, tetpil,k,N;
  GEN x,s,dn,pol;

  if (typ(a) != t_INT) err(talker,"non integral index in sumalt");

  push_val(ep, a);
  N=(long)(0.31*(bit_accuracy(prec) + 5));
  s=gzero; pol=polzagreel(N,N>>1,prec+1); dn=poleval(pol,gun);
  pol[2]=lsub((GEN)pol[2],dn); pol=gdiv(pol,gsub(polx[0],gun));
  N=lgef(pol)-2;
  for (k=0; k<N; k++)
  {
    x = lisexpr(ch);
    if (did_break) err(breaker,"sumalt2");
    s=gadd(s,gmul(x,(GEN)pol[k+2]));
    if (k==N-1) break;
    a = addsi(1,a); ep->value = (void*) a;
  }
  tetpil=avma; pop_val(ep);
  return gerepile(av,tetpil,gdiv(s,dn));
}

GEN
sumpos(entree *ep, GEN a, char *ch, long prec)
{
  long av = avma,tetpil,k,kk,N,G;
  GEN p1,r,q1,unreel,s,az,c,x,e1,d, *stock;

  if (typ(a) != t_INT) err(talker,"non integral index in sumpos");

  push_val(ep, NULL);
  a=subis(a,1); affsr(1,unreel=cgetr(prec));
  e1=addsr(3,gsqrt(stoi(8),prec));
  N=(long)(0.4*(bit_accuracy(prec) + 7));
  d=gpuigs(e1,N); d=shiftr(addrr(d,divsr(1,d)),-1);
  az=negi(gun); c=d; s=gzero;
  G = bit_accuracy(prec) + 5;
  stock=(GEN*)cgeti(N+1); for (k=1; k<=N; k++) stock[k]=NULL;
  for (k=0; k<N; k++)
  {
    if (odd(k) && stock[k]) x=stock[k];
    else
    {
      x=gzero; r=stoi(2*k+2); kk=0;
      do
      {
	q1 = addii(r,a); ep->value = (void*) q1;
        p1 = lisexpr(ch);
        if (did_break) err(breaker,"sumpos");
        p1 = gmul2n(gmul(unreel,p1),kk);
	x = gadd(x,p1); r=shifti(r,1); kk++;
      }
      while (kk<=1 || gexpo(p1) >= -G);
      if (2*k<N) stock[2*k+1]=x;
      q1 = addsi(k+1,a); ep->value = (void*) q1;
      p1 = lisexpr(ch);
      if (did_break) err(breaker,"sumpos");
      x = gadd(gmul(unreel,p1),gmul2n(x,1));
    }
    c=gadd(az,c);
    s = odd(k)? gsub(s,gmul(x,c)): gadd(s,gmul(x,c));
    az = divii(mulii(mulss(N-k,N+k),shifti(az,1)),mulss(k+1,k+k+1));
  }
  tetpil=avma; pop_val(ep);
  return gerepile(av,tetpil,gdiv(s,d));
}

GEN
sumpos2(entree *ep, GEN a, char *ch, long prec)
{
  long av = avma,tetpil,k,kk,N,G;
  GEN p1,r,q1,unreel,s,pol,dn,x, *stock;

  if (typ(a) != t_INT) err(talker,"non integral index in sumpos2");

  push_val(ep, a);
  a=subis(a,1); affsr(1,unreel=cgetr(prec));
  N=(long)(0.31*(bit_accuracy(prec) + 5));
  G = bit_accuracy(prec) + 5;
  stock=(GEN*)cgeti(N+1); for (k=1; k<=N; k++) stock[k]=NULL;
  for (k=1; k<=N; k++)
  {
    if (odd(k) || !stock[k])
    {
      x=gzero; r=stoi(2*k); kk=0;
      do
      {
	q1 = addii(r,a); ep->value = (void*) q1;
        p1 = lisexpr(ch);
        if (did_break) err(breaker,"sumpos2");
        p1 = gmul2n(gmul(unreel,p1),kk);
	x=gadd(x,p1); r=shifti(r,1); kk++;
      }
      while (kk<=1 || gexpo(p1) >= -G);
      if (2*k-1<N) stock[2*k]=x;
      q1 = addsi(k,a); ep->value = (void*) q1;
      p1 = lisexpr(ch);
      if (did_break) err(breaker,"sumpos2");
      stock[k] = gadd(gmul(unreel,p1),gmul2n(x,1));
    }
  }
  pop_val(ep); s = gzero;
  pol=polzagreel(N,N>>1,prec+1); dn=poleval(pol,gun);
  pol[2]=lsub((GEN)pol[2],dn); pol=gdiv(pol,gsub(gun,polx[0]));
  for (k=1; k<=lgef(pol)-2; k++)
  {
    if (odd(k))
      s = gsub(s,gmul((GEN)pol[k+1],stock[k]));
    else
      s = gadd(s,gmul((GEN)pol[k+1],stock[k]));
  }
  tetpil=avma; return gerepile(av,tetpil,gdiv(s,dn));
}

/********************************************************************/
/**                                                                **/
/**                NUMERICAL INTEGRATION (Romberg)                 **/
/**                                                                **/
/********************************************************************/
GEN
intnum0(entree *ep, GEN a, GEN b, char *ch, long flag, long prec)
{
  switch(flag)
  {
    case 0: return qromb  (ep,a,b,ch,prec);
    case 1: return rombint(ep,a,b,ch,prec);
    case 2: return qromi  (ep,a,b,ch,prec);
    case 3: return qromo  (ep,a,b,ch,prec);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

#define JMAX 25
#define JMAXP JMAX+3
#define KLOC 5

static GEN
fix(GEN a, long prec)
{
  GEN p;
  if (typ(a) != t_REAL || lg(a) > prec)
    { p = cgetr(prec); gaffect(a,p); a = p; }
  return a;
}

GEN
qromb(entree *ep, GEN a, GEN b, char *ch, long prec)
{
  GEN ss,dss,s,h,p1,p2,p3,p4,qlint,del,sz,x,sum;
  long av = avma, av1, tetpil,j,j1,j2,lim,it,sig;

  a = fix(a,prec);
  b = fix(b,prec);
  qlint=subrr(b,a); sig=signe(qlint);
  if (!sig)  { avma=av; return gzero; }
  if (sig<0) { setsigne(qlint,1); s=a; a=b; b=s; }

  p3=cgetg(KLOC+1,t_VEC); s=cgetg(JMAXP,t_VEC); 
  p4=cgetg(KLOC+1,t_VEC); h=cgetg(JMAXP,t_VEC);
  affsr(1,(GEN)(h[1]=lgetr(prec)));

  push_val(ep, a);
  p1=lisexpr(ch); if (p1 == a) p1=rcopy(p1);
  ep->value = (void*)b;
  p2=lisexpr(ch);
  s[1]=lmul2n(gmul(qlint,gadd(p1,p2)),-1);
  
  sz=gmul(gzero,(GEN)s[1]);
  s[2]=s[1]; h[2]=lshiftr((GEN)h[1],-2);
  for (it=1,j=2; j<=JMAX; j++,it=it<<1)
  {
    av1=avma; del=divrs(qlint,it); x=addrr(a,shiftr(del,-1));
    for (sum=sz,j1=1; j1<=it; j1++,x=addrr(x,del))
    {
      ep->value = (void*) x; p1=lisexpr(ch); sum=gadd(sum,p1);
    }
    sum = gmul(sum,del); p1 = gadd((GEN)s[j-1],sum);
    tetpil = avma;
    s[j]=lpile(av1,tetpil,gmul2n(p1,-1));

    if (j>=KLOC)
    {
      for (j1=1; j1<=KLOC; j1++)
      {
	p3[j1]=s[j1+j-KLOC]; p4[j1]=h[j1+j-KLOC];
      }
      tetpil=avma; ss=polint(p4,p3,gzero,&dss);
      j1=gexpo(ss); j2=gexpo(dss); lim=bit_accuracy(prec)-j-5;
      if (j1-j2 > lim || (j1 < -lim && j2<j1-1))
      {
	if (gcmp0(gimag(ss))) ss=greal(ss);
	tetpil=avma; pop_val(ep);
	return gerepile(av,tetpil,gmulsg(sig,ss));
      }
      avma=tetpil;
    }
    s[j+1]=s[j]; h[j+1]=lshiftr((GEN)h[j],-2);
  }
  err(intger2); return NULL; /* not reached */
}

GEN
qromo(entree *ep, GEN a, GEN b, char *ch, long prec)
{
  GEN ss,dss,s,h,sz,p1,p3,p4,qlint,del,ddel,x,sum;
  long av = avma,av1,tetpil,j,j1,j2,lim,it,sig;

  a = fix(a, prec);
  b = fix(b, prec);
  qlint=subrr(b,a); sig=signe(qlint);
  if (!sig)  { avma=av; return gzero; }
  if (sig<0) { setsigne(qlint,1); s=a; a=b; b=s; }

  p3=cgetg(KLOC+1,t_VEC); s=cgetg(JMAXP,t_VEC);
  p4=cgetg(KLOC+1,t_VEC); h=cgetg(JMAXP,t_VEC);
  affsr(1,(GEN)(h[1]=lgetr(prec)));

  p1 = shiftr(addrr(a,b),-1); push_val(ep, p1);
  p1=lisexpr(ch); s[1]=lmul(qlint,p1);
  
  sz=gmul(gzero,(GEN)s[1]);
  s[2]=s[1]; h[2]=ldivrs((GEN)h[1],9);
  for (it=1, j=2; j<=JMAX; j++, it*=3)
  {
    av1=avma; del=divrs(qlint,3*it); ddel=shiftr(del,1);
    x=addrr(a,shiftr(del,-1)); sum=sz;
    for (j1=1; j1<=it; j1++)
    {
      ep->value = (void*)x; p1=lisexpr(ch); sum=gadd(sum,p1); x=addrr(x,ddel);
      ep->value = (void*)x; p1=lisexpr(ch); sum=gadd(sum,p1); x=addrr(x,del);
    }
    sum = gmul(sum,del); p1 = gdivgs((GEN)s[j-1],3);
    tetpil = avma;
    s[j]=lpile(av1,tetpil,gadd(p1,sum));

    if (j>=KLOC)
    {
      for (j1=1; j1<=KLOC; j1++)
      {
	p3[j1]=s[j1+j-KLOC]; p4[j1]=h[j1+j-KLOC];
      }
      tetpil=avma; ss=polint(p4,p3,gzero,&dss);
      j1=gexpo(ss); j2=gexpo(dss); lim=bit_accuracy(prec)-(3*j/2)-5;
      if ( j1-j2 > lim || (j1 < -lim && j2<j1-1))
      {
	if (gcmp0(gimag(ss))) ss=greal(ss);
	tetpil=avma; pop_val(ep);
	return gerepile(av,tetpil,gmulsg(sig,ss));
      }
      avma=tetpil;
    }
    s[j+1]=s[j]; h[j+1]=ldivrs((GEN)h[j],9);
  }
  err(intger2); return NULL; /* not reached */
}

#undef JMAX
#undef JMAXP
#define JMAX 16
#define JMAXP JMAX+3

GEN
qromi(entree *ep, GEN a, GEN b, char *ch, long prec)
{
  GEN ss,dss,s,h,q1,sz,p1,p3,p4,p,qlint,del,ddel,x,sum;
  long av = avma, av1,tetpil,j,j1,j2,lim,it,sig;

  p=cgetr(prec); gaffect(ginv(a),p); a=p;
  p=cgetr(prec); gaffect(ginv(b),p); b=p;
  qlint=subrr(b,a); sig= -signe(qlint);
  if (!sig)  { avma=av; return gzero; }
  if (sig>0) { setsigne(qlint,1); s=a; a=b; b=s; }

  p3=cgetg(KLOC+1,t_VEC); p4=cgetg(KLOC+1,t_VEC);
  s=cgetg(JMAXP,t_VEC); h=cgetg(JMAXP,t_VEC);
  affsr(1,(GEN)(h[1]=lgetr(prec)));
  
  x=divsr(2,addrr(a,b)); push_val(ep, x);
  p1=gmul(lisexpr(ch),mulrr(x,x));
  s[1]=lmul(qlint,p1);

  sz=gmul(gzero,(GEN)s[1]);
  s[2]=s[1]; h[2]=ldivrs((GEN)h[1],9);
  for (it=1,j=2; j<=JMAX; j++, it*=3)
  {
    av1=avma; del=divrs(qlint,3*it); ddel=shiftr(del,1);
    x=addrr(a,shiftr(del,-1)); sum=sz;
    for (j1=1; j1<=it; j1++)
    {
      q1 = ginv(x); ep->value = (void*)q1;
      p1=gmul(lisexpr(ch),mulrr(q1,q1));
      sum=gadd(sum,p1); x=addrr(x,ddel);

      q1 = ginv(x); ep->value = (void*)q1;
      p1=gmul(lisexpr(ch),mulrr(q1,q1));
      sum=gadd(sum,p1); x=addrr(x,del);
    }
    sum = gmul(sum,del); p1 = gdivgs((GEN)s[j-1],3);
    tetpil=avma;
    s[j]=lpile(av1,tetpil,gadd(p1,sum));

    if (j>=KLOC)
    {
      for (j1=1; j1<=KLOC; j1++)
      {
	p3[j1]=s[j1+j-KLOC]; p4[j1]=h[j1+j-KLOC];
      }
      tetpil=avma; ss=polint(p4,p3,gzero,&dss);
      j1=gexpo(ss); j2=gexpo(dss); lim=bit_accuracy(prec)-(3*j/2)-5;
      if (j1-j2 > lim || (j1 < -lim && j2 < j1-1))
      {
	if (gcmp0(gimag(ss))) ss=greal(ss);
	tetpil=avma; pop_val(ep);
	return gerepile(av,tetpil,gmulsg(sig,ss));
      }
    }
    s[j+1]=s[j]; h[j+1]=ldivrs((GEN)h[j],9);
  }
  err(intger2); return NULL; /* not reached */
}

GEN
rombint(entree *ep, GEN a, GEN b, char *ch, long prec)
{
  GEN aa,bb,mun,p1,p2,p3;
  long l,av,tetpil;

  l=gcmp(b,a); if (!l) return gzero;
  if (l<0) { bb=a; aa=b; } else { bb=b; aa=a; }
  av=avma; mun = negi(gun);
  if (gcmpgs(bb,100)>=0)
  {
    if (gcmpgs(aa,1)>=0) return qromi(ep,a,b,ch,prec);
    p1=qromi(ep,gun,bb,ch,prec);
    if (gcmpgs(aa,-100)>=0)
    {
      p2=qromo(ep,aa,gun,ch,prec); tetpil=avma;
      return gerepile(av,tetpil,gmulsg(l,gadd(p1,p2)));
    }
    p2=qromo(ep,mun,gun,ch,prec); p3=gadd(p2,qromi(ep,aa,mun,ch,prec));
    tetpil=avma; return gerepile(av,tetpil,gmulsg(l,gadd(p1,p3)));
  }
  if (gcmpgs(aa,-100)>=0) return qromo(ep,a,b,ch,prec);
  if (gcmpgs(bb,-1)>=0)
  {
    p1=qromi(ep,aa,mun,ch,prec); p2=qromo(ep,mun,bb,ch,prec); tetpil=avma;
    return gerepile(av,tetpil,gmulsg(l,gadd(p1,p2)));
  }
  return qromi(ep,a,b,ch,prec);
}

/********************************************************************/
/**                                                                **/
/**                  ZAGIER POLYNOMIALS (for sumiter)              **/
/**                                                                **/
/********************************************************************/

GEN
polzag(long n, long m)
{
  long d1,d,r,k,av=avma,tetpil;
  GEN p1,p2,pol1,g,s;

  if (m>=n || m<0)
    err(talker,"first index must be greater than second in polzag");
  d1=n-m; d=d1<<1; d1--; p1=gsub(gun,gmul2n(polx[0],1));
  pol1=gsub(gun,polx[0]); p2=gmul(polx[0],pol1); r=(m+1)>>1;
  g=gzero;
  for (k=0; k<=d1; k++)
  {
    s=binome(stoi(d),(k<<1)+1); if (k&1) s=negi(s);
    g=gadd(g,gmul(s,gmul(gpuigs(polx[0],k),gpuigs(pol1,d1-k))));
  }
  g=gmul(g,gpuigs(p2,r));
  if (!(m&1)) g=gadd(gmul(p1,g),gmul2n(gmul(p2,deriv(g,0)),1));
  for (k=1; k<=r; k++)
  {
    g=deriv(g,0); g=gadd(gmul(p1,g),gmul2n(gmul(p2,deriv(g,0)),1));
  }
  g = m ? gmul2n(g,(m-1)>>1):gmul2n(g,-1);
  s=mulsi(n-m,mpfact(m+1));
  tetpil=avma; return gerepile(av,tetpil,gdiv(g,s));
}

GEN
polzagreel(long n, long m, long prec)
{
  long d1,d,r,j,k,k2,av=avma,tetpil;
  GEN p2,pol1,g,h,v,b,gend,s,unreel;

  if (m>=n || m<0)
    err(talker,"first index must be greater than second in polzag");
  affsr(1,unreel=cgetr(prec));
  d1=n-m; d=d1<<1; d1--; pol1=gadd(gun,polx[0]);
  p2=gmul(polx[0],pol1); r=(m+1)>>1; gend=stoi(d);
  v=cgetg(d1+2,t_VEC); g=cgetg(d1+2,t_VEC);
  v[d1+1]=un; b=mulri(unreel,gend); g[d1+1]=(long)b;
  for (k=1; k<=d1; k++)
  {
    v[d1-k+1]=un;
    for (j=1; j<k; j++)
      v[d1-k+j+1]=(long)addii((GEN)v[d1-k+j+1],(GEN)v[d1-k+j+2]);
    k2=k+k; b=divri(mulri(b,mulss(d-k2+1,d-k2)),mulss(k2,k2+1));
    for (j=1; j<=k; j++)
      g[d1-k+j+1]=(long)mpadd((GEN)g[d1-k+j+1],mulri(b,(GEN)v[d1-k+j+1]));
    g[d1-k+1]=(long)b;
  }
  h=cgetg(d1+3,t_POL); h[1]=evalsigne(1)+evallgef(d1+3);
  for (k=0; k<=d1; k++) h[k+2]=g[k+1];
  g=gmul(h,gpuigs(p2,r));
  for (j=0; j<=r; j++)
  {
    if (j) g=deriv(g,0);
    if (j || !(m&1))
    {
      h=cgetg(n+3,t_POL); h[1]=evalsigne(1)+evallgef(n+3);
      h[2]=g[2];
      for (k=1; k<n; k++)
	h[k+2]=ladd(gmulsg(k+k+1,(GEN)g[k+2]),gmulsg(k<<1,(GEN)g[k+1]));
      h[n+2]=lmulsg(n<<1,(GEN)g[n+1]); g=h;
    }
  }
  g = m ?gmul2n(g,(m-1)>>1):gmul2n(g,-1);
  s=mulsi(n-m,mpfact(m+1));
  tetpil=avma; return gerepile(av,tetpil,gdiv(g,s));
}

/********************************************************************/
/**                                                                **/
/**            SEARCH FOR REAL ZEROS of an expression              **/
/**                                                                **/
/********************************************************************/

GEN
zbrent(entree *ep, GEN a, GEN b, char *ch, long prec)
{
  long av=avma,tetpil,sig,iter,itmax;
  GEN c,d,e,tol,toli,min1,min2,fa,fb,fc,p,q,r,s,xm;

  a = fix(a,prec);
  b = fix(b,prec);
  sig=cmprr(b,a); if (!sig) { avma = av; return gzero; }
  if (sig<0) { c=a; a=b; b=c; }

  push_val(ep, a);
  fa = lisexpr(ch);
  ep->value = (void*)b;
  fb = lisexpr(ch);
  if (gsigne(fa)*gsigne(fb) > 0)
    err(talker,"roots must be bracketed in solve");
  itmax = (prec<<TWOPOTBITS_IN_LONG) + 50; affsr(1,tol=cgetr(3));
  tol=shiftr(tol, 5-bit_accuracy(prec));
  fc=fb;
  for (iter=1; iter<=itmax; iter++)
  {
    if (gsigne(fb)*gsigne(fc) > 0)
    {
      c=a; fc=fa; d=subrr(b,a); e=d;
    }
    if (gcmp(gabs(fc,0),gabs(fb,0)) < 0)
    {
      a=b; b=c; c=a; fa=fb; fb=fc; fc=fa;
    }
    toli=mulrr(tol,absr(b));
    xm=shiftr(subrr(c,b),-1);
    if (cmprr(absr(xm),toli) <= 0 || gcmp0(fb))
    {
      tetpil=avma; pop_val(ep);
      return gerepile(av,tetpil,rcopy(b));
    }
    if (cmprr(absr(e),toli) >= 0 && gcmp(gabs(fa,0),gabs(fb,0)) > 0)
    {
      s=gdiv(fb,fa);
      if (cmprr(a,b)==0)
      {
	p=gmul2n(gmul(xm,s),1); q=gsubsg(1,s);
      }
      else
      {
	q=gdiv(fa,fc); r=gdiv(fb,fc);
	p=gmul2n(gmul(gsub(q,r),gmul(xm,q)),1);
	p=gmul(s,gsub(p,gmul(gsub(b,a),gsubgs(r,1))));
	q=gmul(gmul(gsubgs(q,1),gsubgs(r,1)),gsubgs(s,1));
      }
      if (gsigne(p) > 0) q=gneg(q); else p=gneg(p);
      min1=gsub(gmulsg(3,gmul(xm,q)),gabs(gmul(q,toli),0));
      min2=gabs(gmul(e,q),0);
      if (gcmp(gmul2n(p,1),gmin(min1,min2)) < 0) 
        { e=d; d=gdiv(p,q); }
      else
        { d=xm; e=d; }
    }
    else { d=xm; e=d; }
    a=b; fa=fb;
    if (gcmp(gabs(d,0),toli) > 0) b=gadd(b,d);
    else
    {
      if (gsigne(xm)>0)
        b = addrr(b,toli);
      else
        b = subrr(b,toli);
    }
    ep->value = (void*)b; fb=lisexpr(ch);
  }
  err(talker,"too many iterations in solve");
  return NULL; /* not reached */
}
