Merge pull request #24 from OHDSI/develop

Develop

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: Characterization
 Type: Package
 Title: Characterizations of Cohorts
-Version: 0.0.6
-Date: 2023-02-13
+Version: 0.1.0
+Date: 2023-03-13
 Authors@R: c(
 	person("Jenna", "Reps", , "[email protected]", role = c("aut", "cre")),
 	person("Patrick", "Ryan", , "[email protected]", role = c("aut"))
@@ -25,15 +25,21 @@ Imports:
 	readr, 
 	rlang
 Suggests:
+  devtools,
 	testthat,
 	Eunomia,
 	kableExtra,
 	knitr,
 	markdown,
+	ResultModelManager,
+	ShinyAppBuilder,
+	shiny,
 	withr
 Remotes:
 	ohdsi/FeatureExtraction,
-	ohdsi/Eunomia
+	ohdsi/Eunomia,
+	ohdsi/ResultModelManager,
+	ohdsi/ShinyAppBuilder
 NeedsCompilation: no
 RoxygenNote: 7.2.3
 Encoding: UTF-8

NAMESPACE

@@ -26,5 +26,6 @@ export(saveCharacterizationSettings)
 export(saveDechallengeRechallengeAnalyses)
 export(saveRechallengeFailCaseSeriesAnalyses)
 export(saveTimeToEventAnalyses)
+export(viewCharacterization)
 importFrom(dplyr,"%>%")
 importFrom(rlang,.data)

NEWS.md

@@ -1,3 +1,10 @@
+Characterization 0.1.0
+======================
+
+- added support to enable target cohorts with multiple cohort entries for the aggregate covariate analysis by restructing to first cohort entry and ensuring the subject has a user specified minPriorObservation days observation in the database at first entry and also perform analysis on first outcomes and any outcome that is recorded during TAR.
+- added shiny app
+
+
 Characterization 0.0.1
 ======================
 

R/AggregateCovariates.R

@@ -18,6 +18,7 @@
 #'
 #' @param targetIds   A list of cohortIds for the target cohorts
 #' @param outcomeIds  A list of cohortIds for the outcome cohorts
+#' @param minPriorObservation The minimum time in the database a patient in the target cohorts must be observed prior to index
 #' @template timeAtRisk
 #' @param covariateSettings   An object created using \code{FeatureExtraction::createCovariateSettings}
 #'
@@ -28,6 +29,7 @@
 createAggregateCovariateSettings <- function(
   targetIds,
   outcomeIds,
+  minPriorObservation = 0,
   riskWindowStart = 1,
   startAnchor = 'cohort start',
   riskWindowEnd = 365,
@@ -57,19 +59,26 @@ createAggregateCovariateSettings <- function(
     endAnchor = endAnchor,
     errorMessages = errorMessages
   )
-  
+
   # check covariateSettings
   .checkCovariateSettings(
     covariateSettings = covariateSettings,
     errorMessages = errorMessages
   )
 
+  # check minPriorObservation
+  .checkMinPriorObservation(
+    minPriorObservation = minPriorObservation,
+    errorMessages = errorMessages
+  )
+
   checkmate::reportAssertions(errorMessages)
 
   # create list
   result <- list(
     targetIds = targetIds,
     outcomeIds = outcomeIds,
+    minPriorObservation = minPriorObservation,
     riskWindowStart = riskWindowStart,
     startAnchor = startAnchor,
     riskWindowEnd = riskWindowEnd ,
@@ -126,6 +135,7 @@ computeAggregateCovariateAnalyses <- function(
   createCohortsOfInterest(
     connection = connection,
     dbms = connectionDetails$dbms,
+    cdmDatabaseSchema = cdmDatabaseSchema,
     aggregateCovariateSettings,
     targetDatabaseSchema,
     targetTable,
@@ -135,16 +145,16 @@ computeAggregateCovariateAnalyses <- function(
   )
 
   ## get counts
-  sql <- 'select cohort_definition_id, count(*) N from #agg_cohorts group by cohort_definition_id;'
+  sql <- 'select cohort_definition_id, count(*) row_count, count(distinct subject_id) person_count from #agg_cohorts group by cohort_definition_id;'
   sql <- SqlRender::translate(
     sql = sql,
     targetDialect = connectionDetails$dbms
     )
   counts <- DatabaseConnector::querySql(
     connection = connection,
-    sql = sql
+    sql = sql,
+    snakeCaseToCamelCase = T,
   )
-  #print(counts) # testing
 
   message("Computing aggregate covariate results")
 
@@ -159,6 +169,8 @@ computeAggregateCovariateAnalyses <- function(
     cdmVersion = cdmVersion,
     aggregated = T
   )
+  # adding counts as a new table
+  result$cohortCounts <- counts
 
   # add databaseId and runId to each table in results
   # could add settings table with this and just have setting id
@@ -234,6 +246,7 @@ computeAggregateCovariateAnalyses <- function(
 
 createCohortsOfInterest <- function(
   connection,
+  cdmDatabaseSchema,
   dbms,
   aggregateCovariateSettings,
   targetDatabaseSchema,
@@ -247,13 +260,15 @@ createCohortsOfInterest <- function(
     sqlFilename = "createTargetOutcomeCombinations.sql",
     packageName = "Characterization",
     dbms = dbms,
+    cdm_database_schema = cdmDatabaseSchema,
     tempEmulationSchema = tempEmulationSchema,
     target_database_schema = targetDatabaseSchema,
     target_table = targetTable,
     outcome_database_schema = outcomeDatabaseSchema,
     outcome_table = outcomeTable,
     target_ids = paste(aggregateCovariateSettings$targetIds, collapse = ',', sep = ','),
     outcome_ids = paste(aggregateCovariateSettings$outcomeIds, collapse = ',', sep = ','),
+    min_prior_observation = aggregateCovariateSettings$minPriorObservation,
     tar_start = aggregateCovariateSettings$riskWindowStart,
     tar_start_anchor = ifelse(
       aggregateCovariateSettings$startAnchor == 'cohort start',

R/Characterization.R

@@ -18,6 +18,5 @@
 "_PACKAGE"
 
 #' @importFrom rlang .data
-#' @importFrom methods is
 #' @importFrom dplyr %>%
 NULL

R/HelperFunctions.R

@@ -29,7 +29,7 @@
   connectionDetails,
   errorMessages
   ) {
-  if (is(connectionDetails, "connectionDetails")) {
+  if (inherits(connectionDetails, "connectionDetails")) {
   checkmate::assertClass(
     x = connectionDetails,
     classes = "connectionDetails",
@@ -65,7 +65,7 @@
     return()
   }
 
-  if(class(settings) == 'dechallengeRechallengeSettings'){
+  if(inherits(settings, 'dechallengeRechallengeSettings')){
     settings <- list(settings)
   }
 
@@ -99,7 +99,7 @@
     return()
   }
 
-  if(class(settings) == 'timeToEventSettings'){
+  if(inherits(settings,'timeToEventSettings')){
     settings <- list(settings)
   }
 
@@ -133,7 +133,7 @@
     return()
   }
 
-  if(class(settings) == 'aggregateCovariateSettings'){
+  if(inherits(settings,'aggregateCovariateSettings')){
     settings <- list(settings)
   }
 
@@ -231,13 +231,30 @@
 
 
 
-.checkCovariateSettings <- function(
-    covariateSettings,
+.checkCovariateSettings <- function(covariateSettings,
+                                    errorMessages) {
+  if (class(covariateSettings) == "covariateSettings") {
+    checkmate::assertClass(x = covariateSettings,
+                           classes = "covariateSettings",
+                           add = errorMessages)
+  } else {
+    for (j in (1:length(covariateSettings))) {
+      checkmate::assertClass(x = covariateSettings[[j]],
+                             classes = "covariateSettings",
+                             add = errorMessages)
+    }
+  }
+
+}
+
+.checkMinPriorObservation <- function(
+    minPriorObservation,
   errorMessages
 ) {
-  checkmate::assertClass(
-    x = covariateSettings,
-    classes = "covariateSettings",
+  checkmate::assertCount(
+    x = minPriorObservation,
+    null.ok = F,
+    .var.name = 'minPriorObservation',
     add = errorMessages
   )
 }

R/RunCharacterization.R

@@ -33,13 +33,13 @@ createCharacterizationSettings <- function(
     errorMessages = errorMessages
   )
 
-  if (class(timeToEventSettings) == "timeToEventSettings") {
+  if (inherits(timeToEventSettings, "timeToEventSettings")) {
     timeToEventSettings <- list(timeToEventSettings)
   }
-  if (class(dechallengeRechallengeSettings) == "dechallengeRechallengeSettings") {
+  if (inherits(dechallengeRechallengeSettings, "dechallengeRechallengeSettings")) {
     dechallengeRechallengeSettings <- list(dechallengeRechallengeSettings)
   }
-  if (class(aggregateCovariateSettings) == "aggregateCovariateSettings") {
+  if (inherits(aggregateCovariateSettings, "aggregateCovariateSettings")) {
     aggregateCovariateSettings <- list(aggregateCovariateSettings)
   }
 

R/SaveLoad.R

@@ -404,6 +404,38 @@ exportAggregateCovariateToCsv <- function(
 
     }
   )
+  # cohort details
+  Andromeda::batchApply(
+    tbl = result$cohortCounts,
+    fun = function(x) {
+
+      append <- file.exists(
+        file.path(
+          saveDirectory,
+          "cohort_counts.csv"
+        )
+      )
+
+      dat <- as.data.frame(
+        x %>%
+          dplyr::collect()
+      )
+
+      colnames(dat) <- SqlRender::camelCaseToSnakeCase(
+        string = colnames(dat)
+      )
+
+      readr::write_csv(
+        x = dat,
+        file = file.path(
+          saveDirectory,
+          "cohort_counts.csv"
+        ),
+        append = append
+      )
+
+    }
+  )
 
   # cohort details
   Andromeda::batchApply(
@@ -577,7 +609,8 @@ exportAggregateCovariateToCsv <- function(
         "analysis_ref.csv",
         "covariate_ref.csv",
         "covariates.csv",
-        "covariates_continuous.csv"
+        "covariates_continuous.csv",
+        "cohort_counts.csv"
       )
     )
   )