Sindbad~EG File Manager

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

/* Differentiation of transcendentals, operators for MathXpert
M. Beeson
9.10.91  original date
3.19.98 last modified
*/

#include <string.h>
#include <assert.h>
#define TRIGCALC_DLL
#include "globals.h"
#include "ops.h"
#include "trig.h"
#include "calc.h"
#include "checkarg.h"
#include "polynoms.h"
#include "order.h"
#include "factor.h"
#include "deriv.h"
#include "prover.h"
#include "algaux.h"
#include "errbuf.h"
#include "pvalaux.h"  /* twoparts */

/*______________________________________________________________________*/
static void set_chainrule_errmsg(void)
/*  See diff.c.  This is a static copy to avoid swapping overlays
just to get this short function.
*/
  { errbuf(0, english(593));
    errbuf(1, english(594));
    errbuf(2, english(595));
    errbuf(3, english(596));
  }
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difsin(term t, term arg, term *next, char *reason)
{ term x,u;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != SIN)
     return 1;
  if(!equals(ARG(0,u),x))
      { set_chainrule_errmsg();
        return 1;
      }
  *next = cos1(x);
  HIGHLIGHT(*next);
  strcpy(reason,"d/dx sin x = cos x");
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difsin2(term t, term arg, term *next, char *reason)
{ term x,u,p;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != SIN)
     return 1;
  p = ARG(0,u);
  if(equals(p,x))
     { *next = cos1(x);
       strcpy(reason,"d/dx sin x = cos x");
     }
  else
     { *next = product(cos1(p),diff(p,x));
       strcpy(reason,"d/dx sin u =         (cos u) du/dx");
     }
  HIGHLIGHT(*next);
  return 0;
}

/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difcos(term t, term arg, term *next, char *reason)
{ term x,u;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != COS)
     return 1;
  if(!equals(ARG(0,u),x))
      { set_chainrule_errmsg();
        return 1;
      }
  *next = tnegate(sin1(x));
  HIGHLIGHT(*next);
  strcpy(reason,"d/dx cos x = -sin x");
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difcos2(term t, term arg, term *next, char *reason)
{ term x,u,p;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != COS)
     return 1;
  p = ARG(0,u);
  if(equals(p,x))
     { *next = tnegate(sin1(x));
       strcpy(reason,"d/dx cos x = -sin x");
     }
  else
     { *next = tnegate(product(sin1(p),diff(p,x)));
       strcpy(reason,"d/dx cos u =         - (sin u) du/dx");
     }
  HIGHLIGHT(*next);
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int diftan(term t, term arg, term *next, char *reason)
{ term x,u;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != TAN)
     return 1;
  if(!equals(ARG(0,u),x))
      { set_chainrule_errmsg();
        return 1;
      }
  *next = make_power(sec1(x),two);
  HIGHLIGHT(*next);
  strcpy(reason,"$d/dx tan x = sec^2 x$");
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int diftan2(term t, term arg, term *next, char *reason)
{ term x,u,p;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != TAN)
     return 1;
  p = ARG(0,u);
  if(equals(p,x))
     { *next = make_power(sec1(x),two);
       strcpy(reason,"$d/dx tan x = sec^2 x$");
     }
  else
     { *next = product(make_power(sec1(p),two),diff(p,x));
       strcpy(reason,"d/dx tan u =         ($sec^2 u) du/dx$");
     }
  HIGHLIGHT(*next);
  return 0;
}

/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difsec(term t, term arg, term *next, char *reason)
{ term x,u;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != SEC)
     return 1;
  if(!equals(ARG(0,u),x))
      { set_chainrule_errmsg();
        return 1;
      }
  *next = product(sec1(x),tan1(x));
  HIGHLIGHT(*next);
  strcpy(reason,"d/dx sec x =          sec x tan x");
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difsec2(term t, term arg, term *next, char *reason)
{ term x,u,p;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != SEC)
     return 1;
  p = ARG(0,u);
  if(equals(p,x))
     { *next = product(sec1(x),tan1(x));
       strcpy(reason,"d/dx sec x =          sec x tan x");
     }
  else
     { *next = product3(sec1(p),tan1(p),diff(p,x));
       strcpy(reason,"d/dx sec u =          sec x tan x  du/dx");
     }
  HIGHLIGHT(*next);
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difcot(term t, term arg, term *next, char *reason)
{ term x,u;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != COT)
     return 1;
  if(!equals(ARG(0,u),x))
      { set_chainrule_errmsg();
        return 1;
      }
  *next = tnegate(make_power(csc1(x),two));
  HIGHLIGHT(*next);
  strcpy(reason,"d/dx cot x = -csc^2 x");
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difcot2(term t, term arg, term *next, char *reason)
{ term x,u,p;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != COT)
     return 1;
  p = ARG(0,u);
  if(equals(p,x))
     { *next = tnegate(make_power(csc1(x),two));
       strcpy(reason,"d/dx cot x = -csc^2 x");
     }
  else
     { *next = tnegate(product(make_power(csc1(p),two),diff(p,x)));
       strcpy(reason,"d/dx cot u =         - (csc^2 u) du/dx");
     }
  HIGHLIGHT(*next);
  return 0;
}

