From 578ec5a50e86c22897db241ffe78db700bc4859d Mon Sep 17 00:00:00 2001
From: Emil Hvitfeldt <emilhhvitfeldt@gmail.com>
Date: Thu, 9 May 2024 18:45:54 -0700
Subject: [PATCH] add sparse_default()

---
 NAMESPACE                        |  1 +
 R/extractors.R                   | 25 +++++++++++++++++++++++--
 man/extractors.Rd                | 15 +++++++++++++--
 src/init.c                       |  1 +
 src/sparse-extractors.c          |  5 +++++
 src/sparse-extractors.h          |  2 ++
 tests/testthat/test-extractors.R | 19 +++++++++++++++++++
 7 files changed, 64 insertions(+), 4 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 2f94f74..f87fc27 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -5,6 +5,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)
diff --git a/R/extractors.R b/R/extractors.R
index c586cd6..817d08f 100644
--- a/R/extractors.R
+++ b/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)
+}
diff --git a/man/extractors.Rd b/man/extractors.Rd
index f4e8ff9..781f224 100644
--- a/man/extractors.Rd
+++ b/man/extractors.Rd
@@ -4,20 +4,26 @@
 \alias{extractors}
 \alias{sparse_positions}
 \alias{sparse_values}
+\alias{sparse_default}
 \title{Information extraction from sparse vectors}
 \usage{
 sparse_positions(x)
 
 sparse_values(x)
+
+sparse_default(x)
 }
 \arguments{
 \item{x}{vector to be extracted from.}
 }
 \description{
-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{
+\code{sparse_default()} returns \code{NA} when applied to non-sparse vectors. This is
+done to have an indicator of non-sparsity.
+
 for ease of use, these functions also works on non-sparse variables.
 }
 \examples{
@@ -26,7 +32,12 @@ x_dense <- c(0, pi, 0, 0, 0.5, 0, 0, 0, 0, 0.1)
 
 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)
 }
diff --git a/src/init.c b/src/init.c
index 0ac32c5..61c09ac 100644
--- a/src/init.c
+++ b/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}};
 
diff --git a/src/sparse-extractors.c b/src/sparse-extractors.c
index deb49ec..e579ec9 100644
--- a/src/sparse-extractors.c
+++ b/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;
+}
diff --git a/src/sparse-extractors.h b/src/sparse-extractors.h
index 5538009..d745736 100644
--- a/src/sparse-extractors.h
+++ b/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
diff --git a/tests/testthat/test-extractors.R b/tests/testthat/test-extractors.R
index 7148971..8578616 100644
--- a/tests/testthat/test-extractors.R
+++ b/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
+  )
+})