tests/testthat/test_emuR-emuRtrackdata.R

##' testthat tests for emuRtrackdata
##'
context("testing emuRtrackdata 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))

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

test_that("emuRtrackdata functions work", {
  # delete, copy and load
  unlink(path2db, recursive = TRUE)
  file.copy(path2orig, 
            path2testData, 
            recursive = TRUE)
  ae = load_emuDB(path2db, 
                  inMemoryCache = internalVars$testingVars$inMemoryCache, 
                  verbose = FALSE)
  
  
  ##############################
  test_that("correct classes are returned", {
    
    sl = query(ae, "Phonetic == @ | i:", 
               resultType = "emuRsegs")
    td = get_trackdata(ae, 
                       seglist = sl, 
                       ssffTrackName = 'fm',
                       resultType = "trackdata",
                       verbose = FALSE)
    
    newTd = create_emuRtrackdata(sl, td)
    
    expect_true(inherits(newTd, "emuRtrackdata"))
    
  })
  
  ##############################
  # test_that("cut works correctly", {
  #   
  #   sl = query(dbName, "Phonetic=@|i:")
  #   td = get_trackdata(dbName, 
  #                      seglist = sl, 
  #                      ssffTrackName = 'fm')
  #   
  #   newTd = create_emuRtrackdata(sl, td)
  #   
  #   propRes = cut_td(newTd, 0.5, prop=TRUE)
  #   print(propRes)
  #   })
  
  
  test_that("normalize_length returns normalized segments on tibble", {

    sl = query(ae, "Phonetic = I", 
               resultType = "tibble")
    td = get_trackdata(ae,
                       seglist = sl,
                       ssffTrackName = 'fm',
                       resultType = "tibble")
  
    N = 21
    td_norm = normalize_length(td, N = N)
    
    expect_true(nrow(td_norm[td_norm$sl_rowIdx == 1,]) == N)
    })

  test_that("normalize_length returns normalized segments on emuRtrackdata", {
    
    sl = query(ae, "Phonetic = I")
    td = get_trackdata(ae,
                       seglist = sl,
                       ssffTrackName = 'fm',
                       resultType = "emuRtrackdata")
    
    N = 21
    td_norm = normalize_length(td, N = N)
    
    expect_true(nrow(td_norm[td_norm$sl_rowIdx == 1,]) == N)
  })
  
  
  # clean up
  DBI::dbDisconnect(ae$connection)
  ae = NULL
  unlink(path2db, recursive = TRUE)
  
})

Try the emuR package in your browser

Any scripts or data that you put into this service are public.

emuR documentation built on Nov. 4, 2023, 1:06 a.m.