Merge pull request #233 from darwin-eu-dev/dev

Dev

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: TreatmentPatterns
 Type: Package
 Title: Analyzes Real-World Treatment Patterns of a Study Population of Interest
-Version: 2.6.5
+Version: 2.6.6
 Authors@R: 
     c(person("Aniek", "Markus", , role = c("aut"), comment = c(ORCID = "0000-0001-5779-4794")),
       person("Maarten", "van Kessel", email = "m.l.vankessel@erasmusmc.nl", role = c("cre"), comment = c(ORCID = "0009-0006-8832-6030")))
@@ -51,9 +51,25 @@ Suggests:
 License: Apache License 2.0
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 VignetteBuilder: knitr
 Config/testthat/edition: 3
 Config/testthat/parallel: true
 Additional_repositories: https://ohdsi.github.io/drat
 Roxygen: list(markdown = TRUE)
+Collate: 
+    'CDMInterface.R'
+    'ShinyModule.R'
+    'CharacterizationPlots.R'
+    'InputHandler.R'
+    'InteractivePlots.R'
+    'SankeyDiagram.R'
+    'ShinyApp.R'
+    'SunburstPlot.R'
+    'TreatmentPatterns-package.R'
+    'computePathways.R'
+    'constructPathways.R'
+    'createSankeyDiagram.R'
+    'createSunburstPlot.R'
+    'executeTreatmentPatterns.R'
+    'export.R'

NAMESPACE

@@ -2,8 +2,9 @@
 
 export(CharacterizationPlots)
 export(InputHandler)
-export(InteractivePlots)
-export(Module)
+export(SankeyDiagram)
+export(ShinyModule)
+export(SunburstPlot)
 export(computePathways)
 export(createSankeyDiagram)
 export(createSankeyDiagram2)

NEWS.md

@@ -1,3 +1,9 @@
+# TreatmentPatterns 2.6.6
+---------
+* Internal update to shinyApp.
+* Update to createSankeyDiagram() to properly handle combinations consisting of >2.
+* Added article to package website about best practices.
+
 # TreatmentPatterns 2.6.5
 ---------
 * Removed stringi, rjson, and googleVis as dependencies.

R/R6-CDMInterface.R → R/CDMInterface.R

@@ -20,69 +20,22 @@ CDMInterface <- R6::R6Class(
     #'
     #' @return (`invisible(self)`)
     initialize = function(connectionDetails = NULL, cdmSchema = NULL, resultSchema = NULL, tempEmulationSchema = NULL, cdm = NULL) {
-      private$connectionDetails <- connectionDetails
-      if (!is.null(private$connectionDetails)) {
-        private$connection <- DatabaseConnector::connect(private$connectionDetails)
+      private$.connectionDetails <- connectionDetails
+      if (!is.null(private$.connectionDetails)) {
+        private$.connection <- DatabaseConnector::connect(private$.connectionDetails)
       }
-      private$cdmSchema <- cdmSchema
-      private$resultSchema <- resultSchema
-      private$tempEmulationSchema <- tempEmulationSchema
-      private$cdm <- cdm
+      private$.cdmSchema <- cdmSchema
+      private$.resultSchema <- resultSchema
+      private$.tempEmulationSchema <- tempEmulationSchema
+      private$.cdm <- cdm
 
       if (!is.null(cdm)) {
-        private$type <- "CDMConnector"
+        private$.type <- "CDMConnector"
       } else if (!is.null(connectionDetails)) {
-        private$type <- "DatabaseConnector"
+        private$.type <- "DatabaseConnector"
       } else {
         stop("Could not assert if CDMConnector or DatabaseConnector is being used.")
       }
-      self$validate()
-      return(invisible(self))
-    },
-
-    #' @description
-    #' Validation method
-    #'
-    #' @return (`invisible(self)`)
-    validate = function() {
-      errorMessages <- checkmate::makeAssertCollection()
-
-      checkmate::assertClass(
-        x = private$connectionDetails,
-        "ConnectionDetails",
-        null.ok = TRUE,
-        add = errorMessages
-      )
-
-      checkmate::assertCharacter(
-        x = private$connectionDetails$dbms,
-        len = 1,
-        null.ok = TRUE,
-        add = errorMessages
-      )
-
-      checkmate::assertCharacter(
-        private$cdmDatabaseSchema,
-        null.ok = TRUE,
-        len = 1,
-        add = errorMessages
-      )
-
-      checkmate::assertCharacter(
-        private$resultSchema,
-        null.ok = TRUE,
-        len = 1,
-        add = errorMessages
-      )
-
-      checkmate::assertClass(
-        private$cdm,
-        classes = "cdm_reference",
-        null.ok = TRUE,
-        add = errorMessages
-      )
-
-      checkmate::reportAssertions(collection = errorMessages)
       return(invisible(self))
     },
 
@@ -98,9 +51,10 @@ CDMInterface <- R6::R6Class(
     #'
     #' @return (`data.frame`)
     fetchCohortTable = function(cohorts, cohortTableName, andromeda, andromedaTableName, minEraDuration = NULL) {
-      switch(private$type,
-             CDMConnector = private$cdmconFetchCohortTable(cohorts, cohortTableName, andromeda, andromedaTableName, minEraDuration),
-             DatabaseConnector = private$dbconFetchCohortTable(cohorts, cohortTableName, andromeda, andromedaTableName, minEraDuration)
+      switch(
+        private$.type,
+        CDMConnector = private$cdmconFetchCohortTable(cohorts, cohortTableName, andromeda, andromedaTableName, minEraDuration),
+        DatabaseConnector = private$dbconFetchCohortTable(cohorts, cohortTableName, andromeda, andromedaTableName, minEraDuration)
       )
     },
 
@@ -111,34 +65,42 @@ CDMInterface <- R6::R6Class(
     #'
     #' @return (`invisible(NULL)`)
     fetchMetadata = function(andromeda) {
-      switch(private$type,
-             CDMConnector = private$cdmconFetchMetadata(andromeda),
-             DatabaseConnector = private$dbconFetchMetadata(andromeda)
+      switch(
+        private$.type,
+        CDMConnector = private$cdmconFetchMetadata(andromeda),
+        DatabaseConnector = private$dbconFetchMetadata(andromeda)
       )
-      return(invisible(self))
     },
 
     #' @description
     #' Destroys instance
     #' 
     #' @return (NULL)
     disconnect = function() {
-      if (!is.null(private$connection)) {
-        DatabaseConnector::disconnect(private$connection)
+      if (!is.null(private$.connection)) {
+        DatabaseConnector::disconnect(private$.connection)
       }
-      private$cdm <- NULL
+      private$.cdm <- NULL
+    },
+
+    checkCohortTable = function() {
+      switch(
+        private$.type,
+        CDMConnector = private$cdmconCheckCohortTable(andromeda),
+        DatabaseConnector = private$dbconCheckCohortTable(andromeda)
+      )
     }
   ),
   private = list(
     ## Private ----
     ### Fields ----
-    connectionDetails = NULL,
-    connection = NULL,
-    cdmSchema = NULL,
-    resultSchema = NULL,
-    tempEmulationSchema = NULL,
-    cdm = NULL,
-    type = "",
+    .connectionDetails = NULL,
+    .connection = NULL,
+    .cdmSchema = NULL,
+    .resultSchema = NULL,
+    .tempEmulationSchema = NULL,
+    .cdm = NULL,
+    .type = "",
 
     ### Methods ----
     finalize = function() {
@@ -149,33 +111,29 @@ CDMInterface <- R6::R6Class(
     # cohortIds (`integer(n)`)
     # cohortTableName (`character(1)`)
     dbconFetchCohortTable = function(cohorts, cohortTableName, andromeda, andromedaTableName, minEraDuration) {
-      targetCohortId <- cohorts %>%
-        dplyr::filter(.data$type == "target") %>%
-        dplyr::select("cohortId") %>%
-        dplyr::pull()
+      targetCohortId <- getCohortIds(cohorts, "target")
 
       # Select relevant data
       sql <- SqlRender::loadRenderTranslateSql(
         sqlFilename = "selectData.sql",
         packageName = "TreatmentPatterns",
-        dbms = private$connection@dbms,
-        tempEmulationSchema = private$tempEmulationSchema,
-        resultSchema = private$resultSchema,
-        cdmSchema = private$cdmSchema,
+        dbms = private$.connection@dbms,
+        tempEmulationSchema = private$.tempEmulationSchema,
+        resultSchema = private$.resultSchema,
+        cdmSchema = private$.cdmSchema,
         cohortTable = cohortTableName,
         cohortIds = cohorts$cohortId,
         minEraDuration = minEraDuration,
         targetCohortId = targetCohortId
       )
 
       DatabaseConnector::querySqlToAndromeda(
-        connection = private$connection,
+        connection = private$.connection,
         sql = sql,
         andromeda = andromeda,
         andromedaTableName = andromedaTableName
       )
-
-      return(invisible(self))
+      return(andromeda)
     },
 
     dbconFetchMetadata = function(andromeda) {
@@ -188,16 +146,16 @@ CDMInterface <- R6::R6Class(
           vocabulary_version
         FROM @cdmSchema.cdm_source
       ;",
-        cdmSchema = private$cdmSchema
+        cdmSchema = private$.cdmSchema
       )
 
       translatedSql <- SqlRender::translate(
         sql = renderedSql,
-        targetDialect = private$connection@dbms
+        targetDialect = private$.connection@dbms
       )
 
       andromeda$metadata <- DatabaseConnector::querySql(
-        connection = private$connection,
+        connection = private$.connection,
         sql = translatedSql,
         snakeCaseToCamelCase = TRUE) %>%
         dplyr::mutate(
@@ -207,7 +165,7 @@ CDMInterface <- R6::R6Class(
           platform = base::version$platform
         )
 
-      return(invisible(self))
+      return(andromeda)
     },
 
     #### CDMConnector ----
@@ -223,20 +181,18 @@ CDMInterface <- R6::R6Class(
 
       cohortIds <- cohorts$cohortId
 
-      andromeda[[andromedaTableName]] <- private$cdm[[cohortTableName]] %>%
+      andromeda[[andromedaTableName]] <- private$.cdm[[cohortTableName]] %>%
         dplyr::filter(.data$cohort_definition_id %in% cohortIds) %>%
         dplyr::filter(!!CDMConnector::datediff("cohort_start_date", "cohort_end_date") >= minEraDuration) %>%
-        #dplyr::filter(.data$cohort_end_date - .data$cohort_start_date >= 0) %>%
         dplyr::group_by(.data$subject_id) %>%
         dplyr::filter(any(.data$cohort_definition_id %in% targetCohortIds, na.rm = TRUE)) %>%
         dplyr::ungroup() %>%
         dplyr::inner_join(
-          private$cdm$person,
+          private$.cdm$person,
           by = dplyr::join_by(subject_id == person_id)) %>%
         dplyr::inner_join(
-          private$cdm$concept,
+          private$.cdm$concept,
           by = dplyr::join_by(gender_concept_id == concept_id)) %>%
-        #dplyr::filter(!!CDMConnector::datediff("cohort_start_date", "cohort_end_date") >= minEraDuration) %>%
         dplyr::mutate(date_of_birth = as.Date(paste0(as.integer(year_of_birth), "-01-01"))) %>%
         dplyr::mutate(age = !!CDMConnector::datediff("date_of_birth", "cohort_start_date", interval = "year")) %>%
         dplyr::rename(sex = "concept_name") %>%
@@ -247,12 +203,12 @@ CDMInterface <- R6::R6Class(
           "cohort_end_date",
           "age",
           "sex")
-      return(invisible(self))
+      return(andromeda)
     },
 
     # andromeda (`Andromeda::andromeda()`)
     cdmconFetchMetadata = function(andromeda) {
-      andromeda$metadata <- private$cdm$cdm_source %>%
+      andromeda$metadata <- private$.cdm$cdm_source %>%
         dplyr::select(
           "cdm_source_name",
           "cdm_source_abbreviation",
@@ -267,7 +223,18 @@ CDMInterface <- R6::R6Class(
           rVersion = base::version$version.string,
           platform = base::version$platform
         )
-      return(invisible(self))
+      return(andromeda)
     }
+  ),
+
+  # Active ----
+  active = list(
+    connectionDetails = function() return(private$.connectionDetails),
+    connection = function() return(private$.connection),
+    cdmSchema = function() return(private$.cdmSchema),
+    resultSchema = function() return(private$.resultSchema),
+    tempEmulationSchema = function() return(private$.tempEmulationSchema),
+    cdm = function() return(private$.cdm),
+    type = function() return(private$.type)
   )
 )

R/CharacterizationPlots.R

@@ -1,12 +1,14 @@
 #' @title CharacterizationPlots
 #' 
+#' @include ShinyModule.R
+#' 
 #' @description
 #' Class to handle the characterization plots.
 #' 
 #' @export
 CharacterizationPlots <- R6::R6Class(
   classname = "CharacterizationPlots",
-  inherit = Module,
+  inherit = ShinyModule,
 
   # Public ----
   public = list(