tests/testthat/test_emuR-database.flatfiledata.R

In emuR: Main Package of the EMU Speech Database Management System

##' testthat tests for flatfiledata
##'
context("testing database flatfiledata functions")

dbName = "ae"

path2orig = file.path(tempdir(), 
                      "emuR_demoData", 
                      paste0(dbName, emuDB.suffix))
path2testData = file.path(tempdir(), "emuR_testthat")
path2db = file.path(path2testData, 
                    paste0(dbName, emuDB.suffix))

# delete, copy and load
unlink(path2db, recursive = TRUE)
file.copy(path2orig, 
          path2testData, 
          recursive = TRUE)

# create a second session
dir.create(file.path(path2db, "0001_ses"))
file.copy(from = list.files(file.path(path2db, "0000_ses"), full.names = TRUE),
          to = file.path(path2db, "0001_ses"),
          recursive = TRUE)

# extract internalVars from environment .emuR_pkgEnv
internalVars = get("internalVars", 
                   envir = .emuR_pkgEnv)

db = load_emuDB(path2db, 
                inMemoryCache = internalVars$testingVars$inMemoryCache, 
                verbose = FALSE)

test_that("join_flatFileData works on emuDB level", {
  
  sl = query(db, "Phonetic == S")
  
  # check error is thrown for bad columns in long data
  long_data = tibble::tibble(bad_col_name = c("location", "institution"), 
                             value = c("Muenchen", "IPS"))
  
  file_path = file.path(db$basePath, paste0(db$dbName, "_long.", "csv"))
  
  readr::write_excel_csv2(x = long_data, file = file_path)
  expect_error(join_flatFileData(db, sl), 
               ".*doesn't only contain the columns.*")
  
  # long emuDB data
  long_data = tibble::tibble(key = c("location", "institution"), 
                             value = c("Muenchen", "IPS"))
  
  file_path = file.path(db$basePath, paste0(db$dbName, "_long.", "csv"))
  
  readr::write_excel_csv2(x = long_data, file = file_path)
  
  sl_joined = join_flatFileData(db, sl)
  
  expect_true(all(c("location", "institution") %in% names(sl_joined)))
  expect_equal(sl_joined$location, rep("Muenchen", 10))
  expect_equal(sl_joined$institution, rep("IPS", 10))
  
  unlink(file_path)
  
  # wide emuDB data
  # specify session and bundle
  wide_data = tibble::tibble(session = c("0000", "0000", "0001"),
                             bundle = c("msajc003", "msajc012", "msajc022"),
                             eyecolor = c("blue", "brown", "green"),
                             height = c("1.80", "1.60", "2.00"))
  
  file_path = file.path(db$basePath, paste0(db$dbName, "_wide.", "csv"))
  
  readr::write_excel_csv2(x = wide_data, file = file_path)
  
  sl_joined = join_flatFileData(db, sl)
  
  # plus new wide data is added and correct
  expect_equal(sl_joined$eyecolor[1:3], c("blue", "brown", "brown"))
  expect_equal(sl_joined$eyecolor[9:10], c("green", "green"))
  expect_equal(length(which(is.na(sl_joined$eyecolor))), 5)
  
  unlink(file_path)
  
})

test_that("join_flatFileData works on single session level", {
  
  sl = query(db, "Phonetic == S")
  
  file_path = file.path(db$basePath, "0000_ses", paste0("0000", "_long.", "csv"))
  
  # long session data
  long_data = tibble::tibble(key = c("location", "fudge", "speed"), 
                             value = c("Muenchen", "yummy", "fast"))
  
  readr::write_excel_csv2(x = long_data, 
                          file = file_path)
  
  
  sl_joined = join_flatFileData(db, sl)
  
  expect_true(all(c("location", "fudge", "speed") %in% names(sl_joined)))
  
  expect_equal(length(which(is.na(sl_joined$location))), 5)
  expect_equal(length(which(is.na(sl_joined$fudge))), 5)
  expect_equal(length(which(is.na(sl_joined$speed))), 5)
  
  
  expect_equal(sl_joined$location[1:5], c("Muenchen",
                                          "Muenchen",
                                          "Muenchen",
                                          "Muenchen",
                                          "Muenchen"))
  
  expect_equal(sl_joined$fudge[1:5], c("yummy",
                                       "yummy",
                                       "yummy",
                                       "yummy",
                                       "yummy"))
  
  unlink(file_path)
  
  # wide session data
  # specify bundle only
  
  file_path = file.path(db$basePath, "0000_ses", paste0("0000", "_wide.", "csv"))
  
  wide_data = tibble::tibble(bundle = c("msajc003", "msajc012"),
                             eyecolor = c("blue", "brown"))
  
  readr::write_excel_csv2(x = wide_data, 
                          file = file_path)
  
  sl_joined = join_flatFileData(db, sl)
  
  expect_equal(length(which(is.na(sl_joined$eyecolor))), 7)
  
  expect_equal(sl_joined$eyecolor[1:3], c("blue", "brown", "brown"))
  
  unlink(file_path)
})


test_that("join_flatFileData works on single bundle level", {
  
  sl = query(db, "Phonetic == S")
  
  file_path = file.path(db$basePath, 
                        "0000_ses", 
                        "msajc003_bndl", 
                        paste0("msajc003", "_long.", "csv"))
  
  # long bundle data
  long_data = tibble::tibble(key = c("location", "fudge", "speed"), 
                             value = c("Muenchen", "yummy", "fast"))
  
  readr::write_excel_csv2(x = long_data, 
                          file = file_path)
  
  sl_joined = join_flatFileData(db, sl)
  
  expect_equal(length(which(is.na(sl_joined$location))), 9)
  
  expect_equal(sl_joined$location[1], "Muenchen")
  expect_equal(sl_joined$fudge[1], "yummy")
  expect_equal(sl_joined$speed[1], "fast")
  
  unlink(file_path)
})