feat: added Delete Cohort/Concept functions + GetConceptSet via WebApi; tests:...

feat: added Delete Cohort/Concept functions + GetConceptSet via WebApi; tests: added further tests for Get/Delete functions
parent 8ef42515
......@@ -116,6 +116,15 @@ Constants <- function() {
))
`_GET_COHORT_DEFINITION_FROM_DATABASE_SCHEMA_` <<- 'OHDSI'
# json files for conceptSet/cohort testing via WebAPI
`_CONCEPT_SET_TEST_FILE_NAME_` <<- 'test_concept_set.json'
`_CONCEPT_SET_TEST_NAME_` <<- "`_SAMPLE_CONCEPT_SET_`"
`_COHORT_TEST_FILE_NAME_` <<- 'test_cohort_definition.json'
`_COHORT_TEST_NAME_` <<- "`_SAMPLE_COHORT_`"
}
#==============================================================================
......@@ -2014,7 +2023,6 @@ GetAllCohortDefinitions <- function(baseUrl){
names(df) <- c('id', 'name', 'description', 'expressionType', 'created')
return(df)
}
# TODO add test
}
#==============================================================================
......@@ -2043,7 +2051,7 @@ GetCohortDefinitionFromWebApi <- function(id, baseUrl){
warning("No Cohort Definition for this ID")
} else {
myGetJson <- httr::content(myGetJson)
myGetJson <- jsonlite::prettify(myGetJson$expression)
#myGetJson <- jsonlite::prettify(myGetJson$expression)
return(myGetJson)
}
}
......@@ -2202,7 +2210,38 @@ GetConceptSetsFromDatabase <-
}
#==============================================================================
#' #' GetIdFromCohortDefinition
#' #' GetConceptSetDefinitionFromWebApi
#' #'
#' #' @description
#' #' Get Concept Set from Atlas via WebAPI by ID
#' #'
#' #' @details
#' #' baseUrl can be retrieved from config.yml
#' #'
#' #' Assumptions: Connection to WebAPI exists\cr
#' #' \cr
#' #' Constraint:\cr
#' #
#' #'
#' #' @param id ID of concept set(int/string)
#' #' @param baseUrl URL of WebAPI Host
#' #'
#' #' @export
GetConceptSetFromWebApi <- function(id, baseUrl){
myGetUrl <- paste(baseUrl, "conceptset", id, sep = "/")
myGetJson <- httr::GET(myGetUrl)
status <- myGetJson$status_code
if (status == "500"){
warning("No Concept Set for this ID")
} else {
myGetJson <- httr::content(myGetJson)
#myGetJson <- jsonlite::prettify(myGetJson$expression)
return(myGetJson)
}
}
#==============================================================================
#' #' GetIdFromCohortDefinitionName
#' #'
#' #' @description
#' #' Get Cohort from Atlas via WebAPI by ID
......@@ -2216,13 +2255,35 @@ GetConceptSetsFromDatabase <-
#' #
#' #'
#' #' @param cohorts dataframe of cohorts (created by GetCohorts())
#' #'
#' #' @param name name of cohort
#' #' @export
GetIdFromCohortDefinition <- function(cohorts, name){
GetIdFromCohortDefinitionName <- function(cohorts, name){
id <- cohorts[cohorts$name == name, ]$id
return(id)
}
#==============================================================================
#' #' GetIdFromConceptSetDefinitionName
#' #'
#' #' @description
#' #' Get ConceptSets ID from Atlas via WebAPI by Name
#' #'
#' #' @details
#' #' baseUrl can be retrieved from config.yml
#' #'
#' #' Assumptions: Connection to WebAPI exists\cr
#' #' \cr
#' #' Constraint:\cr
#' #
#' #'
#' #' @param conceptSets dataframe of conceptSets (created by GetAllCohortDefinitions())
#' #' @param name name of conceptSet
#' #' @export
GetIdFromConceptSetDefinitionName <- function(conceptSets, name){
id <- conceptSets[conceptSets$NAME == name,]$ID
return(id)
}
#==============================================================================
#' #' DeleteCohortDefinition
#' #'
......@@ -2246,7 +2307,7 @@ DeleteCohortDefinition <- function(id, baseUrl){
}
#==============================================================================
#' #' DeleteConceptSet
#' #' DeleteConceptSetDefiniton
#' #'
#' #' @description
#' #' Delete ConceptSet from Atlas by ID
......@@ -2267,34 +2328,52 @@ DeleteConceptSetDefinition <- function(id, baseUrl){
return(myDeleteJson)
}
#==============================================================================
#' #' DeleteAllConceptSet
#' #'
#' #' @description
#' #' Delete all ConceptSet from Atlas
#' #'
#' #' @details
#' #' Delete all ConceptSet from Atlas (via WebAPI)
#' #' baseUrl can be retrieved from config.yml
#' #'
#' #' Assumptions: Connection to WebAPI exists\cr
#' #'
#' #' @param baseUrl URL of WebAPI Host
#' #' @export
DeleteAllConceptSets <- function(baseUrl){
df <- GetAllConceptSets(baseUrl)
lapply(df$ID, function(x) {DeleteConceptSetDefinition(x, baseUrl=baseUrl)})
if (df == "No Concepts") {
warning("No Concepts to delete")
} else {
lapply(df$ID, function(x) {DeleteConceptSetDefinition(x, baseUrl=baseUrl)})
}
}
#==============================================================================
#' #' DeleteAllCohorts
#' #'
#' #' @description
#' #' Delete all Cohorts from Atlas
#' #'
#' #' @details
#' #' Delete all Cohorts from Atlas (via WebAPI)
#' #' baseUrl can be retrieved from config.yml
#' #'
#' #' Assumptions: Connection to WebAPI exists\cr
#' #'
#' #' @param baseUrl URL of WebAPI Host
#' #' @export
DeleteAllCohorts <- function(baseUrl) {
GetAllCohortDefinitions(baseUrl) %>%
select("id") %>%
lapply(function(x) {
DeleteCohortDefinition(x, baseUrl = baseUrl)
})}
#==============================================================================
# work in progress
# needed to set Concepts with ID
SetConceptsFromDatabase <- function(connection){
names()
df <- data.frame(matrix(,1,length(names)))
names(df) <- names
DatabaseConnector::insertTable(connection = connection,
tableName = "ohdsi.concept_set",
data = df,
dropTableIfExists = FALSE,
createTable = FALSE,
tempTable = FALSE,
useMppBulkLoad = FALSE)
# TODO: finish implementation
df <- GetAllCohortDefinitions(baseUrl)
if (df == "No Cohort Definitions"){
warning("No Cohorts to delete")
} else {
df$id %>%
lapply(function(x) {
DeleteCohortDefinition(x, baseUrl = baseUrl)
})
}
}
#==============================================================================
......@@ -2403,7 +2403,7 @@ test_that("cohorts can be set from external file in folder", {
baseUrl <- myWebApiParams$baseURL
jsonFilePath <- file.path("../..", "inst", "json", "deploy_test-cohort.json")
jsonFilePath <- file.path("../..", "inst", "json", `_COHORT_TEST_FILE_NAME_`)
# upload json file directly from folder
post <- SetCohortDefinitionFromFile(jsonFilePath=jsonFilePath, baseUrl=baseUrl)
......@@ -2424,7 +2424,7 @@ test_that("cohort can be set from variable", {
baseUrl <- myWebApiParams$baseURL
jsonFilePath <- file.path("../..", "inst", "json", "deploy_test-cohort.json")
jsonFilePath <- file.path("../..", "inst", "json", `_COHORT_TEST_FILE_NAME_`)
jsonFile <- jsonlite::fromJSON(jsonFilePath)
......@@ -2437,14 +2437,14 @@ test_that("cohort can be set from variable", {
#====================================================================
test_that("conceptset can be set from file", {
test_that("Concept set can be set from external file in folder", {
myFilePath = file.path("../..", "inst", "config.yml")
myWebApiParams <- config::get(file = myFilePath, "WebAPI")
baseUrl <- myWebApiParams$baseURL
jsonFilePath <- file.path("../..", "inst", "json", "test_concept_set.json")
jsonFilePath <- file.path("../..", "inst", "json", `_CONCEPT_SET_TEST_FILE_NAME_`)
myPostJson <- SetConceptSetFromFile(jsonFilePath=jsonFilePath, baseUrl=baseUrl)
......@@ -2456,7 +2456,7 @@ test_that("conceptset can be set from file", {
#====================================================================
test_that("conceptset can be set from variable", {
test_that("Concept set can be set from variable", {
# read WebAPI url from config file
myFilePath = file.path("../..", "inst", "config.yml")
......@@ -2464,7 +2464,7 @@ test_that("conceptset can be set from variable", {
baseUrl <- myWebApiParams$baseURL
jsonFilePath <- file.path("../..", "inst", "json", "test_concept_set.json")
jsonFilePath <- file.path("../..", "inst", "json", `_CONCEPT_SET_TEST_FILE_NAME_`)
jsonFile <- jsonlite::fromJSON(jsonFilePath)
......@@ -2488,7 +2488,7 @@ test_that("Get concept set", {
#====================================================================
test_that("Concept set can be deleted via ID", {
test_that("Cohort definition can be deleted via ID", {
myFilePath = file.path("../..", "inst", "config.yml")
......@@ -2496,45 +2496,193 @@ test_that("Concept set can be deleted via ID", {
baseUrl <- myWebApiParams$baseURL
jsonFilePath <- file.path("../..", "inst", "json", "test_concept_set.json")
# clear by deleting all concept sets
DeleteAllCohorts(baseUrl)
myPostJson <- SetConceptSetFromFile(jsonFilePath=jsonFilePath, baseUrl=baseUrl)
jsonFilePath <- file.path("../..", "inst", "json", `_COHORT_TEST_FILE_NAME_`)
jsonFile <- jsonlite::fromJSON(jsonFilePath)
jsonFileName <- jsonFile$name
myPostJson <- SetCohortDefinitionFromVariable(jsonFile = jsonFile, baseUrl = baseUrl)
#dim(GetAllConceptSets(baseUrl))[1]
cohorts <- GetAllCohortDefinitions(baseUrl = baseUrl)
cohortId <- GetIdFromCohortDefinitionName(cohorts = cohorts, name = jsonFileName)
DeleteCohortDefinition(id = cohortId, baseUrl = baseUrl)
countCohorts <- dim(GetAllCohortDefinitions(baseUrl = baseUrl))[1]
expect_that(countCohorts, equals(NULL))
})
#====================================================================
# test_that("cohort definition can be retrieved via webapi", {
#
# myFilePath = file.path("../..", "inst", "config.yml")
#
# myWebApiParams <- config::get(file = myFilePath, "WebAPI")
#
# baseUrl <- myWebApiParams$baseURL
#
#
# jsonFilePath <- file.path("../..", "inst", "json", "deploy_test-cohort.json")
#
# time <- Sys.time()
#
# jsonFile <- jsonlite::fromJSON(jsonFilePath)
#
# newName <- paste(jsonFile$name, time, sep="+")
#
# jsonFile$name <- newName
#
# write(jsonFile, "testJsonFile.json")
# # upload json file directly from folder
# post <- SetCohortDefinitionFromFile(jsonFilePath=jsonFilePath, baseUrl=baseUrl)
#
# cohorts <- GetAllCohortDefinitions(baseUrl)
#
# myCohortId <- GetIdFromCohortDefinition(cohorts=cohorts, name="`_SAMPLE_COHORT_`")
#
# myCohortName <- cohorts[cohorts$id == myCohortId, ]$name
#
# expect_that(as.character(myCohortName), equals("`_SAMPLE_COHORT_`"))
#
# })
test_that("Concept set definition can be deleted via ID", {
myFilePath = file.path("../..", "inst", "config.yml")
myWebApiParams <- config::get(file = myFilePath, "WebAPI")
baseUrl <- myWebApiParams$baseURL
# clear by deleting all concept sets
DeleteAllConceptSets(baseUrl)
jsonFilePath <- file.path("../..", "inst", "json", `_CONCEPT_SET_TEST_FILE_NAME_`)
jsonFile <- jsonlite::fromJSON(jsonFilePath)
jsonFileName <- jsonFile$name
myPostJson <- SetConceptSetFromVariable(jsonFile = jsonFile, baseUrl = baseUrl)
#dim(GetAllConceptSets(baseUrl))[1]
conceptSets <- GetAllConceptSets(baseUrl = baseUrl)
conceptSetId <- GetIdFromConceptSetDefinitionName(conceptSets = conceptSets, name = jsonFileName)
DeleteConceptSetDefinition(id = conceptSetId, baseUrl = baseUrl)
countConceptSets <- dim(GetAllConceptSets(baseUrl = baseUrl))[1]
expect_that(countConceptSets, equals(NULL))
})
#====================================================================
test_that("All Concept sets can be retrieved at once via WebAPI", {
myFilePath = file.path("../..", "inst", "config.yml")
myWebApiParams <- config::get(file = myFilePath, "WebAPI")
baseUrl <- myWebApiParams$baseURL
# clear by deleting all concept sets
DeleteAllConceptSets(baseUrl)
jsonFilePath <- file.path("../..", "inst", "json", `_CONCEPT_SET_TEST_FILE_NAME_`)
jsonFile <- jsonlite::fromJSON(jsonFilePath)
numberRepetions <- 5
# post test json file multiply times to increase length
for (i in seq(numberRepetions)){
SetConceptSetFromVariable(jsonFile = jsonFile, baseUrl = baseUrl)
}
conceptSets <- GetAllConceptSets(baseUrl = baseUrl)
countConceptSets <- dim(GetAllConceptSets(baseUrl = baseUrl))[1]
expect_that(countConceptSets, equals(numberRepetions))
})
#====================================================================
test_that("All Cohort definitions can be retrieved at once via WebAPI", {
myFilePath = file.path("../..", "inst", "config.yml")
myWebApiParams <- config::get(file = myFilePath, "WebAPI")
baseUrl <- myWebApiParams$baseURL
# clear by deleting all concept sets
DeleteAllCohorts(baseUrl = baseUrl)
jsonFilePath <- file.path("../..", "inst", "json", `_COHORT_TEST_FILE_NAME_`)
jsonFile <- jsonlite::fromJSON(jsonFilePath)
numberRepetions <- 5
# post test json file multiply times to increase length
for (i in seq(numberRepetions)){
SetCohortDefinitionFromVariable(jsonFile = jsonFile, baseUrl = baseUrl)
}
countCohorts <- dim(GetAllCohortDefinitions(baseUrl = baseUrl))[1]
expect_that(countCohorts, equals(numberRepetions))
})
#====================================================================
test_that("Single Cohort definitions can be retrieved by ID via WebAPI", {
myFilePath = file.path("../..", "inst", "config.yml")
myWebApiParams <- config::get(file = myFilePath, "WebAPI")
baseUrl <- myWebApiParams$baseURL
# clear by deleting all concept sets
DeleteAllCohorts(baseUrl = baseUrl)
jsonFilePath <- file.path("../..", "inst", "json", `_COHORT_TEST_FILE_NAME_`)
jsonFile <- jsonlite::fromJSON(jsonFilePath)
numberRepetions <- 5
# post test json file multiply times to increase length
for (i in seq(numberRepetions)){
SetCohortDefinitionFromVariable(jsonFile = jsonFile, baseUrl = baseUrl)
}
cohortIds <- GetAllCohortDefinitions(baseUrl = baseUrl)$id
randomId <- as.integer(as.character(sample(cohortIds, size = 1, replace = F)))
cohort <- GetCohortDefinitionFromWebApi(id = randomId, baseUrl = baseUrl)
expect_that(cohort$id, equals(randomId))
expect_that(cohort$name, equals(`_COHORT_TEST_NAME_`))
})
#====================================================================
test_that("Single concept set definition can be retrieved by ID via Webapi", {
myFilePath = file.path("../..", "inst", "config.yml")
myWebApiParams <- config::get(file = myFilePath, "WebAPI")
baseUrl <- myWebApiParams$baseURL
# clear by deleting all concept sets
DeleteAllCohorts(baseUrl = baseUrl)
jsonFilePath <- file.path("../..", "inst", "json", `_CONCEPT_SET_TEST_FILE_NAME_`)
jsonFile <- jsonlite::fromJSON(jsonFilePath)
numberRepetions <- 5
# post test json file multiply times to increase length
for (i in seq(numberRepetions)){
SetConceptSetFromVariable(jsonFile = jsonFile, baseUrl = baseUrl)
}
conceptSetIds <- GetAllConceptSets(baseUrl = baseUrl)$ID
randomId <- as.integer(as.character(sample(conceptSetIds, size = 1, replace = F)))
conceptSet <- GetConceptSetFromWebApi(id = randomId, baseUrl = baseUrl)
expect_that(conceptSet$id, equals(randomId))
expect_that(conceptSet$name, equals(`_CONCEPT_SET_TEST_NAME_`))
})
#====================================================================
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment