Sindbad~EG File Manager

Current Path : /usr/home/beeson/MathXpert/trigcalc/
Upload File :
Current File : /usr/home/beeson/MathXpert/trigcalc/sigma.c

/* operators associated to SUM and binomial coefficients and factorials
M. Beeson, for MathXpert
1.9.91  original date
6.28.99 last modified
1.21.06  corrected the reason string of sumofallpowers.
1.23.06  added sumtodifofsums and sumtodifofsums0
4.40.13 modified reason strings
5.1.13  modified reason strings
5.17.13  evaluatebernoulli
5.24.13  evaluateeulernumber
5.29.13 changed int n to long n in those two functions
6.2.13  changed evaluatebinomialcoef to call ratbinomial instead of fail on rational non-integer arguments
        made binomialcoeftofactorials fail unless n,k are nonnegative integers and k not a bignum 
        and changed its reason string to a displayed formula.
9.3.17  removed unused function remove_zero_powers
12.31.24 made evaluatesigmatorational, evaluatepuresigmatorational, and
evaluatesigmatodecimal all fail if t contains infinity.
2.10.24 in eval_aux, need input_error_message instead of english in two places to get the right messages.
2.18.25  SETAE after SETTYPE to avoid a warning
*/

#include <string.h>
#include <assert.h>

#include "globals.h"
#include "ops.h"
#include "dcomplex.h"
#include "ceval.h"
#include "probtype.h"
#include "order.h"
#include "algaux.h"
#include "mstring.h"
#include "prover.h"
#include "sigma.h"
#include "deval.h"
#include "symbols.h"
#include "polynoms.h"
#include "errbuf.h"
#include "trig.h"      /* writeaspoly          */
#include "autosimp.h"  /* SetShowStepOperation */
#include "dispfunc.h"
#include "cancel.h"
#include "pvalaux.h"   /* topflatten           */
#include "pstring.h"   /* log_term, for debugging */


/*________________________________________________________________________*/
int  minusoutofsigma(term t, term arg, term *next, char *reason)
{ term u;
  if(FUNCTOR(t)!=SUM)
     return 1;
  u = ARG(0,t);  /* the summand */
  if(FUNCTOR(u) != '-')
     return 1;
  tneg(indexedsum(ARG(0,u),ARG(1,t),ARG(2,t),ARG(3,t)),next);
  HIGHLIGHT(*next);
  strcpy(reason,"$\\sum(-u) = -\\sum u$");
  return 0;
}
/*________________________________________________________________________*/
int  constantoutofsigma(term t, term arg, term *next, char *reason)
/* \sum cu = c \sum u  */
/* "constant" here means not containing the index variable; this should
be ok as there shouldn't be any implicit dependencies on the index
variable */
{ term u,index;
  term c,v;  /* the constant to be pulled out and the new summand */
  unsigned short f;
  if(FUNCTOR(t)!=SUM)
     return 1;
  u = ARG(0,t);  /* the summand */
  index = ARG(1,t); /* the index variable */
  assert(ISATOM(index));
  f = FUNCTOR(u);
  if(f != '*' && f != '/' && f != '-')
     return 1;
  twoparts(u,index,&c,&v);
  if(ONE(c))
     return 1;
  HIGHLIGHT(c);
  *next = product(c,indexedsum(v,index,ARG(2,t),ARG(3,t)));
  strcpy(reason,"$\\sum  cu = c\\sum  u$");   
  return 0;
}
/*________________________________________________________________________*/
int  constantintosigma(term t, term arg, term *next, char *reason)
/* "$c\\sum u = \\sum cu$ */
/* "constant" here means not containing the index variable; this should
be ok as there shouldn't be any implicit dependencies on the index
variable */
{ term u,index,sum;
  term c,v;
  unsigned short n,i;
  if(FUNCTOR(t)!='*')
     return 1;
  n = ARITY(t);
  sum = ARG((unsigned short)(n-1),t);
  if(FUNCTOR(sum) != SUM)
     return 1;
  u = ARG(0,sum);
  index = ARG(1,sum);
  if(n == 2)
     c = ARG(0,t);
  else
     { c = make_term('*',(unsigned short)(n-1));
       for(i=0;i<n-1;i++)
          ARGREP(c,i,ARG(i,t));
     }
  if(contains(c,FUNCTOR(index)))
     return 1;
  if(FUNCTOR(c) == '*' || FUNCTOR(u) == '*')
     v = topflatten(product(c,u));
  else
     v = product(c,u);
  if(ARITY(sum) == 4)
     *next = sigma(v,index,ARG(2,sum),ARG(3,sum));
  else
     *next =series(v,index,ARG(2,sum),ARG(3,sum),ARG(4,sum));
  HIGHLIGHT(*next);
  strcpy(reason, "$c\\sum u = \\sum cu$");   
  return 0;
}
/*________________________________________________________________________*/
int  sigmasum(term t, term arg, term *next, char *reason)
/* \sum (u \pm v) = \sum u + \sum v   */
{ int i;
  unsigned short n;
  term u;
  if(FUNCTOR(t) != SUM)
     return 1;
  u = ARG(0,t);
  if(FUNCTOR(u) != '+')
     return 1;
  if(equals(ARG(3,t),infinity) || equals(ARG(2,t),minusinfinity))
     return 1;  /* this is only for finite series */
  n = ARITY(u);
  *next = make_term('+',n);
  for(i=0;i<n;i++)
     { if(FUNCTOR(ARG(i,u))== '-')
           ARGREP(*next,i,tnegate(indexedsum(ARG(0,ARG(i,u)),ARG(1,t),ARG(2,t),ARG(3,t))));
       else
           ARGREP(*next,i,indexedsum(ARG(i,u),ARG(1,t),ARG(2,t),ARG(3,t)));
     }
  if(n==2 && FUNCTOR(ARG(1,u))== '-')
     strcpy(reason,"$\\sum (u-v) = \\sum u - \\sum v$");
  else
     strcpy(reason,"$\\sum (u+v) = \\sum u + \\sum v$");
  HIGHLIGHT(*next);
  return 0;
}

/*________________________________________________________________________*/
int eval_aux(term t, term arg, term *u, char *reason)
/* t is an indexed sum or product or definite integral.
If it contains more than one
variable other than the index variable, return 1 (failure).  If arg
is ILLEGAL, can succeed only if upper and lower limits of sum are both
seminumerical, and the summand contains only the index variable free,
in which case it returns 0 with *u = t.
If arg contains any variables (other than pi_term, e, or 'i' if complex) then
return 1 also.  If t contains no extra variables, return 0 with *u = t;
otherwise substitute arg for the extra variable in t.  Check that
the resulting values of upper and lower indices are integers.  Return
0 for success, 1 for failure */
/* Reason string produced has the form "n = 4" or whatever, if there
are indeed extra variables. */

