Merge pull request #55 from EmilHvitfeldt/sparse-logical

add sparse logical

NAMESPACE

@@ -3,17 +3,20 @@
 export(as_sparse_character)
 export(as_sparse_double)
 export(as_sparse_integer)
+export(as_sparse_logical)
 export(coerce_to_sparse_data_frame)
 export(coerce_to_sparse_matrix)
 export(coerce_to_sparse_tibble)
 export(is_sparse_character)
 export(is_sparse_double)
 export(is_sparse_integer)
+export(is_sparse_logical)
 export(is_sparse_vector)
 export(sparse_character)
 export(sparse_default)
 export(sparse_double)
 export(sparse_integer)
+export(sparse_logical)
 export(sparse_positions)
 export(sparse_values)
 import(rlang)

R/coerce-vector.R

@@ -82,4 +82,23 @@ as_sparse_character <- function(x, default = "") {
     length = length(x),
     default = default
   )
+}
+
+#' @rdname coerce-vector
+#' @export
+as_sparse_logical <- function(x, default = FALSE) {
+  if (is_sparse_logical(x)) {
+    return(x)
+  }
+
+  check_bool(default)
+
+  index <- which(x != default | is.na(x))
+
+  sparse_logical(
+    values = x[index],
+    positions = index,
+    length = length(x),
+    default = default
+  )
 }

R/sparse_logical.R

@@ -0,0 +1,76 @@
+#' Create sparse logical vector
+#' 
+#' Construction of vectors where only values and positions are recorded. The 
+#' Length and default values determine all other information.
+#' 
+#' @param values logical vector, values of non-zero entries.
+#' @param positions integer vector, indices of non-zero entries.
+#' @param length integer value, Length of vector.
+#' @param default logical value, value at indices not specified by `positions`. 
+#'   Defaults to `FALSE`. Cannot be `NA`.
+#' 
+#' @details
+#' 
+#' `values` and `positions` are expected to be the same length, and are allowed
+#' to both have zero length.
+#' 
+#' Allowed values for `value` are logical values. Missing values such as `NA` 
+#' and `NA_real_` are allowed. Everything else is disallowed, The values are 
+#' also not allowed to take the same value as `default`.
+#' 
+#' `positions` should be integers or integer-like doubles. Everything else is 
+#' not allowed. Positions should furthermore be positive (`0` not allowed),
+#' unique, and in increasing order. Lastly they should all be smaller that 
+#' `length`.
+#' 
+#' For developers: 
+#' 
+#' setting `options("sparsevctrs.verbose_materialize" = TRUE)` will print a 
+#' message each time a sparse vector has been forced to materialize.
+#'
+#' @seealso [sparse_double()] [sparse_integer()] [sparse_character()] 
+#'  
+#' @examples
+#' sparse_logical(logical(), integer(), 10)
+#' 
+#' sparse_logical(c(TRUE, NA, TRUE), c(2, 5, 10), 10)
+#' 
+#' str(
+#'   sparse_logical(c(TRUE, NA, TRUE), c(2, 5, 10), 1000000000)
+#' )
+#' @export
+sparse_logical <- function(values, positions, length, default = FALSE) {
+  check_bool(default)
+  check_number_whole(length, min = 0)
+  if (!is.integer(length)) {
+    length <- as.integer(length)
+  }
+
+  validate_values_logical(values)
+
+  validate_positions(positions, length, len_values = length(values))
+  positions <- as.integer(positions)
+
+  if (any(values == default, na.rm = TRUE)) {
+    offenders <- which(values == default)
+    cli::cli_abort(
+      c(
+        x = "{.arg values} value must not be equal to the default {default}.",
+        i = "{default} values at index: {offenders}."
+      )
+    )
+  }
+
+  new_sparse_logical(values, positions, length, default)
+}
+
+new_sparse_logical <- function(values, positions, length, default) {
+  x <- list(
+    val = values,
+    pos = positions,
+    len = length,
+    default = default
+  )
+
+  .Call(ffi_altrep_new_sparse_logical, x)
+}

R/type-predicates.R

@@ -41,7 +41,8 @@ is_sparse_vector <- function(x) {
   valid <- c(
     "altrep_sparse_double", 
     "altrep_sparse_integer", 
-    "altrep_sparse_string"
+    "altrep_sparse_string",
+    "altrep_sparse_logical"
   )
 
   res %in% valid
@@ -85,3 +86,16 @@ is_sparse_character <- function(x) {
 
   res == "altrep_sparse_string"
 }
+
+#' @rdname type-predicates
+#' @export
+is_sparse_logical <- function(x) {
+  res <- .Call(ffi_extract_altrep_class, x)
+  if (is.null(res)) {
+    return(FALSE)
+  }
+
+  res <- as.character(res[[1]])
+
+  res == "altrep_sparse_logical"
+}

R/validate-input.R

@@ -140,4 +140,14 @@ validate_values_integer <- function(values, call = rlang::caller_env()) {
       call = call
     )
   }
+}
+
+validate_values_logical <- function(values, call = rlang::caller_env()) {
+  if (!is.logical(values)) {
+    cli::cli_abort(
+      "{.arg values} must be a logical vector, \\
+      not {.obj_type_friendly {values}}.",
+      call = call
+    )
+  }
 }

_pkgdown.yml

@@ -8,6 +8,7 @@ reference:
     - sparse_double
     - sparse_integer
     - sparse_character
+    - sparse_logical
 
   - title: Convertion functions
     contents: