extras/templateAutogeneratedTestFunctionScripts.R

In OHDSI/ROhdsiWebApi: Interacting With an OHDSI WebApi Instance

# Copyright 2022 Observational Health Data Sciences and Informatics
#
# This file is part of ROhdsiWebApi
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.


# This file has been autogenerated. Do not change by hand.


sourceKeyVariable = 'SYNPUF5PCT'
idCohort <- 2
idConceptSet <- 2
idCharacterization <- 1
idIncidenceRate <- 2
idPathway <- 1


baseUrl <- Sys.getenv('WEBAPI_TEST_WEBAPI_URL')
library(dplyr)



### Testing functions in WebApi.R

testthat::test_that(desc = "Test .checkBaseUrl", code = {
  testthat::skip_if(baseUrl == "")
  value <- ROhdsiWebApi:::.checkBaseUrl(baseUrl = baseUrl)
  testthat::expect_null(value)
})

testthat::test_that(desc = "Test getPriorityVocabulary", code = {
  testthat::skip_if(baseUrl == "")
  value <- ROhdsiWebApi::getPriorityVocabularyKey(baseUrl = baseUrl)
  testthat::expect_type(object = value, type = 'character')
})

testthat::test_that(desc = "Test getWebApiVersion", code = {
  testthat::skip_if(baseUrl == "")
  value <- ROhdsiWebApi::getWebApiVersion(baseUrl = baseUrl)
  testthat::expect_type(object = value, type = 'character')
})

testthat::test_that(desc = "Test getCdmSources", code = {
  testthat::skip_if(baseUrl == "")
  cdmSources <- ROhdsiWebApi::getCdmSources(baseUrl = baseUrl)
  testthat::expect_s3_class(object = cdmSources, class = "data.frame")
  testthat::expect_gt(object = nrow(cdmSources), expected = 0)
})

testthat::test_that(desc = "Test isValidSourceKey", code = {
  testthat::skip_if(baseUrl == "")
  isValid <- ROhdsiWebApi::isValidSourceKey(baseUrl = baseUrl, sourceKeys = sourceKeyVariable)
  isValid2 <- ROhdsiWebApi::isValidSourceKey(baseUrl = baseUrl, sourceKeys = paste0(sample(letters, size = 10, replace = TRUE), collapse = ""))
  testthat::expect_type(object = isValid, type = 'logical')
  testthat::expect_type(object = isValid2, type = 'logical')
  testthat::expect_setequal(object = c(isValid, isValid2), expected = c(TRUE, FALSE))
})

testthat::test_that(desc = "Test .getStandardCategories", code = {
  standardCategories <- ROhdsiWebApi:::.getStandardCategories() %>% dplyr::arrange() %>% dplyr::pull(categoryStandard)
  testthat::expect_setequal(object = standardCategories, expected = c("conceptSet","cohort","incidenceRate","estimation", "prediction","characterization","pathway"))
})

testthat::test_that(desc = "Test getDefinitionsMetadata1", code = {
  testthat::skip_if(baseUrl == "")
  value <- ROhdsiWebApi::getDefinitionsMetadata(baseUrl = baseUrl, category = 'cohort')
  testthat::expect_s3_class(object = value, class = "tbl")
  testthat::expect_s3_class(object = value$createdDate, class = "POSIXct")
})

testthat::test_that(desc = "Test isValidId (negative test)", code = {
  testthat::skip_if(baseUrl == "")
  validId <- ROhdsiWebApi::isValidId(baseUrl = baseUrl, ids = c(0,-1), category = 'cohort')
  testthat::expect_type(object = validId, type = 'logical')
  testthat::expect_setequal(object = validId, expected = c(FALSE, FALSE))
})

testthat::test_that(desc = "Test deleteDefinition (negative test)", code = {
  testthat::skip_if(baseUrl == "")
  testthat::expect_null(object = ROhdsiWebApi::deleteDefinition(baseUrl = baseUrl, id = -1, category = 'cohort'))
})

testthat::test_that("Test getCohortGenerationInformation", {
  testthat::skip_if(baseUrl == "")
  info <- ROhdsiWebApi::getCohortGenerationInformation(cohortId = idCohort, baseUrl = baseUrl)
  testthat::expect_s3_class(info, "data.frame")
})

testthat::test_that("Test getCohortResults", {
  testthat::skip_if(baseUrl == "")
  results <- getCohortResults(idCohort, baseUrl = baseUrl)
  testthat::expect_type(results, "list")
  testthat::expect_gt(length(results), 0)
})

testthat::test_that("Test getCohortSql", {
  testthat::skip_if(baseUrl == "")
  cohortDefinition <- getCohortDefinition(cohortId = idCohort, baseUrl = baseUrl)
  sql1 <- ROhdsiWebApi::getCohortSql(cohortDefinition = cohortDefinition, baseUrl = baseUrl)
  # sql2 <- ROhdsiWebApi::getCohortDefinitionSql(cohortId = idCohort, baseUrl = baseUrl)
  testthat::expect_type(sql1, "character")
  # testthat::expect_type(sql2, "character")
})

testthat::test_that("Test getDefinitionsMetadata2", {
  testthat::skip_if(baseUrl == "")
  categories <- ROhdsiWebApi:::.getStandardCategories() %>% dplyr::arrange() %>% dplyr::pull(categoryStandard)
  for (category in categories) {
    writeLines(paste0("Testing category ", category))
    metaData <- ROhdsiWebApi::getDefinitionsMetadata(baseUrl = baseUrl, category = category)
    testthat::expect_s3_class(metaData, "data.frame")
    testthat::expect_gt(nrow(metaData), 0)
  }
})

testthat::test_that("Test isValid1...", {
  testthat::skip_if(baseUrl == "")
  categories <- c("conceptSet","cohort","incidenceRate",
                  "estimation","prediction","characterization",
                  "pathway")
  arguments <- list(ids = -1, baseUrl = baseUrl)
  for (category in categories) {
    writeLines(sprintf("Testing category '%s'", category))
    functionName <- paste0("isValid", toupper(substr(category, 1, 1)), substr(category, 2, nchar(category)), "Id")
    names(arguments)[1] <- sprintf("%sIds", category)
    value <- do.call(functionName, arguments)
    testthat::expect_false(value)
  }
})


testthat::test_that("Test evaluate conceptSetExpression (positive test)", {
  testthat::skip_if(baseUrl == "")
  name = paste0("this is a test and may be deleted-", paste0(sample(letters, size = 10, replace = TRUE), collapse = ""))
  expression <- jsonlite::read_json(system.file("/tests/testthat/json/conceptSetExpression.txt", package = "ROhdsiWebApi"))
  postDefinition1 <- ROhdsiWebApi::postDefinition(name = paste0(name,"d"), category = 'conceptSet',
                                                           baseUrl = baseUrl, definition = expression)
  testthat::expect_s3_class(object = postDefinition1, class = 'tbl')
  deleteP <- ROhdsiWebApi::deleteConceptSetDefinition(conceptSetId = postDefinition1$id, baseUrl = baseUrl)
  testthat::expect_null(object = deleteP)
  postDefinition2 <- ROhdsiWebApi::postConceptSetDefinition(name = name, 
                                                       baseUrl = baseUrl, conceptSetDefinition = expression)
  testthat::expect_s3_class(object = postDefinition2, class = 'tbl')
  conceptSetDefinition <- ROhdsiWebApi::getConceptSetDefinition(conceptSetId = postDefinition2$id, baseUrl = baseUrl)
  expressionFromWebApi <- conceptSetDefinition$expression
  testthat::expect_type(object = expressionFromWebApi,type = 'list' )
  testthat::expect_gt(object = length(expressionFromWebApi), expected = 0)
  
  
  resolveConcepts <- ROhdsiWebApi::resolveConceptSet(conceptSetDefinition = conceptSetDefinition, baseUrl = baseUrl)
  testthat::expect_type(object = resolveConcepts, type = 'integer')
  concepts <- ROhdsiWebApi::getConcepts(conceptIds = resolveConcepts, baseUrl = baseUrl)
  testthat::expect_s3_class(object = concepts, class = 'tbl')
  sourceConcepts <- ROhdsiWebApi::getSourceConcepts(conceptIds = resolveConcepts, baseUrl = baseUrl)
  testthat::expect_s3_class(object = concepts, class = 'tbl')
  validTest <- ROhdsiWebApi::isValidConceptSetId(conceptSetIds = postDefinition2$id, baseUrl = baseUrl)
  testthat::expect_true(object = validTest)
  deleteP2 <- ROhdsiWebApi::deleteDefinition(id = postDefinition2$id, baseUrl = baseUrl, category = 'conceptSet')
  testthat::expect_null(object = deleteP2)
  })


testthat::test_that("Test postCohortInvokeStop (positive test)", {
  testthat::skip_if(baseUrl == "")
  name = paste0("this is a test and may be deleted-", paste0(sample(letters, size = 10, replace = TRUE), collapse = ""))
  expression <- jsonlite::read_json(system.file("/tests/testthat/json/cohort.txt", package = "ROhdsiWebApi"))
  postDefinition1 <- ROhdsiWebApi::postDefinition(name = paste0(name, 'd'), category = 'cohort',
                                                       baseUrl = baseUrl, definition = expression)
  testthat::expect_s3_class(object = postDefinition1, class = 'tbl')
  delete <- ROhdsiWebApi::deleteCohortDefinition(cohortId = postDefinition1$id, baseUrl = baseUrl)
  testthat::expect_null(object = delete)
  postDefinition2 <- ROhdsiWebApi::postCohortDefinition(name = name, 
                                                       baseUrl = baseUrl, cohortDefinition = expression)
  testthat::expect_s3_class(object = postDefinition2, class = 'tbl')
  expressionFromWebApi <- ROhdsiWebApi::getCohortDefinition(cohortId = postDefinition2$id, baseUrl = baseUrl)$expression
  testthat::expect_type(object = expressionFromWebApi,type = 'list' )
  testthat::expect_gt(object = length(expressionFromWebApi), expected = 0)
  
  invoke <- ROhdsiWebApi::invokeCohortGeneration(cohortId = postDefinition2$id, baseUrl = baseUrl, sourceKey = sourceKeyVariable)
  testthat::expect_s3_class(object = invoke, class = 'tbl')
  testthat::expect_true(invoke$status %in% c('STARTING', 'STARTED'))
  stopGeneration <- ROhdsiWebApi::cancelCohortGeneration(cohortId = postDefinition2$id, baseUrl = baseUrl, sourceKey = sourceKeyVariable )
  testthat::expect_match(object = stopGeneration, regexp = 'Generation of Cohort definition')
  deleteP2 <- ROhdsiWebApi::deleteDefinition(id = postDefinition2$id, baseUrl = baseUrl, category = 'cohort')
  testthat::expect_null(object = deleteP2)
})

testthat::test_that(desc = "Test getConcepts function (positive test)", {
  testthat::skip_if(baseUrl == "")
  getConc <- ROhdsiWebApi::getConcepts(conceptIds = c(21604686) 
                                               , baseUrl = baseUrl)
  testthat::expect_s3_class(object = getConc, class = 'tbl')
  testthat::expect_equal(object = nrow(getConc), expected = 1)
  testthat::expect_equal(object = getConc$standardConcept, expected = 'C')
})



testthat::test_that(desc = "Test getSourceConcepts function (positive test)", {
  testthat::skip_if(baseUrl == "")
  sourceConcept <- ROhdsiWebApi::getSourceConcepts(conceptIds = 21604686, baseUrl = baseUrl)
  testthat::expect_s3_class(object = sourceConcept, class = 'tbl')
  testthat::expect_equal(object = nrow(sourceConcept), expected = 1)
  testthat::expect_equal(object = sourceConcept$standardConcept, expected = 'C')
})


testthat::test_that("Test CharacterizationGetInvokeStop (positive test)", {
  testthat::skip_if(baseUrl == "")
  metadata <- ROhdsiWebApi::getCharacterizationDefinitionsMetaData(baseUrl = baseUrl)
  testthat::expect_s3_class(object = metadata, class = 'tbl')
  id <- metadata %>% dplyr::sample_n(1) %>% dplyr::pull(id)
  
  invoke <- ROhdsiWebApi::invokeCharacterizationGeneration(characterizationId = id, baseUrl = baseUrl, sourceKey = sourceKeyVariable)
  testthat::expect_s3_class(object = invoke, class = 'tbl')
  testthat::expect_true(invoke$status %in% c('STARTING', 'STARTED'))
  stopGeneration <- ROhdsiWebApi::cancelCharacterizationGeneration(characterizationId = id, baseUrl = baseUrl, sourceKey = sourceKeyVariable)
  testthat::expect_match(object = stopGeneration, regexp = "Generation of Characterization definition")
})

testthat::test_that("Test PathwayGetInvokeStop (positive test)", {
 # id = 78
  testthat::skip_if(baseUrl == "")
  metadata <- ROhdsiWebApi::getPathwayDefinitionsMetaData(baseUrl = baseUrl)
  testthat::expect_s3_class(object = metadata, class = 'tbl')
 id <- metadata %>% dplyr::sample_n(1) %>% dplyr::pull(id)
  
  invoke <- ROhdsiWebApi::invokePathwayGeneration(pathwayId = id, baseUrl = baseUrl, sourceKey = sourceKeyVariable)
  testthat::expect_s3_class(object = invoke, class = 'tbl')
  testthat::expect_true(invoke$status %in% c('STARTING', 'STARTED'))
  stopGeneration <- ROhdsiWebApi::cancelPathwayGeneration(pathwayId = id, baseUrl = baseUrl, sourceKey = sourceKeyVariable)
  testthat::expect_match(object = stopGeneration, regexp = 'Generation of Pathway definition')
})

testthat::test_that("Test IncidenceRateGetInvokeStop (positive test)", {
  # id = 1747233
  testthat::skip_if(baseUrl == "")
  metadata <- ROhdsiWebApi::getIncidenceRateDefinitionsMetaData(baseUrl = baseUrl)
  testthat::expect_s3_class(object = metadata, class = 'tbl')
  id <- metadata %>% dplyr::sample_n(1) %>% dplyr::pull(id)
  
  invoke <- ROhdsiWebApi::invokeIncidenceRateGeneration(incidenceRateId = id, baseUrl = baseUrl, sourceKey = sourceKeyVariable)
  testthat::expect_s3_class(object = invoke, class = 'tbl')
  testthat::expect_true(invoke$status %in% c('STARTING', 'STARTED'))
  stopGeneration <- ROhdsiWebApi::cancelIncidenceRateGeneration(incidenceRateId = id, baseUrl = baseUrl, sourceKey = sourceKeyVariable)
  testthat::expect_match(object = stopGeneration, regexp = 'Generation of IncidenceRate definition')
})