Sindbad~EG File Manager
/*
Some Mathpert log and ln operators adapted for use by polyval
M. Beeson
1.11.91 original date
1.29.98 last modified
2.16.25 removed unused variable 'count' from polyval_collectlogs_aux
*/
#include <string.h>
#include <assert.h>
#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 "plogs.h"
static int polyval_collectlogs_aux(unsigned short, term, term, term *);
/*_________________________________________________________________*/
int polyval_lninexponent2(term t, term *next)
/* 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);
return 0;
}
/*_________________________________________________________________*/
int polyval_logbinexponent2(term t,term *next)
/* 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);
return 0;
}
/*_________________________________________________________________*/
int polyval_loginexponent2(term t, term *next)
/* 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);
return 0;
}
/*_________________________________________________________________*/
static int polyval_collectlogs_aux(unsigned short f,term t, term arg, term *next)
/* 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 */
/* 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;
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;
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(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(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(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(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));
}
if(p+q==n) /* answer is only one term */
{ *next = ans;
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 */
return 0;
}
/*_________________________________________________________________*/
int polyval_collectlogs(term t, term *next)
/* log a + log b = log ab */
{ return polyval_collectlogs_aux(LOG,t,zero,next);
}
/*_________________________________________________________________*/
int polyval_collectlns(term t, term *next)
/* ln a + ln b = ln ab */
{ return polyval_collectlogs_aux(LN,t,zero,next);
}
/*_________________________________________________________________*/
int polyval_collectlogb(term t, term *next)
/* log a + log b = log ab */
{ int i,j;
term index,arg;
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++)
{ if(FUNCTOR(ARG(i,t))==LOGB ||
(FUNCTOR(ARG(i,t))=='-' && FUNCTOR(ARG(0,ARG(i,t)))==LOGB)
)
{ index = (FUNCTOR(ARG(i,t))=='-' ? ARG(0,ARG(0,ARG(i,t))) : ARG(0,ARG(i,t)));
for(j=i+1;j<n;j++)
if(
(FUNCTOR(ARG(j,t))==LOGB && equals(ARG(0,ARG(j,t)),index))
||(FUNCTOR(ARG(j,t))=='-' && equals(ARG(0,ARG(0,ARG(j,t))),index))
)
break;
}
if(j<n)
break;
}
if(i==n)
return 1; /* no two LOGB's with same index */
if (FUNCTOR(ARG(i,t)) == LOGB)
arg = index; /* use arg to pass the index */
else
arg = ARG(0,ARG(0,ARG(i,t))); /* ARG(i,t) is a negation */
return polyval_collectlogs_aux(LOGB,t,arg,next);
}
/*_________________________________________________________________*/
int polyval_attractlogs(term t, term *next)
/* n log a = log a^n */
/* In auto mode when solving equations, don't do it if n isn't constant. */
{ int i,j,flag = 0;
unsigned short n;
term p,u;
if(FUNCTOR(t) == '+')
{ /* called in automode on a sum, whose terms it should be applied to. */
n = ARITY(t);
*next = make_term('+',n);
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u) == '*' && !polyval_attractlogs(u,&p))
{ ARGREP(*next,i,p);
flag = 1;
}
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))==LOG)
break;
}
if(i==n)
return 1; /* no LOG in the product */
if(n==2)
{ u = i ? ARG(0,t) : ARG(1,t);
if(!constant(u))
return 1; /* refuse to create nonconstant exponent */
*next = log1(make_power(ARG(0,ARG(i,t)),u));
}
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(!constant(p))
{ RELEASE(p); /* made just above */
return 1;
}
*next = log1(make_power(ARG(0,ARG(i,t)),p));
}
return 0;
}
/*_________________________________________________________________*/
int polyval_attractlns(term t, term *next)
/* n ln a = ln a^n */
{ int i,j,flag;
unsigned short n;
term p,u;
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) == '*' && !polyval_attractlns(u,&p))
{ ARGREP(*next,i,p);
flag = 1;
}
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))==LN)
break;
}
if(i==n)
return 1; /* no LN in the product */
if(n==2)
{ u = i ? ARG(0,t) : ARG(1,t);
if(!constant(u))
return 1; /* refuse to create nonconstant exponent */
*next = ln1(make_power(ARG(0,ARG(i,t)),u));
}
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(!constant(p))
{ RELEASE(p); /* made just above */
return 1;
}
*next = ln1(make_power(ARG(0,ARG(i,t)),p));
}
return 0;
}
/*_________________________________________________________________*/
int polyval_attractlogb2(term t, term *next)
/* n log(b,a) = log(b,a^n) */
{ int i,j;
unsigned short n;
term index,p;
int flag;
term u;
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) == '*' && !polyval_attractlogb2(u,&p))
{ ARGREP(*next,i,p);
flag = 1;
}
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));
}
return 0;
}
/*_________________________________________________________________*/
int polyval_introducelninexponent(term t, term *next)
{ term x,n; /* t = x^n */
int err;
if(FUNCTOR(t) != '^')
return 1;
x = ARG(0,t);
n = ARG(1,t);
if(equals(x,eulere))
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 = infer(positive(x));
if(err)
return 1;
}
*next = make_power(eulere,product(n,ln1(x)));
if(FUNCTOR(ARG(1,*next))=='*')
sortargs(ARG(1,*next));
return 0;
}
/*_________________________________________________________________*/
int polyval_introduceloginexponent(term t, term *next)
{ term x,n; /* t = x^n */
int err;
if(FUNCTOR(t) != '^')
return 1;
x = ARG(0,t);
n = ARG(1,t);
if(!contains(ARG(1,t),LOG))
return 1; /* introduce ln, not log */
if(equals(x,ten))
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 = infer(positive(x));
if(err)
return 1;
}
*next = make_power(ten,product(n,log1(x)));
if(FUNCTOR(ARG(1,*next))=='*')
sortargs(ARG(1,*next));
return 0;
}
/*_________________________________________________________________*/
int polyval_introducelogbinexponent(term t, term arg, term *next)
{ term x,n; /* t = x^n */
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 = infer(positive(x));
if(err)
return 1;
}
*next = make_power(arg,product(n,logb1(arg,x)));
if(FUNCTOR(ARG(1,*next))=='*')
sortargs(ARG(1,*next));
return 0;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists