The R Project SVN R

/*

 *  R : A Computer Language for Statistical Data Analysis

 *  Copyright (C) 1998--2014	    The R Core Team.

 *

 *  This program is free software; you can redistribute it and/or modify

 *  it under the terms of the GNU General Public License as published by

 *  the Free Software Foundation; either version 2 of the License, or

 *  (at your option) any later version.

 *

 *  This program is distributed in the hope that it will be useful,

 *  but WITHOUT ANY WARRANTY; without even the implied warranty of

 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

 *  GNU General Public License for more details.

 *

 *  You should have received a copy of the GNU General Public License

 *  along with this program; if not, a copy is available at

 *  https://www.R-project.org/Licenses/

 */

SEXP do_math1(SEXP, SEXP, SEXP, SEXP);

SEXP do_math2(SEXP, SEXP, SEXP, SEXP);

SEXP do_math3(SEXP, SEXP, SEXP, SEXP);

SEXP do_math4(SEXP, SEXP, SEXP, SEXP);

#ifdef WHEN_MATH5_IS_THERE

 SEXP do_math5(SEXP, SEXP, SEXP, SEXP);

#endif

SEXP do_cmathfuns(SEXP, SEXP, SEXP, SEXP);

SEXP complex_math1(SEXP, SEXP, SEXP, SEXP);

SEXP complex_math2(SEXP, SEXP, SEXP, SEXP);

SEXP complex_unary(ARITHOP_TYPE, SEXP, SEXP);

SEXP complex_binary(ARITHOP_TYPE, SEXP, SEXP);

double R_pow(double x, double y);

static R_INLINE double R_POW(double x, double y) /* handle x ^ 2 inline */

{

    return y == 2.0 ? x * x : R_pow(x, y);

}

/* some systems get this wrong, possibly depend on what libs are loaded */

static R_INLINE double R_log(double x) {

    return x > 0 ? log(x) : x == 0 ? R_NegInf : R_NaN;

}

/* Note that the behaviour of log(0) required is not necessarily that

   mandated by C99 (-HUGE_VAL), and the behaviour of log(x < 0) is

   optional in C99.  Some systems return -Inf for log(x < 0), e.g.

   libsunmath on Solaris.

*/

static R_INLINE double logbase(double x, double base)

{

#ifdef HAVE_LOG10

    if(base == 10) return x > 0 ? log10(x) : x == 0 ? R_NegInf : R_NaN;

#endif

#ifdef HAVE_LOG2

    if(base == 2) return x > 0 ? log2(x) : x == 0 ? R_NegInf : R_NaN;

#endif

    return R_log(x) / R_log(base);

}

SEXP do_log_builtin(SEXP call, SEXP op, SEXP args, SEXP env);

/* for binary operations */

/* adapted from Radford Neal's pqR */

static R_INLINE SEXP R_allocOrReuseVector(SEXP s1, SEXP s2,

					  SEXPTYPE type , R_xlen_t n)

{

    R_xlen_t n1 = XLENGTH(s1);

    R_xlen_t n2 = XLENGTH(s2);

    /* Try to use space for 2nd arg if both same length, so 1st argument's

       attributes will then take precedence when copied. */

    if (n == n2) {

        if (TYPEOF(s2) == type && NO_REFERENCES(s2)) {

	    if (ATTRIB(s2) != R_NilValue)

		/* need to remove 'names' attribute if present to

		   match what copyMostAttrib does. copyMostAttrib()

		   also skips 'dim' and 'dimnames' but those, here

		   since those, if present, will be replaced by

		   attribute cleanup code in R_Binary) */

		setAttrib(s2, R_NamesSymbol, R_NilValue);

            return s2;

	}

        else

            /* Can use 1st arg's space only if 2nd arg has no attributes, else

               we may not get attributes of result right. */

            if (n == n1 && TYPEOF(s1) == type && NO_REFERENCES(s1)

		&& ATTRIB(s2) == R_NilValue)

                return s1;

    }

    else if (n == n1 && TYPEOF(s1) == type && NO_REFERENCES(s1))

	return s1;

    return allocVector(type, n);

}

// we document that tanpi(0.5) is NaN, but TS 18661-4:2015

// does not require this and the Solaris and macOS versions give Inf.

double Rtanpi(double);