{ term *atomlist;
  term lo,hi,temp;
  char localbuf[81];
  int err,cnt;
  unsigned short g;
  int complex;
  g = FUNCTOR(t);
  assert(g == SUM || g == PRODUCT || (g == INTEGRAL && ARITY(t) ==4));
  complex = get_complex();
  if(FUNCTOR(arg)==ILLEGAL)
     { temp = t;
       strcpy(reason, english(808));  /* numerical calculation */
     }
  else if(complex && !complexnumerical(arg))
     return 1;
  else if(!seminumerical(arg))
     return 1;
  cnt = freevars(t,&atomlist);
  if(cnt > 1)
     { free2(atomlist);
       return 1;   /* too many variables */
     }
  if(cnt == 0)  /* no free variables */
    { *u = t;
      free2(atomlist);
      return 0;
    }
  if(g == SUM || g == PRODUCT)
     { if(FUNCTOR(arg) == ILLEGAL)
          { free2(atomlist);
            return 1;
          }
       subst(arg,atomlist[0],t,&temp);
       if(NEGATIVE(ARG(2,temp)) && INTEGERP(ARG(0,ARG(2,temp))))
          lo = ARG(2,temp);
       else if(INTEGERP(ARG(2,temp)))
          lo = ARG(2,temp);
       else
          { err = value(ARG(2,temp),&lo);
            if(err && err != 2)
            { errbuf(0, input_error_message(111));
                    /* Lower limit of sum must be an integer */
                 free2(atomlist);
                 return 1;
               }
          }
       if(NEGATIVE(ARG(3,temp)) && INTEGERP(ARG(0,ARG(3,temp))))
          hi = ARG(3,temp);
       else if(INTEGERP(ARG(3,temp)))
          hi = ARG(3,temp);
       else
          { err = value(ARG(3,temp),&hi);
            if(err && err != 2)
            { errbuf(0, input_error_message(112));
                    /* Upper limit of sum must be an integer */
                 free2(atomlist);
                 return 1;
               }
          }
       *u = sigma(ARG(0,temp),ARG(1,temp),lo,hi);
     }
  else if(g == INTEGRAL)  /* a definite integral */
    { double a,b;
      term v;
      err = deval(ARG(2,t),&a);
      if(err)
         { errbuf(0, english(821));
              /* Can't evaluate lower limit of integral. */
           free2(atomlist);
           return 1;
         }
      err = deval(ARG(3,t),&b);
      if(err)
         { errbuf(1, english(822));
              /* Can't evaluate upper limit of integral. */
           free2(atomlist);
           return 1;
         }
       v = *u;
       *u = definite_integral(ARG(0,v),ARG(1,v),make_double(a),make_double(b));
    }
  strcpy(reason,atom_string(atomlist[0]));
  strcat(reason," = ");
  err = mstring(arg,localbuf);
  if(err || strlen(localbuf) > MAXREASONSTRING - 4)
     strcat(reason, english(823));  /* specified value */
  else
     strcat(reason,localbuf);
  free2(atomlist);
  return 0;
}
/*________________________________________________________________________*/
int  evaluatesigmatodecimal(term t, term arg, term *next, char *reason)
/* if the sum contains variables other than the index variable,
the operator fails unless there is exactly one such variable,
and then it takes the decimal value of arg, if it has one, as the
value of that variable.   It also fails if t contains infinity.
*/

{ double ans;
  dcomplex cans;
  int err;
  term u;
  if(FUNCTOR(t)!= SUM)
     return 1;
  if(contains(t,INFINITYFUNCTOR))
     return 1;
  err = eval_aux(t,arg,&u,reason);
  if(err)
     return 1;
  if(get_complex())
     { err = ceval(u,&cans);
       if(err)
          return 1;
       *next = make_complex(make_double(cans.r),make_double(cans.i));
     }
  else
     { err = deval(u,&ans);
       if(err)
          return 1;
       *next = make_double(ans);
     }
  HIGHLIGHT(*next);
  return 0;
}
/*________________________________________________________________________*/
int  evaluatesigmatorational(term t, term arg, term *next, char *reason)
/* if the sum contains variables other than the index variable,
the operator fails unless there is exactly one such variable,
and then it takes the decimal value of arg, if it has one, as the
value of that variable, where it occurs in the summand, but it doesn't
use decimal arithmetic in the limits, which must be integers.
It also fails if t contains infinity.
*/

{ aflag flag;
  int err;
  term u;
  if(FUNCTOR(t) != SUM)
     return 1;
  if(contains(t,INFINITYFUNCTOR))
     return 1;
  flag = get_arithflag();
  flag.sums = 1;
  err = eval_aux(t,arg,&u,reason);
  if(err)
     return 1;
  err = eval_indexedsum(u,next,flag);
  if(err==1)
     { nospace();
       return 1;
     }
  if(err)
     { errbuf(0,aem(err));
       return 1;
     }
  HIGHLIGHT(*next);
  return 0;
}
/*________________________________________________________________________*/
int  evalpuresigmatodecimal(term t, term arg, term *next, char *reason)
/* if the sum contains variables other than the index variable,
the operator fails */

{ term *atomlist;
  int nfree;
  if(FUNCTOR(t)!= SUM)
     return 1;
  nfree = freevars(t,&atomlist);
  free2(atomlist);
  if(nfree)
     return 1;
  return evaluatesigmatodecimal(t,arg,next,reason);
}

/*________________________________________________________________________*/
int  evalpuresigmatorational(term t, term arg, term *next, char *reason)
/* if the sum contains variables other than the index variable,
or contains infinity, the operator fails */

{ term *atomlist;
  int nfree;
  if(FUNCTOR(t)!= SUM)
     return 1;
  nfree = freevars(t,&atomlist);
  free2(atomlist);
  if(nfree)
     return 1;
  return evaluatesigmatorational(t,arg,next,reason);
}
/*________________________________________________________________________*/
int  sumofi(term t, term arg, term *next, char *reason)
/* 1+2+..+n = n(n+1)/2 */
{ term n;
  term lo = ARG(2,t);
  if(FUNCTOR(t) != SUM)
     return 1;
  if(!equals(ARG(0,t),ARG(1,t)))
     return 1;
  if(!ZERO(lo) && !ONE(lo))
     return 1; 
  n = ARG(3,t);
  *next = make_fraction(product(n,sum(n,one)),two);
  HIGHLIGHT(*next);
  strcpy(reason,"1+2+..+n = n(n+1)/2");
  return 0;
}
/*________________________________________________________________________*/
int  sumofisquared(term t, term arg, term *next, char *reason)
/* 1+2+..+n^2 = n(n+1)(2n+1)/6 */
{ term index,lo,u,hi;
  if(FUNCTOR(t) != SUM)
     return 1;
  index = ARG(1,t);
  lo = ARG(2,t);
  hi = ARG(3,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != '^')
     return 1;
  if(!equals(ARG(1,u),two))
     return 1;
  if(!equals(ARG(0,u),index))
     return 1;
  if(!ZERO(lo) && !ONE(lo))
     return 1; 
  *next = make_fraction(
                        product3(hi,sum(hi,one),sum(product(two,hi),one)),
                        six
                       );
  HIGHLIGHT(*next);
  strcpy(reason,"1+2^2+..+n^2 =                ");
  strcpy(reason+MAXREASONSTRING,"n(n+1)(2n+1)/6");
  return 0;
}

/*________________________________________________________________________*/
int  sumoficubed(term t, term arg, term *next, char *reason)
/* 1+2^3+..+n^3 = n^2(n+1)^2/4 */
{ term index,lo,u,hi;
  if(FUNCTOR(t) != SUM)
     return 1;
  index = ARG(1,t);
  lo = ARG(2,t);
  hi = ARG(3,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != '^')
     return 1;
  if(!equals(ARG(1,u),three))
     return 1;
  if(!equals(ARG(0,u),index))
     return 1;
  if(! ZERO(lo) && !ONE(lo))
     return 1; 
  *next = make_fraction(
                        product(make_power(hi,two),make_power(sum(hi,one),two)),
                        four
                       );
  HIGHLIGHT(*next);
  strcpy(reason,"1+2^3+..+n^3 =                 ");
  strcpy(reason+MAXREASONSTRING,"$n^2(n+1)^2/4$");
  return 0;
}
/*________________________________________________________________________*/
int  sumofitothefourth(term t, term arg, term *next, char *reason)
/* 1+2^4+..+n^4 = n(n+1)(2n+1)(3n^2+3n-1)/30 */
{ term index,lo,u,hi;
  term num,p;
  if(FUNCTOR(t) != SUM)
     return 1;
  index = ARG(1,t);
  lo = ARG(2,t);
  hi = ARG(3,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != '^')
     return 1;
  if(!equals(ARG(1,u),four))
     return 1;
  if(!equals(ARG(0,u),index))
     return 1;
  if(! ZERO(lo) && !ONE(lo))
     return 1; 
  *next = make_fraction(
                        product(make_power(hi,two),make_power(sum(hi,one),two)),
                        four
                       );
  HIGHLIGHT(*next);
  num = make_term('*',4);
  ARGREP(num,0,hi);
  ARGREP(num,1,sum(hi,one));
  ARGREP(num,2,sum(product(two,hi),one));
  p = make_term('+',3);
  ARGREP(p,0,product(three,make_power(hi,two)));
  ARGREP(p,1,product(three,hi));
  ARGREP(p,2,minusone);
  ARGREP(num,3,p);
  *next = make_fraction(num, make_int(30L));
  strcpy(reason,"1+2^4+..+n^4 = n(n+1)               ");
  strcpy(reason+MAXREASONSTRING,"$(2n+1)(3n^2+3n-1)/30$");
  return 0;
}

