Sindbad~EG File Manager
/* M. Beeson, for Mathpert
7.7.95 original date
1.29.98 last modified
3.5.00 modified trigsimp3 on asec(sec x), etc.
*/
#include <assert.h>
#define POLYVAL_DLL
#include "globals.h"
#include "trigsimp.h"
#include "cancel.h"
#include "pvalaux.h" /* square2 */
#include "trig.h" /* TRIGFUNCTOR, ARCTRIGFUNCTOR */
/*__________________________________________________________________*/
static term trigsimp_aux(term t,term v0,term v1,term x)
/* substitute v0 for sin x
and v1 for cos x, and so on for other trig functions.
*/
{ unsigned short f = FUNCTOR(t);
unsigned short n,i;
term u,ans;
if(ATOMIC(t))
return t;
if(f==SIN || f==TAN || f==COS || f==SEC || f==CSC || f == COT)
{ u = ARG(0,t);
if(ISATOM(u) && FUNCTOR(u) == FUNCTOR(x))
{ switch(f)
{ case SIN: return v0;
case COS: return v1;
case TAN: return make_fraction(v0,v1);
case COT: return make_fraction(v1,v0);
case SEC: return reciprocal(v1);
case CSC: return reciprocal(v0);
}
}
return t;
}
n = ARITY(t);
ans = make_term(f,n);
for(i=0;i<n;i++)
ARGREP(ans,i,trigsimp_aux(ARG(i,t),v0,v1,x));
return ans;
}
/*_______________________________________________________*/
MEXPORT_POLYVAL term trigsimp(term t, term x)
/* replace all trig functions of x by their definitions in terms of
sin and cos. Simplify. Return the result,
expressed in terms of the original variables.
Example: tan x/(sec^2 x sin x cos x) simplifies to 1; this comes
up in checksub when integrating ln(tan x)/(sin x cos x) using u = ln(tan x).
*/
{ int nvariables = get_nvariables();
term a,b,u,v,ans;
a = getnewvar(t,"abcdpqrs");
b = getnewvar(t,"bcdpqrs");
polyval(trigsimp_aux(t,a,b,x),&u);
subst(sin1(x),a,u,&v);
subst(cos1(x),b,v,&ans);
set_nvariables(nvariables);
return ans;
}
/*___________________________________________________________________*/
static int trigsimp_tanflag;
MEXPORT_POLYVAL void set_trigsimp_tanflag(int n)
{ trigsimp_tanflag = n;
}
static int trigsimp_doubleangleflag;
MEXPORT_POLYVAL void set_trigsimp_doubleangleflag(int n)
{ trigsimp_doubleangleflag = n;
}
/*____________________________________________________________________*/
MEXPORT_POLYVAL term trigsimp3(term t)
/* simplify using trig laws. Return in fresh space.
Does not call polyval itself; polyval should be called on the result
if desired.
*/
{ unsigned short n;
int i;
unsigned short f,g;
term ans,mid,v,x,p,q,u;
start: /* label for tail recursion */
if(ATOMIC(t))
return t;
n = ARITY(t);
f = FUNCTOR(t);
u = ARG(0,t);
if(f == ATAN)
{ /* don't convert atan(tan x) to atan(sin(x)/cos(x)) */
if(FRACTION(u) &&
FUNCTOR(ARG(0,u)) == SIN && FUNCTOR(ARG(1,u)) == COS &&
equals(ARG(0,ARG(0,u)),ARG(0,ARG(1,u)))
)
return atan1(tan1(ARG(0,ARG(0,u))));
else if(FUNCTOR(u) == TAN)
return t;
}
if(f == ACOT)
{ if(FRACTION(u) &&
FUNCTOR(ARG(0,u)) == COS && FUNCTOR(ARG(1,u)) == SIN &&
equals(ARG(0,ARG(0,u)),ARG(0,ARG(1,u)))
)
return atan1(tan1(ARG(0,ARG(0,u))));
else if(FUNCTOR(u) == COT)
return t;
}
if(f == ASIN)
{ if(FUNCTOR(u) == SIN)
return t;
}
if(f == ACOS)
{ if(FUNCTOR(u) == COS)
return t;
}
if(f == ASEC)
{ if(FUNCTOR(u) == SEC)
return t;
}
if(f == ACSC)
{ if(FUNCTOR(u) == CSC)
return t;
}
/* Convert SEC, CSC, COT to COS, SIN, TAN */
if(f == COT)
{ t = reciprocal(tan1(ARG(0,t)));
goto start;
}
if(f == SEC)
{ t = reciprocal(cos1(ARG(0,t)));
goto start;
}
if(f == CSC)
{ t = reciprocal(sin1(ARG(0,t)));
goto start;
}
/* Next look for tan((1/2)x) = (1-cos x)/sin(x) */
if(f == TAN && FUNCTOR(ARG(0,t)) == '*' && ARITY(ARG(0,t)) == 2 &&
RATIONALP(ARG(0,ARG(0,t))) && ONEHALF(ARG(0,ARG(0,t)))
)
{ x = ARG(1,ARG(0,t));
v = make_fraction(sum(one,tnegate(cos1(x))),sin1(x));
ans = trigsimp3(v);
RELEASE(ARG(0,v));
RELEASE(v);
return ans;
}
if(f == TAN && trigsimp_tanflag)
{ copy(ARG(0,t),&v);
t = make_fraction(sin1(ARG(0,t)),cos1(v));
goto start;
}
mid = make_term(f,n);
if(n == 1 && !TRIGFUNCTOR(f) && !ARCTRIGFUNCTOR(f) && f != '-')
{ copy(t,&ans); /* don't change log(tan x) to log(sin(x)/cos(x)) */
return ans;
}
for(i=0;i<n;i++)
ARGREP(mid,i,trigsimp3(ARG(i,t)));
q = ARG(0,mid);
g = FUNCTOR(q);
/* Now apply trig laws to mid */
if(SIN <= f && f <= COT && ACOS <= g && g <= ATAN)
return trig_arctrig(mid);
if(SIN <= f && f <= COT && g == '*' && ARITY(q) == 2 &&
ACOS <= FUNCTOR(ARG(1,q)) && FUNCTOR(ARG(1,q)) <= ATAN &&
ISINTEGER(ARG(0,q)) && INTDATA(ARG(0,q)) == 2
)
return trigsimp2(mid);
/* Next look for sin^2((1/2)x */
if(f == '^' && FUNCTOR(ARG(0,t)) == SIN &&
equals(ARG(1,mid),two) &&
FUNCTOR(ARG(0,ARG(0,mid))) == '*' && ARITY(ARG(0,ARG(0,mid))) == 2 &&
RATIONALP(ARG(0,ARG(0,ARG(0,mid)))) && ONEHALF(ARG(0,ARG(0,ARG(0,mid))))
)
{ x = ARG(1,ARG(0,ARG(0,mid)));
/* sin^2 (1/2)x = (1-cos x)/2 */
v = make_fraction(sum(one,tnegate(cos1(x))),two);
ans = trigsimp3(v);
destroy_term(mid);
RELEASE(ARG(0,v));
RELEASE(v);
return ans;
}
/* Next look for cos^2((1/2)x */
if(f == '^' && FUNCTOR(ARG(0,t)) == COS &&
equals(ARG(1,mid),two) &&
FUNCTOR(ARG(0,ARG(0,t))) == '*' && ARITY(ARG(0,ARG(0,t))) == 2 &&
RATIONALP(ARG(0,ARG(0,ARG(0,t)))) && ONEHALF(ARG(0,ARG(0,ARG(0,t))))
)
{ x = ARG(1,ARG(0,ARG(0,t)));
/* cos^2 (1/2)x = (1+cos x)/2 */
v = make_fraction(sum(one,cos1(x)),two);
ans = trigsimp3(v);
destroy_term(mid);
RELEASE(ARG(0,v));
RELEASE(v);
return ans;
}
/* Next look for tan((1/2)x) = (1-cos x)/sin(x) */
if(f == TAN && FUNCTOR(ARG(0,mid)) == '*' && ARITY(ARG(0,mid)) == 2 &&
RATIONALP(ARG(0,ARG(0,mid))) && ONEHALF(ARG(0,ARG(0,mid)))
)
{ x = ARG(1,ARG(0,mid));
v = make_fraction(sum(one,tnegate(cos1(x))),sin1(x));
ans = trigsimp3(v);
destroy_term(mid);
RELEASE(ARG(0,v));
RELEASE(v);
return ans;
}
/* Next look for sin^2(x/2) */
if(f == '^' && FUNCTOR(ARG(0,t)) == SIN &&
equals(ARG(1,mid),two) &&
FRACTION(ARG(0,ARG(0,mid))) && equals(ARG(1,ARG(0,ARG(0,mid))),two)
)
{ x = ARG(0,ARG(0,ARG(0,mid)));
/* sin^2 x/2 = (1-cos x)/2 */
v = make_fraction(sum(one,tnegate(cos1(x))),two);
ans = trigsimp3(v);
destroy_term(mid);
RELEASE(ARG(0,v));
RELEASE(v);
return ans;
}
/* Next look for cos^2((1/2)x */
if(f == '^' && FUNCTOR(ARG(0,t)) == COS &&
equals(ARG(1,mid),two) &&
FRACTION(ARG(0,ARG(0,mid))) && equals(ARG(1,ARG(0,ARG(0,mid))),two)
)
{ x = ARG(0,ARG(0,ARG(0,t)));
/* cos^2 x/2 = (1+cos x)/2 */
v = make_fraction(sum(one,cos1(x)),two);
ans = trigsimp3(v);
destroy_term(mid);
RELEASE(ARG(0,v));
RELEASE(v);
return ans;
}
/* Next look for tan(x/2) = (1-cos x)/sin(x) */
if(f == TAN && FUNCTOR(ARG(0,mid)) == '/' && equals(ARG(1,ARG(0,mid)),two))
{ x = ARG(0,ARG(0,mid));
v = make_fraction(sum(one,tnegate(cos1(x))),sin1(x));
ans = trigsimp3(v);
destroy_term(mid);
RELEASE(ARG(0,v));
RELEASE(v);
return ans;
}
/* Now look for double angles */
if(f == SIN && FUNCTOR(ARG(0,mid)) == '*' && equals(ARG(0,ARG(0,mid)),two))
{ if(ARITY(ARG(0,mid)) == 2)
x = ARG(1,mid);
else
cancel(ARG(0,mid),two,&p,&x);
if(ACOS <= FUNCTOR(x) && FUNCTOR(x) <= ATAN)
return trigsimp2(mid);
if(!trigsimp_doubleangleflag)
return mid;
v = product3(two, sin1(x),cos1(x));
ans = trigsimp3(v);
destroy_term(mid);
return ans;
}
if(f == COS && FUNCTOR(ARG(0,mid)) == '*' && equals(ARG(0,ARG(0,mid)),two))
{ if(ARITY(ARG(0,mid)) == 2)
x = ARG(1,mid);
else
cancel(ARG(0,mid),two,&p,&x);
if(ACOS <= FUNCTOR(x) && FUNCTOR(x) <= ATAN)
return trigsimp2(mid);
if(!trigsimp_doubleangleflag)
return mid;
v = sum(one,tnegate(product(two,make_power(sin1(x),two))));
ans = trigsimp3(v);
destroy_term(mid);
return ans;
}
if(f == TAN && FUNCTOR(ARG(0,mid)) == '*' && equals(ARG(0,ARG(0,mid)),two))
{ if(ARITY(ARG(0,mid)) == 2)
x = ARG(1,mid);
else
cancel(ARG(0,mid),two,&p,&x);
if(ACOS <= FUNCTOR(x) && FUNCTOR(x) <= ATAN)
return trigsimp2(mid);
if(!trigsimp_doubleangleflag)
return mid;
v = make_fraction(product(two,tan1(x)),sum(one,tnegate(make_power(tan1(x),two))));
ans = trigsimp3(v);
destroy_term(mid);
return ans;
}
return mid;
}
/*________________________________________________________________________*/
MEXPORT_POLYVAL term trigsimp2(term t)
/* simplify things like sin (2 arctan x) by applying double angle
formulas and then trig_arctrig, and simplifying the result by polyval.
The result should be an algebraic function. If called on too-complicated
input, or too-simple input, it just returns the input.
*/
{ unsigned short f = FUNCTOR(t);
term u,x,v,ans;
if(ATOMIC(t))
return t;
u = ARG(0,t);
if(SIN <= f && f <= COT &&
FUNCTOR(u) == '*' && ARITY(u) == 2 &&
ISINTEGER(ARG(0,u)) && INTDATA(ARG(0,u)) == 2 &&
ACOS <= FUNCTOR(ARG(1,u)) && FUNCTOR(ARG(1,u)) <= ATAN
)
{ x = ARG(1,u);
/* sin(2 atan x) etc. */
switch(f)
{ case SIN:
v = product3(two,trig_arctrig(sin1(x)),trig_arctrig(cos1(x)));
break;
case COS:
if(FUNCTOR(x) == ACOS)
v = sum(product(two,trig_arctrigsq(cos1(x))),minusone);
else
v = sum(one,tnegate(product(two,trig_arctrigsq(sin1(x)))));
break;
case TAN:
v = make_fraction(product(two, trig_arctrig(tan1(x))),
sum(one,tnegate(trig_arctrigsq(tan1(x))))
);
break;
case COT:
v = make_fraction(sum(one,tnegate(trig_arctrigsq(tan1(x)))),product(two,trig_arctrig(tan1(x))));
break;
case SEC:
v = reciprocal(sum(one,tnegate(trig_arctrigsq(sin1(x)))));
break;
case CSC:
v = reciprocal(product3(two,trig_arctrig(sin1(x)),trig_arctrig(cos1(x))));
break;
}
polyval(v,&ans);
return ans;
}
return t;
}
/*_________________________________________________________________________*/
MEXPORT_POLYVAL term trig_arctrig(term u)
/* u is of the form trig(arctrig(x)), e.g. sin(arctan(x)).
Simplify to an algebraic function and return the answer.
If it's incorrectly called just return the input.
*/
{ unsigned short g = FUNCTOR(u);
unsigned short h;
term x;
if(ATOMIC(u) || ATOMIC(ARG(0,u)))
return u;
h = FUNCTOR(ARG(0,u));
x = ARG(0,ARG(0,u));
switch(g)
{ case TAN:
switch(h)
{ case ATAN:
return x;
case ACOS:
/* tan(arccos x) = sqrt(1-x^2)/x */
return make_fraction(make_sqrt(sum(one,tnegate(square2(x)))),x);
case ACSC:
/* tan(acsc x) = 1/sqrt(x^2-1) */
return reciprocal(make_sqrt(sum(square2(x),minusone)));
case ASIN:
/* tan(asin x) = x / sqrt(1-x^2) */
return make_fraction(x,make_sqrt(sum(one,tnegate(square2(x)))));
case ASEC:
/* tan(asec x) = sqrt(x^2-1) */
return make_sqrt(sum(square2(x),minusone));
case ACOT:
/* tan(acot x) = 1/x */
return reciprocal(x);
default:
return u;
}
case SIN:
switch(h)
{ case ASIN:
return x;
case ACOS:
/* sin(arccos x) = sqrt(1-x^2) */
return make_sqrt(sum(one,tnegate(square2(x))));
case ATAN:
/* sin(arctan x) = x/sqrt(x^2+1) */
return make_fraction(x,make_sqrt(sum(square2(x),one)));
case ASEC:
/* sin(arcsec x) = sqrt(x^2-1) */
return make_sqrt(sum(square2(x),minusone));
case ACSC:
/* sin(arccsc x) = 1/x */
return reciprocal(x);
case ACOT:
/* sin(arccot x) = 1/sqrt(x^2 + 1) */
return reciprocal(make_sqrt(sum(square2(x),one)));
default:
return u;
}
case COS:
switch(h)
{ case ACOS:
/* cos(arccos x) = x */
return x;
case ASIN:
/* cos(arcsin x) = sqrt(1-x^2) */
return make_sqrt(sum(one,tnegate(square2(x))));
case ATAN:
/* cos(arctan x) = 1/sqrt(x^2+1) */
return reciprocal(make_sqrt(sum(square2(x),one)));
case ACOT:
/* cos(arccot x) = x/sqrt(x^2+1) */
return make_fraction(x,make_sqrt(sum(square2(x),one)));
case ACSC:
/* cos(arccsc x) = sqrt(x^2-1)/x */
return make_fraction(make_sqrt(sum(square2(x),minusone)),x);
case ASEC:
/* cos(arcsec x) = 1/x */
return reciprocal(x);
default:
return u;
}
case SEC:
switch(h)
{ case ACOS:
/* sec(arccos x) = 1/x */
return reciprocal(x);
case ASIN:
/* sec(arcsin x) = 1/sqrt(1-x^2) */
return reciprocal(make_sqrt(sum(one,tnegate(square2(x)))));
case ATAN:
/* sec(arctan x) = sqrt(x^2+1) */
return make_sqrt(sum(square2(x),one));
case ACOT:
/* sec(arccot x) = sqrt(x^2+1)/x */
return make_fraction(make_sqrt(sum(square2(x),one)),x);
case ACSC:
/* sec(arccsc x) = x/sqrt(x^2-1) */
return make_fraction(x,make_sqrt(sum(square2(x),minusone)));
case ASEC:
/* sec(arcsec x) = x */
return x;
default:
return u;
}
case CSC:
switch(h)
{ case ASIN:
/* csc(arcsin x) = 1/x */
return reciprocal(x);
case ACOS:
/* csc(arccos x) = 1/ sqrt(1-x^2) */
return reciprocal(make_sqrt(sum(one,tnegate(square2(x)))));
case ATAN:
/* csc(arctan x) = sqrt(x^2+1)/x */
return make_fraction(make_sqrt(sum(square2(x),one)),x);
case ASEC:
/* csc(arcsec x) = 1/sqrt(x^2-1) */
return reciprocal(make_sqrt(sum(square2(x),minusone)));
case ACSC:
/* csc(arccsc x) = x */
return x;
case ACOT:
/* csc(arccot x) = sqrt(x^2 + 1) */
return make_sqrt(sum(square2(x),one));
default:
return u;
}
case COT:
switch(h)
{ case ATAN:
/* cot(arctan x) = 1/x */
return reciprocal(x);
case ACOS:
/* cot(arccos x) = x/sqrt(1-x^2) */
return make_fraction(x,make_sqrt(sum(one,tnegate(square2(x)))));
case ACSC:
/* cot(acsc x) = sqrt(x^2-1) */
return make_sqrt(sum(square2(x),minusone));
case ASIN:
/* cot(asin x) = sqrt(1-x^2)/x */
return make_fraction(make_sqrt(sum(one,tnegate(square2(x)))),x);
case ASEC:
/* cot(asec x) = 1/sqrt(x^2-1) */
return reciprocal(make_sqrt(sum(square2(x),minusone)));
case ACOT:
/* cot(acot x) = x */
return x;
default:
return u;
}
}
return u;
}
/*_________________________________________________________________________*/
MEXPORT_POLYVAL term trig_arctrigsq(term u)
/* u is of the form trig(arctrig(x)), e.g. sin(arctan(x)).
Simplify u^2 to a rational function and return the answer.
If it's incorrectly called just return the input.
*/
{ unsigned short g = FUNCTOR(u);
unsigned short h;
term x;
if(ATOMIC(u) || ATOMIC(ARG(0,u)))
return u;
h = FUNCTOR(ARG(0,u));
x = ARG(0,ARG(0,u));
switch(g)
{ case TAN:
switch(h)
{ case ATAN:
return square2(x);
case ACOS:
/* tan(arccos x) = sqrt(1-x^2)/x */
return make_fraction(sum(one,tnegate(square2(x))),square2(x));
case ACSC:
/* tan(acsc x) = 1/sqrt(x^2-1) */
return reciprocal(sum(square2(x),minusone));
case ASIN:
/* tan(asin x) = x / sqrt(1-x^2) */
return make_fraction(square2(x),sum(one,tnegate(square2(x))));
case ASEC:
/* tan(asec x) = sqrt(x^2-1) */
return sum(square2(x),minusone);
case ACOT:
/* tan(acot x) = 1/x */
return reciprocal(square2(x));
default:
return square2(u);
}
case SIN:
switch(h)
{ case ASIN:
return square2(x);
case ACOS:
/* sin(arccos x) = sqrt(1-x^2) */
return sum(one,tnegate(square2(x)));
case ATAN:
/* sin(arctan x) = x/sqrt(x^2+1) */
return make_fraction(square2(x),sum(square2(x),one));
case ASEC:
/* sin(arcsec x) = sqrt(x^2-1) */
return sum(square2(x),minusone);
case ACSC:
/* sin(arccsc x) = 1/x */
return reciprocal(square2(x));
case ACOT:
/* sin(arccot x) = 1/sqrt(x^2 + 1) */
return reciprocal(sum(square2(x),one));
default:
return square2(u);
}
case COS:
switch(h)
{ case ACOS:
/* cos(arccos x) = x */
return square2(x);
case ASIN:
/* cos(arcsin x) = sqrt(1-x^2) */
return sum(one,tnegate(square2(x)));
case ATAN:
/* cos(arctan x) = 1/sqrt(x^2+1) */
return reciprocal(sum(square2(x),one));
case ACOT:
/* cos(arccot x) = x/sqrt(x^2+1) */
return make_fraction(square2(x),sum(square2(x),one));
case ACSC:
/* cos(arccsc x) = sqrt(x^2-1)/x */
return make_fraction(sum(square2(x),minusone),square2(x));
case ASEC:
/* cos(arcsec x) = 1/x */
return reciprocal(square2(x));
default:
return square2(u);
}
case SEC:
switch(h)
{ case ACOS:
/* sec(arccos x) = 1/x */
return reciprocal(square2(x));
case ASIN:
/* sec(arcsin x) = 1/sqrt(1-x^2) */
return reciprocal(sum(one,tnegate(square2(x))));
case ATAN:
/* sec(arctan x) = sqrt(x^2+1) */
return sum(square2(x),one);
case ACOT:
/* sec(arccot x) = sqrt(x^2+1)/x */
return make_fraction(sum(square2(x),one),square2(x));
case ACSC:
/* sec(arccsc x) = x/sqrt(x^2-1) */
return make_fraction(square2(x),sum(square2(x),minusone));
case ASEC:
/* sec(arcsec x) = x */
return square2(x);
default:
return square2(u);
}
case CSC:
switch(h)
{ case ASIN:
/* csc(arcsin x) = 1/x */
return reciprocal(square2(x));
case ACOS:
/* csc(arccos x) = 1/ sqrt(1-x^2) */
return reciprocal(sum(one,tnegate(square2(x))));
case ATAN:
/* csc(arctan x) = sqrt(x^2+1)/x */
return make_fraction(sum(square2(x),one),square2(x));
case ASEC:
/* csc(arcsec x) = 1/sqrt(x^2-1) */
return reciprocal(sum(square2(x),minusone));
case ACSC:
/* csc(arccsc x) = x */
return square2(x);
case ACOT:
/* csc(arccot x) = sqrt(x^2 + 1) */
return sum(square2(x),one);
default:
return square2(u);
}
case COT:
switch(h)
{ case ATAN:
/* cot(arctan x) = 1/x */
return reciprocal(square2(x));
case ACOS:
/* cot(arccos x) = x/sqrt(1-x^2) */
return make_fraction(square2(x),sum(one,tnegate(square2(x))));
case ACSC:
/* cot(acsc x) = sqrt(x^2-1) */
return sum(square2(x),minusone);
case ASIN:
/* cot(asin x) = sqrt(1-x^2)/x */
return make_fraction(sum(one,tnegate(square2(x))),square2(x));
case ASEC:
/* cot(asec x) = 1/sqrt(x^2-1) */
return reciprocal(sum(square2(x),minusone));
case ACOT:
/* cot(acot x) = x */
return square2(x);
default:
return square2(u);
}
}
return square2(u);
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists