From 69b6e10f26452e635d7436c171c6d2a2007a2cf7 Mon Sep 17 00:00:00 2001 From: Emil Hvitfeldt Date: Wed, 1 May 2024 13:12:11 -0700 Subject: [PATCH] remove dependencies --- DESCRIPTION | 6 +-- NAMESPACE | 9 ---- R/altrep.R | 13 ++++- R/convert.R | 79 ---------------------------- R/sparsevctrs-package.R | 4 -- R/vector.R | 91 --------------------------------- man/new_sparse_vector.Rd | 25 --------- man/sparse_to_tibble.Rd | 27 ---------- man/sparse_vector.Rd | 25 --------- man/sparsevctrs-vctrs.Rd | 9 ---- man/tibble_to_sparse.Rd | 28 ---------- tests/testthat/_snaps/altrep.md | 6 +-- 12 files changed, 16 insertions(+), 306 deletions(-) delete mode 100644 R/convert.R delete mode 100644 R/vector.R delete mode 100644 man/new_sparse_vector.Rd delete mode 100644 man/sparse_to_tibble.Rd delete mode 100644 man/sparse_vector.Rd delete mode 100644 man/sparsevctrs-vctrs.Rd delete mode 100644 man/tibble_to_sparse.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 3ec3e40..efd67c0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,12 +13,8 @@ Depends: R (>= 4.0.0) Imports: cli (>= 3.4.0), - Matrix, - rlang (>= 1.1.0), - tibble, - vctrs + rlang (>= 1.1.0) Suggests: - rsparse, testthat (>= 3.0.0), withr Config/Needs/website: rmarkdown diff --git a/NAMESPACE b/NAMESPACE index a8ed218..09a01eb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,14 +1,5 @@ # Generated by roxygen2: do not edit by hand -S3method(format,sparse_vector) -S3method(vec_arith,sparse_vector) -S3method(vec_math,sparse_vector) -S3method(vec_ptype_abbr,sparse_vector) export(new_sparse_real) -export(new_sparse_vector) -export(sparse_to_tibble) -export(sparse_vector) -export(tibble_to_sparse) import(rlang) -import(vctrs) useDynLib(sparsevctrs, .registration = TRUE) diff --git a/R/altrep.R b/R/altrep.R index a516f29..219049d 100644 --- a/R/altrep.R +++ b/R/altrep.R @@ -56,7 +56,18 @@ new_sparse_real <- function(value, position, length) { } if (!is.integer(position)) { - position <- vec_cast(position, integer()) + if (any(round(position) != position)) { + offenders <- which(round(position) != position) + + cli::cli_abort( + c( + x = "{.arg position} must contain integer values.", + i = "Non-integer values at index: {offenders}." + ) + ) + } + + position <- as.integer(position) } len_value <- length(value) diff --git a/R/convert.R b/R/convert.R deleted file mode 100644 index 6bb811e..0000000 --- a/R/convert.R +++ /dev/null @@ -1,79 +0,0 @@ -#' Convert sparse matrices to tibbles -#' -#' @param x a sparse matrix -#' -#' @return a tibble -#' @export -#' -#' @seealso [tibble_to_sparse()] -#' -#' @examplesIf rlang::is_installed("rsparse") -#' # data("movielens100k", package = "rsparse") -#' -#' # sparse_to_tibble(movielens100k) -sparse_to_tibble <- function(x) { - start <- x@p[seq(1, length(x@p) - 1)] + 1 - end <- x@p[seq(2, length(x@p))] - - column_length <- nrow(x) - - results <- list() - - for (column in seq_along(start)) { - index <- seq(start[column], end[column]) - results[[column]] <- new_sparse_vector( - values = x@x[index], - positions = x@i[index], - length = column_length - ) - } - - names(results) <- colnames(x) - - tibble::as_tibble(results) -} - -#' Convert tibbles to sparse matrices -#' -#' @param x a tibble -#' -#' @return a sparse matrix -#' @export -#' -#' @seealso [sparse_to_tibble()] -#' -#' @examples -#' # mts <- mtcars -#' # mts$new <- new_sparse_vector(c(1, 4, 8), c(8, 1, 20), nrow(mts)) -#' -#' # tibble_to_sparse(mtcars) -#' -#' # tibble_to_sparse(mts) -tibble_to_sparse <- function(x) { - any_sparse_vector <- any( - vapply(x, inherits, "sparse_vector", FUN.VALUE = logical(1)) - ) - - if (any_sparse_vector) { - all_positions <- lapply(x, .positions) - all_values <- lapply(x, .values) - all_rows <- rep(seq_along(x), times = lengths(all_positions)) - - all_positions <- unlist(all_positions, use.names = FALSE) - all_values <- unlist(all_values, use.names = FALSE) - - non_zero <- all_values != 0 - all_positions <- all_positions[non_zero] - all_values <- all_values[non_zero] - all_rows <- all_rows[non_zero] - - res <- Matrix::sparseMatrix( - i = all_positions, - j = all_rows, - x = all_values - ) - } else { - res <- Matrix::Matrix(as.matrix(x), sparse = TRUE) - } - res -} diff --git a/R/sparsevctrs-package.R b/R/sparsevctrs-package.R index 9a42b95..d2cb7a1 100644 --- a/R/sparsevctrs-package.R +++ b/R/sparsevctrs-package.R @@ -1,12 +1,8 @@ #' @keywords internal "_PACKAGE" -#' Internal vctrs methods -#' -#' @import vctrs #' @import rlang #' @keywords internal -#' @name sparsevctrs-vctrs NULL ## usethis namespace: start diff --git a/R/vector.R b/R/vector.R deleted file mode 100644 index 2b37a0d..0000000 --- a/R/vector.R +++ /dev/null @@ -1,91 +0,0 @@ -#' Create new sparse vector -#' -#' @param values Vector of values -#' @param positions Vector of positions, must be integers and same length as -#' values. -#' @param length Length of resulting vector -#' -#' @return A sparse_vector object. -#' @export -#' -#' @examples -#' new_sparse_vector(1, 4, 10) -new_sparse_vector <- function(values, positions, length) { - vec_assert(values, double()) - vec_assert(values, double()) - vec_assert(values, double()) - res <- seq(length) - res <- new_vctr(res, class = "sparse_vector") - attr(res, "values") <- values - attr(res, "positions") <- positions - res -} - -#' Create new sparse vector -#' -#' @param values Vector of values -#' @param positions Vector of positions, must be integers and same length as -#' values. -#' @param length Length of resulting vector -#' -#' @return A sparse_vector object. -#' @export -#' -#' @examples -#' sparse_vector(1, 4, 10) -sparse_vector <- function(values = double(), - positions = double(), - length = double()) { - new_sparse_vector(values, positions, length) -} - -#' @export -format.sparse_vector <- function(x, ...) { - out <- rep(0, length(x)) - out[attr(x, "positions")] <- attr(x, "values") - out -} - -#' @export -vec_ptype_abbr.sparse_vector <- function(x, ...) { - "spvtr" -} - -#' @export -vec_math.sparse_vector <- function(.fn, .x, ...) { - switch( - .fn, - sum = sum(attr(.x, "values")), - prod = ifelse(length(attr(.x, "values")) != length(.x), 0, prod(attr(.x, "values"))), - mean = sum(attr(.x, "values")) / length(.x), - vec_math_base(.fn, .x, ...) - ) -} - -sparse_vector_addition <- function(x, y) { - res <- y - - values <- attr(x, "values") - positions <- attr(x, "positions") - - overlap <- positions %in% attr(res, "positions") - - res_loc <- match(positions[overlap], attr(res, "positions")) - - attr(res, "values")[res_loc] <- attr(res, "values")[res_loc] + values[overlap] - - attr(res, "values") <- c(attr(res, "values"), values[!overlap]) - - attr(res, "positions") <- c(attr(res, "positions"), positions[!overlap]) - res -} - -#' @export -#' @method vec_arith sparse_vector -vec_arith.sparse_vector <- function(op, x, y, ...) { - switch( - op, - "+" = sparse_vector_addition(x, y), - stop_incompatible_op(op, x, y) - ) -} diff --git a/man/new_sparse_vector.Rd b/man/new_sparse_vector.Rd deleted file mode 100644 index fb5adf5..0000000 --- a/man/new_sparse_vector.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vector.R -\name{new_sparse_vector} -\alias{new_sparse_vector} -\title{Create new sparse vector} -\usage{ -new_sparse_vector(values, positions, length) -} -\arguments{ -\item{values}{Vector of values} - -\item{positions}{Vector of positions, must be integers and same length as -values.} - -\item{length}{Length of resulting vector} -} -\value{ -A sparse_vector object. -} -\description{ -Create new sparse vector -} -\examples{ -new_sparse_vector(1, 4, 10) -} diff --git a/man/sparse_to_tibble.Rd b/man/sparse_to_tibble.Rd deleted file mode 100644 index d5e14d0..0000000 --- a/man/sparse_to_tibble.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/convert.R -\name{sparse_to_tibble} -\alias{sparse_to_tibble} -\title{Convert sparse matrices to tibbles} -\usage{ -sparse_to_tibble(x) -} -\arguments{ -\item{x}{a sparse matrix} -} -\value{ -a tibble -} -\description{ -Convert sparse matrices to tibbles -} -\examples{ -\dontshow{if (rlang::is_installed("rsparse")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -# data("movielens100k", package = "rsparse") - -# sparse_to_tibble(movielens100k) -\dontshow{\}) # examplesIf} -} -\seealso{ -\code{\link[=tibble_to_sparse]{tibble_to_sparse()}} -} diff --git a/man/sparse_vector.Rd b/man/sparse_vector.Rd deleted file mode 100644 index 866f861..0000000 --- a/man/sparse_vector.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vector.R -\name{sparse_vector} -\alias{sparse_vector} -\title{Create new sparse vector} -\usage{ -sparse_vector(values = double(), positions = double(), length = double()) -} -\arguments{ -\item{values}{Vector of values} - -\item{positions}{Vector of positions, must be integers and same length as -values.} - -\item{length}{Length of resulting vector} -} -\value{ -A sparse_vector object. -} -\description{ -Create new sparse vector -} -\examples{ -sparse_vector(1, 4, 10) -} diff --git a/man/sparsevctrs-vctrs.Rd b/man/sparsevctrs-vctrs.Rd deleted file mode 100644 index 71ef3bf..0000000 --- a/man/sparsevctrs-vctrs.Rd +++ /dev/null @@ -1,9 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/sparsevctrs-package.R -\name{sparsevctrs-vctrs} -\alias{sparsevctrs-vctrs} -\title{Internal vctrs methods} -\description{ -Internal vctrs methods -} -\keyword{internal} diff --git a/man/tibble_to_sparse.Rd b/man/tibble_to_sparse.Rd deleted file mode 100644 index 101308a..0000000 --- a/man/tibble_to_sparse.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/convert.R -\name{tibble_to_sparse} -\alias{tibble_to_sparse} -\title{Convert tibbles to sparse matrices} -\usage{ -tibble_to_sparse(x) -} -\arguments{ -\item{x}{a tibble} -} -\value{ -a sparse matrix -} -\description{ -Convert tibbles to sparse matrices -} -\examples{ -# mts <- mtcars -# mts$new <- new_sparse_vector(c(1, 4, 8), c(8, 1, 20), nrow(mts)) - -# tibble_to_sparse(mtcars) - -# tibble_to_sparse(mts) -} -\seealso{ -\code{\link[=sparse_to_tibble]{sparse_to_tibble()}} -} diff --git a/tests/testthat/_snaps/altrep.md b/tests/testthat/_snaps/altrep.md index e65a102..4715411 100644 --- a/tests/testthat/_snaps/altrep.md +++ b/tests/testthat/_snaps/altrep.md @@ -45,8 +45,8 @@ new_sparse_real(1, 1.5, 1) Condition Error in `new_sparse_real()`: - ! Can't convert from `position` to due to loss of precision. - * Locations: 1 + x `position` must contain integer values. + i Non-integer values at index: 1. --- @@ -86,7 +86,7 @@ Code new_sparse_real(1, NaN, 1) Condition - Error in `if (len_position > 0 && max(position) > length) ...`: + Error in `if (any(round(position) != position)) ...`: ! missing value where TRUE/FALSE needed ---