Merge pull request #62 from r-lib/is_sparse_numeric

add is_sparse_numeric

NAMESPACE

@@ -11,6 +11,7 @@ export(is_sparse_character)
 export(is_sparse_double)
 export(is_sparse_integer)
 export(is_sparse_logical)
+export(is_sparse_numeric)
 export(is_sparse_vector)
 export(sparse_character)
 export(sparse_default)

R/type-predicates.R

@@ -7,8 +7,9 @@
 #' @details
 #' `is_sparse_vector()` is a general function that detects any type of sparse 
 #' vector created with this package. `is_sparse_double()`, 
-#' `is_sparse_integer()`, and `is_sparse_character()` are more specific 
-#' functions that only detects the type.
+#' `is_sparse_integer()`, `is_sparse_character()`, and `is_sparse_logical()` are 
+#' more specific functions that only detects the type. `is_sparse_numeric()`
+#' matches both sparse integers and doubles.
 #'
 #' @examples
 #' x_sparse <- sparse_double(c(pi, 5, 0.1), c(2, 5, 10), 10)
@@ -47,7 +48,20 @@ is_sparse_vector <- function(x) {
 
   res %in% valid
 }
-
+
+#' @rdname type-predicates
+#' @export
+is_sparse_numeric <- function(x) {
+  res <- .Call(ffi_extract_altrep_class, x)
+  if (is.null(res)) {
+    return(FALSE)
+  }
+
+  res <- as.character(res[[1]])
+
+  res == "altrep_sparse_double" || res == "altrep_sparse_integer"
+}
+
 #' @rdname type-predicates
 #' @export
 is_sparse_double <- function(x) {

tests/testthat/test-type-predicates.R

@@ -7,6 +7,15 @@ test_that("is_sparse_vector works", {
   expect_false(is_sparse_vector(NULL))
 })
 
+test_that("is_sparse_numeric works", {
+  expect_true(is_sparse_numeric(sparse_double(1, 1, 1)))
+  expect_true(is_sparse_numeric(sparse_integer(1, 1, 1)))
+
+  expect_false(is_sparse_numeric(c(1, 1, 1)))
+  expect_false(is_sparse_numeric(1:10))
+  expect_false(is_sparse_numeric(NULL))
+})
+
 test_that("is_sparse_double works", {
   expect_true(is_sparse_double(sparse_double(1, 1, 1)))
 
@@ -30,3 +39,11 @@ test_that("is_sparse_character works", {
   expect_false(is_sparse_character(1:10))
   expect_false(is_sparse_character(NULL))
 })
+
+test_that("is_sparse_logical works", {
+  expect_true(is_sparse_logical(sparse_logical(TRUE, 1, 1)))
+
+  expect_false(is_sparse_logical(c(1, 1, 1)))
+  expect_false(is_sparse_logical(1:10))
+  expect_false(is_sparse_logical(NULL))
+})