/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difcsc(term t, term arg, term *next, char *reason)
{ term x,u;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != CSC)
     return 1;
  if(!equals(ARG(0,u),x))
      { set_chainrule_errmsg();
        return 1;
      }
  *next = tnegate(product(csc1(x),cot1(x)));
  HIGHLIGHT(*next);
  strcpy(reason,"d/dx csc x =             - csc x cot x");
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difcsc2(term t, term arg, term *next, char *reason)
{ term x,u,p;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != CSC)
     return 1;
  p = ARG(0,u);
  if(equals(p,x))
     { *next = tnegate(product(csc1(x),cot1(x)));
       strcpy(reason,"d/dx sec x =          - csc x cot x");
     }
  else
     { *next = tnegate(product3(csc1(p),cot1(p),diff(p,x)));
       strcpy(reason,"d/dx csc u =          -csc u cot u du/dx");
     }
  HIGHLIGHT(*next);
  return 0;
}

/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difatox(term t, term arg, term *next, char *reason)
/* d/dx  a^x = (ln a) a^x  if a doesn't depend on x */
{ term x,a,u;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  if(FUNCTOR(ARG(0,t)) != '^')
     return 1;
  u = ARG(1,ARG(0,t));
  a = ARG(0,ARG(0,t));
  if(!equals(u,x))
      { set_chainrule_errmsg();
        return 1;
      }
  if(depends(a,x))
     { errbuf(0, english(650)); /* Base is not constant. */
       errbuf(1, english(651));
        /* Use d/dx u^v = (d/dx) e^(v ln u) instead. */
       return 1;
     }
  *next = product(ln1(a),ARG(0,t));
  HIGHLIGHT(*next);
  strcpy(reason,"d/dx c^x = (ln a) a^x");
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difatox2(term t, term arg, term *next, char *reason)
/* d/dx  a^u = (ln a) a^u du/dx if a doesn't depend on x */
{ term x,a,u;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  if(FUNCTOR(ARG(0,t)) != '^')
     return 1;
  u = ARG(1,ARG(0,t));
  a = ARG(0,ARG(0,t));
  if(depends(a,x))
     { errbuf(0, english(650)); /* Base is not constant. */
       errbuf(1, english(651));
          /* Use d/dx u^v=  (d/dx) e^(v ln u) instead. */
       return 1;
     }
  *next = product3(ln1(a),ARG(0,t),diff(u,x));
  HIGHLIGHT(*next);
  strcpy(reason,"d/dx c^u =            (ln a) a^u du/dx");
  return 0;
}

/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difln(term t, term arg, term *next, char *reason)
{ term x,u,v;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != LN)
     return 1;
  v =  FUNCTOR(ARG(0,u))==ABS ? ARG(0,ARG(0,u)) : ARG(0,u);
  if(!equals(v,x))
      { set_chainrule_errmsg();
        return 1;
      }
  *next = make_fraction(one,v);
  HIGHLIGHT(*next);
  if(FUNCTOR(ARG(0,u))==ABS)
     strcpy(reason, "d/dx ln |x| = 1/x");
  else
     strcpy(reason,"d/dx ln x = 1/x");
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int diflnabs(term t, term arg, term *next, char *reason)
/* d/dx ln |x| = 1/x */
{ term x,u,v;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != LN)
     return 1;
  if(FUNCTOR(ARG(0,u)) != ABS)
     return 1;
  v =  ARG(0,ARG(0,u));
  if(!equals(v,x))
      { set_chainrule_errmsg();
        return 1;
      }
  *next = make_fraction(one,v);
  HIGHLIGHT(*next);
  strcpy(reason, "d/dx ln |x| = 1/x");
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difln2(term t, term arg, term *next, char *reason)
{ term x,u,p;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != LN)
     return 1;
  p = ARG(0,u);
  if(FUNCTOR(p)==ABS)
     p = ARG(0,p);
  if(equals(p,x))
     return difln(t,arg,next,reason);
  else
     { *next = make_fraction(diff(p,x),p);
       if(FUNCTOR(ARG(0,u))==ABS)
          strcpy(reason,"d/dx ln |u|=(du/dx)/x");
       else
          strcpy(reason,"d/dx ln u = (du/dx)/x");
     }
  HIGHLIGHT(*next);
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int diflnabs2(term t, term arg, term *next, char *reason)
/* d/dx ln |u|=(du/dx)/x */
{ term x,u,p;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != LN)
     return 1;
  p = ARG(0,u);
  if(FUNCTOR(p)!=ABS)
     return 1;
  p = ARG(0,p);
  if(equals(p,x))
     return diflnabs(t,arg,next,reason);
  else
     { *next = make_fraction(diff(p,x),p);
       strcpy(reason,"d/dx ln |u|=(du/dx)/x");
     }
  HIGHLIGHT(*next);
  return 0;
}

/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difexponential(term t, term arg, term *next, char *reason)
/* d/dx (u^v) = d/dx e^(v ln u) */
{ term x,q,u,v,power;
  int err;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  q = ARG(0,t);
  if(FUNCTOR(q) != '^')
     return 1;
  u = ARG(0,q);
  v = ARG(1,q);
  if(!depends(v,x))
     { errbuf(0, english(652)); /* The exponent is constant, */
       errbuf(1, english(653)); /* So use the power rule instead. */
       return 1;
     }
  err = check(positive(u));
  if(err)
     { errbuf(0, english(654));
         /* Can't take ln of a negative number. */
       return 1;
     }
  power = product(v,ln1(u));
  if(FUNCTOR(power)=='*')
     sortargs(power);
  *next = diff(make_power(eulere,power),x);
  strcpy(reason,"u^v = e^(v ln u)");
  HIGHLIGHT(ARG(0,*next));
  inhibit(lninexponent);   /* released when the derivative is evaluated */
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int secondderivlinear(term t, term arg, term *next, char *reason)
/* (AX)" = A X" and etc. for higher derivs */
{ term x,u,c,v,n;
  if(FUNCTOR(t) != DIFF || ARITY(t) != 3)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  n = ARG(2,t);
  if(FUNCTOR(u) != '*')
     return 1;
  twoparts(u,x,&c,&v);
  if(ONE(c))
     return 1;
  *next = product(c,diff3(v,x,n));
  HIGHLIGHT(*next);
  return 0;
}

/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int secondderiv(term t, term arg, term *next, char *reason)
/*  deriv of deriv is second deriv */
{ term x,u,v;
  if(FUNCTOR(t) != DIFF || ARITY(t) != 2)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) != DIFF || ARITY(t) != 2)
     return 1;
  if(!equals(ARG(1,u),x))
     {errbuf(0, english(655));
          /* The two derivatives must be with */
      errbuf(1, english(656));
          /* respect to the same variable. */
     }
  v = ARG(0,u);
  *next = diff3(v,x,two);
  strcpy(reason,"$d/dx(du/dx) = d^2u/dx^2$");
  HIGHLIGHT(*next);
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int highderiv(term t, term arg, term *next, char *reason)
/*  deriv of n-th deriv is n+1-st deriv */
{ term x,u,v,n,m,k;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  k = ARITY(t)==2 ? one : ARG(2,t);
  if(FUNCTOR(u) != DIFF || ARITY(t) == 2)
     return 1;
  if(!equals(ARG(1,u),x))
     { errbuf(0, english(655));
         /* The two derivatives must be with */
       errbuf(1, english(656));
         /* respect to the same variable. */
     }
  v = ARG(0,u);
  m = ARG(2,u);;
  polyval(sum(k,m),&n);
  *next = diff3(v,x,n);
  if(equals(k,one) )
     strcpy(reason,"$d/dx(d�u/dx�)$           = d^(n+1)u/dx^(n+1)");
  else
     strcpy(reason,"$d^m/dx^m(d�u/dx�)$           = d^(m+n)u/dx^(m+n)");
  HIGHLIGHT(*next);
  return 0;
}

