tests/testthat/test-libname.R

In libr: Libraries, Data Dictionaries, and a Data Step for R

context("Libname Tests")

base_path <- "c:\\packages\\libr\\tests\\testthat\\data"

base_path <- "./data"

test_that("lib1: libname() function works as expected with csv.", {

  libname(dat, base_path, engine = "csv")

  expect_equal(class(dat)[[1]], "lib")
  expect_equal(length(dat), 2)
  expect_equal(nrow(dat[[1]]), 10)
  expect_equal(ncol(dat[[1]]), 9)
  expect_equal(nrow(dat[[2]]), 2)
  expect_equal(ncol(dat[[2]]), 9)
})


test_that("lib2: libname() and quiet parameter works as expected with csv.", {

  libname(dat, base_path, engine = "csv", quiet = TRUE)

  expect_equal(class(dat)[[1]], "lib")
  expect_equal(length(dat), 2)
  expect_equal(nrow(dat[[1]]), 10)
  expect_equal(ncol(dat[[1]]), 9)
  expect_equal(nrow(dat[[2]]), 2)
  expect_equal(ncol(dat[[2]]), 9)
})



test_that("lib3: libname() function works as expected with rds", {

  libname(dat, base_path, engine = "rds")


  expect_equal(class(dat)[[1]], "lib")
  expect_equal(length(dat), 2)
  expect_equal(nrow(dat[[1]]), 10)
  expect_equal(ncol(dat[[1]]), 9)
  expect_equal(nrow(dat[[2]]), 2)
  expect_equal(ncol(dat[[2]]), 9)
})

test_that("lib4: libname() function works as expected with rdata", {
  
  
  libname(dat, base_path, engine = "Rdata")
  
  expect_equal(class(dat)[[1]], "lib")
  expect_equal(length(dat), 2)
  expect_equal(nrow(dat[[1]]), 10)
  expect_equal(ncol(dat[[1]]), 9)
  expect_equal(nrow(dat[[2]]), 2)
  expect_equal(ncol(dat[[2]]), 9)
})


test_that("lib5: libname() function works as expected with xls", {

  libname(dat, base_path, engine = "xls")


  expect_equal(class(dat)[[1]], "lib")
  expect_equal(length(dat), 2)
  expect_equal(nrow(dat[[1]]), 10)
  expect_equal(ncol(dat[[1]]), 9)
  expect_equal(nrow(dat[[2]]), 2)
  expect_equal(ncol(dat[[2]]), 9)
})

test_that("lib6: libname() function works as expected with xlsx", {

  libname(dat, base_path, engine = "xlsx")

  expect_equal(class(dat)[[1]], "lib")
  expect_equal(length(dat), 2)
  expect_equal(nrow(dat[[1]]), 10)
  expect_equal(ncol(dat[[1]]), 9)
  expect_equal(nrow(dat[[2]]), 2)
  expect_equal(ncol(dat[[2]]), 9)
})

test_that("lib7: libname() function works as expected with sas7bdat", {

  libname(dat, base_path, engine = "sas7bdat")

  expect_equal(class(dat)[[1]], "lib")
  expect_equal(length(dat), 2)
  expect_equal(nrow(dat[[1]]), 10)
  expect_equal(ncol(dat[[1]]), 9)
  expect_equal(nrow(dat[[2]]), 2)
  expect_equal(ncol(dat[[2]]), 9)
})

test_that("lib8: libname() function works as expected with dbf", {

  tmp <- tempdir()
  libname(dat, tmp, "dbf")

  lib_add(dat, mtcars)

  libname(dat2, tmp, "dbf")


  expect_equal(length(dat2), 1)
  expect_equal(nrow(dat2[[1]]), 32)
  expect_equal(ncol(dat2[[1]]), 11)

  lib_delete(dat)
  lib_delete(dat2)
})

test_that("lib9: libname() function works as expected with xpt", {

  tmp <- tempdir()
  libname(dat, tmp, "xpt")

  lib_add(dat, mtcars)

  libname(dat2, tmp, "xpt")


  expect_equal(length(dat2), 1)
  expect_equal(nrow(dat2[[1]]), 32)
  expect_equal(ncol(dat2[[1]]), 11)

  lib_delete(dat)
  lib_delete(dat2)
})


test_that("lib10: libname() parameter checks work as expected.", {

  expect_error(libname(sam, engine = NULL))
  expect_error(libname(sam, engine = c("sas7bdat", "rds")))
  expect_error(libname(sam, engine = "rds", import_specs = "fork"))
  expect_error(libname(sam, engine = "fork"))


})




test_that("lib11: libname() function works as expected with new directory", {

  fp <- file.path(tempdir(), "fork")

  libname(fork, fp)

  expect_equal(file.exists(fp), TRUE)

  if (file.exists(fp))
    unlink(fp, recursive = TRUE)

})


test_that("lib12: libname() function works as expected within a function.", {

  libname(dat, tempdir())

  lib_load(dat)

  dat.cars <- mtcars
  dat.iris <- iris

  lib_unload(dat)

  expect_equal(length(dat), 2)


})

test_that("lib13: libname() function works as expected within multiple functions.", {

  libname(dat, base_path, "csv")


  func1 <- function() {
    libname(dat, tempdir())

    lib_add(dat, mtcars)

    ret <- names(dat)

    lib_delete(dat)

    return(ret)
  }


  func2 <- function() {

    alt <- file.path(tempdir(), "data2")
    libname(dat, alt)

    lib_add(dat, iris, beaver1)

    ret <- names(dat)


    lib_delete(dat)

    return(ret)
  }

  res1 <- func1()
  res2 <- func2()


  expect_equal(names(dat), c("demo_studya", "demo_studyb"))
  expect_equal(res1, c("mtcars"))
  expect_equal(res2, c("iris", "beaver1"))
})

test_that("lib14: libname() function works as expected with nested functions.", {

  libname(dat, base_path, "csv")


  func1 <- function() {
    libname(dat, tempdir())

    lib_add(dat, mtcars)

    ret <- names(dat)

    lib_delete(dat)

    return(ret)
  }

  func2 <- function() {

    alt <- file.path(tempdir(), "data2")
    libname(dat, alt)

    lib_add(dat, iris, beaver1)

    ret <- list()
    ret[["func2"]] <- names(dat)
    ret[["func1"]] <- func1()

    lib_delete(dat)

    return(ret)
  }

  res <- func2()

  expect_equal(names(dat), c("demo_studya", "demo_studyb"))
  expect_equal(res[["func1"]], c("mtcars"))
  expect_equal(res[["func2"]], c("iris", "beaver1"))
})

test_that("lib15: libname() function works as expected with filter", {

  libname(dat, file.path( base_path, "SDTM"),
          engine = "sas7bdat", filter = c("ae", "dm", "lb", "vs"))

  d <- lib_info(dat)[["Name"]]

  expect_equal(as.character(d), c("ae", "dm", "lb", "vs"))

  libname(dat, file.path( base_path, "SDTM"),
          engine = "sas7bdat", filter = c("*e"))

  d <- lib_info(dat)[["Name"]]

  expect_equal(as.character(d), c("ae", "ie", "pe"))

  libname(dat, file.path( base_path, "SDTM"),
          engine = "sas7bdat", filter = c("d*", "ex", "qs"))

  d <- lib_info(dat)[["Name"]]

  expect_equal(all(d %in% c("da", "dm", "ds", "ds_ihor", "ex", "qs")), TRUE)
})

test_that("lib16: libname()  works as expected with basic operations.", {


  libname(spork, file.path( base_path, "SDTM"),
          engine = "sas7bdat", filter = c("ae", "dm", "lb", "vs"))

  expect_equal("spork" %in% ls(), TRUE)

  lib_load(spork)

  expect_equal("spork.ae" %in% ls(), TRUE)

  lib_unload(spork)

  expect_equal("spork.ae" %in% ls(), FALSE)


  rm("spork")



})


test_that("lib17: libname() standard_eval parameter works as expected with basic operations.", {

  myvar <- "fork"


  libname(myvar, file.path( base_path, "SDTM"),
          engine = "sas7bdat", filter = c("ae", "dm", "lb", "vs"),
          standard_eval = TRUE)

  expect_equal("fork" %in% ls(), TRUE)

  lib_load(myvar)

  expect_equal("fork.ae" %in% ls(), TRUE)

  lib_unload(myvar)

  expect_equal("fork.ae" %in% ls(), FALSE)

  rm("myvar", "fork")


})


test_that("lib18: libname() standard_eval parameter works as expected with all operations.", {

  myvar1 <- "bork1"
  myvar2 <- "bork2"


  libname(myvar1, file.path( base_path, "SDTM"),
          engine = "csv", filter = c("ae", "dm", "lb", "vs"),
          standard_eval = TRUE)


  expect_equal(myvar1 %in% ls(), TRUE)

  lib_info(myvar1)
  lib_path(myvar1)
  lib_size(myvar1)

  lib_load(myvar1)

  expect_equal("bork1.AE" %in% ls(), TRUE)

  lib_unload(myvar1)

  expect_equal("bork1.AE" %in% ls(), FALSE)

  lib_copy(myvar1, myvar2, paste0(base_path, "2"), standard_eval = TRUE)

  expect_equal(nrow(lib_info(myvar2)), 4)
  lib_path(myvar2)
  lib_size(myvar2)

  lib_load(myvar2)

  expect_equal("bork2.AE" %in% ls(), TRUE)


  bork2.mtcars <- mtcars


  expect_equal(nrow(lib_info(myvar2)), 4)


  lib_sync(myvar2)

  expect_equal(nrow(lib_info(myvar2)), 5)


  lib_write(myvar2)
  lib_info(myvar2)
  lib_remove(myvar2, "mtcars")

  expect_equal(nrow(lib_info(myvar2)), 4)

  lib_unload(myvar2)

  expect_equal("bork2.AE" %in% ls(), FALSE)


  lib_add(myvar2, mtcars)

  expect_equal("mtcars" %in% lib_info(myvar2)[[1]], TRUE)

  lib_replace(myvar2, mtcars[1:10, 1:5], name = "mtcars")

  expect_equal(nrow(lib_info(myvar2)), 5)

  lib_delete(myvar2)

  expect_equal(myvar2 %in% ls(), FALSE)

  rm("bork1", "myvar1", "myvar2")



})