/*________________________________________________________________________*/
int  sumofallpowers(term t, term arg, term *next, char *reason)
/* 1+x+..+x^n=(1-x^(n+1))/(1-x) */
{ term n,x,m,temp;
  int err;
  term lo;
  if(FUNCTOR(t) != SUM)
     return 1;
  lo = ARG(2,t);
  if(FUNCTOR(ARG(0,t)) != '^')
     return 1;
  x = ARG(0,ARG(0,t));
  if(!equals(ARG(1,ARG(0,t)),ARG(1,t)))
     return 1;
  n = ARG(3,t);
  m = sum(n,one);
  err = value(m,&temp);
  if(!err || err ==2)
     m = temp;
  if(! ZERO(lo))
     return  1; 
  *next = make_fraction(
                        sum(one,tnegate(make_power(x,m))),
                        sum(one,tnegate(x))
                       );
  HIGHLIGHT(*next);
  strcpy(reason,"1 + x +...+ x^n        = (1-x^(n+1))/(1-x)");
  return 0;
}
/*________________________________________________________________________*/
int  productofsigmas(term t, term arg, term *next, char *reason)
/* (sigma u)(sigms v) = sigma sigma uv */
/* Multiplies the first two adjacent sums in a product */

{ unsigned short n = ARITY(t);
  int i,k;
  term outersum,innersum,first,second;
  if(FUNCTOR(t) != '*')
     return 1;
  for(k=0;k<n-1;k++)
    { if(FUNCTOR(ARG(k,t)) == SUM && FUNCTOR(ARG(k+1,t)) == SUM)
            break;
    }
  if(k==n-1)
     return 1;
  first = ARG(k,t);
  second = ARG(k+1,t);
  if(equals(ARG(1,first),ARG(1,second)))
    { errbuf(0, english(824));
          /* You must first rename one index variable */
      return 1;
    }
  innersum = make_term(SUM,4);
  outersum = make_term(SUM,4);
  ARGREP(innersum,0,product(ARG(0,first),ARG(0,second)));
  for(i=1;i<4;i++)
     ARGREP(innersum,i,ARG(i,second));
  ARGREP(outersum,0,innersum);
  for(i=1;i<4;i++)
     ARGREP(outersum,i,ARG(i,first));
  HIGHLIGHT(outersum);
  if(n==2)
    *next = outersum;
  else
    { *next = make_term('*',(unsigned short)(n-1));
      for(i=0;i<k;i++)
        ARGREP(*next,i,ARG(i,t));
      ARGREP(*next,k,outersum);
      for(i=k+1;i<n-1;i++)
        ARGREP(*next,i,ARG(i+1,t));
    }
  HIGHLIGHT(*next);
  strcpy(reason,"$(\\sum u)(\\sum v) = \\sum \\sum uv$");
  return 0;
}
/*________________________________________________________________________*/
int  evaluatefactorial(term t, term arg, term *next, char *reason)
{ int err;
  aflag flag = get_arithflag();
  if (FUNCTOR(t) != FACTORIAL)
     return 1;
  if(!OBJECT(ARG(0,t)))  /* what's inside should first be evaluated to an integer */
     return 1;
  flag.factorial = 1;
  err = arith(t,next,flag);
  if(err)
     { errbuf(0,aem(err));
       return 1;
     }
  HIGHLIGHT(*next);
  strcpy(reason,english(2164)); /* compute factorial */
  return 0;
}
/*________________________________________________________________________*/
int  evaluatebinomialcoef(term t, term arg, term *next, char *reason)
{ int err;
  term n,k;
  long K;
  bigrat ans;
  if (FUNCTOR(t) != BINOMIAL)
     return 1;
  n = ARG(0,t);
  k = ARG(1,t);
  if(!numerical(n) || !numerical(k))
     return 1;
  if(!ISINTEGER(k))
     { errbuf(0,aem(38));  /* binomial coefficient too large to compute */
       return 1;
     }
  K = INTDATA(k);
  if(INTEGERP(n))
     { err = binomial(n,k,next);
       if(err)  
          { errbuf(0,aem(err));
            return 1;
          }
       HIGHLIGHT(*next);
       strcpy(reason, english(825));   /*  compute binom coef */
       return 0;
     }
  if(NEGATIVE(n) && ISINTEGER(ARG(0,n)))
     err = ratbinomial(-INTDATA(ARG(0,n)),1,K,&ans);       
  else  if(FRACTION(n) && ISINTEGER(ARG(0,n)) && ISINTEGER(ARG(1,n)))
     err = ratbinomial(INTDATA(ARG(0,n)),INTDATA(ARG(1,n)),K,&ans);
  else if(NEGATIVE(n) && FRACTION(ARG(0,n)) && ISINTEGER(ARG(0,ARG(0,n))) && ISINTEGER(ARG(1,ARG(0,n))))
     err = ratbinomial(-INTDATA(ARG(0,ARG(0,n))),INTDATA(ARG(1,ARG(0,n))),K,&ans);
  else if(FRACTION(n) && NEGATIVE(ARG(0,n)) && ISINTEGER(ARG(0,ARG(0,n))) && ISINTEGER(ARG(1,n)))
     err = ratbinomial(-INTDATA(ARG(0,ARG(0,n))), INTDATA(ARG(1,n)),K,&ans);
  else
     return 1;
  if(err)  
     { errbuf(0,aem(err));
       return 1;
     }
  if(ans.sign == 0)
     *next = zero;
  else if (ans.d.ln == 1 && ans.d.val[0] == 1)
     *next = ans.sign > 0 ? bignum_term(ans.n) : tnegate(bignum_term(ans.n));
  else if(ans.sign > 0)
     *next = make_fraction(bignum_term(ans.n),bignum_term(ans.d));
  else // ans.sign < 0 
     *next = tnegate(make_fraction(bignum_term(ans.n), bignum_term(ans.d)));
  HIGHLIGHT(*next);
  strcpy(reason, english(825));   /*  compute binom coef */
  return 0;
}
/*________________________________________________________________________*/
int  evaluatebernoulli(term t, term arg, term *next, char *reason)
/* evaluate Bernoulli numbers occurring in t */
/* Return 0 if at least one Bernoulli number is successfully evaluated;
   otherwise, return 1,  but in that case, *next is set equal to t, so it
   can be called recursively.
*/ 
{ int err;
  long n;
  term nt,temp;
  bignum num, denom;
  term a,b;
  unsigned short m = ARITY(t);
  unsigned short f = FUNCTOR(t);
  int i;
  long A,B;
  if(!contains(t,BERNOULLI))
      { *next = t;
         return 1;
      }
  if(ATOMIC(t))
      { *next = t;
        return 1;
      }
  if(f == BERNOULLI)
     { nt = ARG(0,t);
       if(! (OBJECT(nt) && TYPE(nt)==INTEGER)) // cannot be a bignum or negative
           { *next = t; 
             return 1;
           }
       n = INTDATA(nt);
       if(n %2 == 1)
           { *next = zero;
             strcpy(reason, english(2513));   //  "evaluate Bernoulli number exactly"
             return 0;
           }
       err = exact_bernoulli(n,&num, &denom);
       if(err == 1)
           { errbuf(0,aem(65)); // "Bernoulli number too large to evaluate easily."
             *next = t;
             return 1;
           }
       if(n <= 26)
          { bignum_long(num,&A);
            bignum_long(denom,&B);
            freespace(num.val);
            freespace(denom.val);
            a = make_int(A); 
            b = make_int(B);
            goto out;
          }
       // past n = 26, use bignums for both num and denom 
       SETFUNCTOR(a,0,1);
       SETFUNCTOR(b,0,1);
       a.info = b.info = 0;  // prevent a warning that they are uninitialized
       SETTYPE(a,BIGNUM);
       SETTYPE(b,BIGNUM);
       SETAE(a);
       SETAE(b);
       a.args = callocate(1,sizeof(bignum));
       if(a.args == NULL)
              { nospace();
                return 1;
              }
       b.args  = callocate(1,sizeof(bignum));
       if(b.args == NULL)
              { nospace();
                return 1;
              }
       *((bignum *)(a.args)) = num;
       *((bignum *)(b.args)) = denom;
       goto out;
    }
  *next = make_term(f,m);
  err = 1;
  for(i=0;i<m;i++)
     { err  = err & evaluatebernoulli(ARG(i,t),arg,&temp,reason);  
       // so err2 becomes 0 as soon as one arg contains an evaluated Bernoulli number
       ARGREP(*next,i,temp);
     }
  return err;
       
  out: 
     if(n % 4 == 0 && n!=0)   // B_0 = 1, B_2 is also positive, B_4 is negative, from there on they alternate signs
        *next = tnegate(make_fraction(a,b));
     else
        *next = make_fraction(a,b);
     HIGHLIGHT(*next);
     strcpy(reason, english(2513));   /*  Evaluate Bernoulli number exactly  */
     return 0;
}

