Merge pull request #34 from EmilHvitfeldt/many-small-things

Many small things

DESCRIPTION

@@ -21,4 +21,4 @@ Config/Needs/website: rmarkdown
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.1.9000

NAMESPACE

@@ -1,5 +1,9 @@
 # Generated by roxygen2: do not edit by hand
 
+export(is_sparse_double)
+export(is_sparse_vector)
 export(sparse_double)
+export(sparse_positions)
+export(sparse_values)
 import(rlang)
 useDynLib(sparsevctrs, .registration = TRUE)

R/altrep.R

@@ -1,7 +1,7 @@
 #' Create sparse double vector
 #' 
-#' @param value Numeric vector, values of non-zero entries.
-#' @param position integer vector, indices of non-zero entries.
+#' @param values Numeric vector, values of non-zero entries.
+#' @param positions integer vector, indices of non-zero entries.
 #' @param length Integer, Length of vector.
 #' 
 #' @details
@@ -20,142 +20,131 @@
 #'   sparse_double(c(pi, 5, 0.1), c(2, 5, 10), 1000000000)
 #' )
 #' @export
-sparse_double <- function(value, position, length) {
+sparse_double <- function(values, positions, length) {
   check_number_whole(length, min = 0)
   if (!is.integer(length)) {
     length <- as.integer(length)
   }
 
-  if (!is.numeric(value)) {
+  if (!is.numeric(values)) {
     cli::cli_abort(
-      "{.arg value} must be a numeric vector, not {.obj_type_friendly {value}}."
+      "{.arg values} must be a numeric vector, \\
+      not {.obj_type_friendly {values}}."
     )
   }
 
-  if (any(is.infinite(value))) {
-    offenders <- which(is.infinite(value))
+  if (any(is.infinite(values))) {
+    offenders <- which(is.infinite(values))
     cli::cli_abort(
       c(
-        x = "{.arg value} must not contain infinite values.",
+        x = "{.arg values} must not contain infinite values.",
         i = "Infinite values at index: {offenders}."
       )
     )
   }
 
-  if (is.integer(value)) {
-    value <- as.double(value)
+  if (is.integer(values)) {
+    values <- as.double(values)
   }
 
-  if (!is.numeric(position)) {
+  if (!is.numeric(positions)) {
     cli::cli_abort(
-      "{.arg position} must be a integer vector, \\
-      not {.obj_type_friendly {value}}."
+      "{.arg positions} must be a integer vector, \\
+      not {.obj_type_friendly {positions}}."
     )
   }
 
-  if (any(is.infinite(position))) {
-    offenders <- which(is.infinite(position))
+  if (any(is.infinite(positions))) {
+    offenders <- which(is.infinite(positions))
     cli::cli_abort(
       c(
-        x = "{.arg position} must not contain infinite values.",
+        x = "{.arg positions} must not contain infinite values.",
         i = "Infinite values at index: {offenders}."
       )
     )
   }
 
-  if (!is.integer(position)) {
-    if (any(round(position) != position, na.rm = TRUE)) {
-      offenders <- which(round(position) != position)
+  if (!is.integer(positions)) {
+    if (any(round(positions) != positions, na.rm = TRUE)) {
+      offenders <- which(round(positions) != positions)
 
       cli::cli_abort(
         c(
-          x = "{.arg position} must contain integer values.",
+          x = "{.arg positions} must contain integer values.",
           i = "Non-integer values at index: {offenders}."
         )
       )
     }
 
-    position <- as.integer(position)
+    positions <- as.integer(positions)
   }
 
-  len_value <- length(value)
-  len_position <- length(position)
+  len_values <- length(values)
+  len_positions <- length(positions)
 
-  if (len_value != len_position) {
+  if (len_values != len_positions) {
     cli::cli_abort(
-      "{.arg value} ({len_value}) and {.arg position} ({len_position}) \\
+      "{.arg value} ({len_values}) and {.arg positions} ({len_positions}) \\
       must have the same length."
     )
   }
 
-  if (anyDuplicated(position) > 0) {
-    offenders <- which(duplicated(position))
+  if (anyDuplicated(positions) > 0) {
+    offenders <- which(duplicated(positions))
 
     cli::cli_abort(
       c(
-        x = "{.arg position} must not contain any duplicate values.",
+        x = "{.arg positions} must not contain any duplicate values.",
         i = "Duplicate values at index: {offenders}."
       )
     )
   }
 
-  if (is.unsorted(position)) {
+  if (is.unsorted(positions)) {
     cli::cli_abort(
-      "{.arg position} must be sorted in increasing order."
+      "{.arg positions} must be sorted in increasing order."
     )
   }
 
-  if (len_position > 0 && max(position) > length) {
-    offenders <- which(position > length)
+  if (len_positions > 0 && max(positions) > length) {
+    offenders <- which(positions > length)
     cli::cli_abort(
       c(
-        x = "{.arg position} value must not be larger than {.arg length}.",
+        x = "{.arg positions} value must not be larger than {.arg length}.",
         i = "Offending values at index: {offenders}."
       )
     )
   }
 
-  if (len_position > 0 && min(position) < 1) {
-    offenders <- which(position < 1)
+  if (len_positions > 0 && min(positions) < 1) {
+    offenders <- which(positions < 1)
     cli::cli_abort(
       c(
-        x = "{.arg position} value must positive.",
+        x = "{.arg positions} value must positive.",
         i = "Non-positive values at index: {offenders}."
       )
     )
   }
 
-  if (any(value == 0)) {
-    offenders <- which(value == 0)
+  if (any(values == 0)) {
+    offenders <- which(values == 0)
     cli::cli_abort(
       c(
-        x = "{.arg value} value must not be 0.",
+        x = "{.arg values} value must not be 0.",
         i = "0 values at index: {offenders}."
       )
     )
   }
 
-  new_sparse_double(value, position, length)
+  new_sparse_double(values, positions, length)
 }
 
-new_sparse_double <- function(value, position, length) {
+new_sparse_double <- function(values, positions, length) {
   x <- list(
-    val = value, 
-    pos = position, 
+    val = values, 
+    pos = positions, 
     len = length
   )
 
   .Call(ffi_altrep_new_sparse_double, x)
 }
-
-is_sparse_vector <- function(x) {
-  res <- .Call(ffi_extract_altrep_class, x)
-  if (is.null(res)) {
-    return(FALSE)
-  }
-
-  res <- as.character(res[[1]])
-
-  res %in% c("altrep_sparse_double")
- }
-

R/extractors.R

@@ -1,12 +1,38 @@
-.positions <- function(x) {
+#' Information extraction from sparse vectors
+#' 
+#' Extract positions and values from sparse vectors without the need to 
+#' materialize vector.
+#' 
+#' @param x vector to be extracted from.
+#'
+#' @details
+#' for ease of use, these functions also works on non-sparse variables.
+#' 
+#' @examples
+#' x_sparse <- sparse_double(c(pi, 5, 0.1), c(2, 5, 10), 10)
+#' x_dense <- c(0, pi, 0, 0, 0.5, 0, 0, 0, 0, 0.1)
+#' 
+#' sparse_positions(x_sparse)
+#' sparse_values(x_sparse)
+#' 
+#' sparse_positions(x_dense)
+#' sparse_values(x_dense)
+#' @name extractors
+NULL
+
+#' @rdname extractors
+#' @export
+sparse_positions <- function(x) {
   if (!is_sparse_vector(x)) {
     return(seq_along(x))
   }
 
   .Call(ffi_altrep_sparse_positions, x)
 }
 
-.values <- function(x) {
+#' @rdname extractors
+#' @export
+sparse_values <- function(x) {
   if (!is_sparse_vector(x)) {
     return(x)
   }

R/type-predicates.R

@@ -0,0 +1,41 @@
+#' Sparse vector type checkers
+#' 
+#' @param x value to be checked.
+#'
+#' @examples
+#' x_sparse <- sparse_double(c(pi, 5, 0.1), c(2, 5, 10), 10)
+#' x_dense <- c(0, pi, 0, 0, 0.5, 0, 0, 0, 0, 0.1)
+#' 
+#' is_sparse_vector(x_sparse)
+#' is_sparse_vector(x_dense)
+#' 
+#' # Forced materialization
+#' is_sparse_vector(x_sparse[])
+#' @name type-predicates
+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]])
+
+  res %in% c("altrep_sparse_double")
+}
+
+#' @rdname type-predicates
+#' @export
+is_sparse_double <- function(x) {
+  res <- .Call(ffi_extract_altrep_class, x)
+  if (is.null(res)) {
+    return(FALSE)
+  }
+
+  res <- as.character(res[[1]])
+
+  res == "altrep_sparse_double"
+}

_pkgdown.yml

@@ -2,3 +2,12 @@ url: https://emilhvitfeldt.github.io/sparsevctrs/
 template:
   bootstrap: 5
 
+reference:
+  - title: Create Sparse Vectors
+    contents:
+    - sparse_double
+
+  - title: Helper Functions
+    contents:
+    - type-predicates
+    - extractors