From cb65bc2c447799b890b705fbe51bef441564c11f Mon Sep 17 00:00:00 2001 From: Emil Hvitfeldt Date: Thu, 12 Sep 2024 11:52:57 -0700 Subject: [PATCH 1/5] update roxygen version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 90a003c..8372f81 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,4 +37,4 @@ Config/Needs/website: tidyverse/tidytemplate, rmarkdown, lobstr, ggplot2, Config/testthat/edition: 3 Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.1.9000 +RoxygenNote: 7.3.2 From a45bb357bba0318d8e2f1c162cea2f32f3caf132 Mon Sep 17 00:00:00 2001 From: Emil Hvitfeldt Date: Thu, 12 Sep 2024 11:53:17 -0700 Subject: [PATCH 2/5] refactor out verbose_materialize() --- src/altrep-sparse-double.c | 7 ++----- src/altrep-sparse-integer.c | 7 ++----- src/altrep-sparse-logical.c | 7 ++----- src/altrep-sparse-string.c | 7 ++----- src/sparse-utils.c | 7 +++++++ src/sparse-utils.h | 2 ++ 6 files changed, 17 insertions(+), 20 deletions(-) diff --git a/src/altrep-sparse-double.c b/src/altrep-sparse-double.c index 9c858c9..c440e97 100644 --- a/src/altrep-sparse-double.c +++ b/src/altrep-sparse-double.c @@ -13,17 +13,14 @@ SEXP ffi_altrep_new_sparse_double(SEXP x) { } SEXP alrep_sparse_double_Materialize(SEXP x) { - if (!Rf_isNull(Rf_GetOption1(Rf_install("sparsevctrs.verbose_materialize")) - )) { - Rprintf("sparsevctrs: Sparse vector materialized\n"); - } - SEXP out = R_altrep_data2(x); if (out != R_NilValue) { return out; } + verbose_materialize(); + SEXP val = extract_val(x); const double* v_val = REAL_RO(val); diff --git a/src/altrep-sparse-integer.c b/src/altrep-sparse-integer.c index d092301..cb68494 100644 --- a/src/altrep-sparse-integer.c +++ b/src/altrep-sparse-integer.c @@ -13,17 +13,14 @@ SEXP ffi_altrep_new_sparse_integer(SEXP x) { } SEXP alrep_sparse_integer_Materialize(SEXP x) { - if (!Rf_isNull(Rf_GetOption1(Rf_install("sparsevctrs.verbose_materialize")) - )) { - Rprintf("sparsevctrs: Sparse vector materialized\n"); - } - SEXP out = R_altrep_data2(x); if (out != R_NilValue) { return out; } + verbose_materialize(); + SEXP val = extract_val(x); const int* v_val = INTEGER_RO(val); diff --git a/src/altrep-sparse-logical.c b/src/altrep-sparse-logical.c index 5f7b89f..fcfb753 100644 --- a/src/altrep-sparse-logical.c +++ b/src/altrep-sparse-logical.c @@ -13,17 +13,14 @@ SEXP ffi_altrep_new_sparse_logical(SEXP x) { } SEXP alrep_sparse_logical_Materialize(SEXP x) { - if (!Rf_isNull(Rf_GetOption1(Rf_install("sparsevctrs.verbose_materialize")) - )) { - Rprintf("sparsevctrs: Sparse vector materialized\n"); - } - SEXP out = R_altrep_data2(x); if (out != R_NilValue) { return out; } + verbose_materialize(); + SEXP val = extract_val(x); const int* v_val = LOGICAL_RO(val); diff --git a/src/altrep-sparse-string.c b/src/altrep-sparse-string.c index 7479c07..646c729 100644 --- a/src/altrep-sparse-string.c +++ b/src/altrep-sparse-string.c @@ -13,17 +13,14 @@ SEXP ffi_altrep_new_sparse_string(SEXP x) { } SEXP alrep_sparse_string_Materialize(SEXP x) { - if (!Rf_isNull(Rf_GetOption1(Rf_install("sparsevctrs.verbose_materialize")) - )) { - Rprintf("sparsevctrs: Sparse vector materialized\n"); - } - SEXP out = R_altrep_data2(x); if (out != R_NilValue) { return out; } + verbose_materialize(); + SEXP val = extract_val(x); SEXP pos = extract_pos(x); diff --git a/src/sparse-utils.c b/src/sparse-utils.c index 22ee966..53ab8b4 100644 --- a/src/sparse-utils.c +++ b/src/sparse-utils.c @@ -122,3 +122,10 @@ bool is_index_handleable(SEXP x) { return true; } + +void verbose_materialize(void) { + if (!Rf_isNull(Rf_GetOption1(Rf_install("sparsevctrs.verbose_materialize")) + )) { + Rprintf("sparsevctrs: Sparse vector materialized\n"); + } +} diff --git a/src/sparse-utils.h b/src/sparse-utils.h index 7481b36..ea70ccf 100644 --- a/src/sparse-utils.h +++ b/src/sparse-utils.h @@ -29,4 +29,6 @@ R_xlen_t binary_search(int needle, const int* v_haystack, R_xlen_t size); bool is_index_handleable(SEXP x); +void verbose_materialize(void); + #endif From b3bad5300ea59ce825df4339ff045b9c1b3fdaa7 Mon Sep 17 00:00:00 2001 From: Emil Hvitfeldt Date: Thu, 12 Sep 2024 12:41:41 -0700 Subject: [PATCH 3/5] test that only first materialization triggers verbose --- tests/testthat/_snaps/sparse_character.md | 5 +++-- tests/testthat/_snaps/sparse_double.md | 5 +++-- tests/testthat/_snaps/sparse_integer.md | 5 +++-- tests/testthat/_snaps/sparse_logical.md | 5 +++-- tests/testthat/test-sparse_character.R | 8 +++++--- tests/testthat/test-sparse_double.R | 8 +++++--- tests/testthat/test-sparse_integer.R | 8 +++++--- tests/testthat/test-sparse_logical.R | 10 ++++++---- 8 files changed, 33 insertions(+), 21 deletions(-) diff --git a/tests/testthat/_snaps/sparse_character.md b/tests/testthat/_snaps/sparse_character.md index b4c3092..d65b4c1 100644 --- a/tests/testthat/_snaps/sparse_character.md +++ b/tests/testthat/_snaps/sparse_character.md @@ -285,10 +285,11 @@ # verbose testing Code - sparse_character("A", 1, 1)[] + tmp <- x[] Output sparsevctrs: Sparse vector materialized - [1] "A" + Code + tmp <- x[] # printing works #48 diff --git a/tests/testthat/_snaps/sparse_double.md b/tests/testthat/_snaps/sparse_double.md index 9231d15..92038a4 100644 --- a/tests/testthat/_snaps/sparse_double.md +++ b/tests/testthat/_snaps/sparse_double.md @@ -295,10 +295,11 @@ # verbose testing Code - sparse_double(1, 1, 1)[] + tmp <- x[] Output sparsevctrs: Sparse vector materialized - [1] 1 + Code + tmp <- x[] # printing works #48 diff --git a/tests/testthat/_snaps/sparse_integer.md b/tests/testthat/_snaps/sparse_integer.md index 4c7bb54..83c3755 100644 --- a/tests/testthat/_snaps/sparse_integer.md +++ b/tests/testthat/_snaps/sparse_integer.md @@ -304,10 +304,11 @@ # verbose testing Code - sparse_integer(1, 1, 1)[] + tmp <- x[] Output sparsevctrs: Sparse vector materialized - [1] 1 + Code + tmp <- x[] # printing works #48 diff --git a/tests/testthat/_snaps/sparse_logical.md b/tests/testthat/_snaps/sparse_logical.md index bae0c21..3930deb 100644 --- a/tests/testthat/_snaps/sparse_logical.md +++ b/tests/testthat/_snaps/sparse_logical.md @@ -260,8 +260,9 @@ # verbose testing Code - sparse_logical(TRUE, 1, 1)[] + tmp <- x[] Output sparsevctrs: Sparse vector materialized - [1] TRUE + Code + tmp <- x[] diff --git a/tests/testthat/test-sparse_character.R b/tests/testthat/test-sparse_character.R index 83ad19b..2cc44fb 100644 --- a/tests/testthat/test-sparse_character.R +++ b/tests/testthat/test-sparse_character.R @@ -268,9 +268,11 @@ test_that("default argument is working", { test_that("verbose testing", { withr::local_options("sparsevctrs.verbose_materialize" = TRUE) - expect_snapshot( - sparse_character("A", 1, 1)[] - ) + x <- sparse_character("A", 1, 1) + expect_snapshot({ + tmp <- x[] + tmp <- x[] + }) }) test_that("printing works #48", { diff --git a/tests/testthat/test-sparse_double.R b/tests/testthat/test-sparse_double.R index 7d5dc70..372b33a 100644 --- a/tests/testthat/test-sparse_double.R +++ b/tests/testthat/test-sparse_double.R @@ -446,9 +446,11 @@ test_that("default argument is working", { test_that("verbose testing", { withr::local_options("sparsevctrs.verbose_materialize" = TRUE) - expect_snapshot( - sparse_double(1, 1, 1)[] - ) + x <- sparse_double(1, 1, 1) + expect_snapshot({ + tmp <- x[] + tmp <- x[] + }) }) test_that("printing works #48", { diff --git a/tests/testthat/test-sparse_integer.R b/tests/testthat/test-sparse_integer.R index cb76417..580c9e3 100644 --- a/tests/testthat/test-sparse_integer.R +++ b/tests/testthat/test-sparse_integer.R @@ -452,9 +452,11 @@ test_that("default argument is working", { test_that("verbose testing", { withr::local_options("sparsevctrs.verbose_materialize" = TRUE) - expect_snapshot( - sparse_integer(1, 1, 1)[] - ) + x <- sparse_integer(1, 1, 1) + expect_snapshot({ + tmp <- x[] + tmp <- x[] + }) }) test_that("printing works #48", { diff --git a/tests/testthat/test-sparse_logical.R b/tests/testthat/test-sparse_logical.R index 1d7a250..dddb440 100644 --- a/tests/testthat/test-sparse_logical.R +++ b/tests/testthat/test-sparse_logical.R @@ -280,8 +280,10 @@ test_that("default argument is working", { test_that("verbose testing", { withr::local_options("sparsevctrs.verbose_materialize" = TRUE) - - expect_snapshot( - sparse_logical(TRUE, 1, 1)[] - ) + + x <- sparse_logical(TRUE, 1, 1) + expect_snapshot({ + tmp <- x[] + tmp <- x[] + }) }) From 127adcc721f58e5edd2eaf44fdce70388c687e16 Mon Sep 17 00:00:00 2001 From: Emil Hvitfeldt Date: Thu, 12 Sep 2024 12:51:56 -0700 Subject: [PATCH 4/5] allow for warnings and errors from verbose_materialize() --- src/sparse-utils.c | 27 ++++++++++++++++++++--- tests/testthat/_snaps/sparse_character.md | 18 +++++++++++++++ tests/testthat/_snaps/sparse_double.md | 18 +++++++++++++++ tests/testthat/_snaps/sparse_integer.md | 18 +++++++++++++++ tests/testthat/_snaps/sparse_logical.md | 18 +++++++++++++++ tests/testthat/test-sparse_character.R | 22 ++++++++++++++++-- tests/testthat/test-sparse_double.R | 22 ++++++++++++++++-- tests/testthat/test-sparse_integer.R | 22 ++++++++++++++++-- tests/testthat/test-sparse_logical.R | 22 ++++++++++++++++-- 9 files changed, 176 insertions(+), 11 deletions(-) diff --git a/src/sparse-utils.c b/src/sparse-utils.c index 53ab8b4..25098ad 100644 --- a/src/sparse-utils.c +++ b/src/sparse-utils.c @@ -124,8 +124,29 @@ bool is_index_handleable(SEXP x) { } void verbose_materialize(void) { - if (!Rf_isNull(Rf_GetOption1(Rf_install("sparsevctrs.verbose_materialize")) - )) { - Rprintf("sparsevctrs: Sparse vector materialized\n"); + SEXP option = Rf_GetOption1(Rf_install("sparsevctrs.verbose_materialize")); + + if (!Rf_isNull(option)) { + if (TYPEOF(option) == LGLSXP) { + Rprintf("sparsevctrs: Sparse vector materialized\n"); + } + if (TYPEOF(option) == REALSXP) { + if (*REAL_RO(option) == 3) { + Rf_error("sparsevctrs: Sparse vector materialized"); + } else if (*REAL_RO(option) == 2) { + Rf_warning("sparsevctrs: Sparse vector materialized"); + } else { + Rprintf("sparsevctrs: Sparse vector materialized\n"); + } + } + if (TYPEOF(option) == INTSXP) { + if (*INTEGER_RO(option) == 3) { + Rf_error("sparsevctrs: Sparse vector materialized"); + } else if (*INTEGER_RO(option) == 2) { + Rf_warning("sparsevctrs: Sparse vector materialized"); + } else { + Rprintf("sparsevctrs: Sparse vector materialized\n"); + } + } } } diff --git a/tests/testthat/_snaps/sparse_character.md b/tests/testthat/_snaps/sparse_character.md index d65b4c1..fad64ae 100644 --- a/tests/testthat/_snaps/sparse_character.md +++ b/tests/testthat/_snaps/sparse_character.md @@ -291,6 +291,24 @@ Code tmp <- x[] +--- + + Code + tmp <- x[] + Condition + Warning: + sparsevctrs: Sparse vector materialized + Code + tmp <- x[] + +--- + + Code + tmp <- x[] + Condition + Error: + ! sparsevctrs: Sparse vector materialized + # printing works #48 Code diff --git a/tests/testthat/_snaps/sparse_double.md b/tests/testthat/_snaps/sparse_double.md index 92038a4..70e2db9 100644 --- a/tests/testthat/_snaps/sparse_double.md +++ b/tests/testthat/_snaps/sparse_double.md @@ -301,6 +301,24 @@ Code tmp <- x[] +--- + + Code + tmp <- x[] + Condition + Warning: + sparsevctrs: Sparse vector materialized + Code + tmp <- x[] + +--- + + Code + tmp <- x[] + Condition + Error: + ! sparsevctrs: Sparse vector materialized + # printing works #48 Code diff --git a/tests/testthat/_snaps/sparse_integer.md b/tests/testthat/_snaps/sparse_integer.md index 83c3755..833d81f 100644 --- a/tests/testthat/_snaps/sparse_integer.md +++ b/tests/testthat/_snaps/sparse_integer.md @@ -310,6 +310,24 @@ Code tmp <- x[] +--- + + Code + tmp <- x[] + Condition + Warning: + sparsevctrs: Sparse vector materialized + Code + tmp <- x[] + +--- + + Code + tmp <- x[] + Condition + Error: + ! sparsevctrs: Sparse vector materialized + # printing works #48 Code diff --git a/tests/testthat/_snaps/sparse_logical.md b/tests/testthat/_snaps/sparse_logical.md index 3930deb..288359a 100644 --- a/tests/testthat/_snaps/sparse_logical.md +++ b/tests/testthat/_snaps/sparse_logical.md @@ -266,3 +266,21 @@ Code tmp <- x[] +--- + + Code + tmp <- x[] + Condition + Warning: + sparsevctrs: Sparse vector materialized + Code + tmp <- x[] + +--- + + Code + tmp <- x[] + Condition + Error: + ! sparsevctrs: Sparse vector materialized + diff --git a/tests/testthat/test-sparse_character.R b/tests/testthat/test-sparse_character.R index 2cc44fb..751fd4a 100644 --- a/tests/testthat/test-sparse_character.R +++ b/tests/testthat/test-sparse_character.R @@ -270,9 +270,27 @@ test_that("verbose testing", { x <- sparse_character("A", 1, 1) expect_snapshot({ - tmp <- x[] - tmp <- x[] + tmp <- x[] + tmp <- x[] }) + + withr::local_options("sparsevctrs.verbose_materialize" = 2) + + x <- sparse_character("A", 1, 1) + expect_snapshot({ + tmp <- x[] + tmp <- x[] + }) + + withr::local_options("sparsevctrs.verbose_materialize" = 3) + + x <- sparse_character("A", 1, 1) + expect_snapshot( + error = TRUE, + { + tmp <- x[] + } + ) }) test_that("printing works #48", { diff --git a/tests/testthat/test-sparse_double.R b/tests/testthat/test-sparse_double.R index 372b33a..605364d 100644 --- a/tests/testthat/test-sparse_double.R +++ b/tests/testthat/test-sparse_double.R @@ -448,9 +448,27 @@ test_that("verbose testing", { x <- sparse_double(1, 1, 1) expect_snapshot({ - tmp <- x[] - tmp <- x[] + tmp <- x[] + tmp <- x[] }) + + withr::local_options("sparsevctrs.verbose_materialize" = 2) + + x <- sparse_double(1, 1, 1) + expect_snapshot({ + tmp <- x[] + tmp <- x[] + }) + + withr::local_options("sparsevctrs.verbose_materialize" = 3) + + x <- sparse_double(1, 1, 1) + expect_snapshot( + error = TRUE, + { + tmp <- x[] + } + ) }) test_that("printing works #48", { diff --git a/tests/testthat/test-sparse_integer.R b/tests/testthat/test-sparse_integer.R index 580c9e3..25254ae 100644 --- a/tests/testthat/test-sparse_integer.R +++ b/tests/testthat/test-sparse_integer.R @@ -454,9 +454,27 @@ test_that("verbose testing", { x <- sparse_integer(1, 1, 1) expect_snapshot({ - tmp <- x[] - tmp <- x[] + tmp <- x[] + tmp <- x[] }) + + withr::local_options("sparsevctrs.verbose_materialize" = 2) + + x <- sparse_integer(1, 1, 1) + expect_snapshot({ + tmp <- x[] + tmp <- x[] + }) + + withr::local_options("sparsevctrs.verbose_materialize" = 3) + + x <- sparse_integer(1, 1, 1) + expect_snapshot( + error = TRUE, + { + tmp <- x[] + } + ) }) test_that("printing works #48", { diff --git a/tests/testthat/test-sparse_logical.R b/tests/testthat/test-sparse_logical.R index dddb440..481bdf7 100644 --- a/tests/testthat/test-sparse_logical.R +++ b/tests/testthat/test-sparse_logical.R @@ -283,7 +283,25 @@ test_that("verbose testing", { x <- sparse_logical(TRUE, 1, 1) expect_snapshot({ - tmp <- x[] - tmp <- x[] + tmp <- x[] + tmp <- x[] }) + + withr::local_options("sparsevctrs.verbose_materialize" = 2) + + x <- sparse_logical(TRUE, 1, 1) + expect_snapshot({ + tmp <- x[] + tmp <- x[] + }) + + withr::local_options("sparsevctrs.verbose_materialize" = 3) + + x <- sparse_logical(TRUE, 1, 1) + expect_snapshot( + error = TRUE, + { + tmp <- x[] + } + ) }) From dfbc08c88c54b0f066ca5872173584bbf82efd54 Mon Sep 17 00:00:00 2001 From: Emil Hvitfeldt Date: Thu, 12 Sep 2024 12:52:06 -0700 Subject: [PATCH 5/5] update version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8372f81..f300aa8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: sparsevctrs Title: Sparse Vectors for Use in Data Frames -Version: 0.1.0.9000 +Version: 0.1.0.9001 Authors@R: c( person("Emil", "Hvitfeldt", , "emil.hvitfeldt@posit.co", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-0679-1945")),