tests/testthat/test-data_write.R

In datawizard: Easy Data Wrangling and Statistical Transformations

skip_if_not_installed("httr")
skip_if_not_installed("haven")
skip_if_not_installed("readr")

skip_on_cran()

skip_if_not_installed("curl")
skip_if_offline()

# prepare data set ---------------

data(efc)
d <- data_filter(efc, 1:5)
d$e42dep <- droplevels(d$e42dep)


# data encryption with rds ------------------

test_that("data_write, encrypting rds files", {
  skip_if_not_installed("withr")
  skip_if_not_installed("openssl")
  withr::with_tempfile("tmp", fileext = ".rds", code = {
    expect_warning(data_write(d, tmp, password = "test"), "Remember")

    # no password, returns encrypted data frame
    d2 <- data_read(tmp, verbose = FALSE)
    expect_named(d2, "out")
    expect_false(identical(d, d2))

    # password, returns decrypted data frame
    d2 <- data_read(tmp, password = "test")
    expect_identical(d, d2)

    # wrong password
    expect_error(data_read(tmp, password = "text"), "File does not appear")

    # invalid password arguments
    expect_error(
      data_read(tmp, password = c("test", "test2")),
      regex = "The password must be a single"
    )
    expect_error(
      data_read(tmp, password = 123),
      regex = "The password must be a single"
    )
    expect_error(
      data_read(tmp, password = ""),
      regex = "The password must be a single"
    )
    expect_error(
      data_write(d, tmp, password = c("test", "test2")),
      regex = "The password must be a single"
    )
    expect_error(
      data_write(d, tmp, password = 123),
      regex = "The password must be a single"
    )
    expect_error(
      data_write(d, tmp, password = ""),
      regex = "The password must be a single"
    )

    # not encrypted
    data_write(d, tmp)
    expect_error(data_read(tmp, password = "test"), "File does not appear")

    # check other decryption functions, should fail when encrypted with datawizard
    expect_warning(data_write(d, tmp, password = "test"))
    out <- readRDS(tmp)
    key <- openssl::sha256(charToRaw("test"))
    expect_error(openssl::aes_cbc_decrypt(out, key = key))

    # check other encryption functions, should fail imported with datawizard
    x <- serialize(d, NULL)
    key <- openssl::sha256(charToRaw("test"))
    saveRDS(openssl::aes_cbc_encrypt(x, key = key), tmp)
    expect_error(data_read(tmp, password = "test"), "File does not appear")
  })
})


# data encryption with rdata ------------------

test_that("data_write, encrypting rdata files", {
  skip_if_not_installed("withr")
  skip_if_not_installed("openssl")
  withr::with_tempfile("tmp", fileext = ".rdata", code = {
    expect_warning(data_write(d, tmp, password = "test"), "Remember")

    # no password, returns encrypted data frame
    d2 <- data_read(tmp, verbose = FALSE)
    expect_named(d2, "out")

    # password, returns decrypted data frame
    d2 <- data_read(tmp, password = "test")
    expect_identical(d, d2)
  })
})


# data encryption with parquet ------------------

test_that("data_write, encrypting parquet files", {
  skip_if_not_installed("withr")
  withr::with_tempfile("tmp", fileext = ".parquet", code = {
    expect_error(
      data_write(d, tmp, password = "test"),
      "Data encryption is not supported"
    )
  })
})


# SPSS -------------------------------------

test_that("data_write, SPSS", {
  skip_if_not_installed("withr")
  withr::with_tempfile("tmp", fileext = ".sav", code = {
    expect_message(data_write(d, tmp))
    d2 <- data_read(tmp, verbose = FALSE)
    expect_equal(
      to_factor(d, select = c("e16sex", "c172code")),
      d2,
      ignore_attr = TRUE
    )
    # data encryption not available for SPSS etc.
    expect_error(
      data_write(d, tmp, password = "test"),
      "Data encryption is not supported"
    )
  })
})


