Merge pull request #44 from EmilHvitfeldt/extract_default

add sparse_default()

NAMESPACE

@@ -6,6 +6,7 @@ export(coerce_to_sparse_matrix)
 export(coerce_to_sparse_tibble)
 export(is_sparse_double)
 export(is_sparse_vector)
+export(sparse_default)
 export(sparse_double)
 export(sparse_positions)
 export(sparse_values)

R/extractors.R

@@ -1,7 +1,12 @@
 #' Information extraction from sparse vectors
 #' 
-#' Extract positions and values from sparse vectors without the need to 
-#' materialize vector.
+#' Extract positions, values, and default from sparse vectors without the need 
+#' to materialize vector.
+#' 
+#' @details
+#' 
+#' `sparse_default()` returns `NA` when applied to non-sparse vectors. This is
+#' done to have an indicator of non-sparsity.
 #' 
 #' @param x vector to be extracted from.
 #'
@@ -14,9 +19,14 @@
 #' 
 #' sparse_positions(x_sparse)
 #' sparse_values(x_sparse)
+#' sparse_default(x_sparse)
 #' 
 #' sparse_positions(x_dense)
 #' sparse_values(x_dense)
+#' sparse_default(x_dense)
+#' 
+#' x_sparse_3 <- sparse_double(c(pi, 5, 0.1), c(2, 5, 10), 10, default = 3)
+#' sparse_default(x_sparse_3)
 #' @name extractors
 NULL
 
@@ -39,3 +49,14 @@ sparse_values <- function(x) {
 
   .Call(ffi_altrep_sparse_values, x)
 }
+
+
+#' @rdname extractors
+#' @export
+sparse_default <- function(x) {
+  if (!is_sparse_vector(x)) {
+    return(NA)
+  }
+
+  .Call(ffi_altrep_sparse_default, x)
+}

src/init.c

@@ -12,6 +12,7 @@ static const R_CallMethodDef CallEntries[] = {
      1},
     {"ffi_altrep_sparse_positions", (DL_FUNC) &ffi_altrep_sparse_positions, 1},
     {"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},
     {NULL, NULL, 0}};
 

src/sparse-extractors.c

@@ -9,3 +9,8 @@ SEXP ffi_altrep_sparse_values(SEXP x) {
   SEXP out = extract_val(x);
   return out;
 }
+
+SEXP ffi_altrep_sparse_default(SEXP x) {
+  SEXP out = extract_default(x);
+  return out;
+}

src/sparse-extractors.h

@@ -9,4 +9,6 @@ SEXP ffi_altrep_sparse_positions(SEXP x);
 
 SEXP ffi_altrep_sparse_values(SEXP x);
 
+SEXP ffi_altrep_sparse_default(SEXP x);
+
 #endif

tests/testthat/test-extractors.R

@@ -45,3 +45,22 @@ test_that("sparse_values works with numeric vectors", {
     101:200
   )
 })
+
+test_that("sparse_default works with altrep_sparse_double", {
+  expect_identical(
+    sparse_default(sparse_double(1, 5, 10)),
+    0
+  )
+
+  expect_identical(
+    sparse_default(sparse_double(1, 5, 10, default = 11)),
+    11
+  )
+})
+
+test_that("sparse_values works with numeric vectors", {
+  expect_identical(
+    sparse_default(c(1, 6, 4, 2)),
+    NA
+  )
+})