/*________________________________________________________________________*/
int  evaluateeulernumber(term t, term arg, term *next, char *reason)
/* evaluate Bernoulli numbers occurring in t */
/* Return 0 if at least one Euler number is successfully evaluated;
   otherwise, return 1,  but in that case, *next is set equal to t, so it
   can be called recursively.
*/ 
{ int err;
  long n;
  term nt,temp;
  bignum num;
  term a;
  unsigned short m = ARITY(t);
  unsigned short f = FUNCTOR(t);
  int i;
  long A;
  if(!contains(t,EULERNUMBER))
      { *next = t;
         return 1;
      }
  if(ATOMIC(t))
      { *next = t;
        return 1;
      }
  if(f == EULERNUMBER)
     { nt = ARG(0,t);
       if(! (OBJECT(nt) && TYPE(nt)==INTEGER)) // cannot be a bignum or negative
           { *next = t; 
             return 1;
           }
       n = INTDATA(nt);
       if(n %2 == 1)
           { *next = zero;
             strcpy(reason, english(2514));   //  "evaluate Euler number exactly"
             return 0;
           }
       err = exact_eulernumber(n,&num);
       if(err == 1)
           { errbuf(0,aem(66)); // "Euler number too large to evaluate easily."
             *next = t;
             return 1;
           }
       if(n <= 14)
          { bignum_long(num,&A);
            freespace(num.val);
            a = make_int(A); 
            goto out;
          }
       // past n = 14, use bignums  
       SETFUNCTOR(a,0,1);
       a.info  = 0;  // prevent a warning that it is uninitialized
       SETTYPE(a,BIGNUM);
       SETAE(a);
       a.args = callocate(1,sizeof(bignum));
       if(a.args == NULL)
              { nospace();
                return 1;
              }
       *((bignum *)(a.args)) = num;
       goto out;
    }
  *next = make_term(f,m);
  err = 1;
  for(i=0;i<m;i++)
     { err  = err & evaluatebernoulli(ARG(i,t),arg,&temp,reason);  
       // so err2 becomes 0 as soon as one arg contains an evaluated Bernoulli number
       ARGREP(*next,i,temp);
     }
  return err;
       
  out: 
     if(n % 4 == 2 && n!=0) 
        *next = tnegate(a);
     else
        *next = a;
     HIGHLIGHT(*next);
     strcpy(reason, english(2514));   /*  Evaluate Euler number exactly  */
     return 0;
}
/*________________________________________________________________________*/
int  splitofflastterm(term t, term arg, term *next, char *reason)
{ term index,lo,hi,u,v,last,himinusone;
  int err;
  if(FUNCTOR(t) != SUM)
     return 1;
  u = ARG(0,t);
  index = ARG(1,t);
  lo = ARG(2,t);
  hi = ARG(3,t);
  if(equals(hi,infinity))
     return 1;
  err = check1(lessthan(lo,hi));
  if(err)
     { errbuf(0, english(826));
          /* Lower limit must be less than upper limit */
       return 1;
     }
  polyval(sum(hi,minusone),&himinusone);
  v = sigma(u,index,lo,himinusone);
  subst(hi,index,u,&last);
  HIGHLIGHT(last);
  *next = sum(v,last);
  HIGHLIGHT(ARG(3,ARG(0,*next)));  /* the upper limit */
  strcpy(reason, english(827));   /*  split off last term */
  if(get_problemtype()==INDUCTION)
     inhibit(orderterms);   /* use the induction hypothesis first */
  return 0;
}
/*________________________________________________________________________*/
int  showfirstterms(term t, term arg, term *next, char *reason)
/* show the first few terms (how many is given by arg) of an indexed sum */
/* The number of terms is limited to 1000 */

