...
 
......@@ -47,6 +47,11 @@ Constants <- function() {
'/sql/postgres/selectWithAttrOpValue1.sql'
))
`_SIMPLE_SELECT_WHERE_TEMPLATE` <<- readr::read_file(paste0(
system.file(package = "omopRds"),
'/sql/postgres/selectWithAttrOpValue1.sql'
))
`_MAP_DATA_GROUP_CONDITION_SQL_TEMPLATE` <<-
readr::read_file(paste0(
system.file(package = "omopRds"),
......@@ -69,6 +74,8 @@ Constants <- function() {
# use for DATABASE: OMOP_V5
#`_MAP_CLASS_DB_SCHEMA` <<- 'SYNPUF_CDM'
`_OMOP_V5_DB_SCHEMA` <<- 'ohdsi'
# Names of the of the columns for the input tibble in the `_MapClass.DecorateGeneric` function.
# Also used in the Factory.Map function as one of the `_MapClass.ParseGeneric` parameters.
......@@ -125,7 +132,7 @@ Constants <- function() {
`_GET_CONCEPT_SETS_SQL_TEMPLATE_` <<- readr::read_file(paste0(
system.file(package = "omopRds"),
'/sql/postgres/selectWithJoin.sql'
'/sql/postgres/selectWithJoinSubqueries.sql'
))
`_GET_CONCEPT_SETS_DATABASE_SCHEMA_` <<- "OHDSI"
......@@ -2158,7 +2165,7 @@ OpalValueType <- function(dataTypeIn) {
)
}
#' #==============================================================================
#==============================================================================
#' #' ParseJson
#' #'
#' #' @description
......@@ -2176,25 +2183,91 @@ OpalValueType <- function(dataTypeIn) {
#' #'
#' #' @export
ParseJson <- function(inputJsonFile){
jsonFile <- jsonlite::parse_json(inputJsonFile)
jsonFile <- rjson::fromJSON(inputJsonFile)
length <- length(jsonFile$ConceptSets[[1]]$expression$items)
df <-data.frame(matrix(nrow=length,ncol=5))
names <- c('id','concept_name','concept_code','domain_id','vocabulary_id')
names(df) <- names
for(i in 1:length){
id <- jsonFile$ConceptSets[[1]]$expression$items[[i]]$concept$CONCEPT_ID
concept_name <- jsonFile$ConceptSets[[1]]$expression$items[[i]]$concept$CONCEPT_NAME
concept_code <- jsonFile$ConceptSets[[1]]$expression$items[[i]]$concept$CONCEPT_CODE
domain_id <- jsonFile$ConceptSets[[1]]$expression$items[[i]]$concept$DOMAIN_ID
vocabulary_id <- jsonFile$ConceptSets[[1]]$expression$items[[i]]$concept$VOCABULARY_ID
names <- c('CONCEPT_CODE', 'CONCEPT_ID', 'CONCEPT_NAME',
'DOMAIN_ID', 'STANDARD_CONCEPT', 'VOCABULARY_ID')
df[i,] <- c(id, concept_name, concept_code, domain_id, vocabulary_id)
}
return(df)
}
#==============================================================================
#' #' ParseJson2
#' #'
#' #' @description
#' #' Parse function for json file.
#' #'
#' #' @details
#' #' Create Dataframe from Json file.
#' #' Columns: (CONCEPT_CODE, CONCEPT_ID, CONCEPT_NAME,
#' #' DOMAIN_ID, STANDARD_CONCEPT, VOCABULARY_ID)
#' #'
#' #' Assumptions: input json file is in correct format\cr
#' #
#' #'
#' #' @param inputJsonFile Json file to be parsed
#' #'
#' #' @export
ParseJson2 <- function(inputJsonFile){
jsonFile <- rjson::fromJSON(inputJsonFile)
length <- length(jsonFile$ConceptSets)
df <-data.frame(matrix(nrow=length,ncol=6))
df <- data.frame(matrix(, 0, length(names)))
names <- c('concept set_name', 'id','concept_name','concept_code','domain_id','vocabulary_id')
names(df) <- names
for (i in jsonFile$is[[1]]$expression$items$concept){
concepts <- c()
for(concept_set in 1:length){
lengthItems <- lengthItems <- length(jsonFile$ConceptSets[[concept_set]]$expression$items)
concept_set_name <-jsonFile$ConceptSets[[concept_set]]$name
for(concept in 1:lengthItems){
id <- jsonFile$ConceptSets[[concept_set]]$expression$items[[concept]]$concept$CONCEPT_ID
concept_name <- jsonFile$ConceptSets[[concept_set]]$expression$items[[concept]]$concept$CONCEPT_NAME
concept_code <- jsonFile$ConceptSets[[concept_set]]$expression$items[[concept]]$concept$CONCEPT_CODE
domain_id <- jsonFile$ConceptSets[[concept_set]]$expression$items[[concept]]$concept$DOMAIN_ID
vocabulary_id <- jsonFile$ConceptSets[[concept_set]]$expression$items[[concept]]$concept$VOCABULARY_ID
#df[concept,] <- c(concept_set_name, id, concept_name, concept_code, domain_id, vocabulary_id)
concepts <- c(concepts, concept_code)
de <- c(concept_set_name, id, concept_name, concept_code, domain_id, vocabulary_id)
df = rbind(df, de)
de <- data.frame(i$CONCEPT_CODE, i$CONCEPT_ID, i$CONCEPT_NAME,
i$DOMAIN_ID, i$STANDARD_CONCEPT, i$VOCABULARY_ID)
names(de) <- names(df)
df <- rbind(df, de)
}
}
df <- df[complete.cases(df),]
return(df)
# TODO: write test
}
#==============================================================================
GetInfo <-
function(connection, sqlTemplate = `_GET_CONCEPT_SETS_SQL_TEMPLATE_`) {
renderedSql <- SqlRender::render(
sql = sqlTemplate,
databaseSchema = `_GET_CONCEPT_SETS_DATABASE_SCHEMA_`,
table1 = 'concept_set_item',
table2 = 'concept_set',
columns = 'concept_set.concept_set_id,
concept_set_name, concept_id',
commonAttr = 'concept_set_id',
limit = 100
)
queryResults <-
DatabaseConnector::querySql(connection, renderedSql)
return(queryResults)
# TODO: write test, add parameters
}
#==============================================================================
#' #' SetCohortDefinitionFromFile
#' #'
......@@ -2300,7 +2373,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)
}
}
......@@ -2324,7 +2397,7 @@ GetCohortDefinitionFromWebApi <- function(id, baseUrl){
GetCohortDefinitionFromDatabase <-
function(id,
connection,
sqlTemplate = `_GET_COHORT_DEFINITION_FROM_DATABASE_SCHEMA_`,
sqlTemplate = `_GET_COHORT_DEFINITION_FROM_DATABASE_SQL_TEMPLATE_`,
databaseSchema = `_GET_COHORT_DEFINITION_FROM_DATABASE_SCHEMA_`) {
renderedSql <- SqlRender::render(
sql = sqlTemplate,
......@@ -2414,7 +2487,7 @@ GetAllConceptSets <- function(baseUrl, columnNames=`_GET_CONCEPT_SETS_COLUMN_NAM
myGetJson <- httr::GET(myGetUrl)
myGetJson <- httr::content(myGetJson)
if (length(myGetJson) == 0){
warning("No Concepts")
warning("No Concept Sets")
} else {
df <- data.frame(matrix(unlist(myGetJson), nrow=length(myGetJson), byrow=T))
names(df) <- columnNames
......@@ -2444,11 +2517,15 @@ GetConceptSetsFromDatabase <-
renderedSql <- SqlRender::render(
sql = sqlTemplate,
databaseSchema = `_GET_CONCEPT_SETS_DATABASE_SCHEMA_`,
columns3 = c('concept_set_name, concept_set_id, sub1.concept_id, concept_name'),
columns1 = c('concept_set_item_id', 'concept_set_item.concept_set_id', 'concept_id', 'concept_set_name'),
table1 = 'concept_set_item',
table2 = 'concept_set',
columns = 'concept_set.concept_set_id,
concept_set_name, concept_id',
commonAttr = 'concept_set_id',
joinAttr1 = 'concept_set_id',
columns2 = 'concept_name, concept_id',
databaseSchema2 = 'p21_cdm',
table3 = 'concept',
joinAttr2 = 'concept_id',
limit = 100
)
......@@ -2592,8 +2669,8 @@ DeleteConceptSetDefinition <- function(id, baseUrl){
#' #' @export
DeleteAllConceptSets <- function(baseUrl){
df <- GetAllConceptSets(baseUrl)
if (df == "No Concepts") {
warning("No Concepts to delete")
if (df == "No Concept Sets") {
warning("No Concept Sets to delete")
} else {
lapply(df$ID, function(x) {DeleteConceptSetDefinition(x, baseUrl=baseUrl)})
}
......@@ -2625,8 +2702,6 @@ DeleteAllCohorts <- function(baseUrl) {
}
}
#==============================================================================
#==============================================================================
#' Factory.DataPackage
#'
......
{DEFAULT @limit = 0}
SELECT @columns3 FROM
((SELECT @columns1 from @databaseSchema.@table1, @databaseSchema.@table2
WHERE @table1.@joinAttr1 = @table2.@joinAttr1) sub1
JOIN
(SELECT @columns2 from @databaseSchema2.@table3) sub2
ON sub1.@joinAttr2 = sub2.@joinAttr2)
{0 != @limit}?{ LIMIT @limit};
\ No newline at end of file
......@@ -2151,7 +2151,6 @@ test_that("Opal connection can be established", {
})
#====================================================================
test_that("single Opal table can be created", {
myFilePath = file.path("../..", "inst", "config.yml")
......@@ -2210,7 +2209,6 @@ test_that("single Opal table can be created", {
})
#====================================================================
test_that("single Opal variable can be created", {
myFilePath = file.path("../..", "inst", "config.yml")
......@@ -2316,7 +2314,6 @@ test_that("single Opal variable can be created", {
})
#====================================================================
test_that("dataframe can be uploaded to Opal", {
# -------------------------------------------------------
# define test data
......@@ -2602,7 +2599,6 @@ test_that("calling AggConceptIDsByDomainID without parameters is equal to callin
})
#====================================================================
test_that("cohorts can be set from external file in folder", {
# read WebAPI url from config file
myFilePath = file.path("../..", "inst", "config.yml")
......@@ -2623,7 +2619,6 @@ test_that("cohorts can be set from external file in folder", {
})
#====================================================================
test_that("cohort can be set from variable", {
# read WebAPI url from config file
myFilePath = file.path("../..", "inst", "config.yml")
......@@ -2644,7 +2639,6 @@ test_that("cohort can be set from variable", {
})
#====================================================================
test_that("Concept set can be set from external file in folder", {
myFilePath = file.path("../..", "inst", "config.yml")
......@@ -2662,8 +2656,6 @@ test_that("Concept set can be set from external file in folder", {
})
#====================================================================
test_that("Concept set can be set from variable", {
# read WebAPI url from config file
myFilePath = file.path("../..", "inst", "config.yml")
......@@ -2684,18 +2676,6 @@ test_that("Concept set can be set from variable", {
})
#====================================================================
test_that("Get concept set", {
myFilePath = file.path("../..", "inst", "config.yml")
myWebApiParams <- config::get(file = myFilePath, "WebAPI")
baseUrl <- myWebApiParams$baseURL
})
#====================================================================
test_that("Cohort definition can be deleted via ID", {
myFilePath = file.path("../..", "inst", "config.yml")
......@@ -2728,7 +2708,6 @@ test_that("Cohort definition can be deleted via ID", {
})
#====================================================================
test_that("Concept set definition can be deleted via ID", {
myFilePath = file.path("../..", "inst", "config.yml")
......@@ -2762,7 +2741,6 @@ test_that("Concept set definition can be deleted via ID", {
})
#====================================================================
test_that("All Concept sets can be retrieved at once via WebAPI", {
myFilePath = file.path("../..", "inst", "config.yml")
......@@ -2794,7 +2772,6 @@ test_that("All Concept sets can be retrieved at once via WebAPI", {
})
#====================================================================
test_that("All Cohort definitions can be retrieved at once via WebAPI", {
myFilePath = file.path("../..", "inst", "config.yml")
......@@ -2803,7 +2780,7 @@ test_that("All Cohort definitions can be retrieved at once via WebAPI", {
baseUrl <- myWebApiParams$baseURL
# clear by deleting all concept sets
# clear by deleting all cohorts
DeleteAllCohorts(baseUrl = baseUrl)
jsonFilePath <- file.path("../..", "inst", "json", `_COHORT_TEST_FILE_NAME_`)
......@@ -2824,7 +2801,6 @@ test_that("All Cohort definitions can be retrieved at once via WebAPI", {
})
#====================================================================
test_that("Single Cohort definitions can be retrieved by ID via WebAPI", {
myFilePath = file.path("../..", "inst", "config.yml")
......@@ -2859,7 +2835,6 @@ test_that("Single Cohort definitions can be retrieved by ID via WebAPI", {
})
#====================================================================
test_that("Single concept set definition can be retrieved by ID via Webapi", {
myFilePath = file.path("../..", "inst", "config.yml")
......@@ -2894,3 +2869,87 @@ test_that("Single concept set definition can be retrieved by ID via Webapi", {
})
#====================================================================
test_that("All Cohort definitions can be deleted 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)
cohorts <- GetAllCohortDefinitions(baseUrl = baseUrl)
countCohorts <- dim(cohorts)
expect_that(countCohorts, equals(NULL))
expect_that(cohorts, equals("No Cohort Definitions"))
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))
DeleteAllCohorts(baseUrl = baseUrl)
cohorts <- GetAllCohortDefinitions(baseUrl = baseUrl)
countCohorts <- dim(cohorts)
expect_that(countCohorts, equals(NULL))
expect_that(cohorts, equals("No Cohort Definitions"))
})
#====================================================================
test_that("All Concept Sets can be deleted 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 = baseUrl)
conceptSets <- GetAllConceptSets(baseUrl = baseUrl)
countConceptSets <- dim(conceptSets)
expect_that(countConceptSets, equals(NULL))
expect_that(conceptSets, equals("No Concept Sets"))
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)
}
countConceptSets <- dim(GetAllConceptSets(baseUrl = baseUrl))[1]
expect_that(countConceptSets, equals(numberRepetions))
DeleteAllConceptSets(baseUrl = baseUrl)
conceptSets <- GetAllConceptSets(baseUrl = baseUrl)
countConceptSets <- dim(conceptSets)
expect_that(countConceptSets, equals(NULL))
expect_that(conceptSets, equals("No Concept Sets"))
})
#====================================================================