skip_if_not_installed("httr") skip_if_not_installed("readxl") skip_if_not_installed("haven") skip_if_not_installed("readr") skip_if_not_installed("data.table") skip_if_not_installed("rio") skip_on_cran() skip_if_not_installed("curl") skip_if_offline() # csv ------------------------- test_that("data_read - csv", { d <- data_read( "https://raw.githubusercontent.com/easystats/circus/main/data/bootstrapped.csv", verbose = FALSE ) expect_identical(dim(d), c(10000L, 4L)) }) # csv ------------------------- test_that("data_read, skip_empty", { d <- data_read( "https://raw.githubusercontent.com/easystats/circus/main/data/test_skip_empty.csv", verbose = FALSE ) expect_identical(ncol(d), 3L) expect_identical(colnames(d), c("Var1", "Var2", "Var3")) }) # tsv ------------------------- test_that("data_read - tsv", { skip_if_not_installed("withr") withr::with_tempfile("temp_file", fileext = ".tsv", code = { request <- httr::GET("https://raw.github.com/easystats/circus/main/data/sample1.tsv") httr::stop_for_status(request) writeBin(httr::content(request, type = "raw"), temp_file) d <- data_read( temp_file, verbose = FALSE ) expect_identical(nrow(d), 3L) expect_identical(colnames(d), c("a", "b", "c")) expect_identical(sum(vapply(d, is.numeric, FUN.VALUE = logical(1L))), 2L) expect_identical(sum(vapply(d, is.character, FUN.VALUE = logical(1L))), 1L) }) }) # excel ------------------------- test_that("data_read - excel", { skip_if_not_installed("withr") withr::with_tempfile("temp_file", fileext = ".xlsx", code = { request <- httr::GET("https://raw.github.com/easystats/circus/main/data/sample1.xlsx") httr::stop_for_status(request) writeBin(httr::content(request, type = "raw"), temp_file) d <- data_read( temp_file, verbose = FALSE ) expect_identical(nrow(d), 3L) expect_identical(colnames(d), c("a", "b", "c")) expect_identical(sum(vapply(d, is.numeric, FUN.VALUE = logical(1L))), 2L) expect_identical(sum(vapply(d, is.character, FUN.VALUE = logical(1L))), 1L) }) }) # Stata file ----------------------------------- test_that("data_read - Stata file", { withr::with_tempfile("temp_file", fileext = ".dta", code = { request <- httr::GET("https://raw.github.com/easystats/circus/main/data/stata_test.dta") httr::stop_for_status(request) writeBin(httr::content(request, type = "raw"), temp_file) d <- data_read( temp_file, verbose = FALSE ) expect_identical( d, data.frame( mpg = c(21, 21, 22.8), cyl = c(6, 6, 4), disp = c(160, 160, 108) ) ) }) }) # SAS file ----------------------------------- test_that("data_read - SAS file", { withr::with_tempfile("temp_file", fileext = ".sas7bdat", code = { request <- httr::GET("https://raw.github.com/easystats/circus/main/data/sas_test.sas7bdat") httr::stop_for_status(request) writeBin(httr::content(request, type = "raw"), temp_file) d <- data_read( temp_file, verbose = FALSE ) expect_identical( d, data.frame( mpg = c(21, 21, 22.8), cyl = c(6, 6, 4), disp = c(160, 160, 108) ) ) }) }) # RDS file, matrix, coercible ----------------------------------- test_that("data_read - RDS file, matrix, coercible", { withr::with_tempfile("temp_file", fileext = ".rds", code = { request <- httr::GET("https://raw.github.com/easystats/circus/main/data/matrix_object.rds") httr::stop_for_status(request) writeBin(httr::content(request, type = "raw"), temp_file) expect_message({ d <- data_read( temp_file, verbose = TRUE ) }) expect_s3_class(d, "data.frame") expect_identical(dim(d), c(2L, 5L)) }) }) # RDS file, preserve class /types ----------------------------------- test_that("data_read - RDS file, preserve class", { withr::with_tempfile("temp_file", fileext = ".rds", code = { request <- httr::GET("https://raw.github.com/easystats/circus/main/data/hiv.rds") httr::stop_for_status(request) writeBin(httr::content(request, type = "raw"), temp_file) d <- data_read(temp_file, verbose = FALSE) expect_s3_class(d, "data.frame") expect_identical( sapply(d, class), c( village = "integer", outcome = "integer", distance = "numeric", amount = "numeric", incentive = "integer", age = "integer", hiv2004 = "integer", agecat = "factor" ) ) }) }) # RData ----------------------------------- test_that("data_read - no warning for RData", { withr::with_tempfile("temp_file", fileext = ".RData", code = { data(mtcars) save(mtcars, file = temp_file) expect_silent(data_read(temp_file, verbose = FALSE)) }) }) test_that("data_read - message for multiple objects in RData", { withr::with_tempfile("temp_file", fileext = ".RData", code = { data(mtcars) data(iris) save(mtcars, iris, file = temp_file) expect_message( expect_message( data_read(temp_file, verbose = TRUE), regex = "File contained more than one object" ), "Reading data" ) }) }) # SPSS file ----------------------------------- test_that("data_read - SPSS file", { withr::with_tempfile("temp_file", fileext = ".sav", code = { request <- httr::GET("https://raw.github.com/easystats/circus/main/data/EFC.sav") httr::stop_for_status(request) writeBin(httr::content(request, type = "raw"), temp_file) d <- data_read( temp_file, verbose = FALSE ) expect_identical(sum(vapply(d, is.factor, FUN.VALUE = logical(1L))), 15L) expect_identical(sum(vapply(d, is.numeric, FUN.VALUE = logical(1L))), 11L) expect_identical( levels(d$c172code), c( "low level of education", "intermediate level of education", "high level of education" ) ) expect_identical( attr(d$n4pstu, "labels"), c( `spouse/partner` = 1, child = 2, sibling = 3, `daughter or son -in-law` = 4 ) ) }) }) # SPSS file 2 --------------------------------- test_that("data_read - SPSS file 2", { withr::with_tempfile("temp_file", fileext = ".sav", code = { request <- httr::GET("https://raw.github.com/easystats/circus/main/data/spss_test.sav") httr::stop_for_status(request) writeBin(httr::content(request, type = "raw"), temp_file) d <- data_read( temp_file, verbose = FALSE ) expect_identical( d, structure(list( V1 = structure(1:4, levels = c( "Eins", "Zwei", "Drei", "Vier" ), class = "factor", converted_to_factor = TRUE, label = "Variable 1" ), V2 = structure(c(2, 3, 4, 1), labels = c( Eins = 1, Zwei = 2, Drei = 3 ), label = "Variable 2" ), V3 = structure( c( 3L, 2L, 1L, 4L ), levels = c("Eins", "Zwei", "Drei", "Vier"), class = "factor", converted_to_factor = TRUE, label = "Variable 3" ) ), row.names = c(NA, -4L), class = "data.frame") ) }) }) # zipped SPSS file ----------------------------------- test_that("data_read - zipped SPSS file", { withr::with_tempfile("temp_file", fileext = ".zip", code = { request <- httr::GET("https://raw.github.com/easystats/circus/main/data/EFC.zip") httr::stop_for_status(request) writeBin(httr::content(request, type = "raw"), temp_file) d <- data_read( temp_file, verbose = FALSE ) expect_identical(sum(vapply(d, is.factor, FUN.VALUE = logical(1L))), 15L) expect_identical(sum(vapply(d, is.numeric, FUN.VALUE = logical(1L))), 11L) d <- data_read( temp_file, convert_factors = FALSE, verbose = FALSE ) expect_identical(sum(vapply(d, is.factor, FUN.VALUE = logical(1L))), 0L) expect_identical(sum(vapply(d, is.numeric, FUN.VALUE = logical(1L))), 26L) }) }) # SPSS file, many value labels ----------------------------------- test_that("data_read, convert many labels correctly", { # Output validated against SPSS output from original dataset withr::with_tempfile("temp_file", fileext = ".sav", code = { request <- httr::GET("https://raw.github.com/easystats/circus/main/data/spss_many_labels.sav") httr::stop_for_status(request) writeBin(httr::content(request, type = "raw"), temp_file) d <- data_read( temp_file, verbose = FALSE ) # all are factors by default expect_identical( vapply(d, class, character(1)), c(selv1 = "factor", c12 = "factor", c12a = "factor", c12c = "factor") ) expect_identical( levels(d$selv1), c( "Vignette 1 weiblich (Gülsen E. Reinigungskraft B)", "Vignette 2 weiblich (Gülsen E. Anwältin B)", "Vignette 3 weiblich (Monika E. Reinigungskraft B)", "Vignette 4 weiblich (Monika E. Anwältin B)", "Vignette 5 männlich (Hasan E. Reinigungskraft B)", "Vignette 6 männlich (Hasan E. Anwalt B)", "Vignette 7 männlich (Martin E. Reinigungskraft B)", "Vignette 8 männlich (Martin E. Anwalt B)", "Vignette 9 weiblich (Gülsen E. Reinigungskraft E)", "Vignette 10 weiblich (Gülsen E. Anwältin E)", "Vignette 11 weiblich (Monika E. Reinigungskraft E)", "Vignette 12 weiblich (Monika E. Anwältin E)", "Vignette 13 männlich (Hasan E. Reinigungskraft E)", "Vignette 14 männlich (Hasan E. Anwalt E)", "Vignette 15 männlich (Martin E. Reinigungskraft E)", "Vignette 16 männlich (Martin E. Anwalt E)" ) ) expect_snapshot(data_tabulate(d$selv1)) expect_identical(levels(d$c12), c("ja", "nein", "keine Angabe")) expect_snapshot(data_tabulate(d$c12)) expect_identical(levels(d$c12a), c("Filter", "ja", "nein", "keine Angabe")) expect_snapshot(data_tabulate(d$c12a)) expect_identical( levels(d$c12c), c( "Filter", "0 = keine", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10 = sehr starke", "weiß nicht / keine Angabe" ) ) expect_snapshot(data_tabulate(d$c12c)) expect_message( expect_message( expect_message( data_read(temp_file), regexp = "Reading" ), regexp = "Variables where all" ), regexp = "4 out of 4" ) d <- data_read( temp_file, convert_factors = FALSE, verbose = FALSE ) # all are factors by default expect_identical( vapply(d, class, character(1)), c(selv1 = "numeric", c12 = "numeric", c12a = "numeric", c12c = "numeric") ) expect_snapshot(table(d$selv1)) expect_identical( attributes(d$selv1)$labels, c( `Vignette 1 weiblich (Gülsen E. Reinigungskraft B)` = 1, `Vignette 2 weiblich (Gülsen E. Anwältin B)` = 2, `Vignette 3 weiblich (Monika E. Reinigungskraft B)` = 3, `Vignette 4 weiblich (Monika E. Anwältin B)` = 4, `Vignette 5 männlich (Hasan E. Reinigungskraft B)` = 5, `Vignette 6 männlich (Hasan E. Anwalt B)` = 6, `Vignette 7 männlich (Martin E. Reinigungskraft B)` = 7, `Vignette 8 männlich (Martin E. Anwalt B)` = 8, `Vignette 9 weiblich (Gülsen E. Reinigungskraft E)` = 9, `Vignette 10 weiblich (Gülsen E. Anwältin E)` = 10, `Vignette 11 weiblich (Monika E. Reinigungskraft E)` = 11, `Vignette 12 weiblich (Monika E. Anwältin E)` = 12, `Vignette 13 männlich (Hasan E. Reinigungskraft E)` = 13, `Vignette 14 männlich (Hasan E. Anwalt E)` = 14, `Vignette 15 männlich (Martin E. Reinigungskraft E)` = 15, `Vignette 16 männlich (Martin E. Anwalt E)` = 16, `99` = 99 ) ) expect_snapshot(table(d$c12)) expect_identical(attributes(d$c12)$labels, c(Filter = -2, ja = 1, nein = 2, `keine Angabe` = 99)) expect_snapshot(table(d$c12a)) expect_identical(attributes(d$c12a)$labels, c(Filter = -2, ja = 1, nein = 2, `keine Angabe` = 99)) expect_snapshot(table(d$c12c)) expect_identical( attributes(d$c12c)$labels, c( Filter = -2, `0 = keine` = 0, `1` = 1, `2` = 2, `3` = 3, `4` = 4, `5` = 5, `6` = 6, `7` = 7, `8` = 8, `9` = 9, `10 = sehr starke` = 10, `weiß nicht / keine Angabe` = 99 ) ) }) }) # invalid file type ------------------------- test_that("data_read, no file extension", { expect_error(data_read("mytestfile"), regex = "extension") expect_error(data_read(NULL, regex = "extension")) }) # file not exists ------------------------- test_that("data_read, file not exists", { expect_error(data_read("thisfileshouldnotexist.csv"), regex = "not exist") expect_error( suppressMessages(data_read("thisfileshouldnotexist.sav")), regex = "not exist" ) }) # RDS file, no data frame ----------------------------------- test_that("data_read - RDS file, no data frame", { skip_if_not_installed("withr") withr::with_tempfile("temp_file", fileext = ".rda", code = { request <- httr::GET("https://raw.github.com/easystats/circus/main/data/list_for_testing.rda") httr::stop_for_status(request) writeBin(httr::content(request, type = "raw"), temp_file) expect_message( expect_warning( d <- data_read(temp_file, verbose = TRUE), # nolint regex = "no data frame" ), "Reading data" ) expect_type(d, "list") }) }) test_that("data_read - RDA file, model object", { skip_if_not_installed("withr") skip_if_not_installed("brms") withr::with_tempfile("temp_file", fileext = ".rds", code = { request <- httr::GET("https://raw.github.com/easystats/circus/main/data/model_object.rds") httr::stop_for_status(request) writeBin(httr::content(request, type = "raw"), temp_file) expect_message( expect_message( d <- data_read(temp_file, verbose = TRUE), # nolint regex = "Imported file is a regression" ), "Reading data" ) expect_s3_class(d, "lm") }) withr::with_tempfile("temp_file", fileext = ".rda", code = { request <- httr::GET("https://raw.github.com/easystats/circus/main/data/brms_1.rda") httr::stop_for_status(request) writeBin(httr::content(request, type = "raw"), temp_file) expect_message( expect_message( d <- data_read(temp_file, verbose = TRUE), # nolint regex = "Imported file is a regression" ), "Reading data" ) expect_s3_class(d, "brmsfit") }) }) test_that("data_read - RDS file, from URL", { # works with URL request <- httr::GET("https://raw.github.com/easystats/circus/main/data/model_object.rds") httr::stop_for_status(request) expect_message( expect_message( d <- data_read( # nolint "https://raw.github.com/easystats/circus/main/data/model_object.rds", verbose = TRUE ), regex = "Imported file is a regression" ), "Reading data" ) })