Sindbad~EG File Manager

Current Path : /usr/home/beeson/Otter-Lambda/yyy/trigcalc/
Upload File :
Current File : /usr/home/beeson/Otter-Lambda/yyy/trigcalc/trigsub.c

/* integration by trig substitution */
/*
M. Beeson, for MathXpert
Original date 2.2.92
modified 3.29.99
10.5.00  modified finish_trigsub at lines 328-332 (after the switch)
*/

#include <string.h>
#include <assert.h>
#define TRIGCALC_DLL
#include "globals.h"
#include "ops.h"
#include "calc.h"
#include "checkarg.h"  /* for operator typedef */
#include "operator.h"  /* for menu names */
#include "probtype.h"
#include "prover.h"
#include "match.h"
#include "eqn.h"
#include "algaux.h"
#include "factor.h"
#include "autosub.h"
#include "getprob.h"
#include "mstring.h"
#include "symbols.h"
#include "inveqn.h"  /* invert_eqn2 */
#include "pvalaux.h" /* isinteger */
#include "psubst.h"
#include "errbuf.h"
#include "dispfunc.h"
#include "mpmem.h"

static void adjust_varinfo(void);
static term getsubvar(term);
static int findsqrt(term t,term x,term *p,term *q,term *r);  /*  find p = �(q + rx^2) in t */
static int findpower(term t,term x,term *p,term *q,term *r);
static int finish_trigsub(term t, term p,term arg, term def, term theta, term *next, char *reason);
static int check_trigsub(term t, term x, term rhs, term theta, term *def);
/*_______________________________________________________________*/
static int trigsub_aux(unsigned short f, int signpattern, term t, term arg, term *next, char *reason)
/* does the job of the operators below;
f is the functor of the substitution to be made.
signpattern is 1 for  �(a^2-c^2x^2);
               2 for  �(a^2+c^2x^2)
               3 for  �(c^2x^2-a^2)
*/
{ term theta,x,u,a,c,p,q,r,new,def,range;
  unsigned short g;
  int err;
  int nvariables;
  if(FUNCTOR(t) != INTEGRAL)
     return 1;
  nvariables = get_nvariables();
  u = ARG(0,t);
  x = ARG(1,t);
  theta = getsubvar(t);
  if(FUNCTOR(theta) == ILLEGAL)
     { errbuf(0, english(1448));
       /* Too many subscripted variables, can't make more. */
       return 1;
     }
  /* Now select a and c */
  err = findsqrt(u,x,&p,&q,&r);  /*  find p = �(q + rx^2) in u */
  if(err)
     { err = findpower(u,x,&p,&q,&r);
       if(err)
          goto fail;
     }
  if(signpattern == 1)
     { if(FUNCTOR(r) != '-')
          goto fail;
       err = sqrt_aux(ARG(0,r),&c);
       if(err)
          goto fail;
     }
  else if(NEGATIVE(r))
     goto fail;
  else
     { err = sqrt_aux(r,&c);
       if(err)
          goto fail;
     }
  if(signpattern == 3)
     { if(FUNCTOR(q) != '-')
          goto fail;
       err = sqrt_aux(ARG(0,q),&a);
       if(err)
          goto fail;
     }
  else if(NEGATIVE(q))
     goto fail;
  else
     { err = sqrt_aux(q,&a);
       if(err)
          goto fail;
     }
  new = make_term(f,1);
  ARGREP(new,0,theta);
  arg = equation(x,product(signedfraction(a,c), new));
  switch(f)
     { /* get the inverse functor */
       case SIN :
          g = ASIN;
          range = le(zero,cos1(theta));
          break;
       case TAN:
          g = ATAN;
          range = le(zero,cos1(theta));
          break;
       case SEC:
          g = ASEC;
          range = le(zero,sin1(theta));
          break;
       case COS:
          g = ACOS;
          range = le(zero,sin1(theta));
          break;
       case COT:
          g = ACOT;
          range = le(zero,cos1(theta));
          break;
       case CSC:
          g = ACSC;
          range = le(zero,cos1(theta));
          break;
       case SINH:
          g = ASINH;
          range = true;
          break;
       case COSH:
          g = ACOSH;
          range = le(one,theta);
          break;
       case TANH:
          g = ATANH;
          range = and(lessthan(minusone,theta),lessthan(theta,one));
          break;
       case SECH:
          g = ASECH;
          range = and(lessthan(zero,theta),le(theta,one));
          break;
       case COTH:
          g = ACOTH;
          range = or(lessthan(theta,minusone),lessthan(one,theta));
          break;
       case CSCH:
          g = ACSCH;
          range = ne(theta,zero);
          break;
       default:
          assert(0);
     }
  def = make_term(g,1);
  ARGREP(def,0,product(signedfraction(c,a),x));
  err = finish_trigsub(t,p,arg,def,theta,next,reason);
  if(err)
     goto fail;
  if(ARITY(t) == 2)
     { /* indefinite integral */
       PROTECT(range);
       assume(range);
     }
  adjust_varinfo();
  return 0;
  fail:
  set_nvariables(nvariables);
  /* nvariables is the number BEFORE theta was introduced; this
     gets rid of theta.   */
  return 1;
}

/*_______________________________________________________________*/
MEXPORT_TRIGCALC int trigsubsin(term t, term arg, term *next, char *reason)
/*  x = (a/c) sin �  used for �(a^2-c^2x^2)  */
{ return trigsub_aux(SIN,1,t,arg,next,reason);
}
/*_______________________________________________________________*/
MEXPORT_TRIGCALC int trigsubtanh(term t, term arg, term *next, char *reason)
/*
  x = (a/c) sin �  used for �(a^2-c^2x^2)  */
{ return trigsub_aux(TANH,1,t,arg,next,reason);
}

/*_______________________________________________________________*/
MEXPORT_TRIGCALC int trigsubtan(term t, term arg, term *next, char *reason)
/*  x = a tan �  used for �(a^2+x^2)  */
{ return trigsub_aux(TAN,2,t,arg,next,reason);
}

/*_______________________________________________________________*/
MEXPORT_TRIGCALC int trigsubsec(term t, term arg, term *next, char *reason)
/*  x = a sec �  used for �(x^2-a^2)  */
{ return trigsub_aux(SEC,3,t,arg,next,reason);
}
/*_______________________________________________________________*/
MEXPORT_TRIGCALC int trigsubsinh(term t, term arg, term *next, char *reason)
/*  x = a sinh �  used for �(a^2+x^2)  */
{ return trigsub_aux(SINH,2,t,arg,next,reason);
}
/*_______________________________________________________________*/
MEXPORT_TRIGCALC int trigsubcosh(term t, term arg, term *next, char *reason)
/*  x = a cosh �  used for �(x^2-a^2)  */
{ return trigsub_aux(COSH,3,t,arg,next,reason);
}
/*_______________________________________________________________*/
MEXPORT_TRIGCALC int yourtrigsub(term t, term arg, term *next, char *reason)
/* define your own trigsub  */
/* arg has the form x = f(�) */
/* t is an INTEGRAL to be done by inverse substitution given by arg */
/* checkarg has ensured that arg does have x on the left and
does not have x on the right, but has NOT checked that a new
variable has been introduced */

/* For definite integrals the substitution has to be one-one
and the limits have to be computed. */

