|
1 |
| -#define R_NO_REMAP |
2 | 1 | #include <R.h>
|
3 | 2 | #include <Rinternals.h>
|
4 | 3 |
|
5 |
| -SEXP c_keep_in_bounds(SEXP in, SEXP lower, SEXP upper) { |
6 |
| - const int * x = INTEGER(in); |
7 |
| - const int ll = INTEGER(lower)[0]; |
8 |
| - const int lu = INTEGER(upper)[0]; |
9 |
| - const R_xlen_t n = Rf_xlength(in); |
10 |
| - R_xlen_t i; |
| 4 | +SEXP c_keep_in_bounds(SEXP s_in, SEXP s_lower, SEXP s_upper) { |
| 5 | + const int *x = INTEGER(s_in); |
| 6 | + const int ll = asInteger(s_lower); |
| 7 | + const int lu = asInteger(s_upper); |
| 8 | + const R_xlen_t n = LENGTH(s_in); |
| 9 | + R_xlen_t i, j; |
11 | 10 |
|
12 |
| - // fast-forward to first element not in bounds |
13 |
| - for (i = 0; i < n; i++) { |
14 |
| - if (x[i] == NA_INTEGER || x[i] < ll || x[i] > lu) { |
15 |
| - break; |
16 |
| - } |
17 |
| - } |
18 |
| - |
19 |
| - // everything ok, in == out |
20 |
| - if (i == n) { |
21 |
| - return(in); |
22 |
| - } |
| 11 | + // count the number of elements within bounds |
| 12 | + int count = 0; |
| 13 | + for (i = 0; i < n; i++) |
| 14 | + if (x[i] != NA_INTEGER && x[i] >= ll && x[i] <= lu) count++; |
23 | 15 |
|
24 |
| - // allocate output vector |
25 |
| - SEXP out = PROTECT(Rf_allocVector(INTSXP, n)); |
26 |
| - int * y = INTEGER(out); |
27 |
| - R_xlen_t j; |
| 16 | + // if all ok, immediatly return without alloc and copy |
| 17 | + if (count == n) return(s_in); |
28 | 18 |
|
29 |
| - // copy everything up to the first element out of bounds |
30 |
| - for (j = 0; j < i; j++) { |
31 |
| - y[j] = x[j]; |
32 |
| - } |
| 19 | + // create a new vector to store the filtered elements |
| 20 | + SEXP s_out = PROTECT(allocVector(REALSXP, count)); |
| 21 | + double *out = REAL(s_out); |
33 | 22 |
|
34 |
| - // process remaining elements |
35 |
| - for (i = i + 1; i < n; i++) { |
36 |
| - if (x[i] != NA_INTEGER && x[i] >= ll && x[i] <= lu) { |
37 |
| - y[j] = x[i]; |
38 |
| - j++; |
39 |
| - } |
| 23 | + // Copy the elements within bounds to the new vector |
| 24 | + j = 0; |
| 25 | + for (i = 0; i < n; i++) { |
| 26 | + if (x[i] != NA_INTEGER && x[i] >= ll && x[i] <= lu) |
| 27 | + out[j++] = x[i]; |
40 | 28 | }
|
41 |
| - |
42 |
| - // resize the vector to the right length |
43 |
| - SETLENGTH(out, j); |
44 |
| - |
45 |
| - // unprotect + return |
46 | 29 | UNPROTECT(1);
|
47 |
| - return out; |
| 30 | + return s_out; |
48 | 31 | }
|
0 commit comments