static SEXP
simplify (SEXP fun, SEXP arg1, SEXP arg2)
{
SEXP ans;
if (fun == PlusSymbol)
{
if (isZero (arg1))
ans = arg2;
else if (isUminus (arg1))
ans =
simplify (MinusSymbol, arg2,
((((arg1)->u.listsxp.cdrval))->u.listsxp.carval));
else if (isUminus (arg2))
ans =
simplify (MinusSymbol, arg1,
((((arg2)->u.listsxp.cdrval))->u.listsxp.carval));
}
else if (fun == DivideSymbol)
{
ans = Rf_lang3 (DivideSymbol, arg1, arg2);
}
return ans;
}
static SEXP simplify(SEXP fun, SEXP arg1, SEXP arg2)
{
SEXP ans;
if (fun == PlusSymbol) {
if (isZero(arg1))
ans = arg2;
else if (isZero(arg2))
ans = arg1;
else if (isUminus(arg1))
ans = simplify(MinusSymbol, arg2, CADR(arg1));
else if (isUminus(arg2))
ans = simplify(MinusSymbol, arg1, CADR(arg2));
else
ans = lang3(PlusSymbol, arg1, arg2);
}
else if (fun == MinusSymbol) {
if (arg2 == R_MissingArg) {
if (isZero(arg1))
ans = Constant(0.);
else if (isUminus(arg1))
ans = CADR(arg1);
else
ans = lang2(MinusSymbol, arg1);
}
else {
if (isZero(arg2))
ans = arg1;
else if (isZero(arg1))
ans = simplify(MinusSymbol, arg2, R_MissingArg);
else if (isUminus(arg1)) {
ans = simplify(MinusSymbol,
PP(simplify(PlusSymbol, CADR(arg1), arg2)),
R_MissingArg);
UNPROTECT(1);
}
else if (isUminus(arg2))
ans = simplify(PlusSymbol, arg1, CADR(arg2));
else
ans = lang3(MinusSymbol, arg1, arg2);
}
}
else if (fun == TimesSymbol) {
if (isZero(arg1) || isZero(arg2))
ans = Constant(0.);
else if (isOne(arg1))
ans = arg2;
else if (isOne(arg2))
ans = arg1;
else if (isUminus(arg1)) {
ans = simplify(MinusSymbol,
PP(simplify(TimesSymbol, CADR(arg1), arg2)),
R_MissingArg);
UNPROTECT(1);
}
else if (isUminus(arg2)) {
ans = simplify(MinusSymbol,
PP(simplify(TimesSymbol, arg1, CADR(arg2))),
R_MissingArg);
UNPROTECT(1);
}
else
ans = lang3(TimesSymbol, arg1, arg2);
}
else if (fun == DivideSymbol) {
if (isZero(arg1))
ans = Constant(0.);
else if (isZero(arg2))
ans = Constant(NA_REAL);
else if (isOne(arg2))
ans = arg1;
else if (isUminus(arg1)) {
ans = simplify(MinusSymbol,
PP(simplify(DivideSymbol, CADR(arg1), arg2)),
R_MissingArg);
UNPROTECT(1);
}
else if (isUminus(arg2)) {
ans = simplify(MinusSymbol,
PP(simplify(DivideSymbol, arg1, CADR(arg2))),
R_MissingArg);
UNPROTECT(1);
}
else ans = lang3(DivideSymbol, arg1, arg2);
}
else if (fun == PowerSymbol) {
if (isZero(arg2))
ans = Constant(1.);
else if (isZero(arg1))
ans = Constant(0.);
else if (isOne(arg1))
ans = Constant(1.);
else if (isOne(arg2))
ans = arg1;
else
ans = lang3(PowerSymbol, arg1, arg2);
}
else if (fun == ExpSymbol) {
/* FIXME: simplify exp(lgamma( E )) = gamma( E ) */
ans = lang2(ExpSymbol, arg1);
}
else if (fun == LogSymbol) {
/* FIXME: simplify log(gamma( E )) = lgamma( E ) */
ans = lang2(LogSymbol, arg1);
}
else if (fun == CosSymbol) ans = lang2(CosSymbol, arg1);
else if (fun == SinSymbol) ans = lang2(SinSymbol, arg1);
else if (fun == TanSymbol) ans = lang2(TanSymbol, arg1);
else if (fun == CoshSymbol) ans = lang2(CoshSymbol, arg1);
else if (fun == SinhSymbol) ans = lang2(SinhSymbol, arg1);
else if (fun == TanhSymbol) ans = lang2(TanhSymbol, arg1);
else if (fun == SqrtSymbol) ans = lang2(SqrtSymbol, arg1);
else if (fun == PnormSymbol)ans = lang2(PnormSymbol, arg1);
else if (fun == DnormSymbol)ans = lang2(DnormSymbol, arg1);
else if (fun == AsinSymbol) ans = lang2(AsinSymbol, arg1);
else if (fun == AcosSymbol) ans = lang2(AcosSymbol, arg1);
else if (fun == AtanSymbol) ans = lang2(AtanSymbol, arg1);
else if (fun == GammaSymbol)ans = lang2(GammaSymbol, arg1);
else if (fun == LGammaSymbol)ans = lang2(LGammaSymbol, arg1);
else if (fun == DiGammaSymbol) ans = lang2(DiGammaSymbol, arg1);
else if (fun == TriGammaSymbol) ans = lang2(TriGammaSymbol, arg1);
else if (fun == PsiSymbol){
if (arg2 == R_MissingArg) ans = lang2(PsiSymbol, arg1);
else ans = lang3(PsiSymbol, arg1, arg2);
}
else ans = Constant(NA_REAL);
/* FIXME */
#ifdef NOTYET
if (length(ans) == 2 && isAtomic(CADR(ans)) && CAR(ans) != MinusSymbol)
c = eval(c, rho);
if (length(c) == 3 && isAtomic(CADR(ans)) && isAtomic(CADDR(ans)))
c = eval(c, rho);
#endif
return ans;
}/* simplify() */
