Last updated on 2025-12-28 01:49:22 CET.
| Package | ERROR | WARN | NOTE | OK |
|---|---|---|---|---|
| glow | 2 | 11 | ||
| qs | 6 | 1 | 5 | 1 |
| qs2 | 8 | 5 | ||
| seqtrie | 3 | 10 | ||
| stringfish | 8 | 5 |
Current CRAN status: NOTE: 2, OK: 11
Version: 0.13.0
Check: installed package size
Result: NOTE
installed size is 11.5Mb
sub-directories of 1Mb or more:
doc 1.3Mb
libs 9.9Mb
Flavors: r-oldrel-macos-arm64, r-oldrel-macos-x86_64
Current CRAN status: ERROR: 6, WARN: 1, NOTE: 5, OK: 1
Version: 0.27.3
Check: compiled code
Result: WARN
File ‘qs/libs/qs.so’:
Found non-API calls to R: ‘ATTRIB’, ‘CLOENV’, ‘ENCLOS’, ‘FRAME’,
‘HASHTAB’, ‘IS_S4_OBJECT’, ‘LEVELS’, ‘OBJECT’, ‘PRENV’,
‘Rf_allocSExp’, ‘SETLEVELS’, ‘SET_ATTRIB’, ‘SET_CLOENV’,
‘SET_ENCLOS’, ‘SET_FRAME’, ‘SET_HASHTAB’, ‘SET_OBJECT’,
‘SET_PRENV’, ‘SET_S4_OBJECT’, ‘SET_TRUELENGTH’
These entry points may be removed soon:
‘SET_FRAME’, ‘SET_HASHTAB’, ‘SET_ENCLOS’, ‘SET_S4_OBJECT’, ‘FRAME’, ‘HASHTAB’, ‘IS_S4_OBJECT’, ‘CLOENV’, ‘ENCLOS’, ‘OBJECT’, ‘SET_CLOENV’, ‘LEVELS’, ‘SETLEVELS’
Compiled code should not call non-API entry points in R.
See ‘Writing portable packages’ in the ‘Writing R Extensions’ manual,
and section ‘Moving into C API compliance’ for issues with the use of
non-API entry points.
Flavors: r-devel-linux-x86_64-debian-clang, r-devel-linux-x86_64-debian-gcc, r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc
Version: 0.27.3
Check: tests
Result: ERROR
Running ‘correctness_testing.R’ [178s/189s]
Running ‘qattributes_testing.R’ [39s/47s]
Running ‘qsavemload_testing.R’ [2s/2s]
Running the tests in ‘tests/qattributes_testing.R’ failed.
Complete output:
> total_time <- Sys.time()
>
> suppressMessages(library(Rcpp))
> suppressMessages(library(dplyr))
> suppressMessages(library(data.table))
> suppressMessages(library(qs))
> suppressMessages(library(stringfish))
> options(warn = 1)
>
> do_gc <- function() {
+ if (utils::compareVersion(as.character(getRversion()), "3.5.0") != -1) {
+ gc(full = TRUE)
+ } else {
+ gc()
+ }
+ }
>
> # because sourceCpp uses setwd, we need absolute path to R_TESTS when run within R CMD check
> R_TESTS <- Sys.getenv("R_TESTS") # startup.Rs
> if (nzchar(R_TESTS)) {
+ R_TESTS_absolute <- normalizePath(R_TESTS)
+ Sys.setenv(R_TESTS = R_TESTS_absolute)
+ }
> sourceCpp(code="#include <Rcpp.h>
+ using namespace Rcpp;
+ // [[Rcpp::plugins(cpp11)]]
+ // [[Rcpp::export(rng=false)]]
+ CharacterVector splitstr(std::string x, std::vector<double> cuts){
+ CharacterVector ret(cuts.size() - 1);
+ for(uint64_t i=1; i<cuts.size(); i++) {
+ ret[i-1] = x.substr(std::round(cuts[i-1])-1, std::round(cuts[i])-std::round(cuts[i-1]));
+ }
+ return ret;
+ }
+ // [[Rcpp::export(rng=false)]]
+ int setlev(SEXP x, int i) {
+ return SETLEVELS(x,i);
+ }
+ // [[Rcpp::export(rng=false)]]
+ void setobj(SEXP x, int i) {
+ return SET_OBJECT(x, i);
+ }
+ // [[Rcpp::export(rng=false)]]
+ List generateList(std::vector<int> list_elements){
+ auto randchar = []() -> char
+ {
+ const char charset[] =
+ \"0123456789\"
+ \"ABCDEFGHIJKLMNOPQRSTUVWXYZ\"
+ \"abcdefghijklmnopqrstuvwxyz\";
+ const size_t max_index = (sizeof(charset) - 1);
+ return charset[ rand() % max_index ];
+ };
+ List ret(list_elements.size());
+ std::string str(10,0);
+ for(size_t i=0; i<list_elements.size(); i++) {
+ switch(list_elements[i]) {
+ case 1:
+ ret[i] = R_NilValue;
+ break;
+ case 2:
+ std::generate_n( str.begin(), 10, randchar );
+ ret[i] = str;
+ break;
+ case 3:
+ ret[i] = rand();
+ break;
+ case 4:
+ ret[i] = static_cast<double>(rand());
+ break;
+ }
+ }
+ return ret;
+ }")
> if (nzchar(R_TESTS)) Sys.setenv(R_TESTS = R_TESTS)
>
> args <- commandArgs(T)
> if (nzchar(R_TESTS) || ((length(args) > 0) && args[1] == "check")) { # do fewer tests within R CMD check so it completes within a reasonable amount of time
+ reps <- 2
+ test_points <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16, 1e6)
+ test_points_slow <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16) # for Character Vector, stringfish and list
+ max_size <- 1e6
+ } else {
+ reps <- 3
+ test_points <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16, 1e6, 1e7)
+ test_points_slow <- test_points
+ max_size <- 1e7
+ }
> myfile <- tempfile()
>
> obj_size <- 0
> get_obj_size <- function() {
+ get("obj_size", envir = globalenv())
+ }
> set_obj_size <- function(x) {
+ assign("obj_size", get_obj_size() + as.numeric(object.size(x)), envir = globalenv())
+ return(get_obj_size());
+ }
> random_object_generator <- function(N, with_envs = FALSE) { # additional input: global obj_size, max_size
+ if (sample(3, 1) == 1) {
+ ret <- as.list(1:N)
+ } else if (sample(2, 1) == 1) {
+ ret <- as.pairlist(1:N)
+ } else {
+ ret <- as.pairlist(1:N)
+ setlev(ret, sample(2L^12L, 1L) - 1L)
+ setobj(ret, 1L)
+ }
+
+ for (i in 1:N) {
+ if (get_obj_size() > get("max_size", envir = globalenv())) break;
+ otype <- sample(12, size = 1)
+ z <- NULL
+ is_attribute <- ifelse(i == 1, F, sample(c(F, T), size = 1))
+ if (otype == 1) {z <- rnorm(1e4); set_obj_size(z);}
+ else if (otype == 2) { z <- sample(1e4) - 5e2; set_obj_size(z); }
+ else if (otype == 3) { z <- sample(c(T, F, NA), size = 1e4, replace = T); set_obj_size(z); }
+ else if (otype == 4) { z <- (sample(256, size = 1e4, replace = T) - 1) %>% as.raw; set_obj_size(z); }
+ else if (otype == 5) { z <- replicate(sample(1e4, size = 1), {rep(letters, length.out = sample(10, size = 1)) %>% paste(collapse = "")}); set_obj_size(z); }
+ else if (otype == 6) { z <- rep(letters, length.out = sample(1e4, size = 1)) %>% paste(collapse = ""); set_obj_size(z); }
+ else if (otype == 7) { z <- as.formula("y ~ a + b + c : d", env = globalenv()); attr(z, "blah") <- sample(1e4) - 5e2; set_obj_size(z); }
+ else if (with_envs && otype %in% c(8, 9)) { z <- function(x) {x + runif(1)} }
+ # else if(with_envs && otype %in% c(10,11)) { z <- new.env(); z$x <- random_object_generator(N, with_envs); makeActiveBinding("y", function() runif(1), z) }
+ else { z <- random_object_generator(N, with_envs) }
+ if (is_attribute) {
+ attr(ret[[i - 1]], runif(1) %>% as.character()) <- z
+ } else {
+ ret[[i]] <- z
+ }
+ }
+ return(ret)
+ }
>
> rand_strings <- function(n) {
+ s <- sample(0:100, size = n, replace = T)
+ x <- lapply(unique(s), function(si) {
+ stringfish::random_strings(sum(s == si), si, vector_mode = "normal")
+ }) %>% unlist %>% sample
+ x[sample(n, size = n/10)] <- NA
+ return(x)
+ }
>
> nested_tibble <- function() {
+ sub_tibble <- function(nr = 600, nc = 4) {
+ z <- lapply(1:nc, function(i) rand_strings(nr)) %>%
+ setNames(make.unique(paste0(sample(letters, nc), rand_strings(nc)))) %>%
+ bind_cols %>%
+ as_tibble
+ }
+ tibble(
+ col1 = rand_strings(100),
+ col2 = rand_strings(100),
+ col3 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4)),
+ col4 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4)),
+ col5 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4))
+ ) %>% setNames(make.unique(paste0(sample(letters, 5), rand_strings(5))))
+ }
>
> printCarriage <- function(x) {
+ cat(x, "\r")
+ }
>
> attributes_serialize_identical <- function(attributes, full_object) {
+ identical(serialize(attributes(full_object), NULL), serialize(attributes, NULL))
+ }
>
> attributes_identical <- function(attributes, full_object) {
+ identical(attributes, attributes(full_object))
+ }
>
> ################################################################################################
>
> qsave_rand <- function(x, file) {
+ alg <- sample(c("lz4", "zstd", "lz4hc", "zstd_stream", "uncompressed"), 1)
+ # alg <- "zstd_stream"
+ nt <- sample(5,1)
+ sc <- sample(0:15,1)
+ cl <- sample(10,1)
+ ch <- sample(c(T,F),1)
+ qsave(x, file = file, preset = "custom", algorithm = alg,
+ compress_level = cl, shuffle_control = sc, nthreads = nt, check_hash = ch)
+ }
>
> qattributes_rand <- function(file) {
+ # ar <- sample(c(T,F),1)
+ # don't use altrep to avoid serialization differences
+ # attributes_serialize_identical won't pass with ALTREP
+ ar <- FALSE
+ nt <- sample(5,1)
+ qattributes(file, use_alt_rep = ar, nthreads = nt, strict = T)
+ }
>
> ################################################################################################
>
> for (q in 1:reps) {
+ cat("Rep", q, "of", reps, "\n")
+ # String correctness
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- rep(letters, length.out = tp) %>% paste(collapse = "")
+ x1 <- c(NA, "", x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("strings: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Character vectors
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ # qs_use_alt_rep(F)
+ x1 <- rep(as.raw(sample(255)), length.out = tp*10) %>% rawToChar
+ cuts <- sample(tp*10, tp + 1) %>% sort %>% as.numeric
+ x1 <- splitstr(x1, cuts)
+ x1 <- c(NA, "", x1)
+ qsave_rand(x1, file = myfile)
+ time[i] <- Sys.time()
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Character Vectors: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # stringfish character vectors -- require R > 3.5.0
+ if (utils::compareVersion(as.character(getRversion()), "3.5.0") != -1) {
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ x1 <- rep(as.raw(sample(255)), length.out = tp*10) %>% rawToChar
+ cuts <- sample(tp*10, tp + 1) %>% sort %>% as.numeric
+ x1 <- splitstr(x1, cuts)
+ x1 <- c(NA, "", x1)
+ x1 <- stringfish::convert_to_sf(x1)
+ qsave_rand(x1, file = myfile)
+ time[i] <- Sys.time()
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Stringfish: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+ }
+
+ # Integers
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- sample(1:tp, replace = T)
+ x1 <- c(NA, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Integers: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Doubles
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- rnorm(tp)
+ x1 <- c(NA, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Numeric: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Logical
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+
+ x1 <- sample(c(T, F, NA), replace = T, size = tp)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Logical: %s, %s s",tp, signif(mean(time),4)))
+ }
+ cat("\n")
+
+ # List
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ x1 <- generateList(sample(1:4, replace = T, size = tp))
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("List: %s, %s s",tp, signif(mean(time),4)))
+ }
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- data.frame(str = x1,num = runif(1:1000), stringsAsFactors = F)
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ cat("Data.frame test")
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- data.table(str = x1,num = runif(1:1e6))
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_serialize_identical(z, x1))
+ }
+ cat("Data.table test")
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- tibble(str = x1,num = runif(1:1e6))
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ cat("Tibble test")
+ cat("\n")
+
+ # Encoding test
+ if (Sys.info()[['sysname']] != "Windows") {
+ for (i in 1:3) {
+ x1 <- "己所不欲，勿施于人" # utf 8
+ x2 <- x1
+ Encoding(x2) <- "latin1"
+ x3 <- x1
+ Encoding(x3) <- "bytes"
+ x4 <- rep(x1, x2, length.out = 1e4) %>% paste(collapse = ";")
+ x1 <- c(x1, x2, x3, x4)
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage("Encoding test")
+ } else {
+ printCarriage("(Encoding test not run on windows)")
+ }
+ cat("\n")
+
+ # complex vectors
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ re <- rnorm(tp)
+ im <- runif(tp)
+ x1 <- complex(real = re, imaginary = im)
+ x1 <- c(NA_complex_, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Complex: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # factors
+ for (tp in test_points) {
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- factor(rep(letters, length.out = tp), levels = sample(letters), ordered = TRUE)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Factors: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Random objects
+ time <- vector("numeric", length = 8)
+ for (i in 1:8) {
+ # qs_use_alt_rep(sample(c(T, F), size = 1))
+ obj_size <- 0
+ x1 <- random_object_generator(12)
+ printCarriage(sprintf("Random objects: %s bytes", object.size(x1) %>% as.numeric))
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Random objects: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ # nested attributes
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- as.list(1:26)
+ attr(x1[[26]], letters[26]) <- rnorm(100)
+ for (i in 25:1) {
+ attr(x1[[i]], letters[i]) <- x1[[i + 1]]
+ }
+ time[i] <- Sys.time()
+ for(j in 1:length(x1)) {
+ qsave_rand(x1[[j]], file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1[[j]]))
+ }
+ }
+ printCarriage(sprintf("Nested attributes: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ # alt-rep -- should serialize the unpacked object
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- 1:max_size
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Alt rep integer: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+
+ # Environment test
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- new.env()
+ x1[["a"]] <- 1:max_size
+ x1[["b"]] <- runif(max_size)
+ x1[["c"]] <- stringfish::random_strings(1e4, vector_mode = "normal")
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ stopifnot(attributes_identical(z[["a"]], x1[["a"]]))
+ stopifnot(attributes_identical(z[["b"]], x1[["b"]]))
+ stopifnot(attributes_identical(z[["c"]], x1[["c"]]))
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ }
+ printCarriage(sprintf("Environment test: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- nested_tibble()
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ stopifnot(attributes_identical(z, x1))
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ }
+ printCarriage(sprintf("nested tibble test: %s s", signif(mean(time), 4)))
+ cat("\n")
+ }
Rep 1 of 2
strings: 0, 0.05082 s
strings: 1, 0.04919 s
strings: 2, 0.008973 s
strings: 4, 0.005316 s
strings: 8, 0.003118 s
strings: 31, 0.009231 s
strings: 33, 0.002765 s
strings: 32, 0.006517 s
strings: 255, 0.007391 s
strings: 257, 0.01696 s
strings: 256, 0.000517 s
strings: 65535, 0.01118 s
strings: 65537, 0.01243 s
strings: 65536, 0.004347 s
strings: 1e+06, 0.01022 s
Character Vectors: 0, 0.004165 s
Character Vectors: 1, 0.003115 s
Character Vectors: 2, 0.002115 s
Character Vectors: 4, 0.001147 s
Character Vectors: 8, 0.001371 s
Character Vectors: 31, 0.001967 s
Character Vectors: 33, 0.001322 s
Character Vectors: 32, 0.005508 s
Character Vectors: 255, 0.004501 s
Character Vectors: 257, 0.001548 s
Character Vectors: 256, 0.002847 s
Character Vectors: 65535, 0.004328 s
Character Vectors: 65537, 0.009387 s
Character Vectors: 65536, 0.003019 s
Stringfish: 0, 0.005564 s
Stringfish: 1, 0.001372 s
Stringfish: 2, 0.00573 s
Stringfish: 4, 0.004982 s
Stringfish: 8, 0.002257 s
Stringfish: 31, 0.0015 s
Stringfish: 33, 0.002526 s
Stringfish: 32, 0.002396 s
Stringfish: 255, 0.004095 s
Stringfish: 257, 0.004547 s
Stringfish: 256, 0.001465 s
Stringfish: 65535, 0.00436 s
Stringfish: 65537, 0.002645 s
Stringfish: 65536, 0.007699 s
Integers: 0, 0.002357 s
Integers: 1, 0.005929 s
Integers: 2, 0.001978 s
Integers: 4, 0.004432 s
Integers: 8, 0.006345 s
Integers: 31, 0.005554 s
Integers: 33, 0.003979 s
Integers: 32, 0.006441 s
Integers: 255, 0.0256 s
Integers: 257, 0.01089 s
Integers: 256, 0.006044 s
Integers: 65535, 0.01006 s
Integers: 65537, 0.004668 s
Integers: 65536, 0.003862 s
Integers: 1e+06, 0.02997 s
Numeric: 0, 0.005556 s
Numeric: 1, 0.01232 s
Numeric: 2, 0.002847 s
Numeric: 4, 0.008062 s
Numeric: 8, 0.008895 s
Numeric: 31, 0.005278 s
Numeric: 33, 0.006554 s
Numeric: 32, 0.005155 s
Numeric: 255, 0.006816 s
Numeric: 257, 0.006588 s
Numeric: 256, 0.01038 s
Numeric: 65535, 0.01922 s
Numeric: 65537, 0.01018 s
Numeric: 65536, 0.003398 s
Numeric: 1e+06, 0.3119 s
Logical: 0, 0.006727 s
Logical: 1, 0.005169 s
Logical: 2, 0.00521 s
Logical: 4, 0.004765 s
Logical: 8, 0.003067 s
Logical: 31, 0.001708 s
Logical: 33, 0.02264 s
Logical: 32, 0.006852 s
Logical: 255, 0.004009 s
Logical: 257, 0.002161 s
Logical: 256, 0.00761 s
Logical: 65535, 0.005156 s
Logical: 65537, 0.00699 s
Logical: 65536, 0.009592 s
Logical: 1e+06, 0.0419 s
List: 0, 0.001232 s
List: 1, 0.01558 s
List: 2, 0.007583 s
List: 4, 0.0004638 s
List: 8, 0.006926 s
List: 31, 0.001081 s
List: 33, 0.002559 s
List: 32, 0.004397 s
List: 255, 0.02702 s
List: 257, 0.003988 s
List: 256, 0.008714 s
List: 65535, 0.02735 s
List: 65537, 0.032 s
List: 65536, 0.02981 s
Data.frame test
Error: attributes_serialize_identical(z, x1) is not TRUE
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 0.27.3
Check: tests
Result: ERROR
Running ‘correctness_testing.R’ [156s/161s]
Running ‘qattributes_testing.R’ [34s/38s]
Running ‘qsavemload_testing.R’ [1s/2s]
Running the tests in ‘tests/qattributes_testing.R’ failed.
Complete output:
> total_time <- Sys.time()
>
> suppressMessages(library(Rcpp))
> suppressMessages(library(dplyr))
> suppressMessages(library(data.table))
> suppressMessages(library(qs))
> suppressMessages(library(stringfish))
> options(warn = 1)
>
> do_gc <- function() {
+ if (utils::compareVersion(as.character(getRversion()), "3.5.0") != -1) {
+ gc(full = TRUE)
+ } else {
+ gc()
+ }
+ }
>
> # because sourceCpp uses setwd, we need absolute path to R_TESTS when run within R CMD check
> R_TESTS <- Sys.getenv("R_TESTS") # startup.Rs
> if (nzchar(R_TESTS)) {
+ R_TESTS_absolute <- normalizePath(R_TESTS)
+ Sys.setenv(R_TESTS = R_TESTS_absolute)
+ }
> sourceCpp(code="#include <Rcpp.h>
+ using namespace Rcpp;
+ // [[Rcpp::plugins(cpp11)]]
+ // [[Rcpp::export(rng=false)]]
+ CharacterVector splitstr(std::string x, std::vector<double> cuts){
+ CharacterVector ret(cuts.size() - 1);
+ for(uint64_t i=1; i<cuts.size(); i++) {
+ ret[i-1] = x.substr(std::round(cuts[i-1])-1, std::round(cuts[i])-std::round(cuts[i-1]));
+ }
+ return ret;
+ }
+ // [[Rcpp::export(rng=false)]]
+ int setlev(SEXP x, int i) {
+ return SETLEVELS(x,i);
+ }
+ // [[Rcpp::export(rng=false)]]
+ void setobj(SEXP x, int i) {
+ return SET_OBJECT(x, i);
+ }
+ // [[Rcpp::export(rng=false)]]
+ List generateList(std::vector<int> list_elements){
+ auto randchar = []() -> char
+ {
+ const char charset[] =
+ \"0123456789\"
+ \"ABCDEFGHIJKLMNOPQRSTUVWXYZ\"
+ \"abcdefghijklmnopqrstuvwxyz\";
+ const size_t max_index = (sizeof(charset) - 1);
+ return charset[ rand() % max_index ];
+ };
+ List ret(list_elements.size());
+ std::string str(10,0);
+ for(size_t i=0; i<list_elements.size(); i++) {
+ switch(list_elements[i]) {
+ case 1:
+ ret[i] = R_NilValue;
+ break;
+ case 2:
+ std::generate_n( str.begin(), 10, randchar );
+ ret[i] = str;
+ break;
+ case 3:
+ ret[i] = rand();
+ break;
+ case 4:
+ ret[i] = static_cast<double>(rand());
+ break;
+ }
+ }
+ return ret;
+ }")
> if (nzchar(R_TESTS)) Sys.setenv(R_TESTS = R_TESTS)
>
> args <- commandArgs(T)
> if (nzchar(R_TESTS) || ((length(args) > 0) && args[1] == "check")) { # do fewer tests within R CMD check so it completes within a reasonable amount of time
+ reps <- 2
+ test_points <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16, 1e6)
+ test_points_slow <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16) # for Character Vector, stringfish and list
+ max_size <- 1e6
+ } else {
+ reps <- 3
+ test_points <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16, 1e6, 1e7)
+ test_points_slow <- test_points
+ max_size <- 1e7
+ }
> myfile <- tempfile()
>
> obj_size <- 0
> get_obj_size <- function() {
+ get("obj_size", envir = globalenv())
+ }
> set_obj_size <- function(x) {
+ assign("obj_size", get_obj_size() + as.numeric(object.size(x)), envir = globalenv())
+ return(get_obj_size());
+ }
> random_object_generator <- function(N, with_envs = FALSE) { # additional input: global obj_size, max_size
+ if (sample(3, 1) == 1) {
+ ret <- as.list(1:N)
+ } else if (sample(2, 1) == 1) {
+ ret <- as.pairlist(1:N)
+ } else {
+ ret <- as.pairlist(1:N)
+ setlev(ret, sample(2L^12L, 1L) - 1L)
+ setobj(ret, 1L)
+ }
+
+ for (i in 1:N) {
+ if (get_obj_size() > get("max_size", envir = globalenv())) break;
+ otype <- sample(12, size = 1)
+ z <- NULL
+ is_attribute <- ifelse(i == 1, F, sample(c(F, T), size = 1))
+ if (otype == 1) {z <- rnorm(1e4); set_obj_size(z);}
+ else if (otype == 2) { z <- sample(1e4) - 5e2; set_obj_size(z); }
+ else if (otype == 3) { z <- sample(c(T, F, NA), size = 1e4, replace = T); set_obj_size(z); }
+ else if (otype == 4) { z <- (sample(256, size = 1e4, replace = T) - 1) %>% as.raw; set_obj_size(z); }
+ else if (otype == 5) { z <- replicate(sample(1e4, size = 1), {rep(letters, length.out = sample(10, size = 1)) %>% paste(collapse = "")}); set_obj_size(z); }
+ else if (otype == 6) { z <- rep(letters, length.out = sample(1e4, size = 1)) %>% paste(collapse = ""); set_obj_size(z); }
+ else if (otype == 7) { z <- as.formula("y ~ a + b + c : d", env = globalenv()); attr(z, "blah") <- sample(1e4) - 5e2; set_obj_size(z); }
+ else if (with_envs && otype %in% c(8, 9)) { z <- function(x) {x + runif(1)} }
+ # else if(with_envs && otype %in% c(10,11)) { z <- new.env(); z$x <- random_object_generator(N, with_envs); makeActiveBinding("y", function() runif(1), z) }
+ else { z <- random_object_generator(N, with_envs) }
+ if (is_attribute) {
+ attr(ret[[i - 1]], runif(1) %>% as.character()) <- z
+ } else {
+ ret[[i]] <- z
+ }
+ }
+ return(ret)
+ }
>
> rand_strings <- function(n) {
+ s <- sample(0:100, size = n, replace = T)
+ x <- lapply(unique(s), function(si) {
+ stringfish::random_strings(sum(s == si), si, vector_mode = "normal")
+ }) %>% unlist %>% sample
+ x[sample(n, size = n/10)] <- NA
+ return(x)
+ }
>
> nested_tibble <- function() {
+ sub_tibble <- function(nr = 600, nc = 4) {
+ z <- lapply(1:nc, function(i) rand_strings(nr)) %>%
+ setNames(make.unique(paste0(sample(letters, nc), rand_strings(nc)))) %>%
+ bind_cols %>%
+ as_tibble
+ }
+ tibble(
+ col1 = rand_strings(100),
+ col2 = rand_strings(100),
+ col3 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4)),
+ col4 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4)),
+ col5 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4))
+ ) %>% setNames(make.unique(paste0(sample(letters, 5), rand_strings(5))))
+ }
>
> printCarriage <- function(x) {
+ cat(x, "\r")
+ }
>
> attributes_serialize_identical <- function(attributes, full_object) {
+ identical(serialize(attributes(full_object), NULL), serialize(attributes, NULL))
+ }
>
> attributes_identical <- function(attributes, full_object) {
+ identical(attributes, attributes(full_object))
+ }
>
> ################################################################################################
>
> qsave_rand <- function(x, file) {
+ alg <- sample(c("lz4", "zstd", "lz4hc", "zstd_stream", "uncompressed"), 1)
+ # alg <- "zstd_stream"
+ nt <- sample(5,1)
+ sc <- sample(0:15,1)
+ cl <- sample(10,1)
+ ch <- sample(c(T,F),1)
+ qsave(x, file = file, preset = "custom", algorithm = alg,
+ compress_level = cl, shuffle_control = sc, nthreads = nt, check_hash = ch)
+ }
>
> qattributes_rand <- function(file) {
+ # ar <- sample(c(T,F),1)
+ # don't use altrep to avoid serialization differences
+ # attributes_serialize_identical won't pass with ALTREP
+ ar <- FALSE
+ nt <- sample(5,1)
+ qattributes(file, use_alt_rep = ar, nthreads = nt, strict = T)
+ }
>
> ################################################################################################
>
> for (q in 1:reps) {
+ cat("Rep", q, "of", reps, "\n")
+ # String correctness
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- rep(letters, length.out = tp) %>% paste(collapse = "")
+ x1 <- c(NA, "", x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("strings: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Character vectors
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ # qs_use_alt_rep(F)
+ x1 <- rep(as.raw(sample(255)), length.out = tp*10) %>% rawToChar
+ cuts <- sample(tp*10, tp + 1) %>% sort %>% as.numeric
+ x1 <- splitstr(x1, cuts)
+ x1 <- c(NA, "", x1)
+ qsave_rand(x1, file = myfile)
+ time[i] <- Sys.time()
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Character Vectors: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # stringfish character vectors -- require R > 3.5.0
+ if (utils::compareVersion(as.character(getRversion()), "3.5.0") != -1) {
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ x1 <- rep(as.raw(sample(255)), length.out = tp*10) %>% rawToChar
+ cuts <- sample(tp*10, tp + 1) %>% sort %>% as.numeric
+ x1 <- splitstr(x1, cuts)
+ x1 <- c(NA, "", x1)
+ x1 <- stringfish::convert_to_sf(x1)
+ qsave_rand(x1, file = myfile)
+ time[i] <- Sys.time()
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Stringfish: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+ }
+
+ # Integers
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- sample(1:tp, replace = T)
+ x1 <- c(NA, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Integers: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Doubles
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- rnorm(tp)
+ x1 <- c(NA, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Numeric: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Logical
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+
+ x1 <- sample(c(T, F, NA), replace = T, size = tp)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Logical: %s, %s s",tp, signif(mean(time),4)))
+ }
+ cat("\n")
+
+ # List
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ x1 <- generateList(sample(1:4, replace = T, size = tp))
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("List: %s, %s s",tp, signif(mean(time),4)))
+ }
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- data.frame(str = x1,num = runif(1:1000), stringsAsFactors = F)
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ cat("Data.frame test")
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- data.table(str = x1,num = runif(1:1e6))
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_serialize_identical(z, x1))
+ }
+ cat("Data.table test")
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- tibble(str = x1,num = runif(1:1e6))
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ cat("Tibble test")
+ cat("\n")
+
+ # Encoding test
+ if (Sys.info()[['sysname']] != "Windows") {
+ for (i in 1:3) {
+ x1 <- "己所不欲，勿施于人" # utf 8
+ x2 <- x1
+ Encoding(x2) <- "latin1"
+ x3 <- x1
+ Encoding(x3) <- "bytes"
+ x4 <- rep(x1, x2, length.out = 1e4) %>% paste(collapse = ";")
+ x1 <- c(x1, x2, x3, x4)
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage("Encoding test")
+ } else {
+ printCarriage("(Encoding test not run on windows)")
+ }
+ cat("\n")
+
+ # complex vectors
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ re <- rnorm(tp)
+ im <- runif(tp)
+ x1 <- complex(real = re, imaginary = im)
+ x1 <- c(NA_complex_, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Complex: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # factors
+ for (tp in test_points) {
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- factor(rep(letters, length.out = tp), levels = sample(letters), ordered = TRUE)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Factors: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Random objects
+ time <- vector("numeric", length = 8)
+ for (i in 1:8) {
+ # qs_use_alt_rep(sample(c(T, F), size = 1))
+ obj_size <- 0
+ x1 <- random_object_generator(12)
+ printCarriage(sprintf("Random objects: %s bytes", object.size(x1) %>% as.numeric))
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Random objects: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ # nested attributes
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- as.list(1:26)
+ attr(x1[[26]], letters[26]) <- rnorm(100)
+ for (i in 25:1) {
+ attr(x1[[i]], letters[i]) <- x1[[i + 1]]
+ }
+ time[i] <- Sys.time()
+ for(j in 1:length(x1)) {
+ qsave_rand(x1[[j]], file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1[[j]]))
+ }
+ }
+ printCarriage(sprintf("Nested attributes: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ # alt-rep -- should serialize the unpacked object
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- 1:max_size
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Alt rep integer: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+
+ # Environment test
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- new.env()
+ x1[["a"]] <- 1:max_size
+ x1[["b"]] <- runif(max_size)
+ x1[["c"]] <- stringfish::random_strings(1e4, vector_mode = "normal")
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ stopifnot(attributes_identical(z[["a"]], x1[["a"]]))
+ stopifnot(attributes_identical(z[["b"]], x1[["b"]]))
+ stopifnot(attributes_identical(z[["c"]], x1[["c"]]))
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ }
+ printCarriage(sprintf("Environment test: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- nested_tibble()
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ stopifnot(attributes_identical(z, x1))
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ }
+ printCarriage(sprintf("nested tibble test: %s s", signif(mean(time), 4)))
+ cat("\n")
+ }
Rep 1 of 2
strings: 0, 0.01085 s
strings: 1, 0.006962 s
strings: 2, 0.002808 s
strings: 4, 0.002623 s
strings: 8, 0.001477 s
strings: 31, 0.001711 s
strings: 33, 0.006057 s
strings: 32, 0.006155 s
strings: 255, 0.003673 s
strings: 257, 0.00862 s
strings: 256, 0.008873 s
strings: 65535, 0.004765 s
strings: 65537, 0.006333 s
strings: 65536, 0.007996 s
strings: 1e+06, 0.004169 s
Character Vectors: 0, 0.004814 s
Character Vectors: 1, 0.0002366 s
Character Vectors: 2, 0.003968 s
Character Vectors: 4, 0.0003866 s
Character Vectors: 8, 0.001806 s
Character Vectors: 31, 0.002256 s
Character Vectors: 33, 9.012e-05 s
Character Vectors: 32, 0.00252 s
Character Vectors: 255, 0.003198 s
Character Vectors: 257, 0.001387 s
Character Vectors: 256, 0.00246 s
Character Vectors: 65535, 0.003739 s
Character Vectors: 65537, 0.004092 s
Character Vectors: 65536, 0.003651 s
Stringfish: 0, 0.0001485 s
Stringfish: 1, 0.0022 s
Stringfish: 2, 0.000121 s
Stringfish: 4, 0.001541 s
Stringfish: 8, 0.001065 s
Stringfish: 31, 0.002141 s
Stringfish: 33, 0.0005921 s
Stringfish: 32, 0.00125 s
Stringfish: 255, 0.001854 s
Stringfish: 257, 0.004307 s
Stringfish: 256, 8.79e-05 s
Stringfish: 65535, 0.002119 s
Stringfish: 65537, 0.001854 s
Stringfish: 65536, 0.003106 s
Integers: 0, 0.006641 s
Integers: 1, 0.008951 s
Integers: 2, 0.00269 s
Integers: 4, 0.005495 s
Integers: 8, 0.0005256 s
Integers: 31, 0.003309 s
Integers: 33, 0.003532 s
Integers: 32, 0.002321 s
Integers: 255, 0.001837 s
Integers: 257, 0.003143 s
Integers: 256, 0.004272 s
Integers: 65535, 0.003764 s
Integers: 65537, 0.006934 s
Integers: 65536, 0.01165 s
Integers: 1e+06, 0.01543 s
Numeric: 0, 0.002245 s
Numeric: 1, 0.002659 s
Numeric: 2, 0.004527 s
Numeric: 4, 0.0006354 s
Numeric: 8, 0.003986 s
Numeric: 31, 0.001292 s
Numeric: 33, 0.0007136 s
Numeric: 32, 0.007763 s
Numeric: 255, 0.008098 s
Numeric: 257, 0.003168 s
Numeric: 256, 0.01041 s
Numeric: 65535, 0.003644 s
Numeric: 65537, 0.005891 s
Numeric: 65536, 0.01924 s
Numeric: 1e+06, 0.1566 s
Logical: 0, 0.005451 s
Logical: 1, 0.006072 s
Logical: 2, 0.002644 s
Logical: 4, 0.002863 s
Logical: 8, 0.002292 s
Logical: 31, 0.003339 s
Logical: 33, 0.003329 s
Logical: 32, 0.007279 s
Logical: 255, 0.003617 s
Logical: 257, 0.003521 s
Logical: 256, 0.005711 s
Logical: 65535, 0.0006626 s
Logical: 65537, 0.002672 s
Logical: 65536, 0.005417 s
Logical: 1e+06, 0.03373 s
List: 0, 0.007847 s
List: 1, 0.006476 s
List: 2, 0.004522 s
List: 4, 0.00282 s
List: 8, 0.002148 s
List: 31, 0.0009642 s
List: 33, 0.005905 s
List: 32, 0.002962 s
List: 255, 0.0004397 s
List: 257, 0.01159 s
List: 256, 0.01384 s
List: 65535, 0.02417 s
List: 65537, 0.02377 s
List: 65536, 0.02196 s
Data.frame test
Error: attributes_serialize_identical(z, x1) is not TRUE
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 0.27.3
Check: tests
Result: ERROR
Running ‘correctness_testing.R’ [265s/354s]
Running ‘qattributes_testing.R’ [57s/73s]
Running ‘qsavemload_testing.R’
Running the tests in ‘tests/qattributes_testing.R’ failed.
Complete output:
> total_time <- Sys.time()
>
> suppressMessages(library(Rcpp))
> suppressMessages(library(dplyr))
> suppressMessages(library(data.table))
> suppressMessages(library(qs))
> suppressMessages(library(stringfish))
> options(warn = 1)
>
> do_gc <- function() {
+ if (utils::compareVersion(as.character(getRversion()), "3.5.0") != -1) {
+ gc(full = TRUE)
+ } else {
+ gc()
+ }
+ }
>
> # because sourceCpp uses setwd, we need absolute path to R_TESTS when run within R CMD check
> R_TESTS <- Sys.getenv("R_TESTS") # startup.Rs
> if (nzchar(R_TESTS)) {
+ R_TESTS_absolute <- normalizePath(R_TESTS)
+ Sys.setenv(R_TESTS = R_TESTS_absolute)
+ }
> sourceCpp(code="#include <Rcpp.h>
+ using namespace Rcpp;
+ // [[Rcpp::plugins(cpp11)]]
+ // [[Rcpp::export(rng=false)]]
+ CharacterVector splitstr(std::string x, std::vector<double> cuts){
+ CharacterVector ret(cuts.size() - 1);
+ for(uint64_t i=1; i<cuts.size(); i++) {
+ ret[i-1] = x.substr(std::round(cuts[i-1])-1, std::round(cuts[i])-std::round(cuts[i-1]));
+ }
+ return ret;
+ }
+ // [[Rcpp::export(rng=false)]]
+ int setlev(SEXP x, int i) {
+ return SETLEVELS(x,i);
+ }
+ // [[Rcpp::export(rng=false)]]
+ void setobj(SEXP x, int i) {
+ return SET_OBJECT(x, i);
+ }
+ // [[Rcpp::export(rng=false)]]
+ List generateList(std::vector<int> list_elements){
+ auto randchar = []() -> char
+ {
+ const char charset[] =
+ \"0123456789\"
+ \"ABCDEFGHIJKLMNOPQRSTUVWXYZ\"
+ \"abcdefghijklmnopqrstuvwxyz\";
+ const size_t max_index = (sizeof(charset) - 1);
+ return charset[ rand() % max_index ];
+ };
+ List ret(list_elements.size());
+ std::string str(10,0);
+ for(size_t i=0; i<list_elements.size(); i++) {
+ switch(list_elements[i]) {
+ case 1:
+ ret[i] = R_NilValue;
+ break;
+ case 2:
+ std::generate_n( str.begin(), 10, randchar );
+ ret[i] = str;
+ break;
+ case 3:
+ ret[i] = rand();
+ break;
+ case 4:
+ ret[i] = static_cast<double>(rand());
+ break;
+ }
+ }
+ return ret;
+ }")
> if (nzchar(R_TESTS)) Sys.setenv(R_TESTS = R_TESTS)
>
> args <- commandArgs(T)
> if (nzchar(R_TESTS) || ((length(args) > 0) && args[1] == "check")) { # do fewer tests within R CMD check so it completes within a reasonable amount of time
+ reps <- 2
+ test_points <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16, 1e6)
+ test_points_slow <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16) # for Character Vector, stringfish and list
+ max_size <- 1e6
+ } else {
+ reps <- 3
+ test_points <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16, 1e6, 1e7)
+ test_points_slow <- test_points
+ max_size <- 1e7
+ }
> myfile <- tempfile()
>
> obj_size <- 0
> get_obj_size <- function() {
+ get("obj_size", envir = globalenv())
+ }
> set_obj_size <- function(x) {
+ assign("obj_size", get_obj_size() + as.numeric(object.size(x)), envir = globalenv())
+ return(get_obj_size());
+ }
> random_object_generator <- function(N, with_envs = FALSE) { # additional input: global obj_size, max_size
+ if (sample(3, 1) == 1) {
+ ret <- as.list(1:N)
+ } else if (sample(2, 1) == 1) {
+ ret <- as.pairlist(1:N)
+ } else {
+ ret <- as.pairlist(1:N)
+ setlev(ret, sample(2L^12L, 1L) - 1L)
+ setobj(ret, 1L)
+ }
+
+ for (i in 1:N) {
+ if (get_obj_size() > get("max_size", envir = globalenv())) break;
+ otype <- sample(12, size = 1)
+ z <- NULL
+ is_attribute <- ifelse(i == 1, F, sample(c(F, T), size = 1))
+ if (otype == 1) {z <- rnorm(1e4); set_obj_size(z);}
+ else if (otype == 2) { z <- sample(1e4) - 5e2; set_obj_size(z); }
+ else if (otype == 3) { z <- sample(c(T, F, NA), size = 1e4, replace = T); set_obj_size(z); }
+ else if (otype == 4) { z <- (sample(256, size = 1e4, replace = T) - 1) %>% as.raw; set_obj_size(z); }
+ else if (otype == 5) { z <- replicate(sample(1e4, size = 1), {rep(letters, length.out = sample(10, size = 1)) %>% paste(collapse = "")}); set_obj_size(z); }
+ else if (otype == 6) { z <- rep(letters, length.out = sample(1e4, size = 1)) %>% paste(collapse = ""); set_obj_size(z); }
+ else if (otype == 7) { z <- as.formula("y ~ a + b + c : d", env = globalenv()); attr(z, "blah") <- sample(1e4) - 5e2; set_obj_size(z); }
+ else if (with_envs && otype %in% c(8, 9)) { z <- function(x) {x + runif(1)} }
+ # else if(with_envs && otype %in% c(10,11)) { z <- new.env(); z$x <- random_object_generator(N, with_envs); makeActiveBinding("y", function() runif(1), z) }
+ else { z <- random_object_generator(N, with_envs) }
+ if (is_attribute) {
+ attr(ret[[i - 1]], runif(1) %>% as.character()) <- z
+ } else {
+ ret[[i]] <- z
+ }
+ }
+ return(ret)
+ }
>
> rand_strings <- function(n) {
+ s <- sample(0:100, size = n, replace = T)
+ x <- lapply(unique(s), function(si) {
+ stringfish::random_strings(sum(s == si), si, vector_mode = "normal")
+ }) %>% unlist %>% sample
+ x[sample(n, size = n/10)] <- NA
+ return(x)
+ }
>
> nested_tibble <- function() {
+ sub_tibble <- function(nr = 600, nc = 4) {
+ z <- lapply(1:nc, function(i) rand_strings(nr)) %>%
+ setNames(make.unique(paste0(sample(letters, nc), rand_strings(nc)))) %>%
+ bind_cols %>%
+ as_tibble
+ }
+ tibble(
+ col1 = rand_strings(100),
+ col2 = rand_strings(100),
+ col3 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4)),
+ col4 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4)),
+ col5 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4))
+ ) %>% setNames(make.unique(paste0(sample(letters, 5), rand_strings(5))))
+ }
>
> printCarriage <- function(x) {
+ cat(x, "\r")
+ }
>
> attributes_serialize_identical <- function(attributes, full_object) {
+ identical(serialize(attributes(full_object), NULL), serialize(attributes, NULL))
+ }
>
> attributes_identical <- function(attributes, full_object) {
+ identical(attributes, attributes(full_object))
+ }
>
> ################################################################################################
>
> qsave_rand <- function(x, file) {
+ alg <- sample(c("lz4", "zstd", "lz4hc", "zstd_stream", "uncompressed"), 1)
+ # alg <- "zstd_stream"
+ nt <- sample(5,1)
+ sc <- sample(0:15,1)
+ cl <- sample(10,1)
+ ch <- sample(c(T,F),1)
+ qsave(x, file = file, preset = "custom", algorithm = alg,
+ compress_level = cl, shuffle_control = sc, nthreads = nt, check_hash = ch)
+ }
>
> qattributes_rand <- function(file) {
+ # ar <- sample(c(T,F),1)
+ # don't use altrep to avoid serialization differences
+ # attributes_serialize_identical won't pass with ALTREP
+ ar <- FALSE
+ nt <- sample(5,1)
+ qattributes(file, use_alt_rep = ar, nthreads = nt, strict = T)
+ }
>
> ################################################################################################
>
> for (q in 1:reps) {
+ cat("Rep", q, "of", reps, "\n")
+ # String correctness
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- rep(letters, length.out = tp) %>% paste(collapse = "")
+ x1 <- c(NA, "", x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("strings: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Character vectors
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ # qs_use_alt_rep(F)
+ x1 <- rep(as.raw(sample(255)), length.out = tp*10) %>% rawToChar
+ cuts <- sample(tp*10, tp + 1) %>% sort %>% as.numeric
+ x1 <- splitstr(x1, cuts)
+ x1 <- c(NA, "", x1)
+ qsave_rand(x1, file = myfile)
+ time[i] <- Sys.time()
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Character Vectors: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # stringfish character vectors -- require R > 3.5.0
+ if (utils::compareVersion(as.character(getRversion()), "3.5.0") != -1) {
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ x1 <- rep(as.raw(sample(255)), length.out = tp*10) %>% rawToChar
+ cuts <- sample(tp*10, tp + 1) %>% sort %>% as.numeric
+ x1 <- splitstr(x1, cuts)
+ x1 <- c(NA, "", x1)
+ x1 <- stringfish::convert_to_sf(x1)
+ qsave_rand(x1, file = myfile)
+ time[i] <- Sys.time()
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Stringfish: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+ }
+
+ # Integers
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- sample(1:tp, replace = T)
+ x1 <- c(NA, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Integers: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Doubles
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- rnorm(tp)
+ x1 <- c(NA, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Numeric: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Logical
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+
+ x1 <- sample(c(T, F, NA), replace = T, size = tp)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Logical: %s, %s s",tp, signif(mean(time),4)))
+ }
+ cat("\n")
+
+ # List
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ x1 <- generateList(sample(1:4, replace = T, size = tp))
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("List: %s, %s s",tp, signif(mean(time),4)))
+ }
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- data.frame(str = x1,num = runif(1:1000), stringsAsFactors = F)
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ cat("Data.frame test")
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- data.table(str = x1,num = runif(1:1e6))
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_serialize_identical(z, x1))
+ }
+ cat("Data.table test")
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- tibble(str = x1,num = runif(1:1e6))
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ cat("Tibble test")
+ cat("\n")
+
+ # Encoding test
+ if (Sys.info()[['sysname']] != "Windows") {
+ for (i in 1:3) {
+ x1 <- "己所不欲，勿施于人" # utf 8
+ x2 <- x1
+ Encoding(x2) <- "latin1"
+ x3 <- x1
+ Encoding(x3) <- "bytes"
+ x4 <- rep(x1, x2, length.out = 1e4) %>% paste(collapse = ";")
+ x1 <- c(x1, x2, x3, x4)
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage("Encoding test")
+ } else {
+ printCarriage("(Encoding test not run on windows)")
+ }
+ cat("\n")
+
+ # complex vectors
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ re <- rnorm(tp)
+ im <- runif(tp)
+ x1 <- complex(real = re, imaginary = im)
+ x1 <- c(NA_complex_, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Complex: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # factors
+ for (tp in test_points) {
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- factor(rep(letters, length.out = tp), levels = sample(letters), ordered = TRUE)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Factors: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Random objects
+ time <- vector("numeric", length = 8)
+ for (i in 1:8) {
+ # qs_use_alt_rep(sample(c(T, F), size = 1))
+ obj_size <- 0
+ x1 <- random_object_generator(12)
+ printCarriage(sprintf("Random objects: %s bytes", object.size(x1) %>% as.numeric))
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Random objects: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ # nested attributes
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- as.list(1:26)
+ attr(x1[[26]], letters[26]) <- rnorm(100)
+ for (i in 25:1) {
+ attr(x1[[i]], letters[i]) <- x1[[i + 1]]
+ }
+ time[i] <- Sys.time()
+ for(j in 1:length(x1)) {
+ qsave_rand(x1[[j]], file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1[[j]]))
+ }
+ }
+ printCarriage(sprintf("Nested attributes: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ # alt-rep -- should serialize the unpacked object
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- 1:max_size
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Alt rep integer: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+
+ # Environment test
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- new.env()
+ x1[["a"]] <- 1:max_size
+ x1[["b"]] <- runif(max_size)
+ x1[["c"]] <- stringfish::random_strings(1e4, vector_mode = "normal")
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ stopifnot(attributes_identical(z[["a"]], x1[["a"]]))
+ stopifnot(attributes_identical(z[["b"]], x1[["b"]]))
+ stopifnot(attributes_identical(z[["c"]], x1[["c"]]))
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ }
+ printCarriage(sprintf("Environment test: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- nested_tibble()
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ stopifnot(attributes_identical(z, x1))
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ }
+ printCarriage(sprintf("nested tibble test: %s s", signif(mean(time), 4)))
+ cat("\n")
+ }
Rep 1 of 2
strings: 0, 0.03002 s
strings: 1, 0.009603 s
strings: 2, 0.007507 s
strings: 4, 0.001152 s
strings: 8, 0.007605 s
strings: 31, 0.01061 s
strings: 33, 0.001795 s
strings: 32, 0.005755 s
strings: 255, 0.005023 s
strings: 257, 0.008942 s
strings: 256, 0.005154 s
strings: 65535, 0.01246 s
strings: 65537, 0.004623 s
strings: 65536, 0.01116 s
strings: 1e+06, 0.0111 s
Character Vectors: 0, 0.0008359 s
Character Vectors: 1, 0.003309 s
Character Vectors: 2, 0.002368 s
Character Vectors: 4, 0.003778 s
Character Vectors: 8, 0.001159 s
Character Vectors: 31, 0.0004169 s
Character Vectors: 33, 0.003439 s
Character Vectors: 32, 0.0002722 s
Character Vectors: 255, 0.002782 s
Character Vectors: 257, 0.001211 s
Character Vectors: 256, 0.005099 s
Character Vectors: 65535, 0.005992 s
Character Vectors: 65537, 0.0077 s
Character Vectors: 65536, 0.006215 s
Stringfish: 0, 0.001074 s
Stringfish: 1, 0.007044 s
Stringfish: 2, 0.0001624 s
Stringfish: 4, 0.0001747 s
Stringfish: 8, 0.002396 s
Stringfish: 31, 0.003171 s
Stringfish: 33, 0.003076 s
Stringfish: 32, 0.0004567 s
Stringfish: 255, 0.002023 s
Stringfish: 257, 0.0008605 s
Stringfish: 256, 0.003166 s
Stringfish: 65535, 0.002653 s
Stringfish: 65537, 0.005199 s
Stringfish: 65536, 0.004957 s
Integers: 0, 0.006887 s
Integers: 1, 0.001464 s
Integers: 2, 0.003595 s
Integers: 4, 0.0007495 s
Integers: 8, 0.007794 s
Integers: 31, 0.01693 s
Integers: 33, 0.00375 s
Integers: 32, 0.01152 s
Integers: 255, 0.00675 s
Integers: 257, 0.00436 s
Integers: 256, 0.005943 s
Integers: 65535, 0.01373 s
Integers: 65537, 0.003816 s
Integers: 65536, 0.00916 s
Integers: 1e+06, 0.05327 s
Numeric: 0, 0.001094 s
Numeric: 1, 0.005408 s
Numeric: 2, 0.006115 s
Numeric: 4, 0.0007989 s
Numeric: 8, 0.003113 s
Numeric: 31, 0.005278 s
Numeric: 33, 0.00801 s
Numeric: 32, 0.001482 s
Numeric: 255, 0.00753 s
Numeric: 257, 0.006523 s
Numeric: 256, 0.006103 s
Numeric: 65535, 0.007591 s
Numeric: 65537, 0.01428 s
Numeric: 65536, 0.01321 s
Numeric: 1e+06, 0.2131 s
Logical: 0, 0.01131 s
Logical: 1, 0.005397 s
Logical: 2, 0.004055 s
Logical: 4, 0.002563 s
Logical: 8, 0.00691 s
Logical: 31, 0.0047 s
Logical: 33, 0.007184 s
Logical: 32, 0.002822 s
Logical: 255, 0.00255 s
Logical: 257, 0.002524 s
Logical: 256, 0.005227 s
Logical: 65535, 0.01163 s
Logical: 65537, 0.01284 s
Logical: 65536, 0.003144 s
Logical: 1e+06, 0.02753 s
List: 0, 0.002595 s
List: 1, 0.006332 s
List: 2, 0.002796 s
List: 4, 0.007051 s
List: 8, 0.005828 s
List: 31, 0.005061 s
List: 33, 0.003982 s
List: 32, 0.00236 s
List: 255, 0.003144 s
List: 257, 0.02368 s
List: 256, 0.005819 s
List: 65535, 0.04752 s
List: 65537, 0.02165 s
List: 65536, 0.03846 s
Data.frame test
Error: attributes_serialize_identical(z, x1) is not TRUE
Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 0.27.3
Check: tests
Result: ERROR
Running ‘correctness_testing.R’ [259s/264s]
Running ‘qattributes_testing.R’ [50s/49s]
Running ‘qsavemload_testing.R’
Running the tests in ‘tests/qattributes_testing.R’ failed.
Complete output:
> total_time <- Sys.time()
>
> suppressMessages(library(Rcpp))
> suppressMessages(library(dplyr))
> suppressMessages(library(data.table))
> suppressMessages(library(qs))
> suppressMessages(library(stringfish))
> options(warn = 1)
>
> do_gc <- function() {
+ if (utils::compareVersion(as.character(getRversion()), "3.5.0") != -1) {
+ gc(full = TRUE)
+ } else {
+ gc()
+ }
+ }
>
> # because sourceCpp uses setwd, we need absolute path to R_TESTS when run within R CMD check
> R_TESTS <- Sys.getenv("R_TESTS") # startup.Rs
> if (nzchar(R_TESTS)) {
+ R_TESTS_absolute <- normalizePath(R_TESTS)
+ Sys.setenv(R_TESTS = R_TESTS_absolute)
+ }
> sourceCpp(code="#include <Rcpp.h>
+ using namespace Rcpp;
+ // [[Rcpp::plugins(cpp11)]]
+ // [[Rcpp::export(rng=false)]]
+ CharacterVector splitstr(std::string x, std::vector<double> cuts){
+ CharacterVector ret(cuts.size() - 1);
+ for(uint64_t i=1; i<cuts.size(); i++) {
+ ret[i-1] = x.substr(std::round(cuts[i-1])-1, std::round(cuts[i])-std::round(cuts[i-1]));
+ }
+ return ret;
+ }
+ // [[Rcpp::export(rng=false)]]
+ int setlev(SEXP x, int i) {
+ return SETLEVELS(x,i);
+ }
+ // [[Rcpp::export(rng=false)]]
+ void setobj(SEXP x, int i) {
+ return SET_OBJECT(x, i);
+ }
+ // [[Rcpp::export(rng=false)]]
+ List generateList(std::vector<int> list_elements){
+ auto randchar = []() -> char
+ {
+ const char charset[] =
+ \"0123456789\"
+ \"ABCDEFGHIJKLMNOPQRSTUVWXYZ\"
+ \"abcdefghijklmnopqrstuvwxyz\";
+ const size_t max_index = (sizeof(charset) - 1);
+ return charset[ rand() % max_index ];
+ };
+ List ret(list_elements.size());
+ std::string str(10,0);
+ for(size_t i=0; i<list_elements.size(); i++) {
+ switch(list_elements[i]) {
+ case 1:
+ ret[i] = R_NilValue;
+ break;
+ case 2:
+ std::generate_n( str.begin(), 10, randchar );
+ ret[i] = str;
+ break;
+ case 3:
+ ret[i] = rand();
+ break;
+ case 4:
+ ret[i] = static_cast<double>(rand());
+ break;
+ }
+ }
+ return ret;
+ }")
> if (nzchar(R_TESTS)) Sys.setenv(R_TESTS = R_TESTS)
>
> args <- commandArgs(T)
> if (nzchar(R_TESTS) || ((length(args) > 0) && args[1] == "check")) { # do fewer tests within R CMD check so it completes within a reasonable amount of time
+ reps <- 2
+ test_points <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16, 1e6)
+ test_points_slow <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16) # for Character Vector, stringfish and list
+ max_size <- 1e6
+ } else {
+ reps <- 3
+ test_points <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16, 1e6, 1e7)
+ test_points_slow <- test_points
+ max_size <- 1e7
+ }
> myfile <- tempfile()
>
> obj_size <- 0
> get_obj_size <- function() {
+ get("obj_size", envir = globalenv())
+ }
> set_obj_size <- function(x) {
+ assign("obj_size", get_obj_size() + as.numeric(object.size(x)), envir = globalenv())
+ return(get_obj_size());
+ }
> random_object_generator <- function(N, with_envs = FALSE) { # additional input: global obj_size, max_size
+ if (sample(3, 1) == 1) {
+ ret <- as.list(1:N)
+ } else if (sample(2, 1) == 1) {
+ ret <- as.pairlist(1:N)
+ } else {
+ ret <- as.pairlist(1:N)
+ setlev(ret, sample(2L^12L, 1L) - 1L)
+ setobj(ret, 1L)
+ }
+
+ for (i in 1:N) {
+ if (get_obj_size() > get("max_size", envir = globalenv())) break;
+ otype <- sample(12, size = 1)
+ z <- NULL
+ is_attribute <- ifelse(i == 1, F, sample(c(F, T), size = 1))
+ if (otype == 1) {z <- rnorm(1e4); set_obj_size(z);}
+ else if (otype == 2) { z <- sample(1e4) - 5e2; set_obj_size(z); }
+ else if (otype == 3) { z <- sample(c(T, F, NA), size = 1e4, replace = T); set_obj_size(z); }
+ else if (otype == 4) { z <- (sample(256, size = 1e4, replace = T) - 1) %>% as.raw; set_obj_size(z); }
+ else if (otype == 5) { z <- replicate(sample(1e4, size = 1), {rep(letters, length.out = sample(10, size = 1)) %>% paste(collapse = "")}); set_obj_size(z); }
+ else if (otype == 6) { z <- rep(letters, length.out = sample(1e4, size = 1)) %>% paste(collapse = ""); set_obj_size(z); }
+ else if (otype == 7) { z <- as.formula("y ~ a + b + c : d", env = globalenv()); attr(z, "blah") <- sample(1e4) - 5e2; set_obj_size(z); }
+ else if (with_envs && otype %in% c(8, 9)) { z <- function(x) {x + runif(1)} }
+ # else if(with_envs && otype %in% c(10,11)) { z <- new.env(); z$x <- random_object_generator(N, with_envs); makeActiveBinding("y", function() runif(1), z) }
+ else { z <- random_object_generator(N, with_envs) }
+ if (is_attribute) {
+ attr(ret[[i - 1]], runif(1) %>% as.character()) <- z
+ } else {
+ ret[[i]] <- z
+ }
+ }
+ return(ret)
+ }
>
> rand_strings <- function(n) {
+ s <- sample(0:100, size = n, replace = T)
+ x <- lapply(unique(s), function(si) {
+ stringfish::random_strings(sum(s == si), si, vector_mode = "normal")
+ }) %>% unlist %>% sample
+ x[sample(n, size = n/10)] <- NA
+ return(x)
+ }
>
> nested_tibble <- function() {
+ sub_tibble <- function(nr = 600, nc = 4) {
+ z <- lapply(1:nc, function(i) rand_strings(nr)) %>%
+ setNames(make.unique(paste0(sample(letters, nc), rand_strings(nc)))) %>%
+ bind_cols %>%
+ as_tibble
+ }
+ tibble(
+ col1 = rand_strings(100),
+ col2 = rand_strings(100),
+ col3 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4)),
+ col4 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4)),
+ col5 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4))
+ ) %>% setNames(make.unique(paste0(sample(letters, 5), rand_strings(5))))
+ }
>
> printCarriage <- function(x) {
+ cat(x, "\r")
+ }
>
> attributes_serialize_identical <- function(attributes, full_object) {
+ identical(serialize(attributes(full_object), NULL), serialize(attributes, NULL))
+ }
>
> attributes_identical <- function(attributes, full_object) {
+ identical(attributes, attributes(full_object))
+ }
>
> ################################################################################################
>
> qsave_rand <- function(x, file) {
+ alg <- sample(c("lz4", "zstd", "lz4hc", "zstd_stream", "uncompressed"), 1)
+ # alg <- "zstd_stream"
+ nt <- sample(5,1)
+ sc <- sample(0:15,1)
+ cl <- sample(10,1)
+ ch <- sample(c(T,F),1)
+ qsave(x, file = file, preset = "custom", algorithm = alg,
+ compress_level = cl, shuffle_control = sc, nthreads = nt, check_hash = ch)
+ }
>
> qattributes_rand <- function(file) {
+ # ar <- sample(c(T,F),1)
+ # don't use altrep to avoid serialization differences
+ # attributes_serialize_identical won't pass with ALTREP
+ ar <- FALSE
+ nt <- sample(5,1)
+ qattributes(file, use_alt_rep = ar, nthreads = nt, strict = T)
+ }
>
> ################################################################################################
>
> for (q in 1:reps) {
+ cat("Rep", q, "of", reps, "\n")
+ # String correctness
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- rep(letters, length.out = tp) %>% paste(collapse = "")
+ x1 <- c(NA, "", x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("strings: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Character vectors
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ # qs_use_alt_rep(F)
+ x1 <- rep(as.raw(sample(255)), length.out = tp*10) %>% rawToChar
+ cuts <- sample(tp*10, tp + 1) %>% sort %>% as.numeric
+ x1 <- splitstr(x1, cuts)
+ x1 <- c(NA, "", x1)
+ qsave_rand(x1, file = myfile)
+ time[i] <- Sys.time()
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Character Vectors: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # stringfish character vectors -- require R > 3.5.0
+ if (utils::compareVersion(as.character(getRversion()), "3.5.0") != -1) {
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ x1 <- rep(as.raw(sample(255)), length.out = tp*10) %>% rawToChar
+ cuts <- sample(tp*10, tp + 1) %>% sort %>% as.numeric
+ x1 <- splitstr(x1, cuts)
+ x1 <- c(NA, "", x1)
+ x1 <- stringfish::convert_to_sf(x1)
+ qsave_rand(x1, file = myfile)
+ time[i] <- Sys.time()
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Stringfish: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+ }
+
+ # Integers
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- sample(1:tp, replace = T)
+ x1 <- c(NA, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Integers: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Doubles
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- rnorm(tp)
+ x1 <- c(NA, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Numeric: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Logical
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+
+ x1 <- sample(c(T, F, NA), replace = T, size = tp)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Logical: %s, %s s",tp, signif(mean(time),4)))
+ }
+ cat("\n")
+
+ # List
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ x1 <- generateList(sample(1:4, replace = T, size = tp))
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("List: %s, %s s",tp, signif(mean(time),4)))
+ }
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- data.frame(str = x1,num = runif(1:1000), stringsAsFactors = F)
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ cat("Data.frame test")
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- data.table(str = x1,num = runif(1:1e6))
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_serialize_identical(z, x1))
+ }
+ cat("Data.table test")
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- tibble(str = x1,num = runif(1:1e6))
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ cat("Tibble test")
+ cat("\n")
+
+ # Encoding test
+ if (Sys.info()[['sysname']] != "Windows") {
+ for (i in 1:3) {
+ x1 <- "己所不欲，勿施于人" # utf 8
+ x2 <- x1
+ Encoding(x2) <- "latin1"
+ x3 <- x1
+ Encoding(x3) <- "bytes"
+ x4 <- rep(x1, x2, length.out = 1e4) %>% paste(collapse = ";")
+ x1 <- c(x1, x2, x3, x4)
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage("Encoding test")
+ } else {
+ printCarriage("(Encoding test not run on windows)")
+ }
+ cat("\n")
+
+ # complex vectors
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ re <- rnorm(tp)
+ im <- runif(tp)
+ x1 <- complex(real = re, imaginary = im)
+ x1 <- c(NA_complex_, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Complex: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # factors
+ for (tp in test_points) {
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- factor(rep(letters, length.out = tp), levels = sample(letters), ordered = TRUE)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Factors: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Random objects
+ time <- vector("numeric", length = 8)
+ for (i in 1:8) {
+ # qs_use_alt_rep(sample(c(T, F), size = 1))
+ obj_size <- 0
+ x1 <- random_object_generator(12)
+ printCarriage(sprintf("Random objects: %s bytes", object.size(x1) %>% as.numeric))
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Random objects: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ # nested attributes
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- as.list(1:26)
+ attr(x1[[26]], letters[26]) <- rnorm(100)
+ for (i in 25:1) {
+ attr(x1[[i]], letters[i]) <- x1[[i + 1]]
+ }
+ time[i] <- Sys.time()
+ for(j in 1:length(x1)) {
+ qsave_rand(x1[[j]], file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1[[j]]))
+ }
+ }
+ printCarriage(sprintf("Nested attributes: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ # alt-rep -- should serialize the unpacked object
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- 1:max_size
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Alt rep integer: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+
+ # Environment test
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- new.env()
+ x1[["a"]] <- 1:max_size
+ x1[["b"]] <- runif(max_size)
+ x1[["c"]] <- stringfish::random_strings(1e4, vector_mode = "normal")
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ stopifnot(attributes_identical(z[["a"]], x1[["a"]]))
+ stopifnot(attributes_identical(z[["b"]], x1[["b"]]))
+ stopifnot(attributes_identical(z[["c"]], x1[["c"]]))
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ }
+ printCarriage(sprintf("Environment test: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- nested_tibble()
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ stopifnot(attributes_identical(z, x1))
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ }
+ printCarriage(sprintf("nested tibble test: %s s", signif(mean(time), 4)))
+ cat("\n")
+ }
Rep 1 of 2
strings: 0, 0.01877 s
strings: 1, 0.00233 s
strings: 2, 0.001731 s
strings: 4, 0.001663 s
strings: 8, 0.002074 s
strings: 31, 0.002256 s
strings: 33, 0.001094 s
strings: 32, 0.0069 s
strings: 255, 0.001523 s
strings: 257, 0.006322 s
strings: 256, 0.002874 s
strings: 65535, 0.002745 s
strings: 65537, 0.002542 s
strings: 65536, 0.002555 s
strings: 1e+06, 0.005651 s
Character Vectors: 0, 0.0007025 s
Character Vectors: 1, 0.0005259 s
Character Vectors: 2, 0.0007988 s
Character Vectors: 4, 0.0005541 s
Character Vectors: 8, 0.00188 s
Character Vectors: 31, 0.00111 s
Character Vectors: 33, 0.0007223 s
Character Vectors: 32, 0.0002493 s
Character Vectors: 255, 0.0001628 s
Character Vectors: 257, 0.0004144 s
Character Vectors: 256, 0.0001899 s
Character Vectors: 65535, 0.004162 s
Character Vectors: 65537, 0.006137 s
Character Vectors: 65536, 0.005242 s
Stringfish: 0, 0.0005091 s
Stringfish: 1, 0.0004363 s
Stringfish: 2, 0.001141 s
Stringfish: 4, 0.0003858 s
Stringfish: 8, 0.0008759 s
Stringfish: 31, 0.0002047 s
Stringfish: 33, 0.001546 s
Stringfish: 32, 0.0007424 s
Stringfish: 255, 0.0004779 s
Stringfish: 257, 0.0005674 s
Stringfish: 256, 0.0005625 s
Stringfish: 65535, 0.004842 s
Stringfish: 65537, 0.004768 s
Stringfish: 65536, 0.003957 s
Integers: 0, 0.007171 s
Integers: 1, 0.003663 s
Integers: 2, 0.002543 s
Integers: 4, 0.003133 s
Integers: 8, 0.002388 s
Integers: 31, 0.001636 s
Integers: 33, 0.001823 s
Integers: 32, 0.0008195 s
Integers: 255, 0.002802 s
Integers: 257, 0.002472 s
Integers: 256, 0.0007814 s
Integers: 65535, 0.005651 s
Integers: 65537, 0.01358 s
Integers: 65536, 0.004114 s
Integers: 1e+06, 0.1235 s
Numeric: 0, 0.00308 s
Numeric: 1, 0.002168 s
Numeric: 2, 0.001306 s
Numeric: 4, 0.002583 s
Numeric: 8, 0.001827 s
Numeric: 31, 0.001171 s
Numeric: 33, 0.002374 s
Numeric: 32, 0.001065 s
Numeric: 255, 0.002766 s
Numeric: 257, 0.002006 s
Numeric: 256, 0.00285 s
Numeric: 65535, 0.008034 s
Numeric: 65537, 0.01131 s
Numeric: 65536, 0.02376 s
Numeric: 1e+06, 0.1543 s
Logical: 0, 0.00469 s
Logical: 1, 0.002046 s
Logical: 2, 0.0009995 s
Logical: 4, 0.003164 s
Logical: 8, 0.001053 s
Logical: 31, 0.003974 s
Logical: 33, 0.003265 s
Logical: 32, 0.001825 s
Logical: 255, 0.002292 s
Logical: 257, 0.001415 s
Logical: 256, 0.003399 s
Logical: 65535, 0.004209 s
Logical: 65537, 0.005805 s
Logical: 65536, 0.01047 s
Logical: 1e+06, 0.09702 s
List: 0, 0.00271 s
List: 1, 0.01169 s
List: 2, 0.00126 s
List: 4, 0.004836 s
List: 8, 0.001077 s
List: 31, 0.002509 s
List: 33, 0.002096 s
List: 32, 0.00148 s
List: 255, 0.0008624 s
List: 257, 0.001487 s
List: 256, 0.001679 s
List: 65535, 0.03178 s
List: 65537, 0.02155 s
List: 65536, 0.02548 s
Data.frame test
Error: attributes_serialize_identical(z, x1) is not TRUE
Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc
Version: 0.27.3
Check: compiled code
Result: WARN
File 'qs/libs/x64/qs.dll':
Found non-API calls to R: 'ATTRIB', 'CLOENV', 'ENCLOS', 'FRAME',
'HASHTAB', 'IS_S4_OBJECT', 'LEVELS', 'OBJECT', 'PRENV',
'Rf_allocSExp', 'SETLEVELS', 'SET_ATTRIB', 'SET_CLOENV',
'SET_ENCLOS', 'SET_FRAME', 'SET_HASHTAB', 'SET_OBJECT',
'SET_PRENV', 'SET_S4_OBJECT', 'SET_TRUELENGTH'
These entry points may be removed soon:
'SET_FRAME', 'SET_HASHTAB', 'SET_ENCLOS', 'SET_S4_OBJECT', 'FRAME', 'HASHTAB', 'IS_S4_OBJECT', 'CLOENV', 'ENCLOS', 'OBJECT', 'SET_CLOENV', 'LEVELS', 'SETLEVELS'
Compiled code should not call non-API entry points in R.
See 'Writing portable packages' in the 'Writing R Extensions' manual,
and section 'Moving into C API compliance' for issues with the use of
non-API entry points.
Flavor: r-devel-windows-x86_64
Version: 0.27.3
Check: compiled code
Result: NOTE
File ‘qs/libs/qs.so’:
Found non-API calls to R: ‘CLOENV’, ‘ENCLOS’, ‘FRAME’, ‘HASHTAB’,
‘IS_S4_OBJECT’, ‘LEVELS’, ‘OBJECT’, ‘PRENV’, ‘Rf_allocSExp’,
‘SETLEVELS’, ‘SET_CLOENV’, ‘SET_ENCLOS’, ‘SET_FRAME’,
‘SET_HASHTAB’, ‘SET_PRENV’, ‘SET_S4_OBJECT’, ‘SET_TRUELENGTH’
Compiled code should not call non-API entry points in R.
See ‘Writing portable packages’ in the ‘Writing R Extensions’ manual,
and section ‘Moving into C API compliance’ for issues with the use of
non-API entry points.
Flavors: r-patched-linux-x86_64, r-release-linux-x86_64, r-release-macos-arm64, r-release-macos-x86_64
Version: 0.27.3
Check: tests
Result: ERROR
Running ‘correctness_testing.R’ [189s/194s]
Running ‘qattributes_testing.R’ [39s/44s]
Running ‘qsavemload_testing.R’ [2s/2s]
Running the tests in ‘tests/qattributes_testing.R’ failed.
Complete output:
> total_time <- Sys.time()
>
> suppressMessages(library(Rcpp))
> suppressMessages(library(dplyr))
> suppressMessages(library(data.table))
> suppressMessages(library(qs))
> suppressMessages(library(stringfish))
> options(warn = 1)
>
> do_gc <- function() {
+ if (utils::compareVersion(as.character(getRversion()), "3.5.0") != -1) {
+ gc(full = TRUE)
+ } else {
+ gc()
+ }
+ }
>
> # because sourceCpp uses setwd, we need absolute path to R_TESTS when run within R CMD check
> R_TESTS <- Sys.getenv("R_TESTS") # startup.Rs
> if (nzchar(R_TESTS)) {
+ R_TESTS_absolute <- normalizePath(R_TESTS)
+ Sys.setenv(R_TESTS = R_TESTS_absolute)
+ }
> sourceCpp(code="#include <Rcpp.h>
+ using namespace Rcpp;
+ // [[Rcpp::plugins(cpp11)]]
+ // [[Rcpp::export(rng=false)]]
+ CharacterVector splitstr(std::string x, std::vector<double> cuts){
+ CharacterVector ret(cuts.size() - 1);
+ for(uint64_t i=1; i<cuts.size(); i++) {
+ ret[i-1] = x.substr(std::round(cuts[i-1])-1, std::round(cuts[i])-std::round(cuts[i-1]));
+ }
+ return ret;
+ }
+ // [[Rcpp::export(rng=false)]]
+ int setlev(SEXP x, int i) {
+ return SETLEVELS(x,i);
+ }
+ // [[Rcpp::export(rng=false)]]
+ void setobj(SEXP x, int i) {
+ return SET_OBJECT(x, i);
+ }
+ // [[Rcpp::export(rng=false)]]
+ List generateList(std::vector<int> list_elements){
+ auto randchar = []() -> char
+ {
+ const char charset[] =
+ \"0123456789\"
+ \"ABCDEFGHIJKLMNOPQRSTUVWXYZ\"
+ \"abcdefghijklmnopqrstuvwxyz\";
+ const size_t max_index = (sizeof(charset) - 1);
+ return charset[ rand() % max_index ];
+ };
+ List ret(list_elements.size());
+ std::string str(10,0);
+ for(size_t i=0; i<list_elements.size(); i++) {
+ switch(list_elements[i]) {
+ case 1:
+ ret[i] = R_NilValue;
+ break;
+ case 2:
+ std::generate_n( str.begin(), 10, randchar );
+ ret[i] = str;
+ break;
+ case 3:
+ ret[i] = rand();
+ break;
+ case 4:
+ ret[i] = static_cast<double>(rand());
+ break;
+ }
+ }
+ return ret;
+ }")
> if (nzchar(R_TESTS)) Sys.setenv(R_TESTS = R_TESTS)
>
> args <- commandArgs(T)
> if (nzchar(R_TESTS) || ((length(args) > 0) && args[1] == "check")) { # do fewer tests within R CMD check so it completes within a reasonable amount of time
+ reps <- 2
+ test_points <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16, 1e6)
+ test_points_slow <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16) # for Character Vector, stringfish and list
+ max_size <- 1e6
+ } else {
+ reps <- 3
+ test_points <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16, 1e6, 1e7)
+ test_points_slow <- test_points
+ max_size <- 1e7
+ }
> myfile <- tempfile()
>
> obj_size <- 0
> get_obj_size <- function() {
+ get("obj_size", envir = globalenv())
+ }
> set_obj_size <- function(x) {
+ assign("obj_size", get_obj_size() + as.numeric(object.size(x)), envir = globalenv())
+ return(get_obj_size());
+ }
> random_object_generator <- function(N, with_envs = FALSE) { # additional input: global obj_size, max_size
+ if (sample(3, 1) == 1) {
+ ret <- as.list(1:N)
+ } else if (sample(2, 1) == 1) {
+ ret <- as.pairlist(1:N)
+ } else {
+ ret <- as.pairlist(1:N)
+ setlev(ret, sample(2L^12L, 1L) - 1L)
+ setobj(ret, 1L)
+ }
+
+ for (i in 1:N) {
+ if (get_obj_size() > get("max_size", envir = globalenv())) break;
+ otype <- sample(12, size = 1)
+ z <- NULL
+ is_attribute <- ifelse(i == 1, F, sample(c(F, T), size = 1))
+ if (otype == 1) {z <- rnorm(1e4); set_obj_size(z);}
+ else if (otype == 2) { z <- sample(1e4) - 5e2; set_obj_size(z); }
+ else if (otype == 3) { z <- sample(c(T, F, NA), size = 1e4, replace = T); set_obj_size(z); }
+ else if (otype == 4) { z <- (sample(256, size = 1e4, replace = T) - 1) %>% as.raw; set_obj_size(z); }
+ else if (otype == 5) { z <- replicate(sample(1e4, size = 1), {rep(letters, length.out = sample(10, size = 1)) %>% paste(collapse = "")}); set_obj_size(z); }
+ else if (otype == 6) { z <- rep(letters, length.out = sample(1e4, size = 1)) %>% paste(collapse = ""); set_obj_size(z); }
+ else if (otype == 7) { z <- as.formula("y ~ a + b + c : d", env = globalenv()); attr(z, "blah") <- sample(1e4) - 5e2; set_obj_size(z); }
+ else if (with_envs && otype %in% c(8, 9)) { z <- function(x) {x + runif(1)} }
+ # else if(with_envs && otype %in% c(10,11)) { z <- new.env(); z$x <- random_object_generator(N, with_envs); makeActiveBinding("y", function() runif(1), z) }
+ else { z <- random_object_generator(N, with_envs) }
+ if (is_attribute) {
+ attr(ret[[i - 1]], runif(1) %>% as.character()) <- z
+ } else {
+ ret[[i]] <- z
+ }
+ }
+ return(ret)
+ }
>
> rand_strings <- function(n) {
+ s <- sample(0:100, size = n, replace = T)
+ x <- lapply(unique(s), function(si) {
+ stringfish::random_strings(sum(s == si), si, vector_mode = "normal")
+ }) %>% unlist %>% sample
+ x[sample(n, size = n/10)] <- NA
+ return(x)
+ }
>
> nested_tibble <- function() {
+ sub_tibble <- function(nr = 600, nc = 4) {
+ z <- lapply(1:nc, function(i) rand_strings(nr)) %>%
+ setNames(make.unique(paste0(sample(letters, nc), rand_strings(nc)))) %>%
+ bind_cols %>%
+ as_tibble
+ }
+ tibble(
+ col1 = rand_strings(100),
+ col2 = rand_strings(100),
+ col3 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4)),
+ col4 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4)),
+ col5 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4))
+ ) %>% setNames(make.unique(paste0(sample(letters, 5), rand_strings(5))))
+ }
>
> printCarriage <- function(x) {
+ cat(x, "\r")
+ }
>
> attributes_serialize_identical <- function(attributes, full_object) {
+ identical(serialize(attributes(full_object), NULL), serialize(attributes, NULL))
+ }
>
> attributes_identical <- function(attributes, full_object) {
+ identical(attributes, attributes(full_object))
+ }
>
> ################################################################################################
>
> qsave_rand <- function(x, file) {
+ alg <- sample(c("lz4", "zstd", "lz4hc", "zstd_stream", "uncompressed"), 1)
+ # alg <- "zstd_stream"
+ nt <- sample(5,1)
+ sc <- sample(0:15,1)
+ cl <- sample(10,1)
+ ch <- sample(c(T,F),1)
+ qsave(x, file = file, preset = "custom", algorithm = alg,
+ compress_level = cl, shuffle_control = sc, nthreads = nt, check_hash = ch)
+ }
>
> qattributes_rand <- function(file) {
+ # ar <- sample(c(T,F),1)
+ # don't use altrep to avoid serialization differences
+ # attributes_serialize_identical won't pass with ALTREP
+ ar <- FALSE
+ nt <- sample(5,1)
+ qattributes(file, use_alt_rep = ar, nthreads = nt, strict = T)
+ }
>
> ################################################################################################
>
> for (q in 1:reps) {
+ cat("Rep", q, "of", reps, "\n")
+ # String correctness
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- rep(letters, length.out = tp) %>% paste(collapse = "")
+ x1 <- c(NA, "", x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("strings: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Character vectors
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ # qs_use_alt_rep(F)
+ x1 <- rep(as.raw(sample(255)), length.out = tp*10) %>% rawToChar
+ cuts <- sample(tp*10, tp + 1) %>% sort %>% as.numeric
+ x1 <- splitstr(x1, cuts)
+ x1 <- c(NA, "", x1)
+ qsave_rand(x1, file = myfile)
+ time[i] <- Sys.time()
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Character Vectors: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # stringfish character vectors -- require R > 3.5.0
+ if (utils::compareVersion(as.character(getRversion()), "3.5.0") != -1) {
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ x1 <- rep(as.raw(sample(255)), length.out = tp*10) %>% rawToChar
+ cuts <- sample(tp*10, tp + 1) %>% sort %>% as.numeric
+ x1 <- splitstr(x1, cuts)
+ x1 <- c(NA, "", x1)
+ x1 <- stringfish::convert_to_sf(x1)
+ qsave_rand(x1, file = myfile)
+ time[i] <- Sys.time()
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Stringfish: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+ }
+
+ # Integers
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- sample(1:tp, replace = T)
+ x1 <- c(NA, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Integers: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Doubles
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- rnorm(tp)
+ x1 <- c(NA, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Numeric: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Logical
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+
+ x1 <- sample(c(T, F, NA), replace = T, size = tp)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Logical: %s, %s s",tp, signif(mean(time),4)))
+ }
+ cat("\n")
+
+ # List
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ x1 <- generateList(sample(1:4, replace = T, size = tp))
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("List: %s, %s s",tp, signif(mean(time),4)))
+ }
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- data.frame(str = x1,num = runif(1:1000), stringsAsFactors = F)
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ cat("Data.frame test")
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- data.table(str = x1,num = runif(1:1e6))
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_serialize_identical(z, x1))
+ }
+ cat("Data.table test")
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- tibble(str = x1,num = runif(1:1e6))
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ cat("Tibble test")
+ cat("\n")
+
+ # Encoding test
+ if (Sys.info()[['sysname']] != "Windows") {
+ for (i in 1:3) {
+ x1 <- "己所不欲，勿施于人" # utf 8
+ x2 <- x1
+ Encoding(x2) <- "latin1"
+ x3 <- x1
+ Encoding(x3) <- "bytes"
+ x4 <- rep(x1, x2, length.out = 1e4) %>% paste(collapse = ";")
+ x1 <- c(x1, x2, x3, x4)
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage("Encoding test")
+ } else {
+ printCarriage("(Encoding test not run on windows)")
+ }
+ cat("\n")
+
+ # complex vectors
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ re <- rnorm(tp)
+ im <- runif(tp)
+ x1 <- complex(real = re, imaginary = im)
+ x1 <- c(NA_complex_, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Complex: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # factors
+ for (tp in test_points) {
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- factor(rep(letters, length.out = tp), levels = sample(letters), ordered = TRUE)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Factors: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Random objects
+ time <- vector("numeric", length = 8)
+ for (i in 1:8) {
+ # qs_use_alt_rep(sample(c(T, F), size = 1))
+ obj_size <- 0
+ x1 <- random_object_generator(12)
+ printCarriage(sprintf("Random objects: %s bytes", object.size(x1) %>% as.numeric))
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Random objects: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ # nested attributes
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- as.list(1:26)
+ attr(x1[[26]], letters[26]) <- rnorm(100)
+ for (i in 25:1) {
+ attr(x1[[i]], letters[i]) <- x1[[i + 1]]
+ }
+ time[i] <- Sys.time()
+ for(j in 1:length(x1)) {
+ qsave_rand(x1[[j]], file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1[[j]]))
+ }
+ }
+ printCarriage(sprintf("Nested attributes: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ # alt-rep -- should serialize the unpacked object
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- 1:max_size
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Alt rep integer: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+
+ # Environment test
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- new.env()
+ x1[["a"]] <- 1:max_size
+ x1[["b"]] <- runif(max_size)
+ x1[["c"]] <- stringfish::random_strings(1e4, vector_mode = "normal")
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ stopifnot(attributes_identical(z[["a"]], x1[["a"]]))
+ stopifnot(attributes_identical(z[["b"]], x1[["b"]]))
+ stopifnot(attributes_identical(z[["c"]], x1[["c"]]))
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ }
+ printCarriage(sprintf("Environment test: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- nested_tibble()
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ stopifnot(attributes_identical(z, x1))
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ }
+ printCarriage(sprintf("nested tibble test: %s s", signif(mean(time), 4)))
+ cat("\n")
+ }
Rep 1 of 2
strings: 0, 0.009266 s
strings: 1, 0.002223 s
strings: 2, 0.007671 s
strings: 4, 0.00265 s
strings: 8, 0.007241 s
strings: 31, 0.005385 s
strings: 33, 0.004859 s
strings: 32, 0.006556 s
strings: 255, 0.009068 s
strings: 257, 0.002912 s
strings: 256, 0.006309 s
strings: 65535, 0.004612 s
strings: 65537, 0.004343 s
strings: 65536, 0.005225 s
strings: 1e+06, 0.005279 s
Character Vectors: 0, 0.0007679 s
Character Vectors: 1, 0.005265 s
Character Vectors: 2, 0.001912 s
Character Vectors: 4, 0.005302 s
Character Vectors: 8, 0.002699 s
Character Vectors: 31, 0.002589 s
Character Vectors: 33, 0.002123 s
Character Vectors: 32, 0.00557 s
Character Vectors: 255, 0.002804 s
Character Vectors: 257, 0.0004973 s
Character Vectors: 256, 0.004507 s
Character Vectors: 65535, 0.003491 s
Character Vectors: 65537, 0.003233 s
Character Vectors: 65536, 0.006017 s
Stringfish: 0, 0.002958 s
Stringfish: 1, 0.002406 s
Stringfish: 2, 0.002227 s
Stringfish: 4, 0.002035 s
Stringfish: 8, 0.001661 s
Stringfish: 31, 0.0002929 s
Stringfish: 33, 0.004649 s
Stringfish: 32, 0.0006292 s
Stringfish: 255, 0.0002771 s
Stringfish: 257, 0.001251 s
Stringfish: 256, 0.002665 s
Stringfish: 65535, 0.003706 s
Stringfish: 65537, 0.002324 s
Stringfish: 65536, 0.006042 s
Integers: 0, 0.02357 s
Integers: 1, 0.01597 s
Integers: 2, 0.004495 s
Integers: 4, 0.004973 s
Integers: 8, 0.004492 s
Integers: 31, 0.008321 s
Integers: 33, 0.002936 s
Integers: 32, 0.01706 s
Integers: 255, 0.003017 s
Integers: 257, 0.001349 s
Integers: 256, 0.003095 s
Integers: 65535, 0.01793 s
Integers: 65537, 0.014 s
Integers: 65536, 0.007182 s
Integers: 1e+06, 0.04113 s
Numeric: 0, 0.01579 s
Numeric: 1, 0.0007196 s
Numeric: 2, 0.002466 s
Numeric: 4, 0.006141 s
Numeric: 8, 0.002724 s
Numeric: 31, 0.007196 s
Numeric: 33, 0.003422 s
Numeric: 32, 0.002835 s
Numeric: 255, 0.001236 s
Numeric: 257, 0.006217 s
Numeric: 256, 0.005832 s
Numeric: 65535, 0.00266 s
Numeric: 65537, 0.02158 s
Numeric: 65536, 0.01703 s
Numeric: 1e+06, 0.07503 s
Logical: 0, 0.006371 s
Logical: 1, 0.03009 s
Logical: 2, 0.01412 s
Logical: 4, 0.001675 s
Logical: 8, 0.003439 s
Logical: 31, 0.008325 s
Logical: 33, 0.05828 s
Logical: 32, 0.04441 s
Logical: 255, 0.03292 s
Logical: 257, 0.008382 s
Logical: 256, 0.007674 s
Logical: 65535, 0.007509 s
Logical: 65537, 0.0198 s
Logical: 65536, 0.007301 s
Logical: 1e+06, 0.01145 s
List: 0, 0.006958 s
List: 1, 0.0006555 s
List: 2, 0.01578 s
List: 4, 0.0007408 s
List: 8, 0.02397 s
List: 31, 0.0005113 s
List: 33, 0.008809 s
List: 32, 0.0007137 s
List: 255, 0.003401 s
List: 257, 0.008428 s
List: 256, 0.0007162 s
List: 65535, 0.03993 s
List: 65537, 0.02159 s
List: 65536, 0.03678 s
Data.frame test
Error: attributes_serialize_identical(z, x1) is not TRUE
Execution halted
Flavor: r-release-linux-x86_64
Version: 0.27.3
Check: compiled code
Result: NOTE
File 'qs/libs/x64/qs.dll':
Found non-API calls to R: 'CLOENV', 'ENCLOS', 'FRAME', 'HASHTAB',
'IS_S4_OBJECT', 'LEVELS', 'OBJECT', 'PRENV', 'Rf_allocSExp',
'SETLEVELS', 'SET_CLOENV', 'SET_ENCLOS', 'SET_FRAME',
'SET_HASHTAB', 'SET_PRENV', 'SET_S4_OBJECT', 'SET_TRUELENGTH'
Compiled code should not call non-API entry points in R.
See 'Writing portable packages' in the 'Writing R Extensions' manual,
and section 'Moving into C API compliance' for issues with the use of
non-API entry points.
Flavor: r-release-windows-x86_64
Version: 0.27.3
Check: tests
Result: ERROR
Running 'correctness_testing.R' [157s]
Running 'qattributes_testing.R' [33s]
Running 'qsavemload_testing.R' [2s]
Running the tests in 'tests/qattributes_testing.R' failed.
Complete output:
> total_time <- Sys.time()
>
> suppressMessages(library(Rcpp))
> suppressMessages(library(dplyr))
> suppressMessages(library(data.table))
> suppressMessages(library(qs))
> suppressMessages(library(stringfish))
> options(warn = 1)
>
> do_gc <- function() {
+ if (utils::compareVersion(as.character(getRversion()), "3.5.0") != -1) {
+ gc(full = TRUE)
+ } else {
+ gc()
+ }
+ }
>
> # because sourceCpp uses setwd, we need absolute path to R_TESTS when run within R CMD check
> R_TESTS <- Sys.getenv("R_TESTS") # startup.Rs
> if (nzchar(R_TESTS)) {
+ R_TESTS_absolute <- normalizePath(R_TESTS)
+ Sys.setenv(R_TESTS = R_TESTS_absolute)
+ }
> sourceCpp(code="#include <Rcpp.h>
+ using namespace Rcpp;
+ // [[Rcpp::plugins(cpp11)]]
+ // [[Rcpp::export(rng=false)]]
+ CharacterVector splitstr(std::string x, std::vector<double> cuts){
+ CharacterVector ret(cuts.size() - 1);
+ for(uint64_t i=1; i<cuts.size(); i++) {
+ ret[i-1] = x.substr(std::round(cuts[i-1])-1, std::round(cuts[i])-std::round(cuts[i-1]));
+ }
+ return ret;
+ }
+ // [[Rcpp::export(rng=false)]]
+ int setlev(SEXP x, int i) {
+ return SETLEVELS(x,i);
+ }
+ // [[Rcpp::export(rng=false)]]
+ void setobj(SEXP x, int i) {
+ return SET_OBJECT(x, i);
+ }
+ // [[Rcpp::export(rng=false)]]
+ List generateList(std::vector<int> list_elements){
+ auto randchar = []() -> char
+ {
+ const char charset[] =
+ \"0123456789\"
+ \"ABCDEFGHIJKLMNOPQRSTUVWXYZ\"
+ \"abcdefghijklmnopqrstuvwxyz\";
+ const size_t max_index = (sizeof(charset) - 1);
+ return charset[ rand() % max_index ];
+ };
+ List ret(list_elements.size());
+ std::string str(10,0);
+ for(size_t i=0; i<list_elements.size(); i++) {
+ switch(list_elements[i]) {
+ case 1:
+ ret[i] = R_NilValue;
+ break;
+ case 2:
+ std::generate_n( str.begin(), 10, randchar );
+ ret[i] = str;
+ break;
+ case 3:
+ ret[i] = rand();
+ break;
+ case 4:
+ ret[i] = static_cast<double>(rand());
+ break;
+ }
+ }
+ return ret;
+ }")
> if (nzchar(R_TESTS)) Sys.setenv(R_TESTS = R_TESTS)
>
> args <- commandArgs(T)
> if (nzchar(R_TESTS) || ((length(args) > 0) && args[1] == "check")) { # do fewer tests within R CMD check so it completes within a reasonable amount of time
+ reps <- 2
+ test_points <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16, 1e6)
+ test_points_slow <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16) # for Character Vector, stringfish and list
+ max_size <- 1e6
+ } else {
+ reps <- 3
+ test_points <- c(0, 1, 2, 4, 8, 2^5 - 1, 2^5 + 1, 2^5, 2^8 - 1, 2^8 + 1, 2^8, 2^16 - 1, 2^16 + 1, 2^16, 1e6, 1e7)
+ test_points_slow <- test_points
+ max_size <- 1e7
+ }
> myfile <- tempfile()
>
> obj_size <- 0
> get_obj_size <- function() {
+ get("obj_size", envir = globalenv())
+ }
> set_obj_size <- function(x) {
+ assign("obj_size", get_obj_size() + as.numeric(object.size(x)), envir = globalenv())
+ return(get_obj_size());
+ }
> random_object_generator <- function(N, with_envs = FALSE) { # additional input: global obj_size, max_size
+ if (sample(3, 1) == 1) {
+ ret <- as.list(1:N)
+ } else if (sample(2, 1) == 1) {
+ ret <- as.pairlist(1:N)
+ } else {
+ ret <- as.pairlist(1:N)
+ setlev(ret, sample(2L^12L, 1L) - 1L)
+ setobj(ret, 1L)
+ }
+
+ for (i in 1:N) {
+ if (get_obj_size() > get("max_size", envir = globalenv())) break;
+ otype <- sample(12, size = 1)
+ z <- NULL
+ is_attribute <- ifelse(i == 1, F, sample(c(F, T), size = 1))
+ if (otype == 1) {z <- rnorm(1e4); set_obj_size(z);}
+ else if (otype == 2) { z <- sample(1e4) - 5e2; set_obj_size(z); }
+ else if (otype == 3) { z <- sample(c(T, F, NA), size = 1e4, replace = T); set_obj_size(z); }
+ else if (otype == 4) { z <- (sample(256, size = 1e4, replace = T) - 1) %>% as.raw; set_obj_size(z); }
+ else if (otype == 5) { z <- replicate(sample(1e4, size = 1), {rep(letters, length.out = sample(10, size = 1)) %>% paste(collapse = "")}); set_obj_size(z); }
+ else if (otype == 6) { z <- rep(letters, length.out = sample(1e4, size = 1)) %>% paste(collapse = ""); set_obj_size(z); }
+ else if (otype == 7) { z <- as.formula("y ~ a + b + c : d", env = globalenv()); attr(z, "blah") <- sample(1e4) - 5e2; set_obj_size(z); }
+ else if (with_envs && otype %in% c(8, 9)) { z <- function(x) {x + runif(1)} }
+ # else if(with_envs && otype %in% c(10,11)) { z <- new.env(); z$x <- random_object_generator(N, with_envs); makeActiveBinding("y", function() runif(1), z) }
+ else { z <- random_object_generator(N, with_envs) }
+ if (is_attribute) {
+ attr(ret[[i - 1]], runif(1) %>% as.character()) <- z
+ } else {
+ ret[[i]] <- z
+ }
+ }
+ return(ret)
+ }
>
> rand_strings <- function(n) {
+ s <- sample(0:100, size = n, replace = T)
+ x <- lapply(unique(s), function(si) {
+ stringfish::random_strings(sum(s == si), si, vector_mode = "normal")
+ }) %>% unlist %>% sample
+ x[sample(n, size = n/10)] <- NA
+ return(x)
+ }
>
> nested_tibble <- function() {
+ sub_tibble <- function(nr = 600, nc = 4) {
+ z <- lapply(1:nc, function(i) rand_strings(nr)) %>%
+ setNames(make.unique(paste0(sample(letters, nc), rand_strings(nc)))) %>%
+ bind_cols %>%
+ as_tibble
+ }
+ tibble(
+ col1 = rand_strings(100),
+ col2 = rand_strings(100),
+ col3 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4)),
+ col4 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4)),
+ col5 = lapply(1:100, function(i) sub_tibble(nr = 600, nc = 4))
+ ) %>% setNames(make.unique(paste0(sample(letters, 5), rand_strings(5))))
+ }
>
> printCarriage <- function(x) {
+ cat(x, "\r")
+ }
>
> attributes_serialize_identical <- function(attributes, full_object) {
+ identical(serialize(attributes(full_object), NULL), serialize(attributes, NULL))
+ }
>
> attributes_identical <- function(attributes, full_object) {
+ identical(attributes, attributes(full_object))
+ }
>
> ################################################################################################
>
> qsave_rand <- function(x, file) {
+ alg <- sample(c("lz4", "zstd", "lz4hc", "zstd_stream", "uncompressed"), 1)
+ # alg <- "zstd_stream"
+ nt <- sample(5,1)
+ sc <- sample(0:15,1)
+ cl <- sample(10,1)
+ ch <- sample(c(T,F),1)
+ qsave(x, file = file, preset = "custom", algorithm = alg,
+ compress_level = cl, shuffle_control = sc, nthreads = nt, check_hash = ch)
+ }
>
> qattributes_rand <- function(file) {
+ # ar <- sample(c(T,F),1)
+ # don't use altrep to avoid serialization differences
+ # attributes_serialize_identical won't pass with ALTREP
+ ar <- FALSE
+ nt <- sample(5,1)
+ qattributes(file, use_alt_rep = ar, nthreads = nt, strict = T)
+ }
>
> ################################################################################################
>
> for (q in 1:reps) {
+ cat("Rep", q, "of", reps, "\n")
+ # String correctness
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- rep(letters, length.out = tp) %>% paste(collapse = "")
+ x1 <- c(NA, "", x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("strings: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Character vectors
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ # qs_use_alt_rep(F)
+ x1 <- rep(as.raw(sample(255)), length.out = tp*10) %>% rawToChar
+ cuts <- sample(tp*10, tp + 1) %>% sort %>% as.numeric
+ x1 <- splitstr(x1, cuts)
+ x1 <- c(NA, "", x1)
+ qsave_rand(x1, file = myfile)
+ time[i] <- Sys.time()
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Character Vectors: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # stringfish character vectors -- require R > 3.5.0
+ if (utils::compareVersion(as.character(getRversion()), "3.5.0") != -1) {
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ x1 <- rep(as.raw(sample(255)), length.out = tp*10) %>% rawToChar
+ cuts <- sample(tp*10, tp + 1) %>% sort %>% as.numeric
+ x1 <- splitstr(x1, cuts)
+ x1 <- c(NA, "", x1)
+ x1 <- stringfish::convert_to_sf(x1)
+ qsave_rand(x1, file = myfile)
+ time[i] <- Sys.time()
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Stringfish: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+ }
+
+ # Integers
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- sample(1:tp, replace = T)
+ x1 <- c(NA, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Integers: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Doubles
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ x1 <- rnorm(tp)
+ x1 <- c(NA, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Numeric: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Logical
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+
+ x1 <- sample(c(T, F, NA), replace = T, size = tp)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Logical: %s, %s s",tp, signif(mean(time),4)))
+ }
+ cat("\n")
+
+ # List
+ time <- vector("numeric", length = 3)
+ for (tp in test_points_slow) {
+ for (i in 1:3) {
+ x1 <- generateList(sample(1:4, replace = T, size = tp))
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("List: %s, %s s",tp, signif(mean(time),4)))
+ }
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- data.frame(str = x1,num = runif(1:1000), stringsAsFactors = F)
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ cat("Data.frame test")
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- data.table(str = x1,num = runif(1:1e6))
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_serialize_identical(z, x1))
+ }
+ cat("Data.table test")
+ cat("\n")
+
+ for (i in 1:3) {
+ x1 <- rep( replicate(1000, { rep(letters, length.out = 2^7 + sample(10, size = 1)) %>% paste(collapse = "") }), length.out = 1e6 )
+ x1 <- tibble(str = x1,num = runif(1:1e6))
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ cat("Tibble test")
+ cat("\n")
+
+ # Encoding test
+ if (Sys.info()[['sysname']] != "Windows") {
+ for (i in 1:3) {
+ x1 <- "己所不欲，勿施于人" # utf 8
+ x2 <- x1
+ Encoding(x2) <- "latin1"
+ x3 <- x1
+ Encoding(x3) <- "bytes"
+ x4 <- rep(x1, x2, length.out = 1e4) %>% paste(collapse = ";")
+ x1 <- c(x1, x2, x3, x4)
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage("Encoding test")
+ } else {
+ printCarriage("(Encoding test not run on windows)")
+ }
+ cat("\n")
+
+ # complex vectors
+ time <- vector("numeric", length = 3)
+ for (tp in test_points) {
+ for (i in 1:3) {
+ re <- rnorm(tp)
+ im <- runif(tp)
+ x1 <- complex(real = re, imaginary = im)
+ x1 <- c(NA_complex_, x1)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Complex: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # factors
+ for (tp in test_points) {
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- factor(rep(letters, length.out = tp), levels = sample(letters), ordered = TRUE)
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Factors: %s, %s s",tp, signif(mean(time), 4)))
+ }
+ cat("\n")
+
+ # Random objects
+ time <- vector("numeric", length = 8)
+ for (i in 1:8) {
+ # qs_use_alt_rep(sample(c(T, F), size = 1))
+ obj_size <- 0
+ x1 <- random_object_generator(12)
+ printCarriage(sprintf("Random objects: %s bytes", object.size(x1) %>% as.numeric))
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Random objects: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ # nested attributes
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- as.list(1:26)
+ attr(x1[[26]], letters[26]) <- rnorm(100)
+ for (i in 25:1) {
+ attr(x1[[i]], letters[i]) <- x1[[i + 1]]
+ }
+ time[i] <- Sys.time()
+ for(j in 1:length(x1)) {
+ qsave_rand(x1[[j]], file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1[[j]]))
+ }
+ }
+ printCarriage(sprintf("Nested attributes: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ # alt-rep -- should serialize the unpacked object
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- 1:max_size
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ stopifnot(attributes_identical(z, x1))
+ }
+ printCarriage(sprintf("Alt rep integer: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+
+ # Environment test
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- new.env()
+ x1[["a"]] <- 1:max_size
+ x1[["b"]] <- runif(max_size)
+ x1[["c"]] <- stringfish::random_strings(1e4, vector_mode = "normal")
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ stopifnot(attributes_identical(z[["a"]], x1[["a"]]))
+ stopifnot(attributes_identical(z[["b"]], x1[["b"]]))
+ stopifnot(attributes_identical(z[["c"]], x1[["c"]]))
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ }
+ printCarriage(sprintf("Environment test: %s s", signif(mean(time), 4)))
+ cat("\n")
+
+ time <- vector("numeric", length = 3)
+ for (i in 1:3) {
+ x1 <- nested_tibble()
+ time[i] <- Sys.time()
+ qsave_rand(x1, file = myfile)
+ z <- qattributes_rand(file = myfile)
+ stopifnot(attributes_identical(z, x1))
+ time[i] <- Sys.time() - time[i]
+ do_gc()
+ }
+ printCarriage(sprintf("nested tibble test: %s s", signif(mean(time), 4)))
+ cat("\n")
+ }
Rep 1 of 2
strings: 0, 0.008173 s
strings: 1, 0.005753 s
strings: 2, 0.004758 s
strings: 4, 0.004785 s
strings: 8, 0.01057 s
strings: 31, 0.002491 s
strings: 33, 0.01816 s
strings: 32, 0.002198 s
strings: 255, 0.001604 s
strings: 257, 0.003438 s
strings: 256, 0.001623 s
strings: 65535, 0.006239 s
strings: 65537, 0.005004 s
strings: 65536, 0.004663 s
strings: 1e+06, 0.008224 s
Character Vectors: 0, 0.00164 s
Character Vectors: 1, 0.0002183 s
Character Vectors: 2, 0.0006637 s
Character Vectors: 4, 0.000895 s
Character Vectors: 8, 0.0007137 s
Character Vectors: 31, 0.0001673 s
Character Vectors: 33, 0.0006073 s
Character Vectors: 32, 0.0007986 s
Character Vectors: 255, 0.001033 s
Character Vectors: 257, 0.001895 s
Character Vectors: 256, 0.001336 s
Character Vectors: 65535, 0.002715 s
Character Vectors: 65537, 0.003256 s
Character Vectors: 65536, 0.003826 s
Stringfish: 0, 0.0004973 s
Stringfish: 1, 0.00164 s
Stringfish: 2, 0.001381 s
Stringfish: 4, 0.0001317 s
Stringfish: 8, 0.001391 s
Stringfish: 31, 0.0009197 s
Stringfish: 33, 0.001339 s
Stringfish: 32, 0.0002203 s
Stringfish: 255, 0.0003281 s
Stringfish: 257, 0.0005397 s
Stringfish: 256, 0.001648 s
Stringfish: 65535, 0.002172 s
Stringfish: 65537, 0.003244 s
Stringfish: 65536, 0.003985 s
Integers: 0, 0.008876 s
Integers: 1, 0.002755 s
Integers: 2, 0.001289 s
Integers: 4, 0.003056 s
Integers: 8, 0.00556 s
Integers: 31, 0.003457 s
Integers: 33, 0.001644 s
Integers: 32, 0.00168 s
Integers: 255, 0.005613 s
Integers: 257, 0.001885 s
Integers: 256, 0.002546 s
Integers: 65535, 0.005419 s
Integers: 65537, 0.005231 s
Integers: 65536, 0.0109 s
Integers: 1e+06, 0.01414 s
Numeric: 0, 0.003568 s
Numeric: 1, 0.00333 s
Numeric: 2, 0.001723 s
Numeric: 4, 0.003801 s
Numeric: 8, 0.002167 s
Numeric: 31, 0.003432 s
Numeric: 33, 0.001896 s
Numeric: 32, 0.00352 s
Numeric: 255, 0.005581 s
Numeric: 257, 0.001446 s
Numeric: 256, 0.003614 s
Numeric: 65535, 0.01812 s
Numeric: 65537, 0.01551 s
Numeric: 65536, 0.006931 s
Numeric: 1e+06, 0.06755 s
Logical: 0, 0.008955 s
Logical: 1, 0.005273 s
Logical: 2, 0.001814 s
Logical: 4, 0.00233 s
Logical: 8, 0.001888 s
Logical: 31, 0.0007984 s
Logical: 33, 0.002666 s
Logical: 32, 0.002696 s
Logical: 255, 0.002578 s
Logical: 257, 0.00295 s
Logical: 256, 0.001301 s
Logical: 65535, 0.02363 s
Logical: 65537, 0.007436 s
Logical: 65536, 0.001939 s
Logical: 1e+06, 0.03294 s
List: 0, 0.005019 s
List: 1, 0.002342 s
List: 2, 0.0008224 s
List: 4, 0.002841 s
List: 8, 0.00343 s
List: 31, 0.002859 s
List: 33, 0.0006824 s
List: 32, 0.01522 s
List: 255, 0.001475 s
List: 257, 0.003035 s
List: 256, 0.001278 s
List: 65535, 0.01992 s
List: 65537, 0.01499 s
List: 65536, 0.0126 s
Data.frame test
Error: attributes_serialize_identical(z, x1) is not TRUE
Execution halted
Flavor: r-release-windows-x86_64
Version: 0.27.3
Check: installed package size
Result: NOTE
installed size is 9.2Mb
sub-directories of 1Mb or more:
doc 1.1Mb
libs 7.8Mb
Flavors: r-oldrel-macos-arm64, r-oldrel-macos-x86_64
Current CRAN status: NOTE: 8, OK: 5
Version: 0.1.6
Check: compiled code
Result: NOTE
File ‘qs2/libs/qs2.so’:
Found non-API calls to R: ‘ATTRIB’, ‘SET_ATTRIB’
Compiled code should not call non-API entry points in R.
See ‘Writing portable packages’ in the ‘Writing R Extensions’ manual,
and section ‘Moving into C API compliance’ for issues with the use of
non-API entry points.
Flavors: r-devel-linux-x86_64-debian-clang, r-devel-linux-x86_64-debian-gcc, r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc
Version: 0.1.6
Check: compiled code
Result: NOTE
File 'qs2/libs/x64/qs2.dll':
Found non-API calls to R: 'ATTRIB', 'SET_ATTRIB'
Compiled code should not call non-API entry points in R.
See 'Writing portable packages' in the 'Writing R Extensions' manual,
and section 'Moving into C API compliance' for issues with the use of
non-API entry points.
Flavor: r-devel-windows-x86_64
Version: 0.1.6
Check: installed package size
Result: NOTE
installed size is 8.8Mb
sub-directories of 1Mb or more:
libs 8.6Mb
Flavors: r-oldrel-macos-arm64, r-oldrel-macos-x86_64
Version: 0.1.6
Check: for GNU extensions in Makefiles
Result: NOTE
GNU make is a SystemRequirements.
Flavors: r-oldrel-macos-arm64, r-oldrel-macos-x86_64, r-oldrel-windows-x86_64
Current CRAN status: NOTE: 3, OK: 10
Version: 0.3.5
Check: installed package size
Result: NOTE
installed size is 6.0Mb
sub-directories of 1Mb or more:
data 1.1Mb
libs 4.4Mb
Flavors: r-oldrel-macos-arm64, r-oldrel-macos-x86_64
Version: 0.3.5
Check: for GNU extensions in Makefiles
Result: NOTE
GNU make is a SystemRequirements.
Flavors: r-oldrel-macos-arm64, r-oldrel-macos-x86_64, r-oldrel-windows-x86_64
Version: 0.3.5
Check: package dependencies
Result: NOTE
Package suggested but not available for checking: ‘pwalign’
Flavor: r-oldrel-macos-x86_64
Current CRAN status: NOTE: 8, OK: 5
Version: 0.17.0
Check: compiled code
Result: NOTE
File ‘stringfish/libs/stringfish.so’:
Found non-API call to R: ‘ATTRIB’
Compiled code should not call non-API entry points in R.
See ‘Writing portable packages’ in the ‘Writing R Extensions’ manual,
and section ‘Moving into C API compliance’ for issues with the use of
non-API entry points.
Flavors: r-devel-linux-x86_64-debian-clang, r-devel-linux-x86_64-debian-gcc, r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc
Version: 0.17.0
Check: compiled code
Result: NOTE
File 'stringfish/libs/x64/stringfish.dll':
Found non-API call to R: 'ATTRIB'
Compiled code should not call non-API entry points in R.
See 'Writing portable packages' in the 'Writing R Extensions' manual,
and section 'Moving into C API compliance' for issues with the use of
non-API entry points.
Flavor: r-devel-windows-x86_64
Version: 0.17.0
Check: for GNU extensions in Makefiles
Result: NOTE
GNU make is a SystemRequirements.
Flavors: r-oldrel-macos-arm64, r-oldrel-macos-x86_64, r-oldrel-windows-x86_64
These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.