From 03827e7b17d7e125472bf1a960645957d6d39c7a Mon Sep 17 00:00:00 2001
From: Emil Hvitfeldt <emilhhvitfeldt@gmail.com>
Date: Thu, 19 Sep 2024 15:18:53 -0700
Subject: [PATCH 1/2] rewrite is_sparse_vector() in C

---
 R/type-predicates.R | 16 +---------------
 src/init.c          |  1 +
 src/sparse-utils.c  | 12 ++++++++++++
 src/sparse-utils.h  |  2 ++
 4 files changed, 16 insertions(+), 15 deletions(-)

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

From 68965e2a97b2ea75c710ff1f7def5c3aa66ae255 Mon Sep 17 00:00:00 2001
From: Emil Hvitfeldt <emilhhvitfeldt@gmail.com>
Date: Thu, 19 Sep 2024 15:20:10 -0700
Subject: [PATCH 2/2] update news

---
 NEWS.md | 2 ++
 1 file changed, 2 insertions(+)

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.