test_that("data_write, SPSS, mixed types of labelled vectors", {
  skip_if_not_installed("withr")
  withr::with_tempfile("tmp", fileext = ".sav", code = {
    d <- data.frame(
      a = 1:3,
      b = letters[1:3],
      c = factor(letters[1:3]),
      d = as.Date(c("2022-01-01", "2022-02-01", "2022-03-01")),
      e = c(TRUE, FALSE, FALSE),
      stringsAsFactors = FALSE
    )

    # Date and Logical cannot be labelled
    d$a <- assign_labels(
      d$a,
      variable = "First",
      values = c("one", "two", "three")
    )
    d$b <- assign_labels(d$b, variable = "Second", values = c("A", "B", "C"))
    d$c <- assign_labels(
      d$c,
      variable = "Third",
      values = c("ey", "bee", "see")
    )

    expect_message(data_write(d, tmp), regex = "Preparing")
  })
})


# Stata -------------------------------------

test_that("data_write, Stata", {
  skip_if_not_installed("withr")
  withr::with_tempfile("tmp", fileext = ".dta", code = {
    data_write(d, tmp, verbose = FALSE)
    d2 <- data_read(tmp, verbose = FALSE)

    expect_equal(
      to_factor(d, select = c("e16sex", "c172code")),
      d2,
      ignore_attr = TRUE
    )

    # data encryption not available for SPSS etc.
    expect_error(
      data_write(d, tmp, password = "test"),
      "Data encryption is not supported"
    )
  })
})


# csv -------------------------

test_that("data_write, CSV, keep numeric", {
  skip_if_not_installed("withr")
  withr::with_tempfile("tmp", fileext = ".csv", code = {
    data_write(d, tmp)
    d2 <- data_read(tmp)

    expect_equal(
      to_numeric(d, dummy_factors = FALSE, preserve_levels = TRUE),
      d2,
      ignore_attr = TRUE
    )

    # data encryption not available for SPSS etc.
    expect_error(
      data_write(d, tmp, password = "test"),
      "Data encryption is not supported"
    )
  })
})

test_that("data_write, CSV, convert to factor", {
  skip_if_not_installed("withr")
  withr::with_tempfile("tmp", fileext = ".csv", code = {
    data_write(d, tmp, convert_factors = TRUE)
    d2 <- data_read(tmp)
    out <- to_factor(d, select = c("e16sex", "c172code"))
    out$e16sex <- as.character(out$e16sex)
    out$c172code <- as.character(out$c172code)
    out$e42dep <- as.numeric(as.character(out$e42dep))
    expect_equal(out, d2, ignore_attr = TRUE)
  })
})

test_that("data_write, CSV, create labels file", {
  skip_if_not_installed("withr")
  withr::with_tempfile("tmp", fileext = ".csv", code = {
    # file for labels
    fpath <- dirname(tmp)
    fname <- sub("\\.csv$", "", basename(tmp))
    tmp2 <- paste0(fpath, .Platform$file.sep, fname, "_labels.csv")
    on.exit(unlink(tmp2))

    data(efc)
    expect_message(data_write(efc, tmp, save_labels = TRUE))
    d <- data_read(tmp2)

    expect_identical(d$variable[2], "e16sex")
    expect_identical(d$label[2], "elder's gender")
    expect_identical(d$labels[2], "1=male; 2=female")

    expect_message(data_write(efc, tmp, save_labels = TRUE, delimiter = ";"))
    d <- data_read(tmp2)
    expect_identical(d$variable[2], "e16sex")
    expect_identical(d$label[2], "elder's gender")
    expect_identical(d$labels[2], "1=male; 2=female")
  })
})


# invalid file type -------------------------

test_that("data_write, no file extension", {
  expect_error(data_write(d, "mytestfile"))
  expect_error(data_write(d, NULL))
})


# writing character vector works for missing value labels ------------------

test_that("data_write, existing variable label but missing value labels", {
  skip_if_not_installed("withr")
  withr::with_tempfile("tmp", fileext = ".sav", code = {
    d <- data.frame(
      a = letters[1:3],
      stringsAsFactors = FALSE
    )
    d$a <- assign_labels(d$a, variable = "First")
    # expect message, but no error
    expect_message(data_write(d, tmp), regex = "Preparing")

    # check if data is really the same
    d2 <- data_read(tmp, verbose = FALSE)
    expect_identical(d2, d)
  })
})