diff --git a/DESCRIPTION b/DESCRIPTION
index 5a5b6c3..55739f1 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,8 +1,8 @@
Package: CohortExplorer
Type: Package
-Title: An R package with a Shiny viewer to explore profiles of patients in a cohort.
-Version: 0.0.2
-Date: 2022-11-15
+Title: An R package with a Shiny viewer to explore profiles of patients in a cohort
+Version: 0.0.3
+Date: 2022-11-16
Authors@R: c(
person("Gowtham", "Rao", email = "rao@ohdsi.org", role = c("aut", "cre")),
person("Observational Health Data Science and Informatics", role = c("cph"))
@@ -18,7 +18,8 @@ Imports:
dplyr,
lifecycle,
ParallelLogger,
- rlang
+ rlang,
+ stats
Suggests:
testthat,
knitr,
diff --git a/NAMESPACE b/NAMESPACE
index d3d6750..33e684c 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -5,3 +5,4 @@ import(DatabaseConnector)
import(dplyr)
importFrom(lifecycle,deprecated)
importFrom(rlang,.data)
+importFrom(stats,runif)
diff --git a/NEWS.md b/NEWS.md
index 36c74d1..8f2c8c4 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,9 @@
+CohortExplorer 0.0.3
+======================
+
+Resolving minor issues in github checks.
+Indentation.
+
CohortExplorer 0.0.2
======================
diff --git a/R/CohortExplorer.R b/R/CohortExplorer.R
index b39c000..5441f5f 100644
--- a/R/CohortExplorer.R
+++ b/R/CohortExplorer.R
@@ -20,6 +20,6 @@
#' @importFrom lifecycle deprecated
#' @import dplyr
#' @importFrom rlang .data
-#' @importForm stats runif
+#' @importFrom stats runif
#' @import DatabaseConnector
NULL
diff --git a/R/CreateCohortExplorerApp.R b/R/CreateCohortExplorerApp.R
index e7acf09..2b0436c 100644
--- a/R/CreateCohortExplorerApp.R
+++ b/R/CreateCohortExplorerApp.R
@@ -68,71 +68,79 @@
#' }
#'
#' @export
-createCohortExplorerApp <-
- function(connectionDetails = NULL,
- connection = NULL,
- cohortDatabaseSchema = "cohort",
- cdmDatabaseSchema,
- vocabularyDatabaseSchema = cdmDatabaseSchema,
- tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"),
- cohortTable = "cohort",
- cohortDefinitionId,
- cohortName = NULL,
- sampleSize = 25,
- personIds = NULL,
- exportFolder,
- databaseId,
- shiftDates = FALSE,
- assignNewId = FALSE) {
- startTime <- Sys.time()
-
- errorMessage <- checkmate::makeAssertCollection()
-
- checkmate::assertCharacter(
- x = cohortDatabaseSchema,
- min.len = 1,
- add = errorMessage
- )
-
- checkmate::assertCharacter(
- x = cdmDatabaseSchema,
- min.len = 1,
- add = errorMessage
- )
-
- checkmate::assertCharacter(
- x = vocabularyDatabaseSchema,
- min.len = 1,
- add = errorMessage
- )
-
- checkmate::assertCharacter(
- x = cohortTable,
- min.len = 1,
- add = errorMessage
- )
-
- checkmate::assertCharacter(
- x = databaseId,
- min.len = 1,
- max.len = 1,
- add = errorMessage
- )
-
- checkmate::assertCharacter(
- x = tempEmulationSchema,
- min.len = 1,
- null.ok = TRUE,
- add = errorMessage
- )
-
- checkmate::assertIntegerish(
- x = cohortDefinitionId,
- lower = 0,
- len = 1,
- add = errorMessage
- )
-
+createCohortExplorerApp <- function(connectionDetails = NULL,
+ connection = NULL,
+ cohortDatabaseSchema = "cohort",
+ cdmDatabaseSchema,
+ vocabularyDatabaseSchema = cdmDatabaseSchema,
+ tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"),
+ cohortTable = "cohort",
+ cohortDefinitionId,
+ cohortName = NULL,
+ sampleSize = 25,
+ personIds = NULL,
+ exportFolder,
+ databaseId,
+ shiftDates = FALSE,
+ assignNewId = FALSE) {
+ startTime <- Sys.time()
+
+ errorMessage <- checkmate::makeAssertCollection()
+
+ checkmate::assertCharacter(
+ x = cohortDatabaseSchema,
+ min.len = 1,
+ add = errorMessage
+ )
+
+ checkmate::assertCharacter(
+ x = cdmDatabaseSchema,
+ min.len = 1,
+ add = errorMessage
+ )
+
+ checkmate::assertCharacter(
+ x = vocabularyDatabaseSchema,
+ min.len = 1,
+ add = errorMessage
+ )
+
+ checkmate::assertCharacter(
+ x = cohortTable,
+ min.len = 1,
+ add = errorMessage
+ )
+
+ checkmate::assertCharacter(
+ x = databaseId,
+ min.len = 1,
+ max.len = 1,
+ add = errorMessage
+ )
+
+ checkmate::assertCharacter(
+ x = tempEmulationSchema,
+ min.len = 1,
+ null.ok = TRUE,
+ add = errorMessage
+ )
+
+ checkmate::assertIntegerish(
+ x = cohortDefinitionId,
+ lower = 0,
+ len = 1,
+ add = errorMessage
+ )
+
+ checkmate::assertIntegerish(
+ x = sampleSize,
+ lower = 0,
+ len = 1,
+ null.ok = TRUE,
+ add = errorMessage
+ )
+
+ if (is.null(personIds)) {
checkmate::assertIntegerish(
x = sampleSize,
lower = 0,
@@ -140,98 +148,94 @@ createCohortExplorerApp <-
null.ok = TRUE,
add = errorMessage
)
+ }
- if (is.null(personIds)) {
- checkmate::assertIntegerish(
- x = sampleSize,
- lower = 0,
- len = 1,
- null.ok = TRUE,
- add = errorMessage
- )
- }
-
- checkmate::assertIntegerish(
- x = personIds,
- lower = 0,
- min.len = 1,
- null.ok = TRUE,
- add = errorMessage
- )
-
- exportFolder <- normalizePath(exportFolder, mustWork = FALSE)
- dir.create(path = exportFolder, showWarnings = FALSE, recursive = TRUE)
- checkmate::assertDirectory(
- x = exportFolder,
- access = "x",
- add = errorMessage
- )
+ checkmate::assertIntegerish(
+ x = personIds,
+ lower = 0,
+ min.len = 1,
+ null.ok = TRUE,
+ add = errorMessage
+ )
+
+ exportFolder <- normalizePath(exportFolder, mustWork = FALSE)
+
+ dir.create(
+ path = exportFolder,
+ showWarnings = FALSE,
+ recursive = TRUE
+ )
+
+ checkmate::assertDirectory(
+ x = exportFolder,
+ access = "x",
+ add = errorMessage
+ )
+
+ checkmate::reportAssertions(collection = errorMessage)
+
+ originalDatabaseId <- databaseId
+
+ databaseId <- as.character(gsub(
+ pattern = " ",
+ replacement = "",
+ x = databaseId
+ ))
+
+ databaseId <- as.character(gsub(
+ pattern = "_",
+ replacement = "",
+ x = databaseId
+ ))
+
+ if (nchar(databaseId) < nchar(originalDatabaseId)) {
+ stop(paste0(
+ "databaseId should not have space or underscore: ",
+ originalDatabaseId
+ ))
+ }
- checkmate::reportAssertions(collection = errorMessage)
-
- originalDatabaseId <- databaseId
- databaseId <-
- as.character(gsub(
- pattern = " ",
- replacement = "",
- x = databaseId
- ))
- databaseId <-
- as.character(gsub(
- pattern = "_",
- replacement = "",
- x = databaseId
- ))
-
- if (nchar(databaseId) < nchar(originalDatabaseId)) {
- stop(paste0(
- "databaseId should not have space or underscore: ",
- originalDatabaseId
- ))
+ rdsFileName <- paste0(
+ "CohortExplorer_",
+ cohortDefinitionId,
+ "_",
+ databaseId,
+ ".RData"
+ )
+
+ # Set up connection to server ----------------------------------------------------
+ if (is.null(connection)) {
+ if (!is.null(connectionDetails)) {
+ connection <- DatabaseConnector::connect(connectionDetails)
+ on.exit(DatabaseConnector::disconnect(connection))
+ } else {
+ stop("No connection or connectionDetails provided.")
}
+ }
- rdsFileName <-
- paste0(
- "CohortExplorer_",
- cohortDefinitionId,
- "_",
- databaseId,
- ".RData"
- )
+ if (!is.null(personIds)) {
+ persons <- dplyr::tibble(personId = personIds) %>%
+ dplyr::mutate(randomNumber = runif(n = 1)) %>%
+ dplyr::arrange(.data$randomNumber) %>%
+ dplyr::mutate(newId = dplyr::row_number()) %>%
+ dplyr::select(-.data$randomNumber)
- # Set up connection to server ----------------------------------------------------
- if (is.null(connection)) {
- if (!is.null(connectionDetails)) {
- connection <- DatabaseConnector::connect(connectionDetails)
- on.exit(DatabaseConnector::disconnect(connection))
- } else {
- stop("No connection or connectionDetails provided.")
- }
- }
-
- if (!is.null(personIds)) {
- persons <- dplyr::tibble(personId = personIds) %>%
- dplyr::mutate(randomNumber = runif(n = 1)) %>%
- dplyr::arrange(.data$randomNumber) %>%
- dplyr::mutate(newId = dplyr::row_number()) %>%
- dplyr::select(-.data$randomNumber)
-
- DatabaseConnector::insertTable(
- connection = connection,
- tableName = "#persons_filter",
- createTable = TRUE,
- dropTableIfExists = TRUE,
- tempTable = TRUE,
- tempEmulationSchema = tempEmulationSchema,
- progressBar = TRUE,
- bulkLoad = (Sys.getenv("bulkLoad") == TRUE),
- camelCaseToSnakeCase = TRUE,
- data = persons
- )
- sampleSize <- nrow(persons)
- } else {
- # take a random sample
- sql <- "DROP TABLE IF EXISTS #persons_filter;
+ DatabaseConnector::insertTable(
+ connection = connection,
+ tableName = "#persons_filter",
+ createTable = TRUE,
+ dropTableIfExists = TRUE,
+ tempTable = TRUE,
+ tempEmulationSchema = tempEmulationSchema,
+ progressBar = TRUE,
+ bulkLoad = (Sys.getenv("bulkLoad") == TRUE),
+ camelCaseToSnakeCase = TRUE,
+ data = persons
+ )
+ sampleSize <- nrow(persons)
+ } else {
+ # take a random sample
+ sql <- "DROP TABLE IF EXISTS #persons_filter;
SELECT *
INTO #persons_filter
FROM
@@ -245,24 +249,22 @@ createCohortExplorerApp <-
) f
WHERE new_id <= @sample_size;"
- writeLines("Attempting to find subjects in cohort table.")
- DatabaseConnector::renderTranslateExecuteSql(
- connection = connection,
- sql = sql,
- tempEmulationSchema = tempEmulationSchema,
- sample_size = sampleSize,
- cohort_database_schema = cohortDatabaseSchema,
- cohort_table = cohortTable,
- cohort_definition_id = cohortDefinitionId
- )
- }
-
+ writeLines("Attempting to find subjects in cohort table.")
+ DatabaseConnector::renderTranslateExecuteSql(
+ connection = connection,
+ sql = sql,
+ tempEmulationSchema = tempEmulationSchema,
+ sample_size = sampleSize,
+ cohort_database_schema = cohortDatabaseSchema,
+ cohort_table = cohortTable,
+ cohort_definition_id = cohortDefinitionId
+ )
+ }
- writeLines("Getting cohort table.")
- cohort <-
- DatabaseConnector::renderTranslateQuerySql(
- connection = connection,
- sql = "SELECT c.subject_id,
+ writeLines("Getting cohort table.")
+ cohort <- DatabaseConnector::renderTranslateQuerySql(
+ connection = connection,
+ sql = "SELECT c.subject_id,
p.new_id,
cohort_start_date AS start_date,
cohort_end_date AS end_date
@@ -271,23 +273,22 @@ createCohortExplorerApp <-
ON c.subject_id = p.person_id
WHERE cohort_definition_id = @cohort_definition_id
ORDER BY c.subject_id, cohort_start_date;",
- cohort_database_schema = cohortDatabaseSchema,
- cohort_table = cohortTable,
- tempEmulationSchema = tempEmulationSchema,
- cohort_definition_id = cohortDefinitionId,
- snakeCaseToCamelCase = TRUE
- ) %>%
- dplyr::tibble()
-
- if (nrow(cohort) == 0) {
- warning("Cohort does not have the selected subject ids")
- return(NULL)
- }
+ cohort_database_schema = cohortDatabaseSchema,
+ cohort_table = cohortTable,
+ tempEmulationSchema = tempEmulationSchema,
+ cohort_definition_id = cohortDefinitionId,
+ snakeCaseToCamelCase = TRUE
+ ) %>%
+ dplyr::tibble()
+
+ if (nrow(cohort) == 0) {
+ stop("Cohort does not have the selected subject ids. No shiny app created.")
+ }
- writeLines("Getting person table.")
- person <- DatabaseConnector::renderTranslateQuerySql(
- connection = connection,
- sql = "SELECT p.person_id,
+ writeLines("Getting person table.")
+ person <- DatabaseConnector::renderTranslateQuerySql(
+ connection = connection,
+ sql = "SELECT p.person_id,
pf.new_id,
gender_concept_id,
year_of_birth
@@ -295,31 +296,31 @@ createCohortExplorerApp <-
INNER JOIN #persons_filter pf
ON p.person_id = pf.person_id
ORDER BY p.person_id;",
- cdm_database_schema = cdmDatabaseSchema,
- tempEmulationSchema = tempEmulationSchema,
- snakeCaseToCamelCase = TRUE
+ cdm_database_schema = cdmDatabaseSchema,
+ tempEmulationSchema = tempEmulationSchema,
+ snakeCaseToCamelCase = TRUE
+ ) %>%
+ dplyr::tibble()
+
+ person <- person %>%
+ dplyr::inner_join(
+ cohort %>%
+ dplyr::group_by(.data$subjectId) %>%
+ dplyr::summarise(
+ yearOfCohort = min(clock::get_year(.data$startDate)),
+ .groups = "keep"
+ ) %>%
+ dplyr::ungroup() %>%
+ dplyr::rename("personId" = .data$subjectId),
+ by = "personId"
) %>%
- dplyr::tibble()
-
- person <- person %>%
- dplyr::inner_join(
- cohort %>%
- dplyr::group_by(.data$subjectId) %>%
- dplyr::summarise(
- yearOfCohort = min(clock::get_year(.data$startDate)),
- .groups = "keep"
- ) %>%
- dplyr::ungroup() %>%
- dplyr::rename("personId" = .data$subjectId),
- by = "personId"
- ) %>%
- dplyr::mutate(age = .data$yearOfCohort - .data$yearOfBirth) %>%
- dplyr::select(-.data$yearOfCohort, -.data$yearOfBirth)
+ dplyr::mutate(age = .data$yearOfCohort - .data$yearOfBirth) %>%
+ dplyr::select(-.data$yearOfCohort, -.data$yearOfBirth)
- writeLines("Getting observation period table.")
- observationPeriod <- DatabaseConnector::renderTranslateQuerySql(
- connection = connection,
- sql = "SELECT op.person_id,
+ writeLines("Getting observation period table.")
+ observationPeriod <- DatabaseConnector::renderTranslateQuerySql(
+ connection = connection,
+ sql = "SELECT op.person_id,
p.new_id,
observation_period_start_date AS start_date,
observation_period_end_date AS end_date,
@@ -331,16 +332,16 @@ createCohortExplorerApp <-
p.new_id,
observation_period_start_date,
observation_period_end_date;",
- cdm_database_schema = cdmDatabaseSchema,
- tempEmulationSchema = tempEmulationSchema,
- snakeCaseToCamelCase = TRUE
- ) %>%
- dplyr::tibble()
-
- writeLines("Getting visit occurrence table.")
- visitOccurrence <- DatabaseConnector::renderTranslateQuerySql(
- connection = connection,
- sql = "SELECT v.person_id,
+ cdm_database_schema = cdmDatabaseSchema,
+ tempEmulationSchema = tempEmulationSchema,
+ snakeCaseToCamelCase = TRUE
+ ) %>%
+ dplyr::tibble()
+
+ writeLines("Getting visit occurrence table.")
+ visitOccurrence <- DatabaseConnector::renderTranslateQuerySql(
+ connection = connection,
+ sql = "SELECT v.person_id,
p.new_id,
visit_start_date AS start_date,
visit_end_date AS end_date,
@@ -365,17 +366,16 @@ createCohortExplorerApp <-
visit_concept_id,
visit_type_concept_id,
visit_source_concept_id;",
- cdm_database_schema = cdmDatabaseSchema,
- tempEmulationSchema = tempEmulationSchema,
- snakeCaseToCamelCase = TRUE
- ) %>%
- dplyr::tibble()
-
- writeLines("Getting condition occurrence table.")
- conditionOccurrence <-
- DatabaseConnector::renderTranslateQuerySql(
- connection = connection,
- sql = "SELECT c.person_id,
+ cdm_database_schema = cdmDatabaseSchema,
+ tempEmulationSchema = tempEmulationSchema,
+ snakeCaseToCamelCase = TRUE
+ ) %>%
+ dplyr::tibble()
+
+ writeLines("Getting condition occurrence table.")
+ conditionOccurrence <- DatabaseConnector::renderTranslateQuerySql(
+ connection = connection,
+ sql = "SELECT c.person_id,
p.new_id,
condition_start_date AS start_date,
condition_end_date AS end_date,
@@ -400,16 +400,16 @@ createCohortExplorerApp <-
condition_concept_id,
condition_type_concept_id,
condition_source_concept_id;",
- cdm_database_schema = cdmDatabaseSchema,
- tempEmulationSchema = tempEmulationSchema,
- snakeCaseToCamelCase = TRUE
- ) %>%
- dplyr::tibble()
-
- writeLines("Getting condition era table.")
- conditionEra <- DatabaseConnector::renderTranslateQuerySql(
- connection = connection,
- sql = "SELECT ce.person_id,
+ cdm_database_schema = cdmDatabaseSchema,
+ tempEmulationSchema = tempEmulationSchema,
+ snakeCaseToCamelCase = TRUE
+ ) %>%
+ dplyr::tibble()
+
+ writeLines("Getting condition era table.")
+ conditionEra <- DatabaseConnector::renderTranslateQuerySql(
+ connection = connection,
+ sql = "SELECT ce.person_id,
p.new_id,
condition_era_start_date AS start_date,
condition_era_end_date AS end_date,
@@ -428,17 +428,17 @@ createCohortExplorerApp <-
condition_era_start_date,
condition_era_end_date,
condition_concept_id;",
- cdm_database_schema = cdmDatabaseSchema,
- tempEmulationSchema = tempEmulationSchema,
- snakeCaseToCamelCase = TRUE
- ) %>%
- dplyr::tibble() %>%
- dplyr::mutate(typeConceptId = 0, records = 1)
-
- writeLines("Getting observation table.")
- observation <- DatabaseConnector::renderTranslateQuerySql(
- connection = connection,
- sql = "SELECT o.person_id,
+ cdm_database_schema = cdmDatabaseSchema,
+ tempEmulationSchema = tempEmulationSchema,
+ snakeCaseToCamelCase = TRUE
+ ) %>%
+ dplyr::tibble() %>%
+ dplyr::mutate(typeConceptId = 0, records = 1)
+
+ writeLines("Getting observation table.")
+ observation <- DatabaseConnector::renderTranslateQuerySql(
+ connection = connection,
+ sql = "SELECT o.person_id,
p.new_id,
observation_date AS start_date,
observation_concept_id AS concept_id,
@@ -459,17 +459,16 @@ createCohortExplorerApp <-
observation_date,
observation_concept_id,
observation_type_concept_id;",
- cdm_database_schema = cdmDatabaseSchema,
- tempEmulationSchema = tempEmulationSchema,
- snakeCaseToCamelCase = TRUE
- ) %>%
- dplyr::tibble()
-
- writeLines("Getting procedure occurrence table.")
- procedureOccurrence <-
- DatabaseConnector::renderTranslateQuerySql(
- connection = connection,
- sql = "SELECT p.person_id,
+ cdm_database_schema = cdmDatabaseSchema,
+ tempEmulationSchema = tempEmulationSchema,
+ snakeCaseToCamelCase = TRUE
+ ) %>%
+ dplyr::tibble()
+
+ writeLines("Getting procedure occurrence table.")
+ procedureOccurrence <- DatabaseConnector::renderTranslateQuerySql(
+ connection = connection,
+ sql = "SELECT p.person_id,
pf.new_id,
procedure_date AS start_date,
procedure_concept_id AS concept_id,
@@ -491,17 +490,17 @@ createCohortExplorerApp <-
procedure_concept_id,
procedure_type_concept_id,
procedure_source_concept_id;",
- cdm_database_schema = cdmDatabaseSchema,
- tempEmulationSchema = tempEmulationSchema,
- snakeCaseToCamelCase = TRUE
- ) %>%
- dplyr::tibble() %>%
- dplyr::mutate(endDate = .data$startDate)
-
- writeLines("Getting drug exposure table.")
- drugExposure <- DatabaseConnector::renderTranslateQuerySql(
- connection = connection,
- sql = "SELECT de.person_id,
+ cdm_database_schema = cdmDatabaseSchema,
+ tempEmulationSchema = tempEmulationSchema,
+ snakeCaseToCamelCase = TRUE
+ ) %>%
+ dplyr::tibble() %>%
+ dplyr::mutate(endDate = .data$startDate)
+
+ writeLines("Getting drug exposure table.")
+ drugExposure <- DatabaseConnector::renderTranslateQuerySql(
+ connection = connection,
+ sql = "SELECT de.person_id,
pf.new_id,
drug_exposure_start_date AS start_date,
drug_exposure_end_date AS end_date,
@@ -526,16 +525,16 @@ createCohortExplorerApp <-
drug_concept_id,
drug_type_concept_id,
drug_source_concept_id;",
- cdm_database_schema = cdmDatabaseSchema,
- tempEmulationSchema = tempEmulationSchema,
- snakeCaseToCamelCase = TRUE
- ) %>%
- dplyr::tibble()
-
- writeLines("Getting drug era table.")
- drugEra <- DatabaseConnector::renderTranslateQuerySql(
- connection = connection,
- sql = "SELECT de.person_id,
+ cdm_database_schema = cdmDatabaseSchema,
+ tempEmulationSchema = tempEmulationSchema,
+ snakeCaseToCamelCase = TRUE
+ ) %>%
+ dplyr::tibble()
+
+ writeLines("Getting drug era table.")
+ drugEra <- DatabaseConnector::renderTranslateQuerySql(
+ connection = connection,
+ sql = "SELECT de.person_id,
pf.new_id,
drug_era_start_date AS start_date,
drug_era_end_date AS end_date,
@@ -554,17 +553,17 @@ createCohortExplorerApp <-
drug_era_start_date,
drug_era_end_date,
drug_concept_id;",
- cdm_database_schema = cdmDatabaseSchema,
- tempEmulationSchema = tempEmulationSchema,
- snakeCaseToCamelCase = TRUE
- ) %>%
- dplyr::tibble() %>%
- dplyr::mutate(typeConceptId = 0)
-
- writeLines("Getting measurement table.")
- measurement <- DatabaseConnector::renderTranslateQuerySql(
- connection = connection,
- sql = "SELECT m.person_id,
+ cdm_database_schema = cdmDatabaseSchema,
+ tempEmulationSchema = tempEmulationSchema,
+ snakeCaseToCamelCase = TRUE
+ ) %>%
+ dplyr::tibble() %>%
+ dplyr::mutate(typeConceptId = 0)
+
+ writeLines("Getting measurement table.")
+ measurement <- DatabaseConnector::renderTranslateQuerySql(
+ connection = connection,
+ sql = "SELECT m.person_id,
pf.new_id,
measurement_date AS start_date,
measurement_concept_id AS concept_id,
@@ -586,18 +585,18 @@ createCohortExplorerApp <-
measurement_concept_id,
measurement_type_concept_id,
measurement_source_concept_id;",
- cdm_database_schema = cdmDatabaseSchema,
- tempEmulationSchema = tempEmulationSchema,
- snakeCaseToCamelCase = TRUE
- ) %>%
- dplyr::tibble() %>%
- dplyr::mutate(endDate = .data$startDate)
-
-
- writeLines("Getting concept id.")
- conceptIds <- DatabaseConnector::renderTranslateQuerySql(
- connection = connection,
- sql = "WITH concepts as
+ cdm_database_schema = cdmDatabaseSchema,
+ tempEmulationSchema = tempEmulationSchema,
+ snakeCaseToCamelCase = TRUE
+ ) %>%
+ dplyr::tibble() %>%
+ dplyr::mutate(endDate = .data$startDate)
+
+
+ writeLines("Getting concept id.")
+ conceptIds <- DatabaseConnector::renderTranslateQuerySql(
+ connection = connection,
+ sql = "WITH concepts as
(
SELECT DISTINCT gender_concept_id AS CONCEPT_ID
FROM @cdm_database_schema.person p
@@ -761,226 +760,250 @@ createCohortExplorerApp <-
concepts c2
ON c.concept_id = c2.concept_id
ORDER BY c.concept_id;",
- cdm_database_schema = cdmDatabaseSchema,
- vocabulary_database_schema = vocabularyDatabaseSchema,
- tempEmulationSchema = tempEmulationSchema,
- snakeCaseToCamelCase = TRUE
+ cdm_database_schema = cdmDatabaseSchema,
+ vocabulary_database_schema = vocabularyDatabaseSchema,
+ tempEmulationSchema = tempEmulationSchema,
+ snakeCaseToCamelCase = TRUE
+ ) %>%
+ dplyr::tibble()
+
+ cohort <- cohort %>%
+ dplyr::rename(personId = .data$subjectId)
+
+ subjects <- cohort %>%
+ dplyr::group_by(.data$personId) %>%
+ dplyr::summarise(startDate = min(.data$startDate)) %>%
+ dplyr::inner_join(person,
+ by = "personId"
) %>%
- dplyr::tibble()
-
- cohort <- cohort %>%
- dplyr::rename(personId = .data$subjectId)
+ dplyr::inner_join(conceptIds,
+ by = c("genderConceptId" = "conceptId")
+ ) %>%
+ dplyr::rename(gender = .data$conceptName) %>%
+ dplyr::ungroup()
+
+ personMinObservationPeriodDate <- observationPeriod %>%
+ dplyr::group_by(.data$personId) %>%
+ dplyr::summarise(
+ minObservationPeriodDate = min(.data$startDate),
+ .groups = "keep"
+ ) %>%
+ dplyr::ungroup()
- subjects <- cohort %>%
- dplyr::group_by(.data$personId) %>%
- dplyr::summarise(startDate = min(.data$startDate)) %>%
- dplyr::inner_join(person,
+ shiftDatesInData <- function(data,
+ originDate = as.Date("2000-01-01"),
+ minObservationPeriodDate = personMinObservationPeriodDate) {
+ data <- data %>%
+ dplyr::inner_join(personMinObservationPeriodDate,
by = "personId"
- ) %>%
- dplyr::inner_join(conceptIds,
- by = c("genderConceptId" = "conceptId")
- ) %>%
- dplyr::rename(gender = .data$conceptName) %>%
- dplyr::ungroup()
-
- personMinObservationPeriodDate <- observationPeriod %>%
- dplyr::group_by(.data$personId) %>%
- dplyr::summarise(
- minObservationPeriodDate = min(.data$startDate),
- .groups = "keep"
- ) %>%
- dplyr::ungroup()
-
- shiftDatesInData <- function(data,
- originDate = as.Date("2000-01-01"),
- minObservationPeriodDate = personMinObservationPeriodDate) {
- data <- data %>%
- dplyr::inner_join(personMinObservationPeriodDate,
- by = "personId"
- )
-
- if ("startDate" %in% colnames(data)) {
- data <-
- data %>% dplyr::mutate(startDate = clock::add_days(
- x = as.Date(originDate),
- n = as.integer(
- difftime(
- time1 = .data$startDate,
- time2 = .data$minObservationPeriodDate,
- units = "days"
- )
- )
- ))
- }
-
- if ("endDate" %in% colnames(data)) {
- data <-
- data %>% dplyr::mutate(endDate = clock::add_days(
- x = as.Date(originDate),
- n = as.integer(
- difftime(
- time1 = .data$endDate,
- time2 = .data$minObservationPeriodDate,
- units = "days"
- )
- )
- ))
- }
+ )
+ if ("startDate" %in% colnames(data)) {
data <- data %>%
- dplyr::select(-minObservationPeriodDate)
- }
-
- if (shiftDates) {
- observationPeriod <- shiftDatesInData(data = observationPeriod)
- cohort <- shiftDatesInData(data = cohort)
- conditionEra <- shiftDatesInData(data = conditionEra)
- conditionOccurrence <-
- shiftDatesInData(data = conditionOccurrence)
- drugExposure <- shiftDatesInData(data = drugExposure)
- measurement <- shiftDatesInData(data = measurement)
- observation <- shiftDatesInData(data = observation)
- procedureOccurrence <-
- shiftDatesInData(data = procedureOccurrence)
- visitOccurrence <- shiftDatesInData(data = visitOccurrence)
- measurement <- shiftDatesInData(data = measurement)
+ dplyr::mutate(startDate = clock::add_days(
+ x = as.Date(originDate),
+ n = as.integer(
+ difftime(
+ time1 = .data$startDate,
+ time2 = .data$minObservationPeriodDate,
+ units = "days"
+ )
+ )
+ ))
}
- replaceId <- function(data, useNewId = TRUE) {
- if (useNewId) {
- data <- data %>%
- dplyr::select(-.data$personId) %>%
- dplyr::rename("personId" = .data$newId)
- } else {
- data <- data %>%
- dplyr::select(-.data$newId)
- }
- return(data)
+ if ("endDate" %in% colnames(data)) {
+ data <- data %>%
+ dplyr::mutate(endDate = clock::add_days(
+ x = as.Date(originDate),
+ n = as.integer(
+ difftime(
+ time1 = .data$endDate,
+ time2 = .data$minObservationPeriodDate,
+ units = "days"
+ )
+ )
+ ))
}
- cohort <- replaceId(data = cohort, useNewId = assignNewId)
- person <- replaceId(data = person, useNewId = assignNewId)
- subjects <- replaceId(data = subjects, useNewId = assignNewId)
- observationPeriod <-
- replaceId(data = observationPeriod, useNewId = assignNewId)
- visitOccurrence <-
- replaceId(data = visitOccurrence, useNewId = assignNewId)
- conditionOccurrence <-
- replaceId(data = conditionOccurrence, useNewId = assignNewId)
- conditionEra <-
- replaceId(data = conditionEra, useNewId = assignNewId)
- observation <-
- replaceId(data = observation, useNewId = assignNewId)
- procedureOccurrence <-
- replaceId(data = procedureOccurrence, useNewId = assignNewId)
- drugExposure <-
- replaceId(data = drugExposure, useNewId = assignNewId)
- drugEra <- replaceId(data = drugEra, useNewId = assignNewId)
- measurement <-
- replaceId(data = measurement, useNewId = assignNewId)
-
- results <- list(
- cohort = cohort,
- person = person,
- subjects = subjects,
- observationPeriod = observationPeriod,
- visitOccurrence = visitOccurrence,
- conditionOccurrence = conditionOccurrence,
- conditionEra = conditionEra,
- observation = observation,
- procedureOccurrence = procedureOccurrence,
- drugExposure = drugExposure,
- drugEra = drugEra,
- measurement = measurement,
- conceptId = conceptIds,
- cohortName = cohortName,
- assignNewId = assignNewId,
- shiftDates = shiftDates,
- sampleSize = sampleSize,
- sampleFound = nrow(subjects)
- )
-
- dir.create(
- path = file.path(exportFolder, "CohortExplorer"),
- showWarnings = FALSE,
- recursive = TRUE
- )
- dir.create(
- path = file.path(exportFolder, "CohortExplorer", "data"),
- showWarnings = FALSE,
- recursive = TRUE
- )
- dir.create(
- path = file.path(exportFolder, "CohortExplorer", "R"),
- showWarnings = FALSE,
- recursive = TRUE
- )
- dir.create(
- path = file.path(exportFolder, "CohortExplorer", "renv"),
- showWarnings = FALSE,
- recursive = TRUE
- )
+ data <- data %>%
+ dplyr::select(-minObservationPeriodDate)
+ }
- file.copy(
- from = system.file("shiny", "CohortExplorer.Rproj", package = utils::packageName()),
- to = file.path(exportFolder, "CohortExplorer", "CohortExplorer.Rproj")
- )
- file.copy(
- from = system.file("shiny", "global.R", package = utils::packageName()),
- to = file.path(exportFolder, "CohortExplorer", "global.R")
- )
- file.copy(
- from = system.file("shiny", "ui.R", package = utils::packageName()),
- to = file.path(exportFolder, "CohortExplorer", "ui.R")
- )
- file.copy(
- from = system.file("shiny", "server.R", package = utils::packageName()),
- to = file.path(exportFolder, "CohortExplorer", "server.R")
+ if (shiftDates) {
+ observationPeriod <- shiftDatesInData(data = observationPeriod)
+ cohort <- shiftDatesInData(data = cohort)
+ conditionEra <- shiftDatesInData(data = conditionEra)
+ conditionOccurrence <- shiftDatesInData(
+ data =
+ conditionOccurrence
)
- file.copy(
- from = system.file("shiny", "renv.lock", package = utils::packageName()),
- to = file.path(exportFolder, "CohortExplorer", "renv.lock")
- )
- file.copy(
- from = system.file("shiny", ".Rprofile", package = utils::packageName()),
- to = file.path(exportFolder, "CohortExplorer", ".Rprofile")
- )
- file.copy(
- from = system.file("shiny", "R", "widgets.R", package = utils::packageName()),
- to = file.path(exportFolder, "CohortExplorer", "R", "widgets.R")
- )
- file.copy(
- from = system.file("shiny", "R", "private.R", package = utils::packageName()),
- to = file.path(exportFolder, "CohortExplorer", "R", "private.R")
- )
- file.copy(
- from = system.file("shiny", "renv.lock", package = utils::packageName()),
- to = file.path(exportFolder, "CohortExplorer", "renv.lock")
- )
- file.copy(
- from = system.file("shiny", "renv", ".gitignore", package = utils::packageName()),
- to = file.path(exportFolder, "CohortExplorer", "renv", ".gitignore")
- )
- file.copy(
- from = system.file("shiny", "renv", "activate.R", package = utils::packageName()),
- to = file.path(exportFolder, "CohortExplorer", "renv", "activate.R")
- )
- file.copy(
- from = system.file("shiny", "renv", "settings.dcf", package = utils::packageName()),
- to = file.path(exportFolder, "CohortExplorer", "renv", "settings.dcf")
- )
-
- ParallelLogger::logInfo(paste0("Writing ", rdsFileName))
- saveRDS(
- object = results,
- file = file.path(exportFolder, "CohortExplorer", "data", rdsFileName)
+ drugExposure <- shiftDatesInData(data = drugExposure)
+ measurement <- shiftDatesInData(data = measurement)
+ observation <- shiftDatesInData(data = observation)
+ procedureOccurrence <- shiftDatesInData(
+ data =
+ procedureOccurrence
)
+ visitOccurrence <- shiftDatesInData(data = visitOccurrence)
+ measurement <- shiftDatesInData(data = measurement)
+ }
- delta <- Sys.time() - startTime
- ParallelLogger::logInfo(
- " - Extracting person level data took ",
- signif(delta, 3),
- " ",
- attr(delta, "units")
- )
+ replaceId <- function(data, useNewId = TRUE) {
+ if (useNewId) {
+ data <- data %>%
+ dplyr::select(-.data$personId) %>%
+ dplyr::rename("personId" = .data$newId)
+ } else {
+ data <- data %>%
+ dplyr::select(-.data$newId)
+ }
+ return(data)
}
+
+ cohort <- replaceId(data = cohort, useNewId = assignNewId)
+ person <- replaceId(data = person, useNewId = assignNewId)
+ subjects <- replaceId(data = subjects, useNewId = assignNewId)
+ observationPeriod <- replaceId(
+ data = observationPeriod,
+ useNewId = assignNewId
+ )
+ visitOccurrence <- replaceId(
+ data = visitOccurrence,
+ useNewId = assignNewId
+ )
+ conditionOccurrence <- replaceId(
+ data = conditionOccurrence,
+ useNewId = assignNewId
+ )
+ conditionEra <- replaceId(
+ data = conditionEra,
+ useNewId = assignNewId
+ )
+ observation <- replaceId(
+ data = observation,
+ useNewId = assignNewId
+ )
+ procedureOccurrence <- replaceId(
+ data = procedureOccurrence,
+ useNewId = assignNewId
+ )
+ drugExposure <- replaceId(
+ data = drugExposure,
+ useNewId = assignNewId
+ )
+ drugEra <- replaceId(data = drugEra, useNewId = assignNewId)
+ measurement <- replaceId(
+ data = measurement,
+ useNewId = assignNewId
+ )
+
+ results <- list(
+ cohort = cohort,
+ person = person,
+ subjects = subjects,
+ observationPeriod = observationPeriod,
+ visitOccurrence = visitOccurrence,
+ conditionOccurrence = conditionOccurrence,
+ conditionEra = conditionEra,
+ observation = observation,
+ procedureOccurrence = procedureOccurrence,
+ drugExposure = drugExposure,
+ drugEra = drugEra,
+ measurement = measurement,
+ conceptId = conceptIds,
+ cohortName = cohortName,
+ assignNewId = assignNewId,
+ shiftDates = shiftDates,
+ sampleSize = sampleSize,
+ sampleFound = nrow(subjects)
+ )
+
+ dir.create(
+ path = file.path(exportFolder, "CohortExplorer"),
+ showWarnings = FALSE,
+ recursive = TRUE
+ )
+ dir.create(
+ path = file.path(exportFolder, "CohortExplorer", "data"),
+ showWarnings = FALSE,
+ recursive = TRUE
+ )
+ dir.create(
+ path = file.path(exportFolder, "CohortExplorer", "R"),
+ showWarnings = FALSE,
+ recursive = TRUE
+ )
+ dir.create(
+ path = file.path(exportFolder, "CohortExplorer", "renv"),
+ showWarnings = FALSE,
+ recursive = TRUE
+ )
+
+ file.copy(
+ from = system.file("shiny", "CohortExplorer.Rproj", package = utils::packageName()),
+ to = file.path(exportFolder, "CohortExplorer", "CohortExplorer.Rproj")
+ )
+ file.copy(
+ from = system.file("shiny", "global.R", package = utils::packageName()),
+ to = file.path(exportFolder, "CohortExplorer", "global.R")
+ )
+ file.copy(
+ from = system.file("shiny", "ui.R", package = utils::packageName()),
+ to = file.path(exportFolder, "CohortExplorer", "ui.R")
+ )
+ file.copy(
+ from = system.file("shiny", "server.R", package = utils::packageName()),
+ to = file.path(exportFolder, "CohortExplorer", "server.R")
+ )
+ file.copy(
+ from = system.file("shiny", "renv.lock", package = utils::packageName()),
+ to = file.path(exportFolder, "CohortExplorer", "renv.lock")
+ )
+ file.copy(
+ from = system.file("shiny", ".Rprofile", package = utils::packageName()),
+ to = file.path(exportFolder, "CohortExplorer", ".Rprofile")
+ )
+ file.copy(
+ from = system.file("shiny", "R", "widgets.R", package = utils::packageName()),
+ to = file.path(exportFolder, "CohortExplorer", "R", "widgets.R")
+ )
+ file.copy(
+ from = system.file("shiny", "R", "private.R", package = utils::packageName()),
+ to = file.path(exportFolder, "CohortExplorer", "R", "private.R")
+ )
+ file.copy(
+ from = system.file("shiny", "renv.lock", package = utils::packageName()),
+ to = file.path(exportFolder, "CohortExplorer", "renv.lock")
+ )
+ file.copy(
+ from = system.file("shiny", "renv", ".gitignore", package = utils::packageName()),
+ to = file.path(exportFolder, "CohortExplorer", "renv", ".gitignore")
+ )
+ file.copy(
+ from = system.file("shiny", "renv", "activate.R", package = utils::packageName()),
+ to = file.path(exportFolder, "CohortExplorer", "renv", "activate.R")
+ )
+ file.copy(
+ from = system.file("shiny", "renv", "settings.dcf", package = utils::packageName()),
+ to = file.path(exportFolder, "CohortExplorer", "renv", "settings.dcf")
+ )
+ file.copy(
+ from = system.file("shiny", "README.md", package = utils::packageName()),
+ to = file.path(exportFolder, "CohortExplorer", "README.md")
+ )
+
+ ParallelLogger::logInfo(paste0("Writing ", rdsFileName))
+ saveRDS(
+ object = results,
+ file = file.path(exportFolder, "CohortExplorer", "data", rdsFileName)
+ )
+
+ delta <- Sys.time() - startTime
+ ParallelLogger::logInfo(
+ " - Extracting person level data took ",
+ signif(delta, 3),
+ " ",
+ attr(delta, "units")
+ )
+}
diff --git a/README.md b/README.md
index 439a1d2..b2b8110 100644
--- a/README.md
+++ b/README.md
@@ -15,6 +15,7 @@ Warning
- Contains person level data. This package is not to be considered de-identified.
- Please do not share the output with others as it may violate protected health information.
+- .RData file in output contains PHI.
Features
========
@@ -22,9 +23,18 @@ Features
- From an instantiated cohort, identifies specified number of random persons. It also allows for non random selection by specifying a set of personId as input.
- Extracts person level data for each person from the common data model, and constructs a results object in rds form. This rds object has person level data with personId and dates.
- Accepts a set of configurable parameters for the shiny application. This parameters will be chosen in the shiny app. e.g. regular expression.
-- Allows additional de-identification with shifting dates and newId, ie.. shifts all dates so that the first observation_period_start_date for a person is set to January 1st 1900, and all other dates are shifted in relation to this date. Also creates and replaces the source personId with a new randomly generated id.
+- Allows additional de-identification using two optional mechanisms (shift dates and replace OMOP personId with a new random id). Shift date: shifts all dates so that the first observation_period_start_date for a person is set to January 1st 2000, and all other dates are shifted in relation to this date. Also creates and replaces the source personId with a new randomly generated id.
- Creates a R shiny app in a specified local folder (zipped), that can then be published to a shiny server or explored locally.
+How to use
+========
+
+- The output of createCohortExplorerApp is a Shiny App with person level data in .RData. It is in the output folder.
+- Go the output location in your file browser (e.g. windows file explorer in a Windows computer) and start 'CohortExplorer.Rproj'.
+- In R console now run renv::restore() to enable renv. This will download all required packages and dependencies and set up the run environment.
+- Next call to shiny::runApp()
+- If you want to run this Shiny App on a remote Shiny Server, you may copy all the files in the outpu to the remote shiny servers new app file folder. run renv::restore() in the shiny server and restart app.
+
Technology
============
CohortExplorer is an R package.
diff --git a/docs/404.html b/docs/404.html
index 6acad0f..db0d218 100644
--- a/docs/404.html
+++ b/docs/404.html
@@ -32,7 +32,7 @@
CohortExplorer
- 0.0.2
+ 0.0.3
diff --git a/docs/authors.html b/docs/authors.html
index f6afe29..aa1c0d7 100644
--- a/docs/authors.html
+++ b/docs/authors.html
@@ -17,7 +17,7 @@
CohortExplorer
- 0.0.2
+ 0.0.3
@@ -69,11 +69,11 @@
Citation
Rao G (2022).
-CohortExplorer: An R package with a Shiny viewer to explore profiles of patients in a cohort..
+CohortExplorer: An R package with a Shiny viewer to explore profiles of patients in a cohort.
https://ohdsi.github.io/CohortExplorer/, https://github.com/OHDSI/CohortExplorer.
@Manual{,
- title = {CohortExplorer: An R package with a Shiny viewer to explore profiles of patients in a cohort.},
+ title = {CohortExplorer: An R package with a Shiny viewer to explore profiles of patients in a cohort},
author = {Gowtham Rao},
year = {2022},
note = {https://ohdsi.github.io/CohortExplorer/, https://github.com/OHDSI/CohortExplorer},
diff --git a/docs/index.html b/docs/index.html
index 62e1fea..1064aa5 100644
--- a/docs/index.html
+++ b/docs/index.html
@@ -5,13 +5,13 @@
-An R package with a Shiny viewer to explore profiles of patients in a cohort. • CohortExplorer
+An R package with a Shiny viewer to explore profiles of patients in a cohort • CohortExplorer
-
+
CohortExplorer: An R package with a Shiny viewer to explore profiles of patients in a cohort. — CohortExplorer-package • CohortExplorerCohortExplorer: An R package with a Shiny viewer to explore profiles of patients in a cohort — CohortExplorer-package • CohortExplorer
@@ -17,7 +17,7 @@
CohortExplorer
- 0.0.2
+ 0.0.3
@@ -46,7 +46,7 @@
-
CohortExplorer: An R package with a Shiny viewer to explore profiles of patients in a cohort.
+
CohortExplorer: An R package with a Shiny viewer to explore profiles of patients in a cohort
diff --git a/extras/CohortExplorer.pdf b/extras/CohortExplorer.pdf
index 5e219a2..057e3aa 100644
Binary files a/extras/CohortExplorer.pdf and b/extras/CohortExplorer.pdf differ
diff --git a/inst/shiny/README.md b/inst/shiny/README.md
new file mode 100644
index 0000000..e91db04
--- /dev/null
+++ b/inst/shiny/README.md
@@ -0,0 +1,16 @@
+CohortExplorer
+================
+
+How to use
+========
+
+- The output of createCohortExplorerApp is a Shiny App with person level data in .RData. It is in the output folder.
+- Go the output location in your file browser (e.g. windows file explorer in a Windows computer) and start 'CohortExplorer.Rproj'.
+- In R console now run renv::restore() to enable renv. This will download all required packages and dependencies and set up the run environment.
+- Next call to shiny::runApp()
+- If you want to run this Shiny App on a remote Shiny Server, you may copy all the files in the outpu to the remote shiny servers new app file folder. run renv::restore() in the shiny server and restart app.
+
+
+License
+=======
+CohortExplorer is licensed under Apache License 2.0
\ No newline at end of file
diff --git a/man/CohortExplorer-package.Rd b/man/CohortExplorer-package.Rd
index 60897dc..83fd6fa 100644
--- a/man/CohortExplorer-package.Rd
+++ b/man/CohortExplorer-package.Rd
@@ -4,7 +4,7 @@
\name{CohortExplorer-package}
\alias{CohortExplorer}
\alias{CohortExplorer-package}
-\title{CohortExplorer: An R package with a Shiny viewer to explore profiles of patients in a cohort.}
+\title{CohortExplorer: An R package with a Shiny viewer to explore profiles of patients in a cohort}
\description{
An R package with a Shiny viewer to explore profiles of patients in a cohort.
}
diff --git a/tests/testthat/test-createCohortExplorerApp.R b/tests/testthat/test-createCohortExplorerApp.R
index d5bb2df..2b866f9 100644
--- a/tests/testthat/test-createCohortExplorerApp.R
+++ b/tests/testthat/test-createCohortExplorerApp.R
@@ -61,7 +61,7 @@ test_that("Extract person level data", {
)
)
# cohort table has no subjects
- expect_warning(
+ expect_error(
createCohortExplorerApp(
connectionDetails = connectionDetails,
cohortDatabaseSchema = cohortDatabaseSchema,