{ term x,rhs,theta,def;
  term *atomlist;
  int natoms,i,j,count=0,saveit,err;
  int nvariables;
  term *varlist;
  if(FUNCTOR(t) != INTEGRAL)
     return 1;
  nvariables = get_nvariables();
  varlist = get_varlist();
  x = ARG(1,t);
  assert(FUNCTOR(arg) == '=');
  assert(equals(ARG(0,arg),x));
  rhs = ARG(1,arg);
  /* Now we need to identify the new variable in rhs */
  natoms = atomsin(rhs,&atomlist);
  for(i=0;i<natoms;i++)
    { for(j=0;j<nvariables;j++)
         { if(equals(varlist[j],atomlist[i]))
              break;  /* atomlist[i] is old */
         }
      if(j==nvariables)  /* atomlist[i] is new */
         { ++count;
           saveit = i;
         }
    }
  if(count == 0)
    { errbuf(0, english(690));
         /* Your substitution did not mention a new variable. */
      return 1;
    }
  if(count > 1)
    { errbuf(0, english(691));
        /* Only one new variable can be introduced. */
      return 1;
    }
  theta = atomlist[saveit];
  free2(atomlist);
  err = check_trigsub(t,x,rhs,theta,&def);
  if(err)
     return 1;   /* check_trigsub puts a message in error_buffer */
  err = finish_trigsub(t,zero,equation(x,rhs),def,theta,next,reason);
  if(err)
     goto fail;
  adjust_varinfo();
  return 0;
  fail:
  set_nvariables(nvariables);
  /* nvariables is the number BEFORE theta was introduced; this
     gets rid of theta.   */
  return 1;
}
/*___________________________________________________________________*/
static int finish_trigsub(term t, term p, term arg, term def, term theta, term *next, char *reason)
/* t is an integral of u dx; make the substitution arg, which is x = rhs.
New variable in arg is theta, which should
have already been added to the varlist, and is not removed by this function.
def is the solution theta=def of the equation x = rhs.
Return zero if the substitution eliminates x (the old variable of
integration), 1 if not
If called by intsubsin, etc. as opposed to yourtrigsub, then p is the
square root or power of (r + qx^2) for which we are substituting.
If called by yourtrigsub, p is zero.
Make the let_defn  theta = def.
*/
{ term u,v,w,x,rhs,q,temp,leftcopy,rightcopy;
  int r;
  int mathmode = get_mathmode();
  unsigned short f;
  char localbuf[81];
  u = ARG(0,t);
  x = ARG(1,t);
  assert(FUNCTOR(arg) == '=');
  assert(equals(ARG(0,arg),x));
  rhs = ARG(1,arg);
  if(FUNCTOR(rhs) == '*')
     f = FUNCTOR(ARG(1,rhs));
  else
     f = FUNCTOR(rhs);
  switch(f)
     { case SIN:
          q = cos1(theta);
          break;
       case COS:
          q = sin1(theta);
          break;
       case TAN:
          q = sec1(theta);
          break;
       case SEC:
          q = tan1(theta);
          break;
       case SINH:
          q = cosh1(theta);
          break;
       case COSH:
          q = sinh1(theta);
          break;
       case TANH:
          q = sech1(theta);
          break;
       default:
          q = zero;
     }
  if(FUNCTOR(rhs) == '*' && !ZERO(q))
     { if(FRACTION(ARG(0,rhs)))
          q = product(ARG(0,ARG(0,rhs)),q);
       else
          q = product(ARG(0,rhs),q);
     }
  if(
     (FUNCTOR(p)==SQRT  || (FUNCTOR(p) == '^' && ONEHALF(ARG(1,p))))
     &&
     !ZERO(q)
    )
     { r = psubst(q,p,u,&temp);
       if(r==0 || (r==1 && mathmode==AUTOMODE))
          temp = u;
     }
  else if(FUNCTOR(p) == '^' && !ZERO(q))
     { r = psubst(make_power(q,two),ARG(0,p),u,&temp);
       if(r==0 || (r==1 && mathmode==AUTOMODE))
          temp = u;
     }
  else
     temp = u;
  r = psubst(rhs,x,temp,&v);
  if(r==0 || (mathmode == AUTOMODE && r==1) || contains(v,FUNCTOR(x)))  /* it didn't work */
     { char buffer[128];
       strcpy(buffer, english(692));
          /* That substitution won't eliminate  */
       strcat(buffer,atom_string(x));
       strcat(buffer,".");
       errbuf(0,buffer);
       return 1;
     }
  permcopy(theta,&leftcopy);
  permcopy(def,&rightcopy);
  let(leftcopy,rightcopy);   /* enter this in the defns array */
  SETDEPENDENT(theta);
  w = product(v,diff(rhs,theta));
  if(ARITY(t)==2)  /* indefinite integral */
     *next = integral(w,theta);
  else
     { term newlo,newhi,hi,lo;
       lo = ARG(2,t);
       hi = ARG(3,t);
       subst(lo,x,def,&newlo);
       polyval(newlo,&lo);
       subst(hi,x,def,&newhi);
       polyval(newhi,&hi);
       *next = definite_integral(w,theta,lo,hi);
     }
  mstring(arg,localbuf);
  if(strlen(localbuf) < MAXREASONSTRING)
     strcpy(reason, localbuf);
  else
     strcpy(reason, english(677));  /*  substitution */
  HIGHLIGHT(*next);
  return 0;
}
/*___________________________________________________________________*/
static term getsubvar(term t)
/* get a new atom, preferably �, not occurring in the current varlist */
{ unsigned short tryme[4] = {THETA,PHI,SIGMA,MU};
  int i,j;
  varinf *varinfo;
  term theta;
  term *varlist= get_varlist();
  int nvariables = get_nvariables();
  for(i=0;i<4;i++)
     { for(j=0;j<nvariables;j++)
          { if(FUNCTOR(varlist[j]) == tryme[i])
               break;
          }
       if(j==nvariables)
          { /* tryme[i] was not in the varlist */
            theta = MAKE_ATOM(tryme[i]);
            vaux(theta);
            set_valuepointers(&theta);
            nvariables = get_nvariables();
            varinfo = get_varinfo();
            varinfo[nvariables-1].scope = varinfo[get_eigenindex()].scope;
            return theta;
          }
     }
  return getnewvar(t,"txsuv");   /* adds it to varlist */
}
/*___________________________________________________________________*/
static void adjust_varinfo(void)
/* Once you know a substitution is going to work, do this. */

