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

rc <- 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.4
+Version: 2.6.5-3
 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")))
@@ -19,10 +19,7 @@ Imports:
     checkmate,
     dplyr,
     stringr,
-    stringi,
     utils,
-    rjson,
-    googleVis,
     stats,
     Andromeda,
     tidyr,

NAMESPACE

@@ -21,11 +21,8 @@ import(shinydashboard)
 import(stringr)
 import(sunburstR)
 import(utils)
-importFrom(googleVis,gvisSankey)
 importFrom(htmlwidgets,JS)
 importFrom(networkD3,sankeyNetwork)
-importFrom(rjson,toJSON)
 importFrom(stats,median)
 importFrom(stats,sd)
-importFrom(stringi,stri_replace_all_fixed)
 importFrom(tidyr,pivot_wider)

NEWS.md

@@ -1,3 +1,13 @@
+# TreatmentPatterns 2.6.5
+---------
+* Removed stringi, rjson, and googleVis as dependencies.
+* Fixed unit tests that had dummy data outside of observation data.
+* Fix for complex edge-case paths with re-occuring treatments.
+* Added unit tests for edge-cases.
+* Added warning when `minEraDuration` > `minPostCombinationWindow` or `combinationWindow`.
+* Fixed issue when `filterTreatments` was set to `"changes"`, age and sex columns were dropped from output.
+* datatypes of cohort_table are now checked.
+
 # TreatmentPatterns 2.6.4
 ---------
 * Fixed issue with minPostCombinationWindow broken by the fix for re-occurring treatments.

R/R6-CDMInterface.R

@@ -225,7 +225,8 @@ CDMInterface <- R6::R6Class(
 
       andromeda[[andromedaTableName]] <- private$cdm[[cohortTableName]] %>%
         dplyr::filter(.data$cohort_definition_id %in% cohortIds) %>%
-        dplyr::filter(.data$cohort_end_date - .data$cohort_start_date >= 0) %>%
+        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() %>%
@@ -235,7 +236,7 @@ CDMInterface <- R6::R6Class(
         dplyr::inner_join(
           private$cdm$concept,
           by = dplyr::join_by(gender_concept_id == concept_id)) %>%
-        dplyr::filter(!!CDMConnector::datediff("cohort_start_date", "cohort_end_date") >= minEraDuration) %>%
+        #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") %>%

R/R6-PathwayConstructor.R

@@ -52,6 +52,14 @@ PathwayConstructor <- R6::R6Class(
     validate = function() {
       private$cdmInterface$validate()
 
+      if (private$settings$minEraDuration > private$settings$minPostCombinationDuration) {
+        warning("The `minPostCombinationDuration` is set lower than the `minEraDuration`, this might result in unexpected behavior")
+      }
+
+      if (private$settings$minEraDuration > private$settings$combinationWindow) {
+        warning("The `combinationWindow` is set lower than the `minEraDuration`, this might result in unexpected behavior")
+      }
+
       errorMessages <- checkmate::makeAssertCollection()
 
       checkmate::assertCharacter(
@@ -193,6 +201,8 @@ PathwayConstructor <- R6::R6Class(
         minEraDuration = private$settings$minEraDuration
       )
 
+      private$checkCohortTable()
+
       private$andromeda$cohortTable <- private$andromeda$cohortTable %>%
         dplyr::rename(
           cohortId = "cohort_definition_id",
@@ -283,6 +293,20 @@ PathwayConstructor <- R6::R6Class(
       minPostCombinationDuration = 30,
       filterTreatments = "First",
       maxPathLength = 5
-    )
+    ),
+
+    ## Methods ----
+    checkCohortTable = function() {
+      cohortTableHead <- private$andromeda[["cohortTable"]] %>%
+        head() %>%
+        dplyr::collect()
+
+      assertions <- checkmate::makeAssertCollection()
+      checkmate::assertIntegerish(cohortTableHead$cohort_definition_id, add = assertions)
+      checkmate::assertIntegerish(cohortTableHead$subject_id, add = assertions)
+      checkmate::assertDate(cohortTableHead$cohort_start_date, add = assertions)
+      checkmate::assertDate(cohortTableHead$cohort_end_date, add = assertions)
+      checkmate::reportAssertions(assertions)
+    }
   )
 )

R/TreatmentPatterns-package.R

@@ -15,9 +15,6 @@
 #' @importFrom htmlwidgets JS
 #' @importFrom stats sd median
 #' @importFrom tidyr pivot_wider
-#' @importFrom googleVis gvisSankey
-#' @importFrom rjson toJSON
-#' @importFrom stringi stri_replace_all_fixed
 ## usethis namespace: end
 NULL
 

R/constructPathways.R

@@ -567,10 +567,11 @@ doCombinationWindow <- function(
       dplyr::union_all(andromeda[[sprintf("addRowsFRFS_%s", iterations)]]) %>%
       dplyr::union_all(andromeda[[sprintf("addRowsLRFS_%s", iterations)]]) %>%
       dplyr::mutate(durationEra = .data$eventEndDate - .data$eventStartDate)
-    
+
     treatmentHistory <- treatmentHistory %>%
       #dplyr::filter(.data$eventStartDate != .data$eventEndDate)
       # Original from mi-erasmus and older versions of DARWIN TreatmentPatterns
+      #dbplyr::window_order(.data$sortOrder) %>%
       dplyr::filter(.data$durationEra >= minPostCombinationDuration | is.na(.data$durationEra))
 
     andromeda$treatmentHistory <- treatmentHistory %>%
@@ -718,7 +719,7 @@ doFilterTreatments <- function(andromeda, filterTreatments) {
 
     # Remove all rows with same sequential treatments
     andromeda$treatmentHistory <- andromeda$treatmentHistory %>%
-      dplyr::group_by(.data$personId, .data$indexYear, .data$eventCohortId, .data$group) %>%
+      dplyr::group_by(.data$personId, .data$age, .data$sex, .data$indexYear, .data$eventCohortId, .data$group, .data$sortOrder) %>%
       dplyr::summarise(
         eventStartDate = min(.data$eventStartDate, na.rm = TRUE),
         eventEndDate = max(.data$eventEndDate, na.rm = TRUE),

R/export.R

@@ -87,7 +87,7 @@ export <- function(andromeda, outputPath, ageWindow = 10, minCellCount = 5, cens
   if (!dir.exists(outputPath)) {
     dir.create(outputPath)
   }
-  
+
   treatmentHistory <- andromeda$treatmentHistory %>%
     dplyr::collect() %>%
     dplyr::select(
@@ -369,6 +369,7 @@ computeTreatmentPathways <- function(treatmentHistory, ageWindow, minCellCount,
 
 collapsePaths <- function(treatmentHistory) {
   treatmentHistory %>%
+    dplyr::arrange(.data$eventSeq) %>%
     dplyr::group_by(.data$personId, .data$indexYear) %>%
     dplyr::mutate(
       pathway = list(.data$eventCohortName[.data$eventSeq]),

tests/testthat/test-CDMInterface.R

@@ -0,0 +1,68 @@
+library(testthat)
+library(TreatmentPatterns)
+library(dplyr)
+
+test_that("fetchCohortTable", {
+  skip_on_ci()
+  skip_on_cran()
+  cg <- generateCohortTableCG()
+  cdmc <- generateCohortTableCDMC()
+
+  aCG <- Andromeda::andromeda()
+  aCDMC <- Andromeda::andromeda()
+
+  dbcInterface <- TreatmentPatterns:::CDMInterface$new(
+    connectionDetails = cg$connectionDetails,
+    cdmSchema = "main",
+    resultSchema = "main"
+  )
+
+  cdmcInterface <- TreatmentPatterns:::CDMInterface$new(
+    cdm = cdmc$cdm
+  )
+
+  minEraDuration <- 120
+
+  dbcInterface$fetchCohortTable(
+    cohorts = cg$cohorts,
+    cohortTableName = cg$cohortTableName,
+    andromeda = aCG,
+    andromedaTableName = cg$cohortTableName,
+    minEraDuration = minEraDuration
+  )
+
+  cdmcInterface$fetchCohortTable(
+    cohorts = cdmc$cohorts,
+    cohortTableName = cdmc$cohortTableName,
+    andromeda = aCDMC,
+    andromedaTableName = cdmc$cohortTableName,
+    minEraDuration = minEraDuration
+  )
+
+  # Check nRows
+  expect_identical(
+    aCG$cohort_table %>% collect() %>% nrow(),
+    aCDMC$cohort_table %>% collect() %>% nrow()
+  )
+
+  # check n > 1 treatments
+  expect_identical(
+    aCG$cohort_table %>% group_by(.data$subject_id) %>%
+      summarize(n = n()) %>% filter(n > 1) %>% collect(),
+    aCDMC$cohort_table %>% group_by(.data$subject_id) %>%
+      summarize(n = n()) %>% filter(n > 1) %>% collect()
+  )
+
+  # check n == 1 treatments
+  expect_identical(
+    aCG$cohort_table %>% group_by(.data$subject_id) %>%
+      summarize(n = n()) %>% filter(n == 1) %>% collect(),
+    aCDMC$cohort_table %>% group_by(.data$subject_id) %>%
+      summarize(n = n()) %>% filter(n == 1) %>% collect()
+  )
+
+  dbcInterface$disconnect()
+  Andromeda::close(aCG)
+  Andromeda::close(aCDMC)
+  DBI::dbDisconnect(cdmc$con, shutdown = TRUE)
+})

tests/testthat/test-PathwayConstructor.R

@@ -1,5 +1,6 @@
 library(testthat)
 library(TreatmentPatterns)
+library(CDMConnector)
 
 test_that("new", {
   skip_on_cran()
@@ -48,11 +49,19 @@ test_that("editSettings", {
 
   before <- pathwayConstructor$getSettings()
 
-  pathwayConstructor$editSettings(minEraDuration = 100)
+  pathwayConstructor$editSettings(minEraDuration = 25)
 
   after <- pathwayConstructor$getSettings()
 
   expect_false(identical(before, after))
+
+  expect_warning(
+    pathwayConstructor$editSettings(minEraDuration = 10, minPostCombinationDuration = 5)
+  )
+
+  expect_warning(
+    pathwayConstructor$editSettings(minEraDuration = 10, combinationWindow = 5)
+  )
 })
 
 test_that("getAndromeda", {
@@ -90,3 +99,44 @@ test_that("construct", {
 
   expect_true(Andromeda::isAndromeda(res))
 })
+
+test_that("datatypes", {
+  con <- DBI::dbConnect(duckdb::duckdb(), dbdir = eunomia_dir())
+
+  cohorts <- data.frame(
+    cohortId = c(1, 2, 3),
+    cohortName = c("X", "A", "B"),
+    type = c("target", "event", "event")
+  )
+
+  cohort_table <- dplyr::tribble(
+    ~cohort_definition_id, ~subject_id, ~cohort_start_date,    ~cohort_end_date,
+    1,                     5,           as.POSIXct("2014-01-01"), as.POSIXct("2015-01-01"),
+    2,                     5,           as.POSIXct("2014-01-03"), as.POSIXct("2014-03-02"),
+    3,                     5,           as.POSIXct("2014-03-10"), as.POSIXct("2014-05-10"),
+    2,                     5,           as.POSIXct("2014-05-12"), as.POSIXct("2014-07-12"),
+    3,                     5,           as.POSIXct("2014-07-14"), as.POSIXct("2014-09-14")
+  )
+
+  copy_to(con, cohort_table, overwrite = TRUE)
+
+  cdm <- cdmFromCon(con, cdmSchema = "main", writeSchema = "main", cohortTables = "cohort_table")
+
+  expect_error(
+    TreatmentPatterns::computePathways(
+      cohorts = cohorts,
+      cohortTableName = "cohort_table",
+      cdm = cdm,
+      includeTreatments = "startDate",
+      periodPriorToIndex = 0,
+      minEraDuration = 0,
+      eraCollapseSize = 5,
+      combinationWindow = 30,
+      minPostCombinationDuration = 30,
+      filterTreatments = "All",
+      maxPathLength = 5
+    )
+  )
+
+  DBI::dbDisconnect(con)
+})