test_that("lib19: library parameter checks work as expected.", {
  fork <- "bork"
  f <- "fork"

  expect_error(lib_load(f))
  expect_error(lib_unload(f))
  expect_error(lib_add(f))
  expect_error(lib_replace(f))
  expect_error(lib_remove(f))
  expect_error(lib_write(f))
  expect_error(lib_sync(f))
  expect_error(lib_copy(f))
  expect_error(lib_delete(f))
  expect_error(lib_path(f))
  expect_error(lib_size(f))
  expect_error(lib_info(f))


})

test_that("lib20: lib_export() function works as expected.", {
  
  libname(dat, base_path, engine = "csv")
  
  pth <- paste0(base_path, "2")
  
  lib_export(dat, dat2, pth, "rdata")
  
  expect_equal(length(dat2), 2)
  
  # Clean up
  lib_delete(dat2)
  
  
})

test_that("lib21: lib_export() function works as expected with filter.", {
  
  libname(dat, base_path, engine = "csv")
  
  pth <- paste0(base_path, "2")
  
  lib_export(dat, dat2, pth, "rdata", filter = "*b")
  
  expect_equal(length(dat2), 1)
  
  # Clean up
  lib_delete(dat2)
  
  
})

test_that("lib22: lib_export() function works as expected with standard_eval.", {
  
  libname(dat, base_path, engine = "csv")
  
  pth <- paste0(base_path, "2")
  
  lib_export(dat, "dat3", pth, "rdata", standard_eval = TRUE)
  
  expect_equal(length(dat3), 2)
  
  # Clean up
  lib_delete(dat3)
  
  
})

test_that("lib23: libname works with rda files", {
  
  libname(dat, base_path, engine = "rda")
  
  lib_load(dat)
  
  expect_equal(length(dat), 2)
  
  
  res1 <- lib_info(dat)
  
  expect_equal(res1[[1, "Extension"]], "rda")
  
  pth2 <- paste0(base_path, "2")
  
  libname(dat2, pth2, engine = "rda")  
  
  lib_add(dat2, mtcars)
  
  
  res2 <- lib_info(dat2)
  
  expect_equal(res2[[1, "Extension"]], "rda")
  
  
  lib_copy(dat, dat3, lib_path(dat2))
  
  res3 <- lib_info(dat3)
  
  expect_equal(nrow(res3), 2)
  
  
  
  lib_remove(dat3, name = "demo_studya")
  
  res4 <- lib_info(dat3)
  
  
  expect_equal(nrow(res4), 1)
  
  

  lib_delete(dat2)  
  lib_delete(dat3)
  
  

  
  
  
})


test_that("lib24: lib_export() creates new library.", {
  
  libname(dat, base_path, "xpt", filter = "AD*")
  
  pth2 <- paste0(base_path, "2")
  
  lib_export(dat, dat2, pth2, "rda")
  
  res <- lib_info(dat2)
  
  expect_equal(nrow(res), 2)  
  expect_equal(res[[1, 2]], "rda")
  
  lib_delete(dat2)
  
})


test_that("lib25: libname() function works as expected with rds", {
  
  libname(dat, base_path, engine = "rds", where = expression(sex == 'F'))
  
  # dat$demo_studya
  # dat$demo_studyb
  
  expect_equal(class(dat)[[1]], "lib")
  expect_equal(length(dat), 2)
  expect_equal(nrow(dat[[1]]), 3)
  expect_equal(ncol(dat[[1]]), 9)
  expect_equal(nrow(dat[[2]]), 1)
  expect_equal(ncol(dat[[2]]), 9)
})



# 
# test_that("lib24: lib_export() creates new library.", {
#   
#   v1 <- c(P1 = 10, P2 = 20, P3 = 30)
#   
#   saveRDS(v1, "C:/packages/libr/tests/testthat/data/vect.rds")
#   
#   libname(testme, base_path, "rds")
#   
# 
# })