{ int eigen = get_eigenindex();
  int nvariables = get_nvariables();
  varinf *varinfo = get_varinfo();
  varinfo[eigen].dp |= (1 << (nvariables-1));  /* x depends on theta */
  varinfo[nvariables-1].dp |= (1 << eigen);  /*  theta depends on x */
  set_eigenvariable(nvariables-1);  /* theta is the new eigenvariable */
}
/*___________________________________________________________________*/
static int findpower(term t,term x,term *p,term *q,term *r)
/*  find  p = (q+rx^2)^n in t */
/* return 0 for success */
{ term u,v;
  int i,err,count,marker=0;
  int sign = 1;
  unsigned short n;
  if(ATOMIC(t))
     return 1;
  if(FUNCTOR(t) == '^' && isinteger(ARG(1,t)))
     { *p = t;
       u = ARG(0,t);
       n = ARITY(u);
       count = 0;
       for(i=0;i<n;i++)
          { if (contains(ARG(i,u),FUNCTOR(x)))
               { ++count;
                 marker = i;
               }
          }
       if(count != 1)
          return 1;    /* we miss sqrts inside sqrts this way, but
                                      trig substitution won't work on those anyway */
       v = ARG(marker,u);
       if(FUNCTOR(v) == '-')
         { sign = -1;
           v = ARG(0,v);
         }
       if(FUNCTOR(v) == '^' && equals(ARG(1,v),two) && equals(ARG(0,v),x))
           *r = one;
       else
           { err = matchstring(v,x,"*(a,^(x,2))",r);
             if(err)
                return 1;
           }
       if (n==2)
          *q = ARG(marker ? 0 : 1,u);
       else
          { *q = make_term('+',(unsigned short)(n-1));
            for(i=0;i<n;i++)
               { if(i!= marker)
                    ARGREP(*q,i<marker? i : i-1,ARG(i,u));
               }
          }
       if(sign == -1)
          *r = tnegate(*r);
       return 0;
     }
  n = ARITY(t);
  for(i=0;i<n;i++)
     { err =findpower(ARG(i,t),x,p,q,r);
       if(!err)
          return 0;
     }
  return 1;
}


