/* * 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);