{ long nn;
  unsigned short n;
  term l,newlo,temp,index,q,last,p,hiplusone;
  int err,i;
  if(!ISINTEGER(arg))
     return 1;
  nn =  INTDATA(arg);
  if(nn > 1000)
     { errbuf(0, english(828));
          /* You can't show more than 1000 terms */
       return 1;
     }
  n = (unsigned short) nn;
  if(FUNCTOR(t) != SUM)
     return 1;
  q = ARG(0,t);  /* summand */
  l = ARG(2,t);  /* lower limit of sum */
  index = ARG(1,t);  /* index variable */
  if(ZERO(l))
     newlo = arg;
  else
     { temp = sum(l,arg);
       polyval(temp,&newlo);
     }
  hiplusone = sum(ARG(3,t),one);   /* example, if the sum is from 2 to 6 and
                                    arg is 5, hiplusone is 7, and newlo is 7 */
  err = check1(le(newlo,hiplusone));
  if(err)
     { errbuf(0, english(830));
          /* The sum doesn't have that many terms. */
       return 1;
     }
  polyval(sum(hiplusone,tnegate(newlo)),&p); /* zero if all terms will be shown */
  *next = make_term('+',(unsigned short)(n+1));
  for(i=0;i<n;i++)
    { polyval(sum(make_int(i),l),&temp);
      subst(temp,index,q,ARGPTR(*next) + i);
      HIGHLIGHT(ARG(i,*next));
    }
  if(ZERO(p))
     SETFUNCTOR(*next,'+',n);
  else
     { copy(t,&last);
       ARGREP(last,2,newlo);
       HIGHLIGHT(ARG(2,last));
       ARGREP(*next,n,last);
     }
  strcpy(reason, english(831));  /* split off first terms */
  return 0;
}
/*________________________________________________________________________*/
int  defnoffactorial(term t, term arg, term *next, char *reason)
/* n! = n(n-1)...1 */
/* and protect the product so it has time to get cancelled or whatever */
{  long n;
   int i;
   if(FUNCTOR(t) != FACTORIAL)
      return 1;
   if(!ISINTEGER(ARG(0,t)))
      return 1;
   n = INTDATA(ARG(0,t));
   if(n > 100)
      { errbuf(0, english(832)); /* More than 100 terms.   */
        errbuf(1, english(833)); /* Too long to be useful. */
        return 1;
       }
   if(n==0)
      { *next = one;
        strcpy(reason, english(834));   /* 0! = 1 by defn */
        return 0;
      }
   if(n==1)
      { *next = one;
        strcpy(reason, english(835));   /* 1! = 1 by defn */
        return 0;
      }
   if(n==2)
      { *next = one;
        strcpy(reason,"2! = 2");
        return 0;
      }
   *next = make_term('*',(unsigned short)(n-1));
   for(i=(int)n;i>=2;i--)
      ARGREP(*next,(unsigned short)(n-i),make_int(i));
   HIGHLIGHT(*next);
   strcpy(reason, english(836));  /* defn of factorial */
   SETORDERED(*next);  /* don't re-order these factors */
   return 0;
}
/*________________________________________________________________________*/
int  binomialcoeftofactorials(term t, term arg, term *next, char *reason)
{ term n,k;  /* t is n choose k */
  if(FUNCTOR(t)!= BINOMIAL)
     return 1;
  n = ARG(0,t);
  k = ARG(1,t);
  if(!INTEGERP(n) || !ISINTEGER(k))  // both must be nonnegative and k must not be a bignum 
     return 1;  /* It won't even show on the Term Selection menu */
  *next = make_fraction(factorial1(n),
                         product(factorial1(k),factorial1(sum(n,tnegate(k))))
                       );
  HIGHLIGHT(*next);
  strcpy(reason,"$$binomial(n,k) = factorial(n)/ factorial(k) * factorial(n-k)$$");
  return 0;
}
/*________________________________________________________________________*/
int  renameindexvariable(term t, term arg, term *next, char *reason)
{ term i,k;   /* old and new indices */
  if(FUNCTOR(t) != SUM)
     return 1;
  i = ARG(1,t);  /* old index */
  k = index_variable(history(get_currentline()));
  HIGHLIGHT(k);
  subst(k,i,t,next);
  strcpy(reason, english(837));  /* rename index variable */
  return 0;
}
/*____________________________________________________________________*/
static int boundin(term x, term t)
/* return 1 if variable x occurs bound in t, 0 if not */
/* In MathXpert, you NEVER have the same variable occurring free and
bound.  */

{  unsigned short f = FUNCTOR(t);
   unsigned short n = ARITY(t);
   int i;
   if(ATOMIC(t))
      return 0;
   switch(f)
      { case INTEGRAL:  if(ARITY(t) == 4 && equals(x,ARG(1,t)))
                            return 1;
                        break;
        case BIGOH:     /* fall-through*/
        case LAM  :     /* fall-through*/
        case EXISTS:    /* fall-through*/
        case ALL:       if(equals(x,ARG(0,t)))
                           return 1;
                        break;
        case SUM:       /* fall-through */
        case EVAL:      /* fall-through */
        case PRODUCT:   if(equals(x,ARG(1,t)))
                           return 1;
                        break;
      }
   for(i=0;i<n;i++)
      { if(boundin(x,ARG(i,t)))
           return 1;
      }
   return 0;
}

/*____________________________________________________________________*/
int  freevars(term t, term **atomlist)
/* return in **atomlist an array of all variables occurring free in t
   (without duplicates), that is, atoms not including e,pi_term,complexi,infinity,
   left,right, bounded_oscillations, undefined, unbounded_oscillations,
   and not bound by SUM, PRODUCT, definite integrals, EVAL, BIGOH, or LAM.
   (Note that 'equals'  checks the type of 'i', so complexi will not
   be equal to an index variable i.).  This function
   allocates *atomlist.  The return value is the number of variables.
   (The actual dimension of the array allocated can be more.)
*/
{ term *alist;
  term x;
  int ans = atomsin(t,&alist);
  int i,k=0;
  *atomlist = callocate(ans, sizeof(term));
  for(i=0;i<ans;i++)
     { x = alist[i];
       if(!equals(x,eulere) && !equals(x,pi_term) &&
          !NOTDEFINED(x) &&
          !equals(x,left) && !equals(x,right) &&
          !boundin(x,t)
         )
          { (*atomlist)[k] = x;
            ++k;
          }
     }
  free2(alist);  /* allocated by atomsin */
  return k;
}
/*________________________________________________________________________*/
int  shiftindex(term t, term arg, term *next, char *reason)
/* arg is in response to, Add ? to both upper and lower limits of sum */
{ term k;  /* the index variable */
  term hi,lo;  /* the limits */
  term u;    /* the summand */
  term newhi, newlo, v,kk;
  if(FUNCTOR(t) != SUM)
      return 1;
  u = ARG(0,t);
  k = ARG(1,t);
  lo = ARG(2,t);
  hi = ARG(3,t);
  if(FUNCTOR(arg) == ILLEGAL)
     return 1;  /* arg should be supplied by user */
  if(contains(arg,FUNCTOR(k)))
     { errbuf(0, english(2239));
       /* expression to shift by cannot depend on the index variable */
       return 1;
     }
  if(equals(lo,minusinfinity))
     newlo = minusinfinity;
  else
     polyval(sum(lo,arg),&newlo);
  if(equals(hi,infinity))
     newhi = infinity;
  else
     polyval(sum(hi,arg),&newhi);
  polyval(sum(k,tnegate(arg)),&kk);
  HIGHLIGHT(kk);
  subst(kk,k,u,&v);
  *next = make_term(SUM,4);
  ARGREP(*next,0,v);
  ARGREP(*next,1,k);
  HIGHLIGHT(newlo);
  HIGHLIGHT(newhi);
  ARGREP(*next,2,newlo);
  ARGREP(*next,3,newhi);
  strcpy(reason, english(2165));  /* shift sum limits */
  return 0;
}
/*____________________________________________________________________*/
int  sigmaconstant(term t, term arg, term *next, char *reason)
/* \sum 1 = number of terms */
{ term u,kk,nterms,hi,lo;
  if(FUNCTOR(t) != SUM)
     return 1;
  kk = ARG(1,t);  /* the index variable */
  u = ARG(0,t);
  if(contains(u,FUNCTOR(kk)))
     return 1;
  lo = ARG(2,t);
  hi = ARG(3,t);
  nterms = sum(sum(hi,tnegate(lo)),one);
  polyval(product(nterms,u),next);
  strcpy(reason, english(1382));  /*  \sum 1 = number of terms */
  HIGHLIGHT(*next);
  return 0;
}

/*____________________________________________________________________*/
int  telescopingsum(term t, term arg, term *next, char *reason)
/* collapse a telescoping sum */
/* There is a similar operation for infinite series, but this
one works only on finite sums.
*/
{ int i;
  term u,kk,hi,lo,a,b,temp,q,v,w;
  if(FUNCTOR(t) != SUM)
     return 1;
  kk = ARG(1,t);  /* the index variable */
  u = ARG(0,t);
  if(FUNCTOR(u) != '+' || ARITY(u) != 2)
     return 1;
  lo = ARG(2,t);
  hi = ARG(3,t);
  if(ISINFINITE(lo) || ISINFINITE(hi))
     return 1;
  for(i=0;i<2;i++)
    { a = ARG(i,u);
      b = ARG(i ? 0 : 1,u);
      subst(sum(kk,one),kk,b,&temp);
      polyval(sum(temp,a),&q);
      if(ZERO(q))
         { /*  a[k] + b[k+1] == 0  */
           subst(hi,kk,a,&w);
           subst(lo,kk,b,&v);
           *next = sum(w,v);
           HIGHLIGHT(*next);
           strcpy(reason,english(1383));  /* telescoping sum */
           return 0;
         }
    }
  return 1;
}

/*____________________________________________________________________*/
int  sigmapoly(term t, term arg, term *next, char *reason)
/* write the argument of a sum as a polynomial in the
index variable */
{ int err;
  term u,kk,lo,hi;
  unsigned short path[5];
  unsigned short f;
  POLYnomial p;
  if(FUNCTOR(t) != SUM)
     return 1;
  kk = ARG(1,t);  /* the index variable */
  u = ARG(0,t);
  f = FUNCTOR(u);
  if(f == '^' && !INTEGERP(ARG(1,u)))
     return 1;
  if (f == '/' && contains(ARG(1,t),FUNCTOR(kk)))
     return 1;
  if(f != '+' && f != '-' && f != '*' && f != '/' && f != '^')
     return 1;
  lo = ARG(2,t);
  hi = ARG(3,t);
  err = polyform(u,kk,&p);
  if(err)
     return 1;
  u = poly_term(p,kk);
  HIGHLIGHT(u);
  *next = sigma(u,kk,lo,hi);
  strcpy(reason, english(678));  /* express as polynomial */
  path[0] = SUM;
  path[1] = 1;
  path[2] = 0;
  set_pathtail(path);
  SetShowStepOperation(univariatepoly);
  return 0;
}
/*____________________________________________________________*/
int  difsigma(term t, term arg, term *next, char *reason)
/* differentiate a sum term-by-term */
{ term s,u,x,k,lo,hi,m, du;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  s = ARG(0,t);  /* the sum */
  if(FUNCTOR(s) != SUM)
     return 1;
  u = ARG(0,s);   /* summand */
  k = ARG(1,s);   /* index variable */
  lo = ARG(2,s);
  hi = ARG(2,s);
  if(ARITY(t) == 3)
     { m = ARG(2,t);  /* m-th derivative */
       du = diff3(u,x,m);
     }
  else
     du = diff(u,x);
  *next = make_term(SUM,4);
  ARGREP(*next,0,du);
  ARGREP(*next,1,k);
  ARGREP(*next,2,lo);
  ARGREP(*next,3,hi);
  HIGHLIGHT(*next);
  strcpy(reason,"$d/dx \\sum u = \\sum du/dx$");
  return 0;
}
/*____________________________________________________________*/
int  intsigma(term t, term arg, term *next, char *reason)
/* integrate a sum term-by-term */
{ term s,u,x,k,lo,hi,a,b,intu;
  if(FUNCTOR(t) != INTEGRAL)
     return 1;
  x = ARG(1,t);
  s = ARG(0,t);  /* the sum */
  if(FUNCTOR(s) != SUM)
     return 1;
  u = ARG(0,s);   /* summand */
  k = ARG(1,s);   /* index variable */
  lo = ARG(2,s);
  hi = ARG(3,s);
  if(ARITY(t) == 4)  /* definite integral */
     { a = ARG(2,t);
       b = ARG(3,t);
       intu = definite_integral(u,x,a,b);
     }
  else
     intu = integral(u,x);
  *next = make_term(SUM,4);
  ARGREP(*next,0,intu);
  ARGREP(*next,1,k);
  ARGREP(*next,2,lo);
  ARGREP(*next,3,hi);
  HIGHLIGHT(*next);
  strcpy(reason,"$\\int \\sum u dx = \\sum \\int u dx$");
  return 0;
}

/*____________________________________________________________*/
int  reversedifsigma(term t, term arg, term *next, char *reason)
/* pull d/dx out of a sum */
{ term u,x,k,lo,hi,m;
  if(FUNCTOR(t) != SUM)
     return 1;
  k = ARG(1,t);   /* index variable */
  lo = ARG(2,t);
  hi = ARG(2,t);
  if(FUNCTOR(ARG(0,t)) != DIFF)
     return 1;
  u = ARG(0,ARG(0,t));
  x = ARG(1,ARG(0,t));
  if(ARITY(ARG(0,t)) == 3)
      { m = ARG(2,ARG(0,t));  /* m-th derivative */
        *next = diff3(indexedsum(u,k,lo,hi),x,m);
      }
  else
     *next = diff(indexedsum(u,k,lo,hi),x);
  HIGHLIGHT(*next);
  strcpy(reason,"$\\sum  du/dx = d/dx \\sum u$");
  return 0;
}

/*____________________________________________________________*/
int  reverseintsigma(term t, term arg, term *next, char *reason)
/* pull integral out of a sum */

{ term u,x,k,lo,hi,a,b;
  if(FUNCTOR(t) != SUM)
     return 1;
  k = ARG(1,t);   /* index variable */
  lo = ARG(2,t);
  hi = ARG(2,t);
  if(FUNCTOR(ARG(0,t)) != INTEGRAL)
     return 1;
  u = ARG(0,ARG(0,t));
  x = ARG(1,ARG(0,t));
  if(ARITY(ARG(0,t)) == 4)
      { /* definite integral */
        a = ARG(2,ARG(0,t));
        b = ARG(3,ARG(0,t));
        *next = definite_integral(indexedsum(u,k,lo,hi),x,a,b);
      }
  else
     *next = integral(indexedsum(u,k,lo,hi),x);
  HIGHLIGHT(*next);
  strcpy(reason,"$\\sum \\int u dx = \\int \\sum u dx$");
  return 0;
}

