tests/testthat/test-data_read.R

In easystats/datawizard: Easy Data Wrangling and Statistical Transformations

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)
    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(
      data_read(temp_file, verbose = TRUE),
      regex = "File contained more than one object"
    )
  })
})


# 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_warning(
      {
        d <- data_read(
          temp_file,
          verbose = TRUE
        )
      },
      regex = "no data frame"
    )
    expect_type(d, "list")
  })
})


test_that("data_read - RDA file, model object", {
  skip_if_not_installed("withr")

  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(
      {
        d <- data_read(
          temp_file,
          verbose = TRUE
        )
      },
      regex = "Imported file is a regression"
    )
    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(
      {
        d <- data_read(
          temp_file,
          verbose = TRUE
        )
      },
      regex = "Imported file is a regression"
    )
    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(
    {
      d <- data_read(
        "https://raw.github.com/easystats/circus/main/data/model_object.rds",
        verbose = TRUE
      )
    },
    regex = "Imported file is a regression"
  )
})