/*___________________________________________________________________*/
static int findsqrt(term t,term x,term *p,term *q,term *r)
/*  find p = �(q + rx^2) in t */
/*  or   p = (q+rx^2)^�(n/2)  */
/* return 0 for success */
{ term u,v;
  int i,err,count,marker=0;
  int sign = 1;
  unsigned short n;
  if(ATOMIC(t))
     return 1;
  if( (FUNCTOR(t) == SQRT && FUNCTOR(ARG(0,t))=='+')  ||
      ( FUNCTOR(t) == '^' && FUNCTOR(ARG(1,t)) == '/' &&
        isinteger(ARG(0,ARG(1,t))) &&
        equals(ARG(1,ARG(1,t)),two)
      ) ||
      ( FUNCTOR(t) == '^' && FUNCTOR(ARG(1,t)) == '-' &&
        FUNCTOR(ARG(0,ARG(1,t))) == '/' &&
        isinteger(ARG(0,ARG(0,ARG(1,t)))) &&
        equals(ARG(1,ARG(0,ARG(1,t))),two)
      )
    )
     { *p = t;
       u = ARG(0,t);
       n = ARITY(u);
       count = 0;
       for(i=0;i<n;i++)
          { if (contains(ARG(i,u),FUNCTOR(x)))
               { ++count;
                 marker = i;
               }
          }
       if(count != 1)
          return 1;    /* we miss sqrts inside sqrts this way, but
                                      trig substitution won't work on those anyway */
       v = ARG(marker,u);
       if(FUNCTOR(v) == '-')
         { sign = -1;
           v = ARG(0,v);
         }
       if(FUNCTOR(v) == '^' && equals(ARG(1,v),two) && equals(ARG(0,v),x))
           *r = one;
       else
           { err = matchstring(v,x,"*(a,^(x,2))",r);
             if(err)
                return 1;
           }
       if (n==2)
          *q = ARG(marker ? 0 : 1,u);
       else
          { *q = make_term('+',(unsigned short)(n-1));
            for(i=0;i<n;i++)
               { if(i!= marker)
                    ARGREP(*q,i<marker? i : i-1,ARG(i,u));
               }
          }
       if(sign == -1)
          *r = tnegate(*r);
       return 0;
     }
  n = ARITY(t);
  for(i=0;i<n;i++)
     { err =findsqrt(ARG(i,t),x,p,q,r);
       if(!err)
          return 0;
     }
  return 1;
}
/*__________________________________________________________________________*/
static int check_trigsub(term t, term x, term rhs, term theta, term *def)
/* t is an integral to be done by inverse substitution x = rhs.
   theta is the new variable mentioned in rhs.
   It t is a definite integral, determine whether
   x = rhs(theta) defines a one-one function on the
   interval of integration.  If t is an indefinite integral,
   make assumptions if possible that guarantee the substitution
   is one-one.  Return 0 for success, 1 for failure.
   Return in *def the solution theta = *def of the equation x = rhs.
     t is not actually used here because exec, fexec,
   and autosimp all have called fillbinders before
   calling the operator that in turn calls this function,
   so the prover already knows the inequalities on the
   integration variable.
*/
{ int err;
  char buffer[128];
  err = invert_eqn2(rhs,x,theta,def);
  if(err)
     { strcpy(buffer, english(693));
               /*  Can't solve substitution for  */
       strcat(buffer,atom_string(theta));
       strcat(buffer,".");
       errbuf(0,buffer);
       errbuf(1, english(694));
       /* Substitution either not one-to-one or */
       errbuf(2, english(695));
       /* just too complicated to handle. */
       return 1;
     }
  err = check(domain(*def));
  if(err)
     { errbuf(0, english(696));
       /*  That substitution isn't well-defined. */
       strcpy(buffer, english(697)); /*  In solving for  */
       strcat(buffer, atom_string(theta));
       strcat(buffer, english(698));
       /* , an undefined term occurs. */
       errbuf(1,buffer);
       return 1;
     }
  return 0;
}

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