tests/testthat/test_misc.R

# Persistent vs. Transient array_op ----

test_that("if an array is persisted or transient", {
  skip_if_no_db()
  withr::local_options(stringsAsFactors = FALSE)
  conn = get_scidb_connection()

  dataFrame = data.frame(a=1:3, b=letters[1:3])
  arrayStored = conn$upload_df(dataFrame)
  arrayBuild = conn$compile_df(dataFrame)
  
  expect_identical(arrayStored$is_persistent(), T)  
  expect_identical(arrayBuild$is_persistent(), F)  
})

test_that("persist arrays so they can be reused", {
  skip_if_no_db()
  withr::local_options(stringsAsFactors = FALSE)
  conn = get_scidb_connection()

  dataFrame = data.frame(a=1:3, b=letters[1:3])
  arrayStored = conn$upload_df(dataFrame)
  arrayBuild = conn$compile_df(dataFrame)
  arrayBuildPersisted = arrayBuild$persist(.gc = F)
  arrayBuildPersistedTemp = arrayBuild$persist(.temp = T, .gc = F)
  arrayBuildPersistedGc = arrayBuild$persist(.gc = T)
  
  expect_identical(arrayStored$persist(), arrayStored)
  expect_identical(arrayBuildPersisted$is_persistent(), T)  
  expect_identical(arrayBuildPersisted$persist(), arrayBuildPersisted)
  
  expect_identical(arrayBuildPersisted$array_meta_data()$temporary, FALSE)
  expect_identical(arrayBuildPersistedTemp$array_meta_data()$temporary, TRUE)
  
  aBP = arrayBuildPersisted$to_afl()
  aBPT = arrayBuildPersistedTemp$to_afl()
  aBPGc = arrayBuildPersistedGc$to_afl()
  
  rm(arrayBuildPersisted)
  rm(arrayBuildPersistedTemp)
  rm(arrayBuildPersistedGc)
  gc()
  gc()
  expect_identical(conn$array(aBP)$exists_persistent_array(), T)
  expect_identical(conn$array(aBPT)$exists_persistent_array(), T)
  # The following array should no longer exist
  expect_error(conn$array(aBPGc)$exists_persistent_array(), "SCIDB_LE_ARRAY_DOESNT_EXIST")
  
  conn$array(aBP)$remove_array()
  conn$array(aBPT)$remove_array()
})

test_that("chained arrayop doesn't remove parent's gc'able array", {
  skip_if_no_db()
  withr::local_options(stringsAsFactors = FALSE)
  conn = get_scidb_connection()
  
  dataFrame = data.frame(a=1:3, b=letters[1:3])
  
  arrayStored = conn$upload_df(dataFrame) # Defaults to .gc=T, .temp=F
  selected = arrayStored$select("b")
  rm(selected)
  gc()
  gc()
  expect_identical(arrayStored$to_df(), dataFrame)
  my_afl = arrayStored$to_afl()
  rm(arrayStored)
  gc()
  expect_error(conn$array(my_afl)$to_df())
})

test_that("verify persistent array existence", {
  skip_if_no_db()
  withr::local_options(stringsAsFactors = FALSE)
  conn = get_scidb_connection()

  name = dbutils$random_array_name()
  arr = conn$create_array(name, "<a:string> [z]")
  
  expect_true(arr$is_persistent())
  expect_true(arr$exists_persistent_array())
  expect_identical(arr$array_meta_data()$name, name)
  
  arr$remove_array()
  
  expect_identical(arr$exists_persistent_array(), F)
})

# drop_dims ---- 

# both 'unpack' and 'flatten' modes will place old dimensions in front of existing attributes
test_that("Drop dims", {
  skip_if_no_db()
  withr::local_options(stringsAsFactors = FALSE)
  conn = get_scidb_connection()

  DataContent = data.frame(da = 1:3, db = 11:13, fa = letters[1:3], fb = 3.14 * 1:3)
  RefArray = conn$
    array_from_df(DataContent, template = "<fa:string, fb:double> [da; db]", force_template_schema = T)$
    persist(.gc = F)
  
  expect_identical(RefArray$dims, c('da', 'db'))
  
  verify = function(dropped, patterns = NULL) {
    expect_identical(dropped$attrs, RefArray$dims_n_attrs)
    expect_equal(dropped$to_df() %>% dplyr::arrange(da), DataContent)
    if(!is.null(patterns)) {
      sapply(patterns, function(x) expect_match(dropped$to_afl(), x))
    }
  }
  
  verify(RefArray$drop_dims())
  verify(RefArray$drop_dims(mode = 'unpack'))
  verify(RefArray$drop_dims(mode = 'unpack', .unpack_dim = 'zz'), 'zz')
  verify(RefArray$drop_dims(mode = 'unpack', .unpack_dim = 'zz', .chunk_size = 123), c('zz', '123'))
  
  verify(RefArray$drop_dims(mode = 'flatten'))
  verify(RefArray$drop_dims(mode = 'flatten', .chunk_size = 123), '123')
  
  RefArray$remove_array()
})

# spawn ----

test_that("no field data type requirement for locally created arrays", {
  skip_if_no_db()
  withr::local_options(stringsAsFactors = FALSE)
  conn = get_scidb_connection()

  template = conn$array_from_schema("<fa:string, fb:int32, fc:bool> [da;db]")
  a = template$spawn(excluded = c('da', 'fa'), added = 'extra', renamed = list(fc='fc_re'))
  
  expect_identical(a$dims, c('db'))
  expect_identical(a$attrs, c('fb','fc_re', 'extra'))
  
})
Paradigm4/ArrayOpR documentation built on Dec. 11, 2023, 5:59 a.m.