/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int reversesecondderiv(term t, term arg, term *next, char *reason)
/* second deriv is deriv of deriv */
/* or n+1-st deriv is deriv of n-th deriv */
{ term x,u,n,new;
  int err;
  if(FUNCTOR(t) != DIFF || ARITY(t) != 3)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  n = ARG(2,t);
  polyval(sum(n,minusone),&new);
     /* No need to check that n is an integer as non-integers can never
        get created in this arg position of diff */
  if(ONE(new))
    { *next = diff(u,x);
      strcpy(reason,"$d^2u/dx^2 = d/dx(du/dx)$");
      HIGHLIGHT(*next);
      return 0;
    }
  if (!INTEGERP(new))
    { err = check(le(zero,new));
      if(err)
          return 1;   /* I don't think this can ever happen */
    }
  *next = diff3(u,x,new);
  strcpy(reason,english(2168));  /* defn of d�u/dx� */
  HIGHLIGHT(*next);
  return 0;
 }
/*____________________________________________________________________*/
static void difvector_aux(term u, term x, unsigned short n, term *next)
/* differentiate vector u of length n term-by-term with respect to x
and return the answer in *next */
{ int i;
  term v;
  *next = make_term(VECTOR,n);
  for(i=0;i<n;i++)
    {v = ARG(i,u);
     if(ZERO(v) || !depends(v,x))
         ARGREP(*next,i,zero);
     else
         ARGREP(*next,i,diff(ARG(i,u),x));
    }
}
/*____________________________________________________________________*/
MEXPORT_TRIGCALC int difvector(term t, term arg, term *next, char *reason)
/* d/dx {u,v...}   =      {du/dx,dv/dx...} */
{ unsigned short n;
  term u,x;
  if(FUNCTOR(t) != DIFF || ARITY(t) != 2)
     return 1;
  u = ARG(0,t);
  x = ARG(1,t);
  if(FUNCTOR(u) != VECTOR)
     return 1;
  n = ARITY(t);
  difvector_aux(u,x,n,next);
  HIGHLIGHT(*next);
  if(n==2)
     strcpy(reason, "d/dx {u,v}             = {du/dx,dv/dx}");
  else if(n==3)
     strcpy(reason, "d/dx {u,v,w}             = {du/dx,dv/dx,dw/dx}");
  else
     strcpy(reason, "d/dx {u,v,...}           = {du/dx,dv/dx,...}");
  return 0;
}
/*____________________________________________________________________*/
MEXPORT_TRIGCALC int difmatrix(term t, term arg, term *next, char *reason)
/* d/dx {u,v...}   =      {du/dx,dv/dx...} */
{ unsigned short n;
  term u,x,v;
  int i;
  if(FUNCTOR(t) != DIFF || ARITY(t) != 2)
     return 1;
  u = ARG(0,t);
  x = ARG(1,t);
  if(FUNCTOR(u) != MATRIX)
     return 1;
  n = ARITY(t);
  *next = make_term(MATRIX,n);
  for(i=0;i<n;i++)
    {v = ARG(i,u);
     difvector_aux(v,x,n,ARGPTR(*next)+i);
    }
  HIGHLIGHT(*next);
  strcpy(reason, english(2169));  /* differentiate matrix */
  return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logdif(term t, term arg, term *next, char *reason)
/* logarithmic differentiation  dy/dx = y (d/dx) ln y */
{ term y,x;
  if(FUNCTOR(t) != DIFF || ARITY(t) != 2)
     return 1;
  y = ARG(0,t);
  x = ARG(1,t);
  *next = product(y,diff(ln1(y),x));
  HIGHLIGHT(*next);
  strcpy(reason, "dy/dx = y (d/dx) ln y");
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difexp(term t, term arg, term *next, char *reason)
{ term x,u;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) == '^' && equals(ARG(0,u),eulere))
     {if(!equals(ARG(1,u),x))
          { set_chainrule_errmsg();
            return 1;
          }
     }
  else
     return 1;  /* wrong functor for this rule */
  *next = u;
  HIGHLIGHT(*next);
  strcpy(reason, "d/dx e^x = e^x");
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int difexp2(term t, term arg, term *next, char *reason)
{ term x,u;
  if(FUNCTOR(t) != DIFF)
     return 1;
  x = ARG(1,t);
  u = ARG(0,t);
  if(FUNCTOR(u) == '^' && equals(ARG(0,u),eulere))
     { if(ispolyin(ARG(1,u),x))
          { if (status(difpoly) > LEARNING)
               *next = product(u,derivative(ARG(1,u),x));
            else
               *next = product(u,diff(ARG(1,u),x));
          }
       else
          *next = product(u,diff(ARG(1,u),x));
       strcpy(reason,"d/dx e^u = e^u du/dx");
       if(contains(ARG(1,u),LN))
          release(lninexponent);
    }
  else
     return 1;
  HIGHLIGHT(*next);
  return 0;
}

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