/src/r-source/src/main/arithmetic.h
Line | Count | Source |
1 | | /* |
2 | | * R : A Computer Language for Statistical Data Analysis |
3 | | * Copyright (C) 1998--2014 The R Core Team. |
4 | | * |
5 | | * This program is free software; you can redistribute it and/or modify |
6 | | * it under the terms of the GNU General Public License as published by |
7 | | * the Free Software Foundation; either version 2 of the License, or |
8 | | * (at your option) any later version. |
9 | | * |
10 | | * This program is distributed in the hope that it will be useful, |
11 | | * but WITHOUT ANY WARRANTY; without even the implied warranty of |
12 | | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
13 | | * GNU General Public License for more details. |
14 | | * |
15 | | * You should have received a copy of the GNU General Public License |
16 | | * along with this program; if not, a copy is available at |
17 | | * https://www.R-project.org/Licenses/ |
18 | | */ |
19 | | |
20 | | SEXP do_math1(SEXP, SEXP, SEXP, SEXP); |
21 | | SEXP do_math2(SEXP, SEXP, SEXP, SEXP); |
22 | | SEXP do_math3(SEXP, SEXP, SEXP, SEXP); |
23 | | SEXP do_math4(SEXP, SEXP, SEXP, SEXP); |
24 | | #ifdef WHEN_MATH5_IS_THERE |
25 | | SEXP do_math5(SEXP, SEXP, SEXP, SEXP); |
26 | | #endif |
27 | | SEXP do_cmathfuns(SEXP, SEXP, SEXP, SEXP); |
28 | | |
29 | | SEXP complex_math1(SEXP, SEXP, SEXP, SEXP); |
30 | | SEXP complex_math2(SEXP, SEXP, SEXP, SEXP); |
31 | | SEXP complex_unary(ARITHOP_TYPE, SEXP, SEXP); |
32 | | SEXP complex_binary(ARITHOP_TYPE, SEXP, SEXP); |
33 | | |
34 | | double R_pow(double x, double y); |
35 | | static R_INLINE double R_POW(double x, double y) /* handle x ^ 2 inline */ |
36 | 7.35M | { |
37 | 7.35M | return y == 2.0 ? x * x : R_pow(x, y); |
38 | 7.35M | } Line | Count | Source | 36 | 6.93M | { | 37 | 6.93M | return y == 2.0 ? x * x : R_pow(x, y); | 38 | 6.93M | } |
Unexecuted instantiation: complex.c:R_POW Line | Count | Source | 36 | 420k | { | 37 | 420k | return y == 2.0 ? x * x : R_pow(x, y); | 38 | 420k | } |
Unexecuted instantiation: names.c:R_POW |
39 | | |
40 | | /* some systems get this wrong, possibly depend on what libs are loaded */ |
41 | 0 | static R_INLINE double R_log(double x) { |
42 | 0 | return x > 0 ? log(x) : x == 0 ? R_NegInf : R_NaN; |
43 | 0 | } Unexecuted instantiation: arithmetic.c:R_log Unexecuted instantiation: complex.c:R_log Unexecuted instantiation: eval.c:R_log Unexecuted instantiation: names.c:R_log |
44 | | |
45 | | /* Note that the behaviour of log(0) required is not necessarily that |
46 | | mandated by C99 (-HUGE_VAL), and the behaviour of log(x < 0) is |
47 | | optional in C99. Some systems return -Inf for log(x < 0), e.g. |
48 | | libsunmath on Solaris. |
49 | | */ |
50 | | static R_INLINE double logbase(double x, double base) |
51 | 18.2k | { |
52 | 18.2k | #ifdef HAVE_LOG10 |
53 | 18.2k | if(base == 10) return x > 0 ? log10(x) : x == 0 ? R_NegInf : R_NaN; |
54 | 0 | #endif |
55 | 0 | #ifdef HAVE_LOG2 |
56 | 0 | if(base == 2) return x > 0 ? log2(x) : x == 0 ? R_NegInf : R_NaN; |
57 | 0 | #endif |
58 | 0 | return R_log(x) / R_log(base); |
59 | 0 | } Line | Count | Source | 51 | 18.2k | { | 52 | 18.2k | #ifdef HAVE_LOG10 | 53 | 18.2k | if(base == 10) return x > 0 ? log10(x) : x == 0 ? R_NegInf : R_NaN; | 54 | 0 | #endif | 55 | 0 | #ifdef HAVE_LOG2 | 56 | 0 | if(base == 2) return x > 0 ? log2(x) : x == 0 ? R_NegInf : R_NaN; | 57 | 0 | #endif | 58 | 0 | return R_log(x) / R_log(base); | 59 | 0 | } |
Unexecuted instantiation: complex.c:logbase Unexecuted instantiation: eval.c:logbase Unexecuted instantiation: names.c:logbase |
60 | | |
61 | | SEXP do_log_builtin(SEXP call, SEXP op, SEXP args, SEXP env); |
62 | | |
63 | | /* for binary operations */ |
64 | | /* adapted from Radford Neal's pqR */ |
65 | | static R_INLINE SEXP R_allocOrReuseVector(SEXP s1, SEXP s2, |
66 | | SEXPTYPE type , R_xlen_t n) |
67 | 2.68M | { |
68 | 2.68M | R_xlen_t n1 = XLENGTH(s1); |
69 | 2.68M | R_xlen_t n2 = XLENGTH(s2); |
70 | | |
71 | | /* Try to use space for 2nd arg if both same length, so 1st argument's |
72 | | attributes will then take precedence when copied. */ |
73 | | |
74 | 2.68M | if (n == n2) { |
75 | 2.10M | if (TYPEOF(s2) == type && NO_REFERENCES(s2)) { |
76 | 1.58M | if (ATTRIB(s2) != R_NilValue) |
77 | | /* need to remove 'names' attribute if present to |
78 | | match what copyMostAttrib does. copyMostAttrib() |
79 | | also skips 'dim' and 'dimnames' but those, here |
80 | | since those, if present, will be replaced by |
81 | | attribute cleanup code in R_Binary) */ |
82 | 38.8k | setAttrib(s2, R_NamesSymbol, R_NilValue); |
83 | 1.58M | return s2; |
84 | 1.58M | } |
85 | 521k | else |
86 | | /* Can use 1st arg's space only if 2nd arg has no attributes, else |
87 | | we may not get attributes of result right. */ |
88 | 521k | if (n == n1 && TYPEOF(s1) == type && NO_REFERENCES(s1) |
89 | 361k | && ATTRIB(s2) == R_NilValue) |
90 | 361k | return s1; |
91 | 2.10M | } |
92 | 580k | else if (n == n1 && TYPEOF(s1) == type && NO_REFERENCES(s1)) |
93 | 336k | return s1; |
94 | | |
95 | 405k | return allocVector(type, n); |
96 | 2.68M | } arithmetic.c:R_allocOrReuseVector Line | Count | Source | 67 | 2.04M | { | 68 | 2.04M | R_xlen_t n1 = XLENGTH(s1); | 69 | 2.04M | R_xlen_t n2 = XLENGTH(s2); | 70 | | | 71 | | /* Try to use space for 2nd arg if both same length, so 1st argument's | 72 | | attributes will then take precedence when copied. */ | 73 | | | 74 | 2.04M | if (n == n2) { | 75 | 1.59M | if (TYPEOF(s2) == type && NO_REFERENCES(s2)) { | 76 | 1.14M | if (ATTRIB(s2) != R_NilValue) | 77 | | /* need to remove 'names' attribute if present to | 78 | | match what copyMostAttrib does. copyMostAttrib() | 79 | | also skips 'dim' and 'dimnames' but those, here | 80 | | since those, if present, will be replaced by | 81 | | attribute cleanup code in R_Binary) */ | 82 | 8.74k | setAttrib(s2, R_NamesSymbol, R_NilValue); | 83 | 1.14M | return s2; | 84 | 1.14M | } | 85 | 451k | else | 86 | | /* Can use 1st arg's space only if 2nd arg has no attributes, else | 87 | | we may not get attributes of result right. */ | 88 | 451k | if (n == n1 && TYPEOF(s1) == type && NO_REFERENCES(s1) | 89 | 294k | && ATTRIB(s2) == R_NilValue) | 90 | 294k | return s1; | 91 | 1.59M | } | 92 | 457k | else if (n == n1 && TYPEOF(s1) == type && NO_REFERENCES(s1)) | 93 | 217k | return s1; | 94 | | | 95 | 397k | return allocVector(type, n); | 96 | 2.04M | } |
complex.c:R_allocOrReuseVector Line | Count | Source | 67 | 634k | { | 68 | 634k | R_xlen_t n1 = XLENGTH(s1); | 69 | 634k | R_xlen_t n2 = XLENGTH(s2); | 70 | | | 71 | | /* Try to use space for 2nd arg if both same length, so 1st argument's | 72 | | attributes will then take precedence when copied. */ | 73 | | | 74 | 634k | if (n == n2) { | 75 | 510k | if (TYPEOF(s2) == type && NO_REFERENCES(s2)) { | 76 | 440k | if (ATTRIB(s2) != R_NilValue) | 77 | | /* need to remove 'names' attribute if present to | 78 | | match what copyMostAttrib does. copyMostAttrib() | 79 | | also skips 'dim' and 'dimnames' but those, here | 80 | | since those, if present, will be replaced by | 81 | | attribute cleanup code in R_Binary) */ | 82 | 30.1k | setAttrib(s2, R_NamesSymbol, R_NilValue); | 83 | 440k | return s2; | 84 | 440k | } | 85 | 70.1k | else | 86 | | /* Can use 1st arg's space only if 2nd arg has no attributes, else | 87 | | we may not get attributes of result right. */ | 88 | 70.1k | if (n == n1 && TYPEOF(s1) == type && NO_REFERENCES(s1) | 89 | 66.8k | && ATTRIB(s2) == R_NilValue) | 90 | 66.8k | return s1; | 91 | 510k | } | 92 | 123k | else if (n == n1 && TYPEOF(s1) == type && NO_REFERENCES(s1)) | 93 | 118k | return s1; | 94 | | | 95 | 8.42k | return allocVector(type, n); | 96 | 634k | } |
Unexecuted instantiation: eval.c:R_allocOrReuseVector Unexecuted instantiation: names.c:R_allocOrReuseVector |
97 | | |
98 | | // we document that tanpi(0.5) is NaN, but TS 18661-4:2015 |
99 | | // does not require this and the Solaris and macOS versions give Inf. |
100 | | double Rtanpi(double); |