Sindbad~EG File Manager
/*
M. Beeson, for Mathpert
invert_eqn solves some one-one-equations
Original date 3.25.92
Last modified 1.30.98
*/
#include <assert.h>
#include <string.h>
#include "globals.h"
#include "eqn.h"
#include "ops.h"
#include "prover.h"
#include "algaux.h"
#include "pvalaux.h"
#include "inveqn.h"
static term invertible_domain(unsigned f, term x);
static int inveqn_aux(int checkflag, term u, term c, term x, term *ans);
static term trigatrig(unsigned short f,unsigned short g, term x);
static int contains_zero_denom(term t);
/*_________________________________________________________________*/
int invert_eqn(term u,term c,term x,term *ans)
/* solves some one-to-one equations (u=c) assuming complex is off;
including linear equations, equations involving SQRT and ROOT and
trig and argtrig functions. The unknown x must occur only once and only
on the left side, i.e. in u.
returns 0 if *ans solves u = c for x;
returns -1 if equation is impossible, e.g. sin x = 2; in this case
and all other nonzero returns, *ans is garbage.
returns 1 if it can't figure it out, or an error condition arises,
such as a non-one-to-one function.
Example: if u is tan x; then *ans = arctan c
This function just applies inverse functions WITHOUT checking that
the resulting terms are defined. The calling function should then
check that *ans is defined. However, it MUST infer that the
value is in the range where the inverse function is an inverse,
e.g. when tan x = c, don't say x = arctan c unless -\pi/2 < x < \pi/2. */
{ return inveqn_aux(0,u,c,x,ans);
}
/*_________________________________________________________________*/
static int inveqn_aux(int checkflag, term u, term c, term x, term *ans)
/* when checkflag = 0, do the work of invert_eqn; that is, solve
u = c for x, getting x = *ans.
When checkflag is nonzero, do the work of invert_eqn2, i.e.
same as invert_eqn but calling 'check' instead of 'infer'.
*/
{ term a,v,w,temp,denom,num,power,dom;
unsigned short f,g;
int err;
int sign=0;
if(contains(c,FUNCTOR(x))) /* x must appear only on the left */
return 1;
if(equals(u,x)) /* equation already solved */
{ *ans = c;
return 0;
}
if(ATOMIC(u))
return 1; /* should never get such a call */
f = FUNCTOR(u);
v = ARG(0,u);
if(f=='/' && !contains(ARG(1,u),FUNCTOR(x)))
{ polyval(signedproduct(ARG(1,u),c),&temp);
return inveqn_aux(checkflag,v,temp,x,ans);
}
if(f=='/' && !contains(v,FUNCTOR(x)))
{ polyval(signedfraction(v,c),&temp);
return inveqn_aux(checkflag,ARG(1,u),temp,x,ans);
}
if(f=='*')
{ twoparts(u,x,&a,&v);
if(ONE(a))
return 1; /* u is a product of two or more terms containing x */
err = infer(ne(zero,a));
if(!err)
{ polyval(signedfraction(c,a),&temp);
return inveqn_aux(checkflag,v,temp,x,ans);
}
else
return 1;
}
if(f=='+')
{ unsigned short i,n = ARITY(u);
int count=0,marker=0;
term s;
if(n==2) /* common case */
{ for(i=0;i<2;i++)
{ if(!contains(ARG(i,u),FUNCTOR(x)))
{ polyval(sum(c,tnegate(ARG(i,u))),&temp);
return inveqn_aux(checkflag,ARG(i ? 0 : 1,u),temp,x,ans);
}
}
return 1;
}
assert(n > 2);
for(i=0;i<n;i++)
{ s = ARG(i,u);
if(contains(s,FUNCTOR(x)))
{ if(count)
return 1; /* more than one term with x in it */
else
{ ++count;
marker = i;
}
}
}
if(!count)
return 1;
temp = make_term('+',(unsigned short)(n-1));
/* put all the terms except the one with index marker in temp */
for(i=0;i<n;i++)
{ if(i<marker)
ARGREP(temp,i,ARG(i,u));
else if (i> marker)
ARGREP(temp,i-1,ARG(i,u));
}
polyval(sum(c,tnegate(temp)),&a);
return inveqn_aux(checkflag,ARG(marker,u),a,x,ans);
}
if(f=='^' && INTEGERP(ARG(1,u)) && ISODD(ARG(1,u)) && !contains(c,FUNCTOR(x)))
/* x^3 = -1 for example */
{ if(NEGATIVE(c))
{ c = ARG(0,c);
sign = -1;
}
else sign = 1;
if(FUNCTOR(c) == '^')
{ polyval(product(ARG(1,c),reciprocal(ARG(1,u))),&temp);
temp = make_power(ARG(0,c),temp);
}
else
temp = make_power(c,reciprocal(ARG(1,u)));
return inveqn_aux(checkflag,v,(sign == -1 ? tnegate(temp) : temp),x,ans);
}
if(f=='^' && !contains(v,FUNCTOR(x)) ) /* constant base */
{ if(equals(v,eulere))
return inveqn_aux(checkflag,ARG(1,u),ln1(c),x,ans);
else if(!contains(c,FUNCTOR(x)))
return inveqn_aux(checkflag,ARG(1,u),make_fraction(ln1(c),ln1(v)),x,ans);
return 1;
}
if(f=='^' && !contains(ARG(1,u),FUNCTOR(x)))
{ /* lambda(x,x^n) is one-one only if n is an odd integer,
or a rational with an odd denom and odd num */
power = ARG(1,u);
err = infer(le(zero,v));
if(!err) /* then need not worry about whether power is odd or not */
{ polyval(make_power(c,reciprocal(power)),&temp);
return inveqn_aux(checkflag,v,temp,x,ans);
}
if(FUNCTOR(power)=='/')
{ num = ARG(0,power);
denom = ARG(1,power);
if(!INTEGERP(num))
{ err = infer(type(num,INTEGER));
if(err)
return 1;
}
if(!INTEGERP(denom))
{ err = infer(type(denom,INTEGER));
if(err)
return 1;
}
err = infer(odd(denom));
if(err)
return 1;
err = infer(odd(num));
if(err)
return 1;
}
else if(!INTEGERP(power))
{ err = infer(type(power,INTEGER));
if(err)
return 1;
err = infer(odd(power));
if(err)
return 1;
}
err = infer(even(power));
if(!err) /* function isn't one-one, so can't invert */
{ err= infer(le(zero,v)); /* then it would still be ok */
if(err)
{ err = infer(le(v,zero));
if(err)
return 1;
else
sign = -1;
}
else sign = 1;
}
else
{ err = infer(odd(power));
if(err)
return 1; /* can't tell if power is even or odd */
}
polyval(make_power(c,reciprocal(ARG(1,u))),&temp);
err = infer(domain(temp));
if(err)
return -1;
if(sign == -1)
temp = tnegate(temp); /* as when inverting x^2 = 1 when x < 0 is known */
return inveqn_aux(checkflag,v,temp,x,ans);
}
if(f==ROOT)
{ if(contains(v,FUNCTOR(x)))
return 1;
return inveqn_aux(checkflag,ARG(1,u),make_power(c,ARG(0,u)),x,ans);
}
if(ARITY(u) != 1)
return 1;
if(f == '-')
return inveqn_aux(checkflag,v,tnegate(c),x,ans);
dom = invertible_domain(f,x);
if(!equals(dom,trueterm))
{ if(get_nextassumption()==0 && ISATOM(x))
return 1; /* no hope of inferring dom so don't try */
if(ATOMIC(x))
{ sign = immediate(dom);
if(sign == 1)
goto invert; /* eight lines below */
if(sign == -1)
return -1; /* impossible equation */
return 1; /* can't tell */
}
err = infer(dom);
if(err)
return 1;
}
invert: /* there's one jump to here from eight lines above */
/* Now it's ok to invert, we're on the invertible domain */
g = FUNCTOR(v);
if(
(f == SIN || f == COS || f == TAN || f == CSC || f == SEC || f == COT) &&
(g == ASIN || g == ACOS || g == ATAN || g == ACSC || g == ASEC || g == ACOT)
)
{ w = ARG(0,v);
temp = trigatrig(f,g,w);
if(contains_zero_denom(w))
return 1;
return inveqn_aux(checkflag,temp,c,x,ans);
}
err = invert_function(f,c,&temp);
if(err)
return 1;
return inveqn_aux(checkflag,v,temp,x,ans);
}
/*_________________________________________________________________*/
int invert_eqn2(term u,term c,term x,term *ans)
/* Like invert_eqn, but calls 'check' where invert_eqn calls
'infer'. So it solves equations if at all possible, making
assumptions right and left to do so. */
{ return inveqn_aux(1,u,c,x,ans);
}
/*________________________________________________________________*/
int invert_function(unsigned f, term c, term *ans)
/* return f^(-1)(c) in *ans; return 0 for success, 1 for failure.
Does not check whether *ans is defined, but does infer the
condition for arctrig functions to be inverses. */
{ switch(f)
{ case TAN : *ans = atan1(c); break;
case SIN : *ans = asin1(c); break;
case COS : *ans = acos1(c); break;
case SEC : *ans = asec1(c); break;
case CSC : *ans = acsc1(c); break;
case COT : *ans = atan1(reciprocal(c)); break;
case LN : *ans = make_power(eulere,c); break;
case SQRT: *ans = make_power(c,two); break;
case COSH: *ans = acosh1(c); break;
case SINH: *ans = asinh1(c); break;
case TANH: *ans = atanh1(c); break;
case SECH: *ans = asech1(c); break;
case CSCH: *ans = acsch1(c); break;
case COTH: *ans = atanh1(reciprocal(c)); break;
case ATAN : *ans = tan1(c); break;
case ASIN : *ans = sin1(c); break;
case ACOS : *ans = cos1(c); break;
case ASEC : *ans = sec1(c); break;
case ACSC : *ans = csc1(c); break;
case ACOT : *ans = cot1(c); break;
case ACOSH: *ans = cosh1(c); break;
case ASINH: *ans = sinh1(c); break;
case ATANH: *ans = tanh1(c); break;
case ASECH: *ans = sech1(c); break;
case ACSCH: *ans = csch1(c); break;
case ACOTH: *ans = tanh1(reciprocal(c)); break;
default: return 1;
}
return 0;
}
/*________________________________________________________________*/
static term invertible_domain(unsigned f, term x)
/* return the expression defining the set of x for which f is invertible
For example, when f == TAN, arctan is the inverse of f when -\pi/2 < x < \pi/2.
If f is not one of the functions with a partial inverse, return true
The answer defines the invertible domain as a subset of dom(f(x));
for example for f=SQRT we return true
because f is invertible on its whole domain.
*/
{ switch(f)
{ case TAN : return and(lessthan(tnegate(piover2),x),lessthan(x,piover2));
case SIN : return and(le(tnegate(piover2),x),le(x,piover2));
case COS : return and(le(zero,x),le(x,pi_term));
case SEC : return and(lessthan(zero,x),lessthan(x,pi_term));
case CSC : return and(lessthan(tnegate(piover2),x),lessthan(x,piover2));
case COT : return and(lessthan(zero,x),lessthan(x,pi_term));
case ABSFUNCTOR : return le(zero,x);
case COSH: return le(zero,x);
case SECH: return le(zero,x);
case CSCH: return ne(x,zero); /* sinh y = 1/x can be solved if x != 0 */
}
return trueterm;
}
/*_________________________________________________________________________*/
static term trigatrig(unsigned short f,unsigned short g, term x)
/* f is a trig functor (SIN, COS, TAN, CSC, SEC, or CSC), and
g is an arctric functor (ASIN, ACOS, ATAN, ACSC, ASEC, or ACSC).
Return the simplified form of f(g(x)), which will be an algebraic
function of x, and return 0.
*/
{ switch(g)
{ case ASIN:
switch(f)
{ case SIN: return x;
case COS: return make_sqrt(sum(one,tnegate(square2(x))));
case TAN: return make_fraction(x, make_sqrt(sum(one,tnegate(square2(x)))));
case SEC: return reciprocal(make_sqrt(sum(one,tnegate(square2(x)))));
case CSC: return reciprocal(x);
case COT: return make_fraction(make_sqrt(sum(one,tnegate(square2(x)))),x);
}
break;
case ACOS:
switch(f)
{ case SIN: return make_sqrt(sum(one,tnegate(square2(x))));
case COS: return x;
case TAN: return make_fraction(sum(one,tnegate(square2(x))),x);
case SEC: return reciprocal(x);
case CSC: return reciprocal(sum(one,tnegate(square2(x))));
case COT: return make_fraction(x,sum(one,tnegate(square2(x))));
}
break;
case ATAN:
switch(f)
{ case SIN: return make_fraction(x,make_sqrt(sum(square2(x),one)));
case COS: return reciprocal(make_sqrt(sum(square2(x),one)));
case TAN: return x;
case SEC: return make_sqrt(sum(square2(x),one));
case CSC: return make_fraction(x,make_sqrt(sum(square2(x),one)));
case COT: return reciprocal(x);
}
break;
case ACSC:
switch(f)
{ case SIN: return reciprocal(x);
case COS: return make_fraction(make_sqrt(sum(square2(x),minusone)),x);
case TAN: return reciprocal(make_sqrt(sum(square2(x),minusone)));
case SEC: return make_fraction(x,make_sqrt(sum(square2(x),minusone)));
case CSC: return x;
case COT: return make_sqrt(sum(square2(x),minusone));
}
break;
case ASEC:
switch(f)
{ case SIN: return make_fraction(make_sqrt(sum(square2(x),minusone)),x);
case COS: return reciprocal(x);
case TAN: return make_sqrt(sum(square2(x),minusone));
case SEC: return x;
case CSC: return make_fraction(x,make_sqrt(sum(square2(x),minusone)));
case COT: return reciprocal(make_sqrt(sum(square2(x),minusone)));
}
break;
case ACOT:
switch(f)
{ case SIN: return reciprocal(make_sqrt(sum(square2(x),one)));
case COS: return make_fraction(x,make_sqrt(sum(square2(x),one)));
case TAN: return reciprocal(x);
case SEC: return make_fraction(make_sqrt(sum(square2(x),one)),x);
case CSC: return make_sqrt(sum(square2(x),one));
case COT: return x;
}
break;
}
assert(0);
return x;
}
/*__________________________________________________________________________*/
static int contains_zero_denom(term t)
/* return 1 if t contains a zero (literally) in a denominator */
{ unsigned short n;
int i;
if(ATOMIC(t))
return 0;
if(FRACTION(t) && ZERO(ARG(1,t)))
return 1;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(contains_zero_denom(ARG(i,t)))
return 1;
}
return 0;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists