diff --git a/NEWS.md b/NEWS.md index 8ef2c4a..bb2804c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,6 +8,8 @@ * Helper function `has_sparse_elements()` has been added (#70) +* `is_sparse_vector()` has been rewritten for speed improvement. (#76) + # sparsevctrs 0.1.0 * Initial CRAN submission. diff --git a/R/type-predicates.R b/R/type-predicates.R index e16f11d..16cc74c 100644 --- a/R/type-predicates.R +++ b/R/type-predicates.R @@ -34,21 +34,7 @@ NULL #' @rdname type-predicates #' @export is_sparse_vector <- function(x) { - res <- .Call(ffi_extract_altrep_class, x) - if (is.null(res)) { - return(FALSE) - } - - res <- as.character(res[[1]]) - - valid <- c( - "altrep_sparse_double", - "altrep_sparse_integer", - "altrep_sparse_string", - "altrep_sparse_logical" - ) - - res %in% valid + .Call(ffi_is_sparse_vector, x) } #' @rdname type-predicates diff --git a/src/init.c b/src/init.c index c5d387d..d62dbdd 100644 --- a/src/init.c +++ b/src/init.c @@ -35,6 +35,7 @@ static const R_CallMethodDef CallEntries[] = { {"ffi_altrep_sparse_values", (DL_FUNC) &ffi_altrep_sparse_values, 1}, {"ffi_altrep_sparse_default", (DL_FUNC) &ffi_altrep_sparse_default, 1}, {"ffi_extract_altrep_class", (DL_FUNC) &ffi_extract_altrep_class, 1}, + {"ffi_is_sparse_vector", (DL_FUNC) &ffi_is_sparse_vector, 1}, {NULL, NULL, 0}}; void R_init_sparsevctrs(DllInfo* dll) { diff --git a/src/sparse-utils.c b/src/sparse-utils.c index 25098ad..3976097 100644 --- a/src/sparse-utils.c +++ b/src/sparse-utils.c @@ -68,6 +68,18 @@ SEXP ffi_extract_altrep_class(SEXP x) { return ATTRIB(ALTREP_CLASS(x)); } +static inline SEXP altrep_package(SEXP x) { + return VECTOR_ELT(Rf_PairToVectorList(ATTRIB(ALTREP_CLASS(x))), 1); +} + +SEXP ffi_is_sparse_vector(SEXP x) { + if (!is_altrep(x)) { + return (Rf_ScalarLogical(FALSE)); + } + + return Rf_ScalarLogical(altrep_package(x) == Rf_install("sparsevctrs")); +} + static inline R_xlen_t midpoint(R_xlen_t lhs, R_xlen_t rhs) { return lhs + (rhs - lhs) / 2; } diff --git a/src/sparse-utils.h b/src/sparse-utils.h index ea70ccf..4d1f149 100644 --- a/src/sparse-utils.h +++ b/src/sparse-utils.h @@ -25,6 +25,8 @@ bool is_altrep(SEXP x); SEXP ffi_extract_altrep_class(SEXP x); +SEXP ffi_is_sparse_vector(SEXP x); + R_xlen_t binary_search(int needle, const int* v_haystack, R_xlen_t size); bool is_index_handleable(SEXP x);