/*____________________________________________________________*/
int  factorialrecursion(term t, term arg, term *next, char *reason)
/* n! = n (n-1)!  */
{ term u,v;
  unsigned short path[10];
  if(FRACTION(t))
     { // we want it to be used in a fraction such as (n+1)! / n! 
       term num, denom, N,M,temp, newnum, newdenom;
       unsigned short n,m;
       int i,j,k;
       num = ARG(0,t);
       denom = ARG(1,t);
       // look for a factorial in the numerator 
       if(FUNCTOR(num) == FACTORIAL && FUNCTOR(denom) == FACTORIAL)
           { N = ARG(0,num);
             M = ARG(0,denom);
             polyval(sum(N,tnegate(M)),&temp);
             if(!ONE(temp) && !equals(temp,minusone))
                return 1;
           }
       else if (FUNCTOR(num) == '*' && FUNCTOR(denom) == '*')
          { n = ARITY(num);
            for(i=0;i<n;i++)
               { if(FUNCTOR(ARG(i,num)) == FACTORIAL)
                     { N =ARG(0,ARG(i,num));
                       //   now look for a matching factorial in the denom
                       m = ARITY(denom);
                       for(j=0;j<m;j++)
                          { if(FUNCTOR(ARG(j,denom)) == FACTORIAL)
                               { M = ARG(0,ARG(j,denom));
                                polyval(sum(N,tnegate(M)),&temp);
                                if(ONE(temp) || equals(temp,minusone))
                                     break;
                               }
                          }
                       if(j<m)
                          break;
                      }
                }
             if(i==n)
                return 1;   
           }
        else if(FUNCTOR(num) == '*' && FUNCTOR(denom) == FACTORIAL)
           { M = ARG(0,denom);
             n = ARITY(num);
             for(i=0;i<n;i++)
                 { if(FUNCTOR(ARG(i,num)) == FACTORIAL) 
                      { N = ARG(0,ARG(i,num));
                        polyval(sum(N,tnegate(M)),&temp);
                        if(ONE(temp) || equals(temp,minusone))
                            break;
                       }
                 }
             if(i==n)
                return 1;
           }
        else if(FUNCTOR(denom) == '*' && FUNCTOR(num) == FACTORIAL)
           { N = ARG(0,num);
             m = ARITY(denom);
             for(j=0;j<m;j++)
                { if(FUNCTOR(ARG(j,denom)) == FACTORIAL)
                     { M = ARG(0,ARG(j,denom));
                       polyval(sum(N,tnegate(M)),&temp);
                       if(ONE(temp) || equals(temp,minusone))
                           break;
                     }
                }
             if(j==m)
                return 1;
           }
        else
          return 1;
        if(ONE(temp))
           { // apply the operation in num
             if(FUNCTOR(num) == FACTORIAL)
                { newnum = product(N, factorial1(M));
                  HIGHLIGHT(newnum);
                  *next = make_fraction(newnum,denom);
                  path[0] = '/';
                  path[1] = 1;
                  path[2] = 0;
                  set_pathtail(path);
                  goto out;
                }
             else
                { newnum = make_term('*', n+1);
                  for(k=0;k<i;k++)
                     ARGREP(newnum,k,ARG(k,num));
                  ARGREP(newnum,i,N);
                  ARGREP(newnum,i+1,factorial1(M));
                  for(k=i+2;k<n+1;k++)
                     ARGREP(newnum,k,ARG(k-1,num));
                  HIGHLIGHT(ARG(i,newnum));
                  HIGHLIGHT(ARG(i+1,newnum));
                  *next = make_fraction(newnum,denom);
                  path[0] = '/';
                  path[1] = 1;
                  path[2] = '*';
                  path[3] = i+1;
                  path[4] = 0;
                  set_pathtail(path);
                  goto out;
                 }
             }
           if(equals(temp,minusone))
             { // apply the operation in denom
               if(FUNCTOR(denom) == FACTORIAL)
                  { newdenom = product(M, factorial1(N));
                    HIGHLIGHT(newdenom);
                    *next = make_fraction(num, newdenom);
                    path[0] = '/';
                    path[1] = 2;
                    path[2] = 0;
                    set_pathtail(path);
                    goto out;
                  }
               else
                  { newdenom = make_term('*',m+1);
                    for(k=0;k<j;k++)
                       ARGREP(newdenom,k,ARG(k,denom));
                    ARGREP(newdenom,j,M);
                    ARGREP(newdenom,j+1,factorial1(N));
                    HIGHLIGHT(ARG(j,newdenom));
                    HIGHLIGHT(ARG(j+1,newdenom));
                    for(k=j+2;k<m+1;k++)
                        ARGREP(newdenom,k,ARG(k-1,denom));
                    *next = make_fraction(num, newdenom);
                     path[0] = '/';
                     path[1] = 2;
                     path[2] = '*';
                     path[3] = j+1;
                     path[4] = 0; 
                     set_pathtail(path);
                     goto out;
                   }
              }
    }                       
  if(FUNCTOR(t) != FACTORIAL)
     return 1;
  u = ARG(0,t);
  if(ZERO(u))
     return 1;
  polyval(sum(u,minusone),&v);
  *next = product(u,factorial1(v));
  HIGHLIGHT(*next);
  out:
    strcpy(reason,"n! = n (n-1)!");
    return 0;
}

/*____________________________________________________________*/
int  cancelfactorial1(term t, term arg, term *next, char *reason)
/* n!/n = (n-1)! */
/* also works on a quotient containing n! as a factor in the numerator and
n as a factor in the denominator.
*/
{ term num,denom,u,n,w,v,cancelled,newnum;
  unsigned short m,i,j;
  int err;
  if(!FRACTION(t))
     return 1;
  num = ARG(0,t);
  denom = ARG(1,t);
  if(FUNCTOR(num) == FACTORIAL)
     { n = ARG(0,num);
       if(equals(denom,n))
          { polyval(sum(n,minusone),&u);
            *next = factorial1(u);
            HIGHLIGHT(*next);
            strcpy(reason, "n!/n = (n-1)!");
            return 0;
          }
       if(FUNCTOR(denom) != '*')
          return 1;
       err = cancel(denom,n,&cancelled,&u);
       if(err)
          return 1;
       if(!equals(cancelled,n))
          return 1;
       polyval(sum(n,minusone),&v);
       *next = make_fraction(factorial1(v),u);
       HIGHLIGHT(ARG(0,*next));
       strcpy(reason, "n!/n = (n-1)!");
       return 0;
     }
  if(FUNCTOR(num) != '*')
     return 1;
  m = ARITY(num);
  for(i=0;i<m;i++)
     { w = ARG(i,num);
       if(FUNCTOR(w) == FACTORIAL)
          { n = ARG(0,w);
            err = cancel(denom,n,&cancelled,&u);
            if(!err && equals(cancelled,n))
               break;
          }
     }
  if(i==m)
     return 1;
  polyval(sum(n,minusone),&v);
  newnum = make_term('*',m);
  for(j=0;j<m;j++)
     ARGREP(newnum,j, j==i ? factorial1(v) : ARG(j,num));
  HIGHLIGHT(ARG(i,newnum));
  *next = ONE(u) ? newnum : make_fraction(newnum,u);
  strcpy(reason,"n!/n = (n-1)!");
  return 0;
}

