Sindbad~EG File Manager
/*
MathXpert log and ln operators
M. Beeson
1.11.91 original date
3.30.99 last modified
6.21.04 added lnrecip, logrecip, logbrecip
*/
#include <string.h>
#include <assert.h>
#include <math.h>
#define TRIGCALC_DLL
#include "globals.h"
#include "probtype.h"
#include "dcomplex.h"
#include "ceval.h"
#include "deval.h"
#include "prover.h"
#include "order.h"
#include "ops.h" /* collectpowers */
#include "trig.h" /* attractlns */
#include "eqn.h" /* econstant */
#include "pvalaux.h" /* topflatten */
#include "symbols.h"
#include "errbuf.h"
#include "autosimp.h" /* SetShowStepOperation, get_lastbase */
#include "nfactor.h"
static int perfect_power(term, term *, term *);
static int collectlogs_aux(unsigned short, term, term, term *, char *);
/*_________________________________________________________________*/
static int logpower_aux(term t,term arg,term *next,char *reason)
/* ln a� = n ln a , also for log and logb */
/* Do the work of the next three operators */
{ term n,a,u;
int err,absflag=0;
unsigned short f = FUNCTOR(t);
assert(f == LN || f == LOG || f == LOGB);
u = f == LOGB ? ARG(1,t) : ARG(0,t);
if(FUNCTOR(u) == ABS)
{ u = ARG(0,u);
absflag = 1;
}
if(FUNCTOR(u) != '^')
return 1;
n = ARG(1,u);
a = ARG(0,u);
err = check(type(n,R));
if(err)
{ errbuf(0, english(659));
/* That operation requires the exponent to be real. */
return 1;
}
if(!absflag)
{ err = infer(le(zero,a)); /* Not lessthan, just le, because both
sides require a != 0 already, so
it's only a question of whether
we need an absolute value sign or not */
if(!err)
{ if(f==LN)
strcpy(reason, english(1138)); /* ln a� = n ln a */
else
strcpy(reason, english(1140)); /* log a� = n log a */
}
else if(err && !get_complex())
{ a = abs1(a);
if(f==LN)
strcpy(reason, english(1139)); /* ln a� = n ln |a| */
else
strcpy(reason, english(1141)); /* log a� = n log |a| */
}
else /* if err && complex */
{ errbuf(0, english(1137));
/* Express complex log in polar form first */
return 1;
}
}
else
strcpy(reason, f==LN ? english(1138) : english(1140));
/* ln a� = n ln a or log a� = n log a */
switch(f)
{ case LN:
*next = signedproduct(n,ln1(a));
break;
case LOG:
*next = signedproduct(n,log1(a));
break;
case LOGB:
*next = signedproduct(n,logb1(ARG(0,t),a));
break;
}
HIGHLIGHT(*next);
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int lnofpowerreverse(term t, term arg, term *next, char *reason)
/* ln u = (1/a) ln u^a */
/* a is in 'arg' */
/* Used in auto mode e.g. to calculate diff(ln x, x) from defn */
{ term u;
if(FUNCTOR(t) != LN)
return 1;
u = ARG(0,t);
if(FUNCTOR(arg) == ILLEGAL)
{ /* given ln(1+b) select arg = reciprocal(b); but this should
only be done if inside a limit and b is going to zero, so
make sure this is only called in automode in those circumstances. */
int i,err;
int nvariables;
term limit,v,temp;
varinf *varinfo = get_varinfo();
if(FUNCTOR(u) != '+')
return 1;
if(!equals(ARG(0,u),one))
return 1;
if(ARITY(u) == 2)
arg = ARG(1,u);
else
{ unsigned short n = (unsigned short)(ARITY(u)-1);
int i;
arg = make_term('+',n);
for(i=0;i<n;i++)
ARGREP(arg,i,ARG(i+1,u));
}
/* Now check that arg approaches zero. For that we have
to find the limit variable and find out whether it is a one-sided
or two-sided limit. The only way we can be here with originally
ILLEGAL arg is in automode inside a limit, and in that case
the 'locus' of the bound variable was set by autosimp.
Get that locus. */
nvariables = get_nvariables();
for(i=0;i<nvariables;i++)
{ if(varinfo[i].scope == BOUND && FUNCTOR(varinfo[i].locus) == LIMIT)
break;
}
if(i==nvariables)
return 1;
limit = varinfo[i].locus;
v = make_term(LIMIT,ARITY(limit));
ARGREP(v,0,ARG(0,limit));
if(ARITY(limit) == 3)
{ ARGREP(v,1,ARG(1,limit));
ARGREP(v,2,arg);
}
else
ARGREP(v,1,arg);
err = limval(v,&temp);
if(err)
return 1; /* can't calculate the limit */
if(!ZERO(temp))
return 1; /* arg doesn't go to zero */
*next = product(arg, ln1(make_power(u,reciprocal(arg))));
inhibit(attractlns); /* to prevent a loop. It gets
released when the limit is evaluated
using defnofe */
}
else
*next = product(reciprocal(arg),ln1(make_power(u,arg)));
HIGHLIGHT(*next);
strcpy(reason, "ln u = (1/a) ln u^a");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logofpowerreverse(term t, term arg, term *next, char *reason)
/* log u = (1/a) log u^a */
/* a is in 'arg' */
/* Not used in auto mode */
{ term u;
if(FUNCTOR(t) != LOG || ARITY(t) != 1)
return 1;
u = ARG(0,t);
if(FUNCTOR(arg) == ILLEGAL)
return 1;
*next = product(reciprocal(arg),log1(make_power(u,arg)));
HIGHLIGHT(*next);
strcpy(reason, "log u = (1/a) log u^a");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int lnofpower(term t, term arg, term *next, char *reason)
/* ln a� = n ln a */
{ if(FUNCTOR(t) != LN)
return 1;
return logpower_aux(t,arg,next,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logofpower(term t, term arg, term *next, char *reason)
/* log a� = n log a, provided a > 0 */
{ if(FUNCTOR(t) != LOG)
return 1;
return logpower_aux(t,arg,next,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logbofpower(term t, term arg, term *next, char *reason)
/* logb a� = n logb a */
{ if(FUNCTOR(t) != LOGB)
return 1;
return logpower_aux(t,arg,next,reason);
}
/*____________________________________________________________*/
static int logproduct_aux(term t, term arg, term *next, char *reason)
/* do the work of the next three operators */
/* ln ab = ln a + ln b and so on for log and logb */
{ int i,err;
int flag = 0;
int absflag = 0;
unsigned short n;
term temp,v;
unsigned short f = FUNCTOR(t);
term u = f == LOGB ? ARG(1,t) : ARG(0,t);
if(FUNCTOR(u)==ABS)
{ absflag = 1;
u = ARG(0,u);
}
if(FUNCTOR(u)!= '*')
return 1;
n = ARITY(u);
*next = make_term('+',n);
for(i=0;i<n;i++)
{ temp = ARG(i,u);
if(!absflag)
{ err = infer(le(zero,temp)); /* le is enough to use x instead of abs(x),
we don't need to infer lessthan(zero,temp) */
if(err && get_complex())
{ errbuf(0, english(1137));
/* Express complex log in polar form first */
errbuf(1,english(2371));
errbuf(2,english(2372));
errbuf(3,english(2373));
/* The law $ln(ab) = ln a + ln b$ is not always correct.
The two sides can differ by a multiple of $2 pi i$.
For example, try the case when $a$ and $b$ are both $-1$.
*/
return 1;
}
if(err) /* && !complex */
flag = 1;
}
else
err = 1;
switch(f)
{ case LN :
v = ln1(err? abs1(temp) : temp);
break;
case LOG:
v = log1(err? abs1(temp) : temp);
break;
case LOGB:
v = logb1(ARG(0,t),err? abs1(temp) : temp);
break;
}
ARGREP(*next,i,v);
}
if(absflag)
flag = 1;
HIGHLIGHT(*next);
if(flag && f == LN)
strcpy(reason, english(1142)); /* ln ab = ln|a| + ln|b| */
else if(f==LN)
strcpy(reason, english(1143)); /* ln ab = ln a + ln b */
else if(flag)
strcpy(reason, english(1144)); /* log ab = log|a| + log|b| */
else
strcpy(reason, english(1145)); /* log ab = log a + log b */
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int lnofproduct(term t, term arg, term *next, char *reason)
{ if(FUNCTOR(t) != LN)
return 1;
return logproduct_aux(t,arg,next,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logofproduct(term t, term arg, term *next, char *reason)
{ if(FUNCTOR(t) != LOG)
return 1;
return logproduct_aux(t,arg,next,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logbofproduct(term t, term arg, term *next, char *reason)
{ if(FUNCTOR(t) != LOGB)
return 1;
return logproduct_aux(t,arg,next,reason);
}
/*_________________________________________________________________*/
static int logreciprocal_aux(term t, term arg, term *next, char *reason)
/* Do the work of lnofreciprocal, logofreciprocal, logbofreciprocal */
{ term u,a;
int absflag = 0;
unsigned short f = FUNCTOR(t);
u = f == LOGB ? ARG(1,t) : ARG(0,t);
if(FUNCTOR(u) == ABS)
{ absflag = 1;
u = ARG(0,u);
}
if(FUNCTOR(u)!= '/')
return 1;
if(!ONE(ARG(0,u)))
return 1;
a = ARG(1,u);
if(absflag)
a = abs1(a);
switch(f)
{ case LOG:
*next = tnegate(log1(a));
strcpy(reason,"log(1/a) = -log a");
break;
case LN:
*next = tnegate(ln1(a));
strcpy(reason,"ln (1/a) = -ln a");
break;
case LOGB:
*next = tnegate(logb1(ARG(0,t),a));
strcpy(reason,"log (1/a) = -log a");
}
HIGHLIGHT(*next);
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logofreciprocal(term t, term arg, term *next, char *reason)
/* log(1/a) = -log a */
{ if(FUNCTOR(t) != LOG)
return 1;
return logreciprocal_aux(t,arg,next,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int lnofreciprocal(term t, term arg, term *next, char *reason)
/* ln(1/a) = -ln a */
{ if(FUNCTOR(t) != LN)
return 1;
return logreciprocal_aux(t,arg,next,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logbofreciprocal(term t, term arg, term *next, char *reason)
/* log(b,1/a) = -log(b,a) */
{ if(FUNCTOR(t) != LOGB)
return 1;
return logreciprocal_aux(t,arg,next,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int loginexponent(term t, term arg, term *next, char *reason)
/* 10^log a = a provided a>0 */
{ int err;
if(FUNCTOR(t) != '^')
return 1;
if(! ISINTEGER(ARG(0,t)))
return 1;
if( INTDATA(ARG(0,t)) != 10)
return 1;
if(FUNCTOR(ARG(1,t)) != LOG)
return 1;
*next = ARG(0,ARG(1,t));
if(!get_complex())
{ err = infer(positive(*next));
if(err)
*next = abs1(*next);
}
HIGHLIGHT(*next);
strcpy(reason,"10^(log a) = a");
release(collectpowers); /* possibly inhibited by reversecollectpowers
when it rewrote 10^(a+log b)=>10^a 10^log b */
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int lninexponent(term t, term arg, term *next, char *reason)
/* e^ln a = a provided a>0 */
{ int err;
term power;
if(FUNCTOR(t) != '^')
return 1;
if(! equals(ARG(0,t),eulere))
return 1;
power = ARG(1,t);
if(FUNCTOR(power) != LN)
return 1;
*next = ARG(0,power);
if(!get_complex() && get_polyvaldomainflag())
{ err = check(positive(*next));
if(err)
return 1;
}
HIGHLIGHT(*next);
strcpy(reason,"e^(ln a) = a");
release(collectpowers); /* possibly inhibited by reversecollectpowers
when it rewrote e^(a+ln b)=>e^a e^ln b */
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int lninexponent2(term t, term arg, term *next, char *reason)
/* e^((ln c) x) = c^x */
{ int i,k,err;
unsigned short n;
term power,u,a;
if(FUNCTOR(t) != '^')
return 1;
if(! equals(ARG(0,t),eulere))
return 1;
power = ARG(1,t);
if(FUNCTOR(power) != '*')
return 1;
n = ARITY(power);
for(k=0;k<n;k++)
{ if(FUNCTOR(ARG(k,power))==LN)
break;
}
if(k==n)
return 1;
else
a = ARG(0,ARG(k,power));
if(! get_complex())
{ err = infer(positive(a));
if(err)
a = abs1(a);
}
if(n == 2)
u = k ? ARG(0,power) : ARG(1,power);
else
{ u = make_term('*',(unsigned short)(n-1));
for(i=0;i<k;i++)
ARGREP(u,i,ARG(i,power));
for(i=k+1;i<n;i++)
ARGREP(u,i-1,ARG(i,power));
}
*next = make_power(a,u);
HIGHLIGHT(*next);
strcpy(reason, "e^((ln c) a) = c^a");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logbinexponent(term t, term arg, term *next, char *reason)
/* b^log(b,a) = a provided a>0 */
{ int err;
if(FUNCTOR(t) != '^')
return 1;
if(FUNCTOR(ARG(1,t)) != LOGB)
return 1;
if(! equals(ARG(0,t),ARG(0,ARG(1,t))))
return 1;
*next = ARG(1,ARG(1,t));
if(!get_complex())
{ err = infer(positive(*next));
if(err)
*next = abs1(*next);
}
HIGHLIGHT(*next);
strcpy(reason,"b^(log(b,a)) = a");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logbinexponent2(term t, term arg, term *next, char *reason)
/* b^(n log(b,a)) = a^n */
{ int i,k,err;
unsigned short n;
term power,base,a,u;
if(FUNCTOR(t) != '^')
return 1;
base = ARG(0,t);
power = ARG(1,t);
if(FUNCTOR(power) != '*')
return 1;
n = ARITY(power);
for(k=0;k<n;k++)
{ if(FUNCTOR(ARG(k,power))==LOGB && equals(base,ARG(0,ARG(k,power))))
break;
}
if(k==n)
return 1;
a = ARG(1,ARG(k,power));
if(! get_complex())
{ err = infer(positive(a));
if(err)
a = abs1(a);
}
if(n == 2)
u = k ? ARG(0,power) : ARG(1,power);
else
{ u = make_term('*',(unsigned short)(n-1));
for(i=0;i<k;i++)
ARGREP(u,i,ARG(i,power));
for(i=k+1;i<n;i++)
ARGREP(u,i-1,ARG(i,power));
}
*next = make_power(a,u);
HIGHLIGHT(*next);
strcpy(reason, "b^(n log(b,a)) = a^n");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int loginexponent2(term t, term arg, term *next, char *reason)
/* 10^(n log a) = a^n */
{ int i,k,err;
unsigned short n;
term power,a,u;
if(FUNCTOR(t) != '^')
return 1;
if(!equals(ARG(0,t),ten))
return 1 ;
power = ARG(1,t);
if(FUNCTOR(power) != '*')
return 1;
n = ARITY(power);
for(k=0;k<n;k++)
{ if(FUNCTOR(ARG(k,power))==LOG)
break;
}
if(k==n)
return 1;
a = ARG(0,ARG(k,power));
if(! get_complex())
{ err = infer(positive(a));
if(err)
a = abs1(a);
}
if(n == 2)
u = k ? ARG(0,power) : ARG(1,power);
else
{ u = make_term('*',(unsigned short)(n-1));
for(i=0;i<k;i++)
ARGREP(u,i,ARG(i,power));
for(i=k+1;i<n;i++)
ARGREP(u,i-1,ARG(i,power));
}
*next = make_power(a,u);
HIGHLIGHT(*next);
strcpy(reason, "10^(n log a) = a^n");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logofpowerof10(term t, term arg, term *next, char *reason)
/* log 10� = n if n real */
{ term b,n;
int err;
if(FUNCTOR(t) != LOG)
return 1;
if(FUNCTOR(ARG(0,t))!= '^')
return 1;
b = ARG(0,ARG(0,t));
if(!(ISINTEGER(b) && INTDATA(b) == 10))
return 1;
n = ARG(1,ARG(0,t));
err = check(type(n,R));
if(err)
{ errbuf(0, english(659));
/* That operation requires the exponent to be real. */
return 1;
}
*next = ARG(1,ARG(0,t));
HIGHLIGHT(*next);
strcpy(reason,"log 10^n = n");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int lnofpowerofe(term t, term arg, term *next, char *reason)
/* ln e� = n */
{ term b,n;
int err;
if(FUNCTOR(t) != LN)
return 1;
if(FUNCTOR(ARG(0,t))!= '^')
return 1;
b = ARG(0,ARG(0,t));
if(! equals(b,eulere))
return 1;
n = ARG(1,ARG(0,t));
err = check(type(n,R));
if(err)
{ errbuf(0, english(659));
/* That operation requires the exponent to be real. */
return 1;
}
*next = ARG(1,ARG(0,t));
HIGHLIGHT(*next);
strcpy(reason,"ln e^n = n");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logbofb(term t, term arg, term *next, char *reason)
/* logb b = 1 */
{ if(FUNCTOR(t) != LOGB)
return 1;
if(! equals(ARG(0,t),ARG(1,t)))
return 1;
*next = one;
HIGHLIGHT(*next);
strcpy(reason,"log(b,b) = 1");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logbofpowerofb(term t, term arg, term *next, char *reason)
/* logb b� = n */
/* logb b = 1 */
{ term b;
int err;
if(FUNCTOR(t) != LOGB)
return 1;
if(equals(ARG(0,t),ARG(1,t)))
{ *next = one;
HIGHLIGHT(*next);
strcpy(reason,"log(b,b) = 1");
SetShowStepOperation(logbofb);
return 0;
}
if(FUNCTOR(ARG(1,t))!= '^')
return 1;
b = ARG(0,ARG(1,t));
if(! equals(b,ARG(0,t)))
return 1;
*next = ARG(1,ARG(1,t));
err = check(type(*next,R));
if(err)
{ errbuf(0, english(659));
return 1;
}
HIGHLIGHT(*next);
strcpy(reason,"log(b,b^n) = n");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logpowerofbofb(term t, term arg, term *next, char *reason)
/* log(b�,b) = 1/n or more generally,
log(b�,u) = 1/n log(b,u) */
/* also works when first arg is a number equal to b� */
{ term b,u;
int err;
double x,y;
long n;
if(FUNCTOR(t) != LOGB)
return 1;
u = ARG(1,t);
if(equals(ARG(0,t),u))
{ *next = one;
HIGHLIGHT(*next);
strcpy(reason,"log(b,b) = 1");
SetShowStepOperation(logbofb);
return 0;
}
if(FUNCTOR(ARG(0,t)) == '^')
{ err = check(type(ARG(1,ARG(0,t)),R));
if(err)
{ errbuf(0, english(659));
return 1;
}
b = ARG(0,ARG(0,t));
if(equals(b,u))
{ *next = reciprocal(ARG(1,ARG(0,t)));
strcpy(reason,"log(b^n,b) = 1/n");
HIGHLIGHT(*next);
return 0;
}
*next = product(reciprocal(ARG(1,ARG(0,t))),logb1(b,u));
goto out;
}
if(seminumerical(ARG(0,t)) && seminumerical(ARG(1,t)))
{ err = deval(ARG(0,t),&x);
if(err)
return 1;
err = deval(ARG(1,t),&y);
if(err)
return 1;
if(x <=0.0 || y <= 0.0)
return 1;
if(!nearint(log(x)/log(y),&n))
return 1;
if(get_mathmode() == AUTOMODE)
{ err = factorlogbase(t,arg,next,reason);
if(!err)
return 0; /* SetShowStepOperation has been called
by factorlogbase. */
}
*next = reciprocal(make_int(n));
strcpy(reason,"log(b^n,b) = 1/n");
HIGHLIGHT(*next);
return 0;
}
return 1;
out:
HIGHLIGHT(*next);
strcpy(reason,"log(b^n,x)=log(b,x)/n");
return 0;
}
/*_________________________________________________________________*/
static int logofquotient_aux(int absflag, term t, term *next, term base,unsigned short f, char *reason)
/* t is a quotient, simplify log t, ln t, or log(base,t),
checking signs of the num and denom, in order
to do the work of the next two operators */
/* f is LN, LOG, or LOGB. You have to pass f, not just base, because
log and logb1(10,..) are distinct functions.
Return 0 for success, 1 for failure. */
/* absflag, if nonzero, means the original input was log |a/b| */
{ term a,b;
int err, signa, signb;
if(FUNCTOR(t) != '/')
return 1;
a = ARG(0,t);
b = ARG(1,t);
if(absflag)
{ signa = signb = 0;
a = abs1(a);
b = abs1(b);
}
else if(get_complex())
signa = signb = 1;
else
{ err = infer(le(zero,a));
if(!err)
signa = 1;
else
{ err = infer(le(a,zero));
if(!err)
{ signa = -1;
a = tnegate(a);
}
else
{ signa = 0;
a = abs1(a);
}
}
err = infer(le(zero,b));
if(!err)
signb = 1;
else
{ err = infer(le(b,zero));
if(!err)
{ signb = -1;
b = tnegate(b);
}
else
{ signb = 0;
b = abs1(b);
}
}
}
if(f==LOG)
{ *next = sum(log1(a),tnegate(log1(b)));
if(signa * signb)
strcpy(reason,"log a/b =log a-log b");
else
strcpy(reason,"log a/b=log|a|-log|b|");
}
else if (f==LN)
{ *next = sum(ln1(a),tnegate(ln1(b)));
if(signa * signb)
strcpy(reason,"ln a/b = ln a - ln b");
else
strcpy(reason,"ln a/b = ln|a|-ln|b|");
}
else /* f must be LOGB */
{ *next = sum(logb1(base,a),tnegate(logb1(base,b)));
if(signa * signb)
strcpy(reason,"log a/c = log a-log c");
else
strcpy(reason,"log a/b=log|a|-log|b|");
/* log(b,.. makes it too long */
}
HIGHLIGHT(*next);
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logofquotient(term t, term arg, term *next, char *reason)
/* log a/b = log a - log b */
{ term u;
int absflag = 0;
if(FUNCTOR(t) != LOG)
return 1;
u = ARG(0,t);
if(FUNCTOR(u) == ABS)
{ u = ARG(0,u);
absflag = 1;
}
if(!FRACTION(u))
return 1;
return logofquotient_aux(absflag,u,next,ten,LOG,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int lnofquotient(term t, term arg, term *next, char *reason)
/* ln a/b = ln a - ln b */
{ term u;
int absflag = 0;
if(FUNCTOR(t) != LN)
return 1;
u = ARG(0,t);
if(FUNCTOR(u) == ABS)
{ u = ARG(0,u);
absflag = 1;
}
if(!FRACTION(u))
return 1;
return logofquotient_aux(absflag,u,next,eulere,LN,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logbofquotient(term t, term arg, term *next, char *reason)
/* log a/c = log a - log c */
{ term u;
int absflag = 0;
if(FUNCTOR(t) != LOGB)
return 1;
u = ARG(1,t);
if(FUNCTOR(u) == ABS)
{ u = ARG(0,u);
absflag = 1;
}
if(!FRACTION(u))
return 1;
return logofquotient_aux(absflag,u,next,ARG(0,t),LOGB,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logofone(term t, term arg, term *next, char *reason)
{ if(FUNCTOR(t) != LOG)
return 1;
if(!ONE(ARG(0,t)))
return 1;
*next = zero;
HIGHLIGHT(*next);
strcpy(reason,"log 1 = 0");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int lnofone(term t, term arg, term *next, char *reason)
{ if(FUNCTOR(t) != LN)
return 1;
if(!ONE(ARG(0,t)))
return 1;
*next = zero;
HIGHLIGHT(*next);
strcpy(reason,"ln 1 = 0");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logbofone(term t, term arg, term *next, char *reason)
{ if(FUNCTOR(t) != LOGB)
return 1;
if(!ONE(ARG(1,t)))
return 1;
*next = zero;
HIGHLIGHT(*next);
strcpy(reason,"log(b,1) = 0");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logoften(term t, term arg, term *next, char *reason)
/* log 10 = 1 */
{ if(FUNCTOR(t) != LOG)
return 1;
if(!equals(ARG(0,t),ten))
return 1;
*next = one;
HIGHLIGHT(*next);
strcpy(reason,"log 10 = 1");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int lnofe(term t, term arg, term *next, char *reason)
/* ln e = 1 */
{ if(FUNCTOR(t) != LN)
return 1;
if(!equals(ARG(0,t),eulere))
return 1;
*next = one;
HIGHLIGHT(*next);
strcpy(reason,"ln e = 1");
return 0;
}
/*_________________________________________________________________*/
static int collectlogs_aux(unsigned short f,term t, term arg, term *next, char *reason)
/* collectlogs, collectlns, and collectlogb call this function to do the work */
/* f must be either LOG or LN or LOGB */
/* if f is LOGB, then arg contains the index of the first LOGB term */
/* This operator has to set checksolutionsflag = 1 because, for example,
when ln x - ln(x+1) is collected, the new expression ln(x/(x+1)) has
a larger domain than the original function! */
/* In automode, this is used when the sum is in an exponent,
or when solving equations. */
{ term u,num, denom,temp,ans;
int i,flag,problemtype;
unsigned short k,p,q;
int flattenflag = 0; /* set if one of the collected logs has a product for an arg */
int flattenflag2 = 0; /* similarly for the product going into the denom */
unsigned short n;
unsigned short count = 0; /* count the nonconstant log terms */
if(FUNCTOR(t) != '+')
return 1;
n = ARITY(t);
p=q=0;
/* Go through the summands of t and put them into three piles:
positive logs, negative logs, and non-logs. Build products
of the positive and negative logs' args in num and denom */
num = make_term('*',n);
denom = make_term('*',n);
if(f==LOG || f == LN)
{ for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u)==f)
{ ARGREP(num,p,ARG(0,u));
++p;
if(! econstant(ARG(0,u)))
++count;
if(FUNCTOR(ARG(0,u)) == '*')
flattenflag = 1;
}
else if(FUNCTOR(u)=='-' && FUNCTOR(ARG(0,u))==f)
{ ARGREP(denom,q,ARG(0,ARG(0,u)));
++q;
if(! econstant(ARG(0,ARG(0,u))))
++count;
if(FUNCTOR(ARG(0,ARG(0,u))) == '*')
flattenflag2 = 1;
}
}
}
else if(f==LOGB)
{ for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u)==LOGB && equals(arg,ARG(0,u)))
{ ARGREP(num,p,ARG(1,u));
++p;
if(! econstant(ARG(1,u)))
++count;
if(FUNCTOR(ARG(1,u)) == '*')
flattenflag = 1;
}
else if(FUNCTOR(u)=='-' && FUNCTOR(ARG(0,u))==LOGB && equals(arg,ARG(0,ARG(0,u))))
{ ARGREP(denom,q,ARG(1,ARG(0,u)));
++q;
if(! econstant(ARG(1,ARG(0,u))))
++count;
if(FUNCTOR(ARG(1,ARG(0,u))) == '*')
flattenflag2 = 1;
}
}
}
if(p+q < 2)
return 1; /* forget it, nothing to collect */
/* Formerly 'count' was used to avoid collecting constant logs,
but consider log 5 + log x = 2; we WANT to collect constant logs too. */
if(p==0)
{ RELEASE(num);
num = one;
}
else if(p==1)
{ temp = ARG(0,num);
RELEASE(num);
num = temp;
}
else
{ SETFUNCTOR(num,'*',p);
if(flattenflag)
num = topflatten(num);
sortargs(num);
}
if(q==0)
{ RELEASE(denom);
denom = one;
}
else if(q==1)
{ temp = ARG(0,denom);
RELEASE(denom);
denom = temp;
}
else
{ SETFUNCTOR(denom,'*',q);
if(flattenflag2)
denom = topflatten(denom);
sortargs(denom);
}
if(ONE(denom))
{ if(f==LOGB)
{ ans = make_term(f,2);
ARGREP(ans,0,arg);
ARGREP(ans,1,num);
}
else
{ ans = make_term(f,1);
ARGREP(ans,0,num);
}
}
else if(f==LOGB)
{ ans = make_term(f,2);
ARGREP(ans,0,arg);
ARGREP(ans,1,make_fraction(num,denom));
}
else
{ ans = make_term(f,1);
ARGREP(ans,0,make_fraction(num,denom));
}
HIGHLIGHT(ans);
if(f==LOG || f == LOGB)
{ if(p==1 && q>0)
strcpy(reason,"log a-log b=log a/b");
else if(q==0)
strcpy(reason,"log a+log b = log ab");
else
strcpy(reason,"log a + log b - log c = log ab/c");
}
else if(f==LN)
{ if(p==1 && q>0)
strcpy(reason,"ln a - ln b = ln a/b");
else if(q==0)
strcpy(reason,"ln a + ln b = ln ab");
else
strcpy(reason,"ln a + ln b - ln c = ln ab/c");
}
if(p+q==n) /* answer is only one term */
{ *next = ans;
problemtype = get_problemtype();
if(SOLVETYPE(problemtype) && count >= 2)
{ set_checksolutionsflag(1);
for(i=0;i<4;i++)
commentbuf(i, english(662+i));
/* The new equation may have solutions that are not solutions
of the previous equation, since log(ab) is defined when both
a and b are negative, but log a and log b are not. Remember
to check your final solution(s) in the original equation. */
if(q > 0 && p == 1)
commentbuf(1, english(1843)); /* log(a/b) instead of log(ab) */
}
return 0;
}
/* there are non-log terms, so put the log terms where the first log term was */
*next = make_term('+',(unsigned short)(n-p-q+1));
assert(n>=2);
k=0;
flag=0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u) != f && !(FUNCTOR(u)=='-' && FUNCTOR(ARG(0,u))==f))
{ ARGREP(*next,k,u);
++k;
}
else if(!flag)
{ ARGREP(*next,k,ans);
++k;
flag =1;
}
}
assert(k==ARITY(*next)); /* all argument slots were filled */
problemtype = get_problemtype();
if(SOLVETYPE(problemtype) && count >= 2)
{ set_checksolutionsflag(1);
for(i=0;i<4;i++)
commentbuf(i, english(662+i));
if(q > 0 && p==1)
commentbuf(1, english(1151));
/* mention log(a/b) instead of log(ab) */
}
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int collectlogs(term t, term arg, term *next, char *reason)
/* log a + log b = log ab */
{ return collectlogs_aux(LOG,t,arg,next,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int collectlns(term t, term arg, term *next, char *reason)
/* ln a + ln b = ln ab */
{ return collectlogs_aux(LN,t,arg,next,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int collectlogb(term t, term arg, term *next, char *reason)
/* log a + log b = log ab */
{ int i,j;
term index,u,v;
unsigned short n;
if(FUNCTOR(t) != '+')
return 1;
/* find the first two logb terms with same index */
n = ARITY(t);
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(NEGATIVE(u))
u = ARG(0,u);
if(FUNCTOR(u) == LOGB)
{ index = ARG(0,u);
for(j=i+1;j<n;j++)
{ v = ARG(j,t);
if(NEGATIVE(v))
v = ARG(0,v);
if(FUNCTOR(v) == LOGB && equals(ARG(0,v),index))
break;
}
if(j < n)
break;
}
}
if(i==n)
return 1; /* no two LOGB's with same index */
arg = index; /* use arg to pass the index */
return collectlogs_aux(LOGB,t,arg,next,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int collectlogs2(term t, term arg, term *next, char *reason)
/* log a - log b = log a/b */
/* it just calls collectlogs after checking for at least one minus log term */
{ term u;
int i,count,minuscount;
unsigned short n;
if(FUNCTOR(t) != '+')
return 1;
n = ARITY(t);
count = minuscount = 0;
for(i=0;i<n;i++) /* count the plus and minus log terms */
{ u = ARG(i,t);
if(FUNCTOR(u)==LOG)
++count;
if(FUNCTOR(u) == '-' && FUNCTOR(ARG(0,u))==LOG)
++minuscount;
}
if(minuscount==0)
return 1;
if(count == 0 && minuscount == 1)
return 1;
return collectlogs(t,arg,next,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int collectlns2(term t, term arg, term *next, char *reason)
/* ln a - ln b = ln a/b */
/* it just calls collectlns after checking for at least one minus log term */
{ term u;
int i,count,minuscount;
unsigned short n;
if(FUNCTOR(t) != '+')
return 1;
n = ARITY(t);
count = minuscount = 0;
for(i=0;i<n;i++) /* count the plus and minus log terms */
{ u = ARG(i,t);
if(FUNCTOR(u)==LN) ++count;
if(FUNCTOR(u) == '-' && FUNCTOR(ARG(0,u))==LN) ++minuscount;
}
if(minuscount==0)
return 1;
if(count == 0 && minuscount == 1)
return 1;
return collectlns(t,arg,next,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int collectlogb2(term t, term arg, term *next, char *reason)
/* log a - log b = log a/b */
/* it just calls collectlogb after checking for at least one minus log term */
{ term u;
int i,count,minuscount;
unsigned short n;
if(FUNCTOR(t) != '+')
return 1;
n = ARITY(t);
count = minuscount = 0;
for(i=0;i<n;i++) /* count the plus and minus log terms */
{ u = ARG(i,t);
if(FUNCTOR(u)==LOGB)
++count;
if(FUNCTOR(u) == '-' && FUNCTOR(ARG(0,u))==LOGB)
++minuscount;
}
if(minuscount==0)
return 1;
if(count == 0 && minuscount == 1)
return 1;
return collectlogb(t,arg,next,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int attractlogs(term t, term arg, term *next, char *reason)
/* n log a = log a� */
/* In auto mode when solving equations, don't do it if n isn't constant. */
{ int i,j,flag,problemtype;
unsigned short n;
term p,u;
unsigned short path[5];
if(FUNCTOR(t) == '+')
{ /* called in automode on a sum, whose terms it should be applied to. */
n = ARITY(t);
*next = make_term('+',n);
flag = 0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u) == '*' && !flag && !attractlogs(u,arg,&p,reason))
/* In order that ShowStep can imitate it, we only apply
attractlogs to one term at a time. That's why the !flag. */
{ ARGREP(*next,i,p);
flag = 1;
path[0] = '+';
path[1] = i+1;
path[2] = 0;
set_pathtail(path);
}
else
ARGREP(*next,i,ARG(i,t));
}
return !flag;
}
if(FUNCTOR(t) != '*')
return 1;
problemtype = get_problemtype();
flag = SOLVETYPE(problemtype);
n = ARITY(t);
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,t))==LOG)
break;
}
if(i==n)
return 1; /* no LOG in the product */
if(n==2)
{ u = i ? ARG(0,t) : ARG(1,t);
if(get_mathmode() == AUTOMODE && flag && !econstant(u))
return 1; /* refuse to create nonconstant exponent */
*next = log1(make_power(ARG(0,ARG(i,t)),u));
if(SOLVETYPE(problemtype) && (!isinteger(u) || !isodd(u)))
set_checksolutionsflag(1);
}
else /* must form the product of all args except the i-th of t */
{ p = make_term('*',(unsigned short)(n-1));
for(j=0;j<n;j++)
{ if(j<i)
ARGREP(p,j,ARG(j,t));
else if(j>i)
ARGREP(p,j-1,ARG(j,t));
}
if(get_mathmode() == AUTOMODE && flag && !econstant(p))
{ RELEASE(p); /* made just above */
return 1;
}
*next = log1(make_power(ARG(0,ARG(i,t)),p));
set_checksolutionsflag(1);
}
HIGHLIGHT(*next);
strcpy(reason,"n log a = log a^n");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int attractlns(term t, term arg, term *next, char *reason)
/* n ln a = ln a� */
{ int i,j,flag,problemtype;
unsigned short n;
term p,u;
unsigned short path[5];
if(FUNCTOR(t) == '+')
{ /* called in automode on a sum, whose terms it should be applied to. */
n = ARITY(t);
*next = make_term('+',n);
flag = 0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u) == '*' && !flag && !attractlns(u,arg,&p,reason))
/* In order that ShowStep can imitate it, we only apply
attractlogs to one term at a time. That's why the !flag. */
{ ARGREP(*next,i,p);
flag = 1;
path[0] = '+';
path[1] = i+1;
path[2] = 0;
set_pathtail(path);
}
else
ARGREP(*next,i,ARG(i,t));
}
return !flag;
}
if(FUNCTOR(t) != '*')
return 1;
problemtype = get_problemtype();
flag = SOLVETYPE(problemtype);
n = ARITY(t);
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,t))==LN)
break;
}
if(i==n)
return 1; /* no LN in the product */
if(n==2)
{ u = i ? ARG(0,t) : ARG(1,t);
if(get_mathmode() == AUTOMODE && flag && !econstant(u))
return 1; /* refuse to create nonconstant exponent */
*next = ln1(make_power(ARG(0,ARG(i,t)),u));
if(SOLVETYPE(problemtype) && (!isinteger(u) || !isodd(u)))
set_checksolutionsflag(1);
}
else /* must form the product of all args except the i-th of t */
{ p = make_term('*',(unsigned short)(n-1));
for(j=0;j<n;j++)
{ if(j<i)
ARGREP(p,j,ARG(j,t));
else if(j>i)
ARGREP(p,j-1,ARG(j,t));
}
if(get_mathmode() == AUTOMODE && flag && !econstant(p))
{ RELEASE(p); /* made just above */
return 1;
}
*next = ln1(make_power(ARG(0,ARG(i,t)),p));
set_checksolutionsflag(1);
}
HIGHLIGHT(*next);
strcpy(reason,"n ln a = ln a^n");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int attractlogb2(term t, term arg, term *next, char *reason)
/* n log(b,a) = log(b,a�) */
{ int i,j;
unsigned short n;
term index,p;
int flag;
term u;
unsigned short path[5];
if(FUNCTOR(t) == '+')
{ /* called in automode on a sum, whose terms it should be applied to. */
n = ARITY(t);
*next = make_term('+',n);
flag = 0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u) == '*' && !flag && !attractlogb2(u,arg,&p,reason))
/* In order that ShowStep can imitate it, we only apply
attractlogs to one term at a time. That's why the !flag. */
{ ARGREP(*next,i,p);
flag = 1;
path[0] = '+';
path[1] = i+1;
path[2] = 0;
set_pathtail(path);
}
else
ARGREP(*next,i,ARG(i,t));
}
return !flag;
}
if(FUNCTOR(t) != '*')
return 1;
n = ARITY(t);
for(i=0;i<n;i++)
{if(FUNCTOR(ARG(i,t))==LOGB)
{ index = ARG(0,ARG(i,t));
break;
}
}
if(i==n)
return 1; /* no LOGB in the product */
if(n==2)
{ if(i==0)
{ *next = make_term(LOGB,2);
ARGREP(*next,0,index);
ARGREP(*next,1,make_power(ARG(1,ARG(0,t)),ARG(1,t)));
}
else /* i==1 */
{ *next = make_term(LOGB,2);
ARGREP(*next,0,index);
ARGREP(*next,1,make_power(ARG(1,ARG(1,t)),ARG(0,t)));
}
}
else /* must form the product of all args except the i-th of t */
{ p = make_term('*',(unsigned short)(n-1));
for(j=0;j<n;j++)
{ if(j<i)
ARGREP(p,j,ARG(j,t));
else if(j>i)
ARGREP(p,j-1,ARG(j,t));
}
*next = make_term(LOGB,2);
ARGREP(*next,0,index);
ARGREP(*next,1,make_power(ARG(1,ARG(i,t)),p));
}
HIGHLIGHT(*next);
strcpy(reason,"n log(b,a)=log(b,a^n)");
set_checksolutionsflag(1);
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int computelog(term t, term arg, term *next, char *reason)
{ double ans;
dcomplex cans;
int err;
if (FUNCTOR(t) != LOG)
return 1;
if(get_complex())
{ if(!complexnumerical(t))
{ errbuf(0, english(1365));
/* Logarithm to be computed must not contain variables. */
return 1;
}
err = ceval(t,&cans);
if(err)
return 1;
*next = make_complex(make_double(cans.r),make_double(cans.i));
strcpy(reason, english(666)); /* compute complex log */
}
else
{ if(!seminumerical(t))
{ errbuf(0, english(1365));
/* Logarithm to be computed must not contain variables. */
return 1;
}
err = deval(t,&ans);
if(err)
return 1;
*next = make_double(ans);
strcpy(reason, english(667)); /* compute log */
}
HIGHLIGHT(*next);
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int computeln(term t, term arg, term *next, char *reason)
{ double ans;
dcomplex cans;
int err;
if (FUNCTOR(t) != LN)
return 1;
if(get_complex())
{ if(!complexnumerical(t))
{ errbuf(0, english(1365));
/* Logarithm to be computed must not contain variables. */
return 1;
}
err = ceval(t,&cans);
if(err)
return 1;
*next = make_complex(make_double(cans.r),make_double(cans.i));
strcpy(reason, english(668)); /* compute complex ln */
}
else
{ if(!seminumerical(t))
{ errbuf(0, english(1365));
/* Logarithm to be computed must not contain variables. */
return 1;
}
err = deval(t,&ans);
if(err)
return 1;
*next = make_double(ans);
strcpy(reason, english(669)); /* compute ln */
}
HIGHLIGHT(*next);
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int introducelninexponent(term t, term arg, term *next, char *reason)
{ term x,n; /* t = x� */
int err;
if(FUNCTOR(t) != '^')
return 1;
x = ARG(0,t);
n = ARG(1,t);
if(equals(x,eulere))
{ errbuf(0, english(670));
/* Writing e� = e^(n ln e) can't possibly help. */
return 1;
}
if(!get_complex() && constant(ARG(1,t)))
/* if the exponent isn't constant, then t can't be defined
anyway unless x is positive. */
{ err = check(positive(x));
if(err)
{ errbuf(0, english(671));
/* Introducing ln u requires u>0, */
errbuf(1, english(672));
/* as complex numbers are turned off now */
return 1;
}
}
*next = make_power(eulere,product(n,ln1(x)));
if(FUNCTOR(ARG(1,*next))=='*')
sortargs(ARG(1,*next));
HIGHLIGHT(*next);
strcpy(reason,"u^v = e^(v ln u)");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int introduceloginexponent(term t, term arg, term *next, char *reason)
{ term x,n; /* t = x� */
int err;
if(FUNCTOR(t) != '^')
return 1;
x = ARG(0,t);
n = ARG(1,t);
if(get_mathmode()==AUTOMODE && !contains(ARG(1,t),LOG))
return 1; /* introduce ln, not log */
if(equals(x,ten))
{ errbuf(0, english(670));
/* Writing 10� = 10^(n log 10) can't possibly help. */
return 1;
}
if(!get_complex() && constant(ARG(1,t)))
/* if the exponent isn't constant, then t can't be defined
anyway unless x is positive. */
{ err = check(positive(x));
if(err)
{ errbuf(0, english(1152));
/* Introducing log u requires u>0, */
errbuf(1, english(672));
/* as complex numbers are turned off now */
return 1;
}
}
*next = make_power(ten,product(n,log1(x)));
if(FUNCTOR(ARG(1,*next))=='*')
sortargs(ARG(1,*next));
HIGHLIGHT(*next);
strcpy(reason,"u^v = 10^(v log u)");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int introducelogbinexponent(term t, term arg, term *next, char *reason)
{ term x,n; /* t = x� */
int err,i;
if(FUNCTOR(t) != '^')
return 1;
x = ARG(0,t);
n = ARG(1,t);
if(FUNCTOR(arg) == ILLEGAL)
{ /* search for a LOGB term in the exponent */
if(FRACTION(n) && FUNCTOR(ARG(1,n)) == LOGB && equals(ARG(1,ARG(1,n)),x))
arg = ARG(0,ARG(1,n));
else if(FRACTION(n) && FUNCTOR(ARG(1,n)) == '*')
{ for(i=0;i<ARITY(ARG(1,n));i++)
{ if(FUNCTOR(ARG(i,ARG(1,n))) == LOGB && equals(ARG(1,ARG(i,ARG(1,n))),x))
{ arg = ARG(0,ARG(i,ARG(1,n)));
break;
}
}
}
else if(FUNCTOR(n) == '*')
{ for(i=0;i<ARITY(n);i++)
{ if(FUNCTOR(ARG(i,n)) == LOGB && equals(ARG(1,ARG(i,n)),x))
{ arg = ARG(0,ARG(i,n));
break;
}
}
}
else if(FUNCTOR(n) == LOGB)
arg = ARG(0,n);
else
return 1;
}
if(!get_complex() && constant(ARG(1,t)))
/* if the exponent isn't constant, then t can't be defined
anyway unless x is positive. */
{ err = check(positive(x));
if(err)
{ errbuf(0, english(1152));
/* Introducing log u requires u>0, */
errbuf(1, english(672));
/* as complex numbers are turned off now */
return 1;
}
}
*next = make_power(arg,product(n,logb1(arg,x)));
if(FUNCTOR(ARG(1,*next))=='*')
sortargs(ARG(1,*next));
HIGHLIGHT(*next);
strcpy(reason,"u^v = b^(v log(b,u))");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logbtolog(term t, term arg, term *next, char *reason)
/* log(10,x) = log x*/
{ if(FUNCTOR(t) != LOGB)
return 1;
if(!(ISINTEGER(ARG(0,t)) && INTDATA(ARG(0,t))==10))
return 1;
*next = log1(ARG(1,t));
HIGHLIGHT(*next);
strcpy(reason,"log(10,x) = log x");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logbtoln(term t, term arg, term *next, char *reason)
/*log(e,x) = ln x */
{ if(FUNCTOR(t) != LOGB)
return 1;
if(!equals(ARG(0,t),eulere))
return 1;
*next = ln1(ARG(1,t));
HIGHLIGHT(*next);
strcpy(reason,"log(e,x) = ln x");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logbtolns(term t, term arg, term *next, char *reason)
/*log(b,x) = ln x / ln b */
{ if(FUNCTOR(t) != LOGB)
return 1;
*next = make_fraction(ln1(ARG(1,t)),ln1(ARG(0,t)));
HIGHLIGHT(*next);
strcpy(reason,"log(b,x)=ln x / ln b");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logbtologs(term t, term arg, term *next, char *reason)
/*log(b,x) = log x/log b */
{ if(FUNCTOR(t) != LOGB)
return 1;
*next = make_fraction(log1(ARG(1,t)),log1(ARG(0,t)));
HIGHLIGHT(*next);
strcpy(reason,"log(b,x)=log x/log b");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int lntolog(term t, term arg, term *next, char *reason)
/* ln x = log x / log e */
{ term x;
if(FUNCTOR(t) != LN)
return 1;
x = ARG(0,t);
*next = make_fraction(log1(x),log1(eulere));
HIGHLIGHT(*next);
strcpy(reason,"ln x = log x / log e");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int logtoln(term t, term arg, term *next, char *reason)
/* log x = ln x / ln 10 */
{ term x;
if(FUNCTOR(t) != LOG)
return 1;
x = ARG(0,t);
*next = make_fraction(ln1(x),ln1(ten));
HIGHLIGHT(*next);
strcpy(reason,"log x = (ln x)/ln 10");
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int changebase(term t, term arg, term *next, char *reason)
/* log(b,x) = log(a,x) / log(a,b) */
/* a comes in as arg */
{ term num,denom,x,b,lastbase;
if(FUNCTOR(t) == LOGB)
{ x = ARG(1,t);
b = ARG(0,t);
}
else if(FUNCTOR(t) == LN)
{ x = ARG(0,t);
b = eulere;
}
else if(FUNCTOR(t) == LOG)
{ x = ARG(0,t);
b = ten;
}
else
return 1; /* functor must be LOG, LN, or LOGB */
if(FUNCTOR(arg) == ILLEGAL)
{ if(FUNCTOR(t) == LOGB && FRACTION(ARG(0,t)))
arg = ARG(1,ARG(0,t)); /* in log(1/5,x), change to base 5 */
else
{ lastbase = get_lastbase();
/* if we're in an exponent, this retrieves the base */
if(ATOMIC(lastbase))
arg = lastbase;
else
arg = eulere;
}
}
if(equals(arg,b))
return 1;
if(equals(arg,eulere))
num = ln1(x);
else if(equals(arg,ten))
num = log1(x);
else
{ num = make_term(LOGB,2);
ARGREP(num,0,arg);
ARGREP(num,1,x);
}
if(equals(b,eulere))
denom = ln1(arg);
else if(equals(b,ten))
denom = log1(arg);
else
{ denom = make_term(LOGB,2);
ARGREP(denom,0,arg);
ARGREP(denom,1,b);
}
*next = make_fraction(num,denom);
HIGHLIGHT(*next);
strcpy(reason, english(674)); /* change base of logs */
/* the formula is too long */
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int factoroutbase10(term t, term arg, term *next, char *reason)
/* see factoroutbase for comments. This works only on logs base 10. */
{ if(FUNCTOR(t) != LOG)
return 1;
return factoroutbase(t,arg,next,reason);
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int factoroutbase(term t, term arg, term *next, char *reason)
/* An expression like log 100 should become log 10^2 = 2 */
/* The algorithm is NOT to factor the number, but simply to
repeatedly divide out the base of the logs */
/* This operator works on logs to any base. */
{ int count=0;
term u,b,q,r,saveq;
if(FUNCTOR(t) != LOG && FUNCTOR(t) != LOGB)
return 1;
u = (FUNCTOR(t)==LOG ? ARG(0,t) : ARG(1,t));
if(!INTEGERP(u))
return 1;
b = (FUNCTOR(t)==LOG ? ten : ARG(0,t));
if(OBJECT(b) && TYPE(b)==BIGNUM)
{ errbuf(0, english(675));
/* Sorry, the base is too large for MathXpert. */
return 1;
}
if(!ISINTEGER(b))
return 1;
r = zero;
q = zero; /* avoid a warning 2 lines below */
while (ZERO(r))
{ if(count)
saveq = q;
intdivide(u,b,&q,&r);
if(ZERO(r))
{ ++count;
u=q;
}
}
if(count == 0)
return 1;
u = product(make_power(b,make_int(count)),saveq);
HIGHLIGHT(u);
PROTECT(u); /* to avoid arithmetic multiplying it out again */
if(FUNCTOR(t)==LOG)
*next = log1(u);
else
{ *next = make_term(LOGB,2);
ARGREP(*next,0,b);
ARGREP(*next,1,u);
}
strcpy(reason, english(676)); /* factor out base */
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int factornumberinlog(term t, term arg, term *next, char *reason)
/* factor an integer under a log */
{ unsigned short f = FUNCTOR(t);
unsigned short path[5];
term u,ans;
int err;
unsigned nfactors;
unsigned short i;
if( f!= LOG && f != LN && f != LOGB)
return 1;
u = (f == LOGB ? ARG(1,t) : ARG(0,t));
if(!INTEGERP(u))
return 1;
err = factor_integer(u,&nfactors,&ans);
if(err)
return 1;
if(FUNCTOR(ans) == '^')
PROTECT(ans);
else if(FUNCTOR(ans) == '*')
{ for(i=0;i<ARITY(ans);i++)
{ if(FUNCTOR(ARG(i,ans)) == '^')
PROTECT(ARG(i,ans));
}
}
if(get_mathmode() == AUTOMODE && FUNCTOR(ans) == '*')
/* don't use a square-free answer */
{ for(i=0;i<nfactors;i++)
{ if(FUNCTOR(ARG(i,ans))=='^')
break; /* it's not square-free */
}
if(i==nfactors) /* it was square-free */
return 1;
}
PROTECT(ans);
if(f==LOGB)
{ *next = make_term(LOGB,2);
ARGREP(*next,0,ARG(0,t));
ARGREP(*next,1,ans);
}
else
*next = ( f==LN ? ln1(ans) : log1(ans));
HIGHLIGHT(*next);
strcpy(reason, english(255)); /* factor integer */
path[0] = f;
path[1] = f == LOGB ? 2 : 1;
path[2] = 0;
set_pathtail(path);
SetShowStepOperation(factorinteger);
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int factorlogbase(term t, term arg, term *next, char *reason)
/* factor an integer base into a power of a single prime */
{ unsigned short f = FUNCTOR(t);
term b,ans,base,power;
int err;
unsigned short path[5];
if( f!= LOGB)
return 1;
b = ARG(0,t);
if(!INTEGERP(b))
return 1;
err = perfect_power(b,&base,&power);
if(err)
{ errbuf(0, english(677)); /* Base is not an exact power */
return 1;
}
ans = make_power(base,power);
PROTECT(ans);
*next = logb1(ans,ARG(1,t));
HIGHLIGHT(*next);
strcpy(reason, english(1840)); /* write integer as a^n */
path[0] = LOGB;
path[1] = 1;
path[2] = 0;
set_pathtail(path);
SetShowStepOperation(writeintegeraspower);
return 0;
}
/*___________________________________________________________*/
static int perfect_power(term b, term *base, term *power)
/* write the integer or bignum b in the form base^power where
power > 1 if possible. Return 0 for success, 1 for failure. */
{ int i,err;
unsigned short nfactors;
unsigned n;
long c;
term ans,temp;
if(!INTEGERP(b) || ONE(b))
return 1;
err = factor_integer(b,&n,&ans);
if(err)
return 1;
assert(n < 0xffff);
nfactors = (unsigned short) n;
if(OBJECT(ans))
return 1;
if(nfactors == 1)
{ *base = ARG(0,ans);
*power = ARG(1,ans);
return 0;
}
for(i=0;i<nfactors; i++)
{ if(FUNCTOR(ARG(i,ans)) != '^')
return 1; /* some prime appears to the first power */
}
assert(ISINTEGER(ARG(1,ARG(0,ans))));
c = INTDATA(ARG(1,ARG(0,ans)));
for(i=1;i<nfactors;i++)
{ assert(ISINTEGER(ARG(1,ARG(i,ans))));
c = intgcd(c,INTDATA(ARG(1,ARG(i,ans))));
if(c==1)
return 1;
}
*power = make_int(c);
temp = make_term('*',nfactors);
for(i=0;i<nfactors;i++)
ARGREP(temp,i,make_power(ARG(0,ARG(i,ans)),make_int(INTDATA(ARG(1,ARG(i,ans)))/c)));
value(temp,base);
RELEASE(temp);
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_TRIGCALC int lnsqrt(term t, term arg, term *next, char *reason)
/* ln �a = � ln a */
{ term a;
if(FUNCTOR(t) != LN || FUNCTOR(ARG(0,t)) != SQRT)
return 1;
a = ARG(0,ARG(0,t));
*next = product(make_fraction(one,two),ln1(a));
HIGHLIGHT(*next);
strcpy(reason,"$ln �a = � ln a$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_TRIGCALC int logsqrt(term t, term arg, term *next, char *reason)
/* log sqrt(a) = (1/2) log a */
/* also log(b,sqrt(a)) = (1/2) log(b,a) */
{ term a;
unsigned short f = FUNCTOR(t);
term u;
if(f != LOG && f != LOGB)
return 1;
u = ARG(f == LOGB ? 1 : 0, t);
if(FUNCTOR(u) != SQRT)
return 1;
a = ARG(0,u);
*next = product(make_fraction(one,two),f == LOG ? log1(a) : logb1(ARG(0,t),a));
HIGHLIGHT(*next);
strcpy(reason,"$log �a = � log a$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_TRIGCALC int lnroot(term t, term arg, term *next, char *reason)
/* ln ��a = (1/n) ln a */
{ term a;
if(FUNCTOR(t) != LN || FUNCTOR(ARG(0,t)) != ROOT)
return 1;
a = ARG(1,ARG(0,t));
*next = product(make_fraction(one,ARG(0,ARG(0,t))),ln1(a));
HIGHLIGHT(*next);
strcpy(reason,"$ln ��a = (1/n) ln a$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_TRIGCALC int logroot(term t, term arg, term *next, char *reason)
/* log ��a = (1/n) log a */
/* also works on LOGB */
{ term a,u;
unsigned short f = FUNCTOR(t);
if(f == LOG)
u = ARG(0,t);
else if(f == LOGB)
u = ARG(1,t);
else
return 1;
if(FUNCTOR(u) != ROOT)
return 1;
a = ARG(1,u);
*next = product(reciprocal(ARG(0,u)), f == LOG ? log1(a) : logb1(ARG(0,t),a));
HIGHLIGHT(*next);
strcpy(reason,"$log ��a = (1/n) log a$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_TRIGCALC int lnofi(term t, term arg, term *next, char *reason)
/* ln i = i�/2 */
{ if(FUNCTOR(t) != LN)
return 1;
if(!equals(ARG(0,t),complexi))
return 1;
*next = make_fraction(product(complexi, pi),two);
SETORDERED(ARG(0,*next));
HIGHLIGHT(*next);
strcpy(reason,"$ln i = i�/2$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_TRIGCALC int lnofminusone(term t, term arg, term *next, char *reason)
/* ln(-1) = i� */
{ if(FUNCTOR(t) != LN)
return 1;
if(!equals(ARG(0,t),minusone))
return 1;
*next = product(complexi, pi);
SETORDERED(*next);
HIGHLIGHT(*next);
strcpy(reason,"$ln(-1) = i�$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_TRIGCALC int lnofnegative(term t, term arg, term *next, char *reason)
/* ln(-a) = ln a + i� (a > 0) */
{ term a;
if(FUNCTOR(t) != LN)
return 1;
if(!NEGATIVE(ARG(0,t)))
return 1;
a = ARG(0,ARG(0,t));
if(ONE(a))
return lnofminusone(t,arg,next,reason);
if(OBJECT(a) || !infer(le(zero,a)))
{ *next = sum(ln1(a), product(complexi, pi));
SETORDERED(ARG(1,*next));
HIGHLIGHT(*next);
strcpy(reason,"$ln(-a)=ln a+i� (a>0)$");
return 0;
}
return 1;
}
/*_____________________________________________________________________*/
MEXPORT_TRIGCALC int lnrecip(term t, term arg, term *next, char *reason)
/* ln(a/b) = -ln(b/a) */
{ term u;
if(FUNCTOR(t) != LN || FUNCTOR(ARG(0,t)) != '/')
return 1;
u = ARG(0,t);
*next = tnegate(ln1(make_fraction(ARG(1,u),ARG(0,u))));
strcpy(reason,"ln(a/b) = -ln(b/a)");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_TRIGCALC int logrecip(term t, term arg, term *next, char *reason)
/* log(a/b) = -log(b/a) */
{ term u;
if(FUNCTOR(t) != LOG || FUNCTOR(ARG(0,t)) != '/')
return 1;
u = ARG(0,t);
*next = tnegate(log1(make_fraction(ARG(1,u),ARG(0,u))));
strcpy(reason,"log(a/b) = -log(b/a)");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_TRIGCALC int logbrecip(term t, term arg, term *next, char *reason)
/* log(b,a/c) = -log(b,c/a) */
{ term u;
if(FUNCTOR(t) != LOGB || FUNCTOR(ARG(1,t)) != '/')
return 1;
u = ARG(1,t);
*next = tnegate(logb1(ARG(0,t),make_fraction(ARG(1,u),ARG(0,u))));
strcpy(reason,"log(b,a/c)= -log(b,c/a)");
return 0;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists