Merge pull request #278 from OHDSI/character_settings

Update generateSequenceCohortSet.R
OHDSI · Nov 8, 2024 · ebd3ced · ebd3ced
2 parents 9465951 + 5109fa0
commit ebd3ced
Show file tree

Hide file tree

Showing 11 changed files with 47 additions and 106 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -51,7 +51,6 @@ Imports:
     CDMConnector (>= 1.3.0),
     dplyr,
     ggplot2,
-    magrittr,
     PatientProfiles,
     rlang,
     stringr,

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,6 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
-export("%>%")
 export(generateSequenceCohortSet)
 export(mockCohortSymmetry)
 export(plotSequenceRatios)
@@ -9,7 +8,7 @@ export(summariseSequenceRatios)
 export(summariseTemporalSymmetry)
 export(tableSequenceRatios)
 export(tableSequenceRatiosOptions)
-importFrom(magrittr,"%>%")
+importFrom(dplyr,"%>%")
 importFrom(rlang,":=")
 importFrom(rlang,.data)
 importFrom(rlang,.env)
diff --git a/R/CohortSymmetry-package.R b/R/CohortSymmetry-package.R
@@ -2,6 +2,7 @@
 "_PACKAGE"
 
 ## usethis namespace: start
+#' @importFrom dplyr %>%
 #' @importFrom rlang .data
 #' @importFrom rlang .env
 #' @importFrom rlang :=

diff --git a/R/generateSequenceCohortSet.R b/R/generateSequenceCohortSet.R
@@ -50,11 +50,11 @@ generateSequenceCohortSet <- function(cdm,
                               cohortDateRange = as.Date(c(NA, NA)),
                               daysPriorObservation = 0,
                               washoutWindow = 0,
-                              indexMarkerGap = NULL,
+                              indexMarkerGap = Inf,
                               combinationWindow = c(0,365),
                               movingAverageRestriction = 548){
   ### checks
-  checkInputgenerateSequenceCohortSet(
+  checkInputGenerateSequenceCohortSet(
     cdm = cdm,
     indexTable = indexTable,
     markerTable = markerTable,
@@ -77,31 +77,6 @@ generateSequenceCohortSet <- function(cdm,
     )
   }
 
-  cohort_date_range_1 <- cohortDateRange[[1]]
-  cohort_date_range_2 <- cohortDateRange[[2]]
-
-  comb_export_1 <- as.character(combinationWindow[[1]])
-  comb_export_2 <- as.character(combinationWindow[[2]])
-
-  combination_window <- combinationWindow
-
-  if(!is.finite(combination_window[2])){
-    combination_window[2] <- as.integer(99999)
-  }
-
-  moving_average_restriction <- movingAverageRestriction
-
-  if(!is.finite(moving_average_restriction)){
-    moving_average_restriction <- as.integer(99999)
-  }
-
-  index_marker_gap <- indexMarkerGap
-
-  if (is.null(index_marker_gap)) {
-    index_marker_gap <- combination_window[2]
-    indexMarkerGap <- combinationWindow[2]
-  }
-
   ### nsr
   nsr_name <- omopgenerics::uniqueId()
   nsr_summary_name <- paste0(nsr_name, "_summary")
@@ -192,11 +167,17 @@ generateSequenceCohortSet <- function(cdm,
           )
         ) |>
         dplyr::select("cohort_start_date", "index_n", "marker_n") |>
-        dplyr::collect() |>
-        dplyr::mutate(
-          marker_forward = deltaCumulativeSum(.data$marker_n, .data$cohort_start_date, moving_average_restriction, backwards = F),
-          marker_backward = deltaCumulativeSum(.data$marker_n, .data$cohort_start_date, moving_average_restriction, backwards = T)
-        ) |>
+        dplyr::collect() %>%
+        {if (is.infinite(movingAverageRestriction))
+          dplyr::mutate(.,
+            marker_forward = deltaCumulativeSum(.data$marker_n, .data$cohort_start_date, 99999, backwards = F),
+            marker_backward = deltaCumulativeSum(.data$marker_n, .data$cohort_start_date, 99999, backwards = T)
+          ) else
+          dplyr::mutate(.,
+            marker_forward = deltaCumulativeSum(.data$marker_n, .data$cohort_start_date, movingAverageRestriction, backwards = F),
+            marker_backward = deltaCumulativeSum(.data$marker_n, .data$cohort_start_date, movingAverageRestriction, backwards = T)
+          )
+        } |>
         dplyr::mutate(im_forward = .data$index_n * .data$marker_forward,
                       im_backward = .data$index_n * .data$marker_backward)
 
@@ -230,9 +211,6 @@ generateSequenceCohortSet <- function(cdm,
                   "marker_end_date" = "cohort_end_date",
                   "gap_to_prior_marker" = "gap_to_prior")
 
-  time_1 <- combination_window[1]
-  time_2 <- combination_window[2]
-
   joinedData <- indexPreprocessed |>
     dplyr::inner_join(
       markerPreprocessed,
@@ -313,14 +291,14 @@ generateSequenceCohortSet <- function(cdm,
     dplyr::group_by(.data$cohort_definition_id, .data$cohort_name, .data$index_id,
                     .data$index_name, .data$marker_id, .data$marker_name) |>
     dplyr::distinct() |>
-    dplyr::mutate(cohort_date_range = paste0("(",.env$cohort_date_range_1, ",",
-                                             .env$cohort_date_range_2, ")"),
-                  days_prior_observation = .env$daysPriorObservation,
-                  washout_window = .env$washoutWindow,
-                  index_marker_gap = .env$indexMarkerGap,
-                  combination_window = paste0("(",.env$comb_export_1, ",",
-                                              .env$comb_export_2, ")"),
-                  moving_average_restriction = .env$movingAverageRestriction) |>
+    dplyr::mutate(cohort_date_range = !!paste0("(",cohortDateRange[[1]], ",",
+                                             cohortDateRange[[2]], ")"),
+                  days_prior_observation = !!daysPriorObservation,
+                  washout_window = !!format(washoutWindow, nsmall = 0),
+                  index_marker_gap = !!format(indexMarkerGap, nsmall = 0),
+                  combination_window = !!paste0("(",combinationWindow[[1]], ",",
+                                                combinationWindow[[2]], ")"),
+                  moving_average_restriction = !!format(movingAverageRestriction, nsmall = 0)) |>
     dplyr::left_join(nsr_tbl,
                      by = c("index_id", "marker_id"),
                      copy = T)
@@ -345,17 +323,29 @@ generateSequenceCohortSet <- function(cdm,
 
     ### exclusion criteria - where attrition starts
     # 1) within combination window
-    cdm[[name]] <- cdm[[name]] |>
-      dplyr::filter(abs(.data$gap) > .env$time_1 &
-                      abs(.data$gap) <= .env$time_2) |>
+    cdm[[name]] <- cdm[[name]] %>%
+      {if (is.infinite(combinationWindow[2]))
+        dplyr::filter(.,
+                      abs(.data$gap) > !!combinationWindow[1])
+        else
+        dplyr::filter(.,
+                      abs(.data$gap) > !!combinationWindow[1] &
+                      abs(.data$gap) <= !!combinationWindow[2])
+        } |>
       dplyr::compute(name = name, temporary = FALSE) |>
       omopgenerics::recordCohortAttrition(reason="Events excluded due to the prespecified combination window")
 
     # 2) indexMarkerGap
-    cdm[[name]] <- cdm[[name]] |>
-      dplyr::filter(.data$cei <= .env$index_marker_gap) |>
-      dplyr::compute(name = name, temporary = FALSE) |>
-      omopgenerics::recordCohortAttrition(reason="Events excluded due to the prespecified index marker gap")
+    if(is.infinite(indexMarkerGap)){
+      cdm[[name]] <- cdm[[name]] |>
+        dplyr::compute(name = name, temporary = FALSE) |>
+        omopgenerics::recordCohortAttrition(reason="Events excluded due to the prespecified index marker gap")
+    } else {
+      cdm[[name]] <- cdm[[name]] |>
+        dplyr::filter(.data$cei <= .env$indexMarkerGap) |>
+        dplyr::compute(name = name, temporary = FALSE) |>
+        omopgenerics::recordCohortAttrition(reason="Events excluded due to the prespecified index marker gap")
+    }
 
     # 3) days prior observation
     cdm[[name]] <- cdm[[name]] |>

diff --git a/R/inputValidation.R b/R/inputValidation.R
@@ -1,4 +1,4 @@
-checkInputgenerateSequenceCohortSet <- function(cdm,
+checkInputGenerateSequenceCohortSet <- function(cdm,
                                         indexTable,
                                         markerTable,
                                         name,
@@ -263,9 +263,6 @@ checkIndexMarkerGap <- function(indexMarkerGap, combinationWindow, errorMessage)
         lower = 0, any.missing = FALSE, max.len = 4, add = errorMessage
       )
     }
-    if (indexMarkerGap > combinationWindow[2]) {
-      errorMessage$push("indexMarkerGap cannot be bigger than the second element of combinationWindow.")
-    }
   }
 }
 

diff --git a/R/utils-pipe.R b/R/utils-pipe.R
diff --git a/man/generateSequenceCohortSet.Rd b/man/generateSequenceCohortSet.Rd
diff --git a/man/pipe.Rd b/man/pipe.Rd
diff --git a/tests/testthat/test-generateSequenceCohortSet.R b/tests/testthat/test-generateSequenceCohortSet.R
@@ -939,17 +939,6 @@ test_that("generateSequenceCohortSet - inputValidation", {
       combinationWindow = c(0, Inf)
     )
   )
-  expect_error(
-    generateSequenceCohortSet(
-      cdm = cdm,
-      name = "joined_cohorts",
-      indexTable = "cohort_1",
-      markerTable = "cohort_2",
-      cohortDateRange = as.Date(c("2002-01-01", NA)),
-      indexMarkerGap = 41,
-      combinationWindow = c(0, 40)
-    )
-  )
   expect_error(
     generateSequenceCohortSet(
       cdm = cdm,

diff --git a/tests/testthat/test-summariseSequenceRatios.R b/tests/testthat/test-summariseSequenceRatios.R
@@ -119,7 +119,7 @@ test_that("summariseSequenceRatios - testing ratios and CIs, Example 1", {
   expect_true(all(res$days_prior_observation==0))
   expect_true(all(res$washout_window==0))
   expect_true(all(res$combination_window == "(0,365)"))
-  expect_true(all(res$index_marker_gap==365))
+  expect_true(all(res$index_marker_gap=="Inf"))
   expect_true(all(res$confidence_interval==95))
   expect_true(all(as.integer(res$first_pharmac_index_percentage)<=100 & 0 <= as.integer(res$first_pharmac_index_percentage)))
 
@@ -184,7 +184,7 @@ test_that("summariseSequenceRatios - testing ratios and CIs, Example 2", {
   expect_true(all(res$days_prior_observation==0))
   expect_true(all(res$washout_window==0))
   expect_true(all(res$combination_window == "(0,365)"))
-  expect_true(all(res$index_marker_gap==365))
+  expect_true(all(res$index_marker_gap=="Inf"))
   expect_true(all(res$confidence_interval==95))
   expect_true((res$index_cohort_name=="cohort_1"))
   expect_true((res$marker_cohort_name=="cohort_3"))

diff --git a/vignettes/a02_Generate_a_sequence_cohort.Rmd b/vignettes/a02_Generate_a_sequence_cohort.Rmd
@@ -94,7 +94,7 @@ cdm <- generateSequenceCohortSet(
   cohortDateRange = as.Date(c(NA, NA)), #default
   daysPriorObservation = 0, #default
   washoutWindow = 0, #default
-  indexMarkerGap = NULL, #default
+  indexMarkerGap = Inf, #default
   combinationWindow = c(0,Inf)) # default
 
 cdm$intersect |>