/*____________________________________________________________*/
int  cancelfactorial2(term t, term arg, term *next, char *reason)
/* n!/(n-1)! = n  */
{ term num,denom,u,v,w,newnum,newdenom,q;
  unsigned short i,j,m,i2,j2,n;
  if(!FRACTION(t))
     return 1;
  num = ARG(0,t);
  denom = ARG(1,t);
  if(FUNCTOR(num) == FACTORIAL && FUNCTOR(denom) == FACTORIAL)
     { polyval(sum(ARG(0,denom),one),&u);
       if(equals(u,ARG(0,num)))
          { *next = ARG(0,num);
            HIGHLIGHT(*next);
            strcpy(reason,"n!/(n-1)! = n");
            return 0;
          }
       return 1;
     }
  if(FUNCTOR(num) == FACTORIAL)
     { if(FUNCTOR(denom) != '*')
          return 1;
       m = ARITY(denom);
       for(i=0;i<m;i++)
          { w = ARG(i,denom);
            if(FUNCTOR(w) == FACTORIAL)
               { polyval(sum(ARG(0,w),one),&u);
                 if(equals(u,ARG(0,num)))
                    { newnum = ARG(0,num);
                      if(m == 2)
                         newdenom = ARG(i ? 0 : 1, denom);
                      else
                         { newdenom = make_term('*',(unsigned short)(m-1));
                           for(j=0;j<m-1;j++)
                              ARGREP(newdenom,j, ARG(j<i ? j : j+1,denom));
                         }
                      HIGHLIGHT(newnum);
                      *next = make_fraction(newnum,newdenom);
                      strcpy(reason,"n!/(n-1)! = n");
                      return 0;
                    }
               }
          }
       return 1;
     }
  if(FUNCTOR(num) != '*')
     return 1;
  if(FUNCTOR(denom) != '*')
     return 1;
  /* Now we must find the proper factors in num and denom */
  n = ARITY(num);
  m = ARITY(denom);
  for(i=0;i<n;i++)
     { u = ARG(i,num);
       if(FUNCTOR(u) != FACTORIAL)
          continue;
       for(j=0;j<m;j++)
          { v = ARG(j,denom);
            if(FUNCTOR(v) != FACTORIAL)
               continue;
            polyval(sum(ARG(0,v),one),&w);
            if(equals(w,ARG(0,u)))
               { /* that's it! */
                 /* replace ARG(i,num) by ARG(0,u) and
                    drop the j-th factor in the denom */
                 q = ARG(0,u);
                 HIGHLIGHT(q);
                 newnum = make_term('*',n);
                 for(i2 = 0;i2<n;i2++)
                    ARGREP(newnum,i2, i2==i ? q : ARG(i2,num));
                 if(m==2)
                    newdenom = ARG(j ? 0 : 1, denom);
                 else
                    { newdenom = make_term('*',m);
                      for(j2=0;j2<m;j2++)
                         ARGREP(newdenom,j2,ARG(j2<j ? j2 : j2+1,denom));
                    }
                 *next = make_fraction(newnum,newdenom);
                 strcpy(reason,"n!/(n-1)! = n");
                 return 0;
               }
          }
     }
  return 1;
}
/*____________________________________________________________*/
int  cancelfactorial3(term t, term arg, term *next, char *reason)
/* n!/k!=n(n-1)...(n-k+1) */
/* n-k must be a numerical integer */
{ term num,denom,n,k,u,v,w,newdenom,newnum;
  unsigned short m,i,j,K,i2,j2;
  int err;
  long p;
  if(!FRACTION(t))
     return 1;
  num = ARG(0,t);
  denom = ARG(1,t);
  if(FUNCTOR(num) == FACTORIAL && FUNCTOR(denom) == FACTORIAL)
     { n = ARG(0,num);
       k = ARG(0,denom);
       if(equals(n,k))
          return 1;
       polyval(sum(n,tnegate(k)),&u);
       if(!ISINTEGER(u))
          return 1;
       if(INTDATA(u) > 1000)
          return 1;
       m = (unsigned short) INTDATA(u);
       if(m==1)
          { *next = n;
            HIGHLIGHT(*next);
            strcpy(reason,"n!/k! = n(n-1)...(n-k+1)");
            return 0;
          }
       *next = make_term('*',m);
       if(ISINTEGER(n))
          { p = INTDATA(n);
            for(i=0;i<m;i++)
               ARGREP(*next,i,make_int((unsigned long)(p-i)));
          }
       else
          { for(i=0;i<m;i++)
               polyval(sum(n,tnegate(make_int(i))),ARGPTR(*next)+i);
          }
       HIGHLIGHT(*next);
       strcpy(reason,"n!/k!=n(n-1)...(n-k+1)");
       return 0;
     }
  if(FUNCTOR(num) == '*' && FUNCTOR(denom) == FACTORIAL)
     { m = ARITY(num);
       for(i=0;i<m;i++)
          { u = ARG(i,num);
            if(FUNCTOR(u) == FACTORIAL)
                { err = cancelfactorial3(make_fraction(u,denom),arg,&v,reason);
                  if(!err)
                     { /* replace u by v in num and make that *next */
                       w = make_term('*',m);
                       for(j=0;j<m;j++)
                          ARGREP(w,j,j==i ? v : ARG(j,num));
                       if(FUNCTOR(v) == '*')
                          *next = topflatten(w);
                       else
                          *next = w;
                       return 0;
                     }
                }
          }
       return 1;
     }
  if(FUNCTOR(denom) == '*' && FUNCTOR(num) == FACTORIAL)
     { m = ARITY(denom);
       for(i=0;i<m;i++)
          { u = ARG(i,denom);
            if(FUNCTOR(u) == FACTORIAL)
               { err = cancelfactorial3(make_fraction(num,u),arg,&v,reason);
                 if(!err)
                    { /* replace num by v and drop the i-th factor in denom */
                      if(m == 2)
                         newdenom = ARG(i ? 0 : 1, denom);
                      else
                         { newdenom = make_term('*',(unsigned short)(m-1));
                           for(j=0;j<m-1;j++)
                              ARGREP(newdenom, j, ARG(j<i ? j : j+1,denom));
                         }
                      *next = make_fraction(v,newdenom);
                      return 0;
                    }
               }
          }
       return 1;
     }
  if(FUNCTOR(num) != '*')
     return 1;
  if(FUNCTOR(denom) != '*')
     return 1;
  m = ARITY(num);
  K = ARITY(denom);
  for(i=0;i<m;i++)
     { u = ARG(i,num);
       if(FUNCTOR(u) != FACTORIAL)
          continue;
       for(j=0;j<K;j++)
          { v = ARG(j,denom);
            if(FUNCTOR(v) != FACTORIAL)
               continue;
            err = cancelfactorial3(make_fraction(u,v),arg,&w,reason);
            if(!err)
               { /* replace u by w and drop v */
                 newnum = make_term('*',m);
                 for(i2 = 0; i2 < m; i2++)
                    ARGREP(newnum,i2,i2==i ? w : ARG(i2,num));
                 if(FUNCTOR(w) == '*')
                    newnum = topflatten(newnum);
                 if(K==2)
                    newdenom = ARG(j ? 0 : 1,denom);
                 else
                    { newdenom = make_term('*',(unsigned short)(K-1));
                      for(j2=0;j2<K;j2++)
                         ARGREP(newdenom,j2, ARG(j2<j ? j2 : j2+1,denom));
                    }
                 *next = make_fraction(newnum,newdenom);
                 return 0;
               }
          }
     }
  return 1;
}
/*____________________________________________________________*/
int  cancelfactorial1b(term t, term arg, term *next, char *reason)
/* n/n! = 1/(n-1)! */
/* also works on a quotient containing n as a factor in the numerator and
n! as a factor in the denominator */
{ term u;
  int err;
  if(!FRACTION(t))
     return 1;
  err = cancelfactorial1(reciprocal(t),arg,&u,reason);
  if(err)
     return 1;
  *next = reciprocal(u);
  HIGHLIGHT(*next);
  strcpy(reason,"n/n! = 1/(n-1)!");
  return 0;
}
/*____________________________________________________________*/
int  cancelfactorial2b(term t, term arg, term *next, char *reason)
/* (n-1)!/n! = 1/n  */
{ term u;
  int err;
  if(!FRACTION(t))
     return 1;
  err = cancelfactorial2(reciprocal(t),arg,&u,reason);
  if(err)
     return 1;
  *next = reciprocal(u);
  HIGHLIGHT(*next);
  strcpy(reason,"(n-1)!/n! = 1/n");
  return 0;
}
/*____________________________________________________________*/
int  cancelfactorial3b(term t, term arg, term *next, char *reason)
/* k!/n!=1/(n...(n-k+1)) */
/* n-k must be a numerical integer */
{ term u;
  int err;
  if(!FRACTION(t))
     return 1;
  err = cancelfactorial3(reciprocal(t),arg,&u,reason);
  if(err)
     return 1;
  *next = reciprocal(u);
  HIGHLIGHT(*next);
  strcpy(reason,"k!/n!=1/(n...(n-k+1))");
  return 0;
}

/*__________________________________________________________*/
int sumtodifofsums0(term t, term arg, term *next, char *reason)
/* sum(t,i,first,last) = sum(t,i,0,last)-sum(t,i,0,first)  */
{ int err = sumtodifofsums(t,zero,next,reason);
  if(!err)
	  strcpy(reason,  "$$\\sum(t,i,a,b)=\\sum(t,i,0,b)-\\sum(t,i,0,a-1)$$");
  return err;
}

/*__________________________________________________________*/
int sumtodifofsums(term t, term arg, term *next, char *reason)
/* sum(t,i,first,last) = sum(t,i,arg,last)-sum(t,i,arg,first-1)  */
{ term first,w,v,p,q;
  if(FUNCTOR(t) != SUM) 
     return 1;
  first = ARG(2,t);
  v = sum(first,tnegate(one));
  if(numerical(v))
	  value(v,&w);
  else
	  w = v;
  p = indexedsum(ARG(0,t),ARG(1,t),arg,ARG(3,t));
  q = indexedsum(ARG(0,t),ARG(1,t),arg,w);
  *next = sum(p,tnegate(q));
  strcpy(reason, "$$\\sum(t,i,a,b)=\\sum(t,i,c,b)-\\sum(t,i,c,a-1)$$");
  return 0;
}

Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists