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

Dev
darwin-eu-dev · Jan 26, 2024 · a9c6b88 · a9c6b88
2 parents 1f932d9 + 23dbdf8
commit a9c6b88
Show file tree

Hide file tree

Showing 3 changed files with 124 additions and 28 deletions.
diff --git a/R/constructPathways.R b/R/constructPathways.R
@@ -300,7 +300,6 @@ doSplitEventCohorts <- function(
   return(invisible(NULL))
 }
 
-
 #' doEraCollapse
 #'
 #' Updates the treatmentHistory data.frame where if gapSame is smaller than the
@@ -361,7 +360,7 @@ doEraCollapse <- function(andromeda, eraCollapseSize) {
         eventEndDate = if_else(
           is.null(.data$newEndDate), 
           .data$eventEndDate, 
-          .data$newEndDate)) %>% filter(is.na(needsMerge))%>%
+          .data$newEndDate)) %>%
       dplyr::filter(is.na(.data$needsMerge)) %>%
       dplyr::select(-"newEndDate", -"needsMerge", -"rowNumber") %>%
       dplyr::mutate(durationEra = .data$eventEndDate - .data$eventStartDate)
@@ -465,11 +464,11 @@ doCombinationWindow <- function(
     ))
 
     sumSwitchComb <- andromeda$treatmentHistory %>%
-      filter(
+      dplyr::filter(
         .data$switch == 1 |
           .data$combinationFRFS == 1 |
           .data$combinationLRFS == 1) %>%
-      summarise(n()) %>%
+      dplyr::summarise(dplyr::n()) %>%
       pull()
 
     sumSelectedRows <- andromeda$treatmentHistory %>%
@@ -570,9 +569,9 @@ doCombinationWindow <- function(
       dplyr::mutate(durationEra = .data$eventEndDate - .data$eventStartDate)
 
     treatmentHistory <- treatmentHistory %>%
-      filter(.data$eventStartDate != .data$eventEndDate)
+      #dplyr::filter(.data$eventStartDate != .data$eventEndDate)
       # Original from mi-erasmus and older versions of DARWIN TreatmentPatterns
-      #dplyr::filter(.data$durationEra >= minPostCombinationDuration | is.na(.data$durationEra))
+      dplyr::filter(.data$durationEra >= minPostCombinationDuration | is.na(.data$durationEra))
 
     andromeda$treatmentHistory <- treatmentHistory %>%
       dplyr::select(

diff --git a/tests/testthat/test-computePathways.R b/tests/testthat/test-computePathways.R
@@ -3,6 +3,7 @@ library(testthat)
 library(TreatmentPatterns)
 library(dplyr)
 library(stringr)
+library(CDMConnector)
 
 test_that("computePathways DatabaseConnector", {
   testthat::skip_on_cran()
@@ -20,9 +21,9 @@ test_that("computePathways DatabaseConnector", {
           cdmSchema = "main",
           resultSchema = "main"
         ),
-        "After maxPathLength: 6675"
+        "After maxPathLength: 554"
       ),
-      "After combinationWindow: 6682"
+      "After combinationWindow: 555"
     ),
     "Original number of rows: 8352"
   )
@@ -40,9 +41,9 @@ test_that("computePathways CDMConnector", {
           cohorts = globals$cohorts,
           cohortTableName = globals$cohortTableName
         ),
-        "After maxPathLength: 6675"
+        "After maxPathLength: 554"
       ),
-      "After combinationWindow: 6682"
+      "After combinationWindow: 555"
     ),
     "Original number of rows: 8352"
   )
@@ -66,7 +67,7 @@ test_that("nrow exitCohorts > 0", {
       cohorts = cohorts,
       cohortTableName = globals$cohortTableName
     ),
-    "After maxPathLength: 6919"
+    "After maxPathLength: 2117"
   )
 })
 
@@ -248,21 +249,117 @@ test_that("combinationWindow", {
   )
 })
 
-test_that("minPostCombinationDuration", {
-  skip_on_cran()
-  globals <- generateCohortTableCDMC()
+test_that("minPostCombinationDuration: 30", {
+  con <- DBI::dbConnect(duckdb::duckdb(), dbdir = eunomia_dir())
 
-  expect_error(
-    computePathways(
-      cohorts = globals$cohorts,
-      cohortTableName = globals$cohortTableName,
-      cdm = globals$cdm,
-      minPostCombinationDuration = "Stuff"
-    ),
-    "Must be of.+type.+"
+  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,                     1,           as.Date("2020-01-01"), as.Date("2023-01-01"),
+    2,                     1,           as.Date("2020-01-01"), as.Date("2020-03-01"),
+    3,                     1,           as.Date("2020-01-10"), as.Date("2020-03-15")
+  )
+
+  copy_to(con, cohort_table, overwrite = TRUE)
+
+  cdm <- cdmFromCon(con, cdmSchema = "main", writeSchema = "main", cohortTables = "cohort_table")
+
+  ## 30 ----
+  andromeda <- TreatmentPatterns::computePathways(
+    cohorts = cohorts,
+    cohortTableName = "cohort_table",
+    cdm = cdm,
+    includeTreatments = "startDate",
+    periodPriorToIndex = 0,
+    minEraDuration = 0,
+    eraCollapseSize = 3,
+    combinationWindow = 30,
+    minPostCombinationDuration = 30,
+    filterTreatments = "All",
+    maxPathLength = 5
+  )
+
+  tempDir <- tempdir()
+  TreatmentPatterns::export(andromeda, tempDir, minCellCount = 1)
+
+  treatmentPaths <- read.csv(file.path(tempDir, "treatmentPathways.csv"))
+
+  path <- treatmentPaths %>%
+    dplyr::filter(
+      .data$age == "all",
+      .data$sex == "all",
+      .data$indexYear == "all") %>%
+    dplyr::pull(.data$path)
+
+  expect_identical(path, "A+B")
+
+  ## 12 ----
+  andromeda <- TreatmentPatterns::computePathways(
+    cohorts = cohorts,
+    cohortTableName = "cohort_table",
+    cdm = cdm,
+    includeTreatments = "startDate",
+    periodPriorToIndex = 0,
+    minEraDuration = 0,
+    eraCollapseSize = 3,
+    combinationWindow = 30,
+    minPostCombinationDuration = 12,
+    filterTreatments = "All",
+    maxPathLength = 5
+  )
+
+  tempDir <- tempdir()
+  TreatmentPatterns::export(andromeda, tempDir, minCellCount = 1)
+
+  treatmentPaths <- read.csv(file.path(tempDir, "treatmentPathways.csv"))
+
+  path <- treatmentPaths %>%
+    dplyr::filter(
+      .data$age == "all",
+      .data$sex == "all",
+      .data$indexYear == "all") %>%
+    dplyr::pull(.data$path)
+
+  expect_identical(path, "A+B-B")
+
+
+  ## 8 ----
+  andromeda <- TreatmentPatterns::computePathways(
+    cohorts = cohorts,
+    cohortTableName = "cohort_table",
+    cdm = cdm,
+    includeTreatments = "startDate",
+    periodPriorToIndex = 0,
+    minEraDuration = 0,
+    eraCollapseSize = 3,
+    combinationWindow = 30,
+    minPostCombinationDuration = 8,
+    filterTreatments = "All",
+    maxPathLength = 5
+  )
+
+  tempDir <- tempdir()
+  TreatmentPatterns::export(andromeda, tempDir, minCellCount = 1)
+
+  treatmentPaths <- read.csv(file.path(tempDir, "treatmentPathways.csv"))
+
+  path <- treatmentPaths %>%
+    dplyr::filter(
+      .data$age == "all",
+      .data$sex == "all",
+      .data$indexYear == "all") %>%
+    dplyr::pull(.data$path)
+
+  expect_identical(path, "A-A+B-B")
+
+  DBI::dbDisconnect(con)
 })
-
+p
 test_that("filterTreatments", {
   skip_on_cran()
   globals <- generateCohortTableCDMC()

diff --git a/tests/testthat/test-export.R b/tests/testthat/test-export.R
@@ -223,7 +223,7 @@ test_that("censorType", {
 
   ## "remove" ----
   expect_message(
-    export(
+    TreatmentPatterns::export(
       andromeda = andromeda,
       outputPath = tempDirLocal,
       minCellCount = 10,
@@ -238,7 +238,7 @@ test_that("censorType", {
 
   ## "minCellCount" ----
   expect_message(
-    export(
+    TreatmentPatterns::export(
       andromeda = andromeda,
       outputPath = tempDirLocal,
       minCellCount = 10,
@@ -253,7 +253,7 @@ test_that("censorType", {
 
   ## "mean" ----
   expect_message(
-    export(
+    TreatmentPatterns::export(
       andromeda = andromeda,
       outputPath = tempDirLocal,
       minCellCount = 10,
@@ -264,7 +264,7 @@ test_that("censorType", {
 
   treatmentPathways <- read.csv(file.path(tempDirLocal, "treatmentPathways.csv"))
 
-  expect_equal(min(treatmentPathways$freq), 1)
+  expect_equal(min(treatmentPathways$freq), 2)
 
   ## "stuff" ----
   expect_error(
@@ -506,7 +506,7 @@ test_that("censorType", {
 
   treatmentPathways <- read.csv(file.path(tempDirLocal, "treatmentPathways.csv"))
 
-  expect_equal(min(treatmentPathways$freq), 1)
+  expect_equal(min(treatmentPathways$freq), 2)
 
   ## "stuff" ----
   expect_error(