Created
December 29, 2015 23:21
-
-
Save nathan-russell/eacb0803ab7dc81bb2d8 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#include <Rcpp.h> | |
template <int RTYPE> | |
struct CompareTwo { | |
typedef typename Rcpp::traits::storage_type<RTYPE>::type stored_type; | |
typedef Rcpp::Vector<RTYPE> VECTOR; | |
inline static Rcpp::Vector<LGLSXP> | |
apply(const VECTOR& x, stored_type y, stored_type z) { | |
R_xlen_t i = 0, n = x.size(); | |
Rcpp::Vector<LGLSXP> result(n); | |
for ( ; i < n; i++) { | |
result[i] = (x[i] == y || x[i] == z); | |
} | |
return result; | |
} | |
inline static Rcpp::Vector<LGLSXP> | |
string_apply(const Rcpp::Vector<STRSXP>& x, Rcpp::String y, Rcpp::String z) { | |
R_xlen_t i = 0, n = x.size(); | |
Rcpp::Vector<LGLSXP> result(n); | |
for ( ; i < n; i++) { | |
result[i] = (x[i] == y || x[i] == z); | |
} | |
return result; | |
} | |
}; | |
// [[Rcpp::export]] | |
SEXP this_or_that(SEXP x, SEXP y, SEXP z) { | |
switch (TYPEOF(x)) { | |
case INTSXP: { | |
int yy = Rf_asInteger(y), zz = Rf_asInteger(z); | |
return CompareTwo<INTSXP>::apply(x, yy, zz); | |
} | |
case REALSXP: { | |
double yy = Rf_asReal(y), zz = Rf_asReal(z); | |
return CompareTwo<REALSXP>::apply(x, yy, zz); | |
} | |
case STRSXP: { | |
Rcpp::String yy(CHAR(Rf_asChar(y))); | |
Rcpp::String zz(CHAR(Rf_asChar(z))); | |
return CompareTwo<STRSXP>::string_apply(x, yy, zz); | |
} | |
case CPLXSXP: { | |
Rcomplex yy = Rf_asComplex(y), zz = Rf_asComplex(z); | |
return CompareTwo<CPLXSXP>::apply(x, yy, zz); | |
} | |
case LGLSXP: { | |
bool yy = Rf_asLogical(y), zz = Rf_asLogical(z); | |
return CompareTwo<LGLSXP>::apply(x, yy, zz); | |
} | |
default: | |
return R_NilValue; | |
} | |
} | |
/*** R | |
r_this_or_that <- function(x, y, z) { | |
x == y | x == z | |
} | |
vec <- 1L:5L | |
all.equal(r_this_or_that(vec, 2L, 4L), this_or_that(vec, 2L, 4L)) | |
## | |
vec <- 1.5:5.5 | |
all.equal(r_this_or_that(vec, 2.5, 4.5), this_or_that(vec, 2.5, 4.5)) | |
## | |
vec <- LETTERS[1:5] | |
all.equal(r_this_or_that(vec, "B", "D"), this_or_that(vec, "B", "D")) | |
## | |
vec <- 1:5 + 2i | |
all.equal(r_this_or_that(vec, 2 + 2i, 4 + 2i), | |
this_or_that(vec, 2 + 2i, 4 + 2i)) | |
## | |
vec <- rep(c(TRUE, FALSE), 2) | |
all.equal(r_this_or_that(vec, TRUE, TRUE), | |
this_or_that(vec, TRUE, TRUE)) | |
## | |
*/ |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment