updates

Author: edward-burn

NAMESPACE

@@ -1,6 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
-export(generateCombinationCohortSet)
+export(generateIntersectCohortSet)
 export(generateMatchedCohortSet)
 export(getIdentifier)
 export(joinOverlap)

R/generateCombinationCohorts.R R/generateIntersectCohorts.R

@@ -20,7 +20,7 @@
 #'
 #' cdm <- mockPatientProfiles()
 #'
-#' cdm <- generateCombinationCohortSet(
+#' cdm <- generateIntersectCohortSet(
 #'   cdm = cdm,
 #'   name = "cohort3",
 #'   targetCohortName = "cohort2"
@@ -32,7 +32,7 @@
 #'
 #' }
 
-generateCombinationCohortSet <- function(cdm,
+generateIntersectCohortSet <- function(cdm,
                                          name,
                                          targetCohortName,
                                          targetCohortId = NULL,

R/generateUnionCohortSet.R

@@ -0,0 +1,4 @@
+
+generateUnionCohortSet <- function(){
+
+}

R/requireCohortIntersectFlag.R

@@ -11,19 +11,30 @@
 #' (in overlap) or on its own (for incidence)
 #' @param targetEndDate date of reference in cohort table, either for end
 #' (overlap) or NULL (if incidence)
-#' @param window window to consider events of
+#' @param window window to consider events over
+#' @param negate If set as TRUE, criteria will be applied as exclusion
+#' rather than inclusion (i.e. require absence in another cohort)
 #'
 #' @return Cohort table with only those in the other cohort kept
 #' @export
 #'
 #' @examples
+#' library(DrugUtilisation)
+#' library(CohortConstructor)
+#' cdm <- mockDrugUtilisation(numberIndividuals = 100)
+#' cdm$cohort1 %>%
+#'   requireCohortIntersectFlag(targetCohortTable = "cohort2",
+#'                              targetCohortId = 1,
+#'                              indexDate = "cohort_start_date",
+#'                              window = c(-Inf, 0))
 requireCohortIntersectFlag <- function(x,
                                        targetCohortTable,
                                        targetCohortId = NULL,
                                        indexDate = "cohort_start_date",
                                        targetStartDate = "cohort_start_date",
                                        targetEndDate = "cohort_end_date",
-                                       window = list(c(0, Inf))){
+                                       window = list(c(0, Inf)),
+                                       negate = FALSE){
 
 cols <- unique(c("cohort_definition_id", "subject_id",
           "cohort_start_date", "cohort_end_date",
@@ -67,9 +78,19 @@ subsetCohort <- x %>%
     targetEndDate = targetEndDate,
     window = window,
     nameStyle = "intersect_cohort"
-  ) %>%
-  dplyr::filter(.data$intersect_cohort == 1) %>%
-  dplyr::select(!"intersect_cohort")
+  )
+
+if(isFALSE(negate)){
+  subsetCohort <- subsetCohort %>%
+    dplyr::filter(.data$intersect_cohort == 1) %>%
+    dplyr::select(!"intersect_cohort")
+} else {
+  # ie require absence instead of presence
+  subsetCohort <- subsetCohort %>%
+    dplyr::filter(.data$intersect_cohort != 1) %>%
+    dplyr::select(!"intersect_cohort")
+}
+
 
 x %>%
   dplyr::inner_join(subsetCohort,

R/requireDateRange.R

@@ -10,6 +10,12 @@
 #' @export
 #'
 #' @examples
+#' library(DrugUtilisation)
+#' library(CohortConstructor)
+#' cdm <- mockDrugUtilisation(numberIndividuals = 100)
+#' cdm$cohort1 %>%
+#'   requireInDateRange(indexDate = "cohort_start_date",
+#'                      dateRange = as.Date(c("2010-01-01", "2019-01-01")))
 requireInDateRange <- function(cohort,
                              indexDate = "cohort_start_date",
                              dateRange = as.Date(c(NA, NA))) {
@@ -38,10 +44,20 @@ requireInDateRange <- function(cohort,
 #' @param dateRange A window of time during which the index date must have
 #' been observed
 #'
-#' @return
+#' @return The cohort table with record timings updated to only be within the
+#' date range. Any records with all time outside of the range will have
+#' been dropped.
 #' @export
 #'
 #' @examples
+#' library(DrugUtilisation)
+#' library(CohortConstructor)
+#' cdm <- mockDrugUtilisation(numberIndividuals = 100)
+#' cdm$cohort1 %>%
+#'   trimToDateRange(startDate = "cohort_start_date",
+#'                   endDate = "cohort_end_date",
+#'                   dateRange = as.Date(c("2015-01-01",
+#'                                         "2015-12-31")))
 trimToDateRange <- function(cohort,
                             startDate = "cohort_start_date",
                             endDate = "cohort_end_date",
@@ -93,6 +109,8 @@ trimToDateRange <- function(cohort,
       endDate,
       " <= ", dateRange[2]
     ))
+
+  cohort
 }
 
 trimStartDate <- function(cohort,

R/requireDemographics.R

@@ -13,10 +13,20 @@
 #' @param minFutureObservation A minimum number of future observation days in
 #' the database.
 #'
-#' @return
+#' @return The cohort table with only records for individuals satisfying the
+#' demographic requirements
 #' @export
 #'
 #' @examples
+#' library(DrugUtilisation)
+#' library(CohortConstructor)
+#' cdm <- mockDrugUtilisation(numberIndividuals = 100)
+#' cdm$cohort1 %>%
+#'   requireDemographics(indexDate = "cohort_start_date",
+#'                       ageRange = list(c(18, 65)),
+#'                       sex = "Female",
+#'                       minPriorObservation = 365)
+#'
 requireDemographics <- function(cohort,
                                 indexDate = "cohort_start_date",
                                 ageRange = list(c(0, 150)),
@@ -63,10 +73,17 @@ requireDemographics <- function(cohort,
 #' demographics characteristics on which to restrict on.
 #' @param ageRange A list of minimum and maximum age
 #'
-#' @return
+#' @return The cohort table with only records for individuals satisfying the
+#' age requirement
 #' @export
 #'
 #' @examples
+#' library(DrugUtilisation)
+#' library(CohortConstructor)
+#' cdm <- mockDrugUtilisation(numberIndividuals = 100)
+#' cdm$cohort1 %>%
+#'   requireAge(indexDate = "cohort_start_date",
+#'              ageRange = list(c(18, 65)))
 requireAge <- function(cohort,
                        indexDate = "cohort_start_date",
                        ageRange = list(c(0, 150))) {
@@ -94,10 +111,16 @@ requireAge <- function(cohort,
 #' @param sex Can be "Both", "Male" or "Female". If one of the latter, only
 #' those with that sex will be included.
 #'
-#' @return
+#' @return The cohort table with only records for individuals satisfying the
+#' sex requirement
 #' @export
 #'
 #' @examples
+#' library(DrugUtilisation)
+#' library(CohortConstructor)
+#' cdm <- mockDrugUtilisation(numberIndividuals = 100)
+#' cdm$cohort1 %>%
+#'   requireSex(sex = "Female")
 requireSex <- function(cohort,
                        sex = c("Both")) {
   cohort <- demographicsFilter(
@@ -127,10 +150,17 @@ requireSex <- function(cohort,
 #' @param minPriorObservation A mimimum number of prior observation days in
 #' the database.
 #'
-#' @return
+#' @return The cohort table with only records for individuals satisfying the
+#' prior observation requirement
 #' @export
 #'
 #' @examples
+#' library(DrugUtilisation)
+#' library(CohortConstructor)
+#' cdm <- mockDrugUtilisation(numberIndividuals = 100)
+#' cdm$cohort1 %>%
+#'   requirePriorObservation(indexDate = "cohort_start_date",
+#'                           minPriorObservation = 365)
 requirePriorObservation <- function(cohort,
                                     indexDate = "cohort_start_date",
                                     minPriorObservation = 0) {
@@ -160,10 +190,18 @@ requirePriorObservation <- function(cohort,
 #' @param minFutureObservation A minimum number of future observation days in
 #' the database.
 #'
-#' @return
+#' @return The cohort table with only records for individuals satisfying the
+#' future observation requirement
+#'
 #' @export
 #'
 #' @examples
+#' library(DrugUtilisation)
+#' library(CohortConstructor)
+#' cdm <- mockDrugUtilisation(numberIndividuals = 100)
+#' cdm$cohort1 %>%
+#'   requireFutureObservation(indexDate = "cohort_start_date",
+#'                            minFutureObservation = 30)
 requireFutureObservation <- function(cohort,
                                      indexDate = "cohort_start_date",
                                      minFutureObservation = 0) {

R/restrictToFirstEntry.R

@@ -30,10 +30,11 @@ restrictToFirstEntry <- function(cohort,
   #restrict to first entry
   indexDateSym <- rlang::sym(indexDate)
 
-  cohort <- cohort |> dplyr::group_by(.data$subject_id,.data$cohort_definition_id) |>
-    dplyr::filter(!!indexDateSym == min(!!indexDateSym, na.rm = TRUE)) |>
-    dplyr::ungroup() |>
-    CDMConnector::recordCohortAttrition("restrict to first entry")
+  cohort <- cohort %>%
+    dplyr::group_by(.data$subject_id,.data$cohort_definition_id) %>%
+    dplyr::filter(!!indexDateSym == min(!!indexDateSym, na.rm = TRUE)) %>%
+    dplyr::ungroup() %>%
+    CDMConnector::recordCohortAttrition("Restricted to first entry")
 
   return(cohort)
 

README.Rmd

@@ -130,7 +130,7 @@ Both diclofenac and acetaminophen
 Generate a combination cohort.
 
 ```{r}
-cdm <- generateCombinationCohortSet(cdm = cdm, 
+cdm <- generateIntersectCohortSet(cdm = cdm, 
                                     name = "combinations", 
                                     targetCohortName = "medications")
 

man/generateCombinationCohortSet.Rd man/generateIntersectCohortSet.Rd

@@ -123,7 +123,7 @@ test_that("splitOverlap", {
   DBI::dbDisconnect(db, shutdown = TRUE)
 })
 
-test_that("generateCombinationCohortSet", {
+test_that("generateIntersectCohortSet", {
   cohort <- dplyr::tibble(
     cohort_definition_id = c(1, 2, 3, 1, 2, 3, 1, 2),
     subject_id = c(1, 1, 1, 2, 3, 3, 4, 4),
@@ -154,7 +154,7 @@ test_that("generateCombinationCohortSet", {
   )
 
   # mutually exclusive
-  expect_no_error(cdm <- generateCombinationCohortSet(
+  expect_no_error(cdm <- generateIntersectCohortSet(
     cdm = cdm, name = "cohort2", targetCohortName = "cohort1",
     mutuallyExclusive = TRUE
   ))
@@ -167,7 +167,7 @@ test_that("generateCombinationCohortSet", {
   ))
 
   # not mutually exclusive
-  expect_no_error(cdm <- generateCombinationCohortSet(
+  expect_no_error(cdm <- generateIntersectCohortSet(
     cdm = cdm, name = "cohort3", targetCohortName = "cohort1",
     mutuallyExclusive = FALSE
   ))
@@ -180,7 +180,7 @@ test_that("generateCombinationCohortSet", {
   ))
 
   # not enough cohorts provided
-  expect_warning(cdm <- generateCombinationCohortSet(
+  expect_warning(cdm <- generateIntersectCohortSet(
     cdm = cdm, name = "cohort4", targetCohortName = "cohort1",
     targetCohortId = 1
   ))
@@ -219,7 +219,7 @@ test_that("only return comb", {
     observation_period = observation_period, person = person, cohort1 = cohort
   )
 
-  cdm <- generateCombinationCohortSet(
+  cdm <- generateIntersectCohortSet(
     cdm = cdm, name = "cohort2", targetCohortName = "cohort1",
     mutuallyExclusive = FALSE, returnOnlyComb = TRUE
   )

man/getIdentifier.Rd

@@ -0,0 +1,3 @@
+test_that("multiplication works", {
+  expect_equal(2 * 2, 4)
+})

man/joinOverlap.Rd

@@ -54,4 +54,29 @@ test_that("requiring presence in another cohort", {
 
   })
 
+test_that("requiring absence in another cohort", {
 
+cdm <- PatientProfiles::mockPatientProfiles(patient_size = 100,
+                                              drug_exposure_size = 100)
+
+cdm$cohort3_inclusion <-  requireCohortIntersectFlag(x = cdm$cohort1,
+                                             targetCohortTable = "cohort2",
+                                             targetCohortId = 1,
+                                             window = c(-Inf, Inf))
+cdm$cohort3_exclusion <-  requireCohortIntersectFlag(x = cdm$cohort1,
+                                                     targetCohortTable = "cohort2",
+                                                     targetCohortId = 1,
+                                                     window = c(-Inf, Inf),
+                                                     negate = TRUE)
+
+in_both <- intersect(cdm$cohort3_inclusion %>%
+  dplyr::pull("subject_id") %>%
+  unique(),
+  cdm$cohort3_exclusion %>%
+  dplyr::pull("subject_id") %>%
+  unique())
+expect_true(length(in_both) == 0)
+
+CDMConnector::cdm_disconnect(cdm)
+
+})

man/requireAge.Rd

@@ -1,5 +1,5 @@
 ---
-title: "a02_applying_cohort_restrictions"
+title: "Applying cohort restrictions"
 output: rmarkdown::html_vignette
 vignette: >
   %\VignetteIndexEntry{a02_applying_cohort_restrictions}
@@ -9,11 +9,108 @@ vignette: >
 
 ```{r, include = FALSE}
 knitr::opts_chunk$set(
-  collapse = TRUE,
+  collapse = TRUE, 
+  message = FALSE,
+  warning = FALSE,
   comment = "#>"
 )
 ```
 
-```{r setup}
+For this example we'll use the Eunomia synthetic data from the CDMConnector package.
+```{r}
+library(CDMConnector)
+library(DrugUtilisation)
 library(CohortConstructor)
+con <- DBI::dbConnect(duckdb::duckdb(), dbdir = eunomia_dir())
+cdm <- cdm_from_con(con, cdm_schema = "main", 
+                    write_schema = c(prefix = "my_study_", schema = "main"))
 ```
+
+Let's start by creating two drug cohorts, one for users of diclofenac and another for users of acetaminophen. We'll use the `generateDrugUtilisationCohortSet()` from the DrugUtilisation package so that we can specify a gap era when creating the cohort.
+```{r}
+cdm <- generateDrugUtilisationCohortSet(cdm = cdm,  
+                                        name = "medications",
+                                        conceptSet = list("diclofenac" = 1124300,
+                                                          "acetaminophen" = 1127433),
+                                        gapEra = 7)
+cohortCount(cdm$medications)
+```
+
+As well as our medication cohorts, let's also make another cohort containing individuals with a record of a GI bleed. For this cohort we can use `generateConceptCohortSet()` from the CDMConnector package. Later we'll use this cohort when specifying inclusion/ exclusion criteria.
+```{r}
+cdm <- generateConceptCohortSet(cdm = cdm,  
+                                   name = "gi_bleed", 
+                                   conceptSet = list("gi_bleed" = 192671))
+```
+
+## Keep only the first record per person
+Individuals can contribute multiple records per cohort. However now we'll keep only their earliest cohort entry of the remaining records using `restrictToFirstEntry()` from CohortConstructor. We can see that after this we have one record per person for each cohort.
+```{r}
+cdm$medications <- cdm$medications %>% 
+  restrictToFirstEntry(indexDate = "cohort_start_date")
+
+cohortCount(cdm$medications)
+```
+
+Note, applying this criteria later after applying other criteria would result in a different result. Here we're requiring that individuals meet inclusion criteria at the time of their first use of diclofenac or acetaminophen.
+
+## Applying restrictions on patient demographics
+Using `requireDemographics()` we'll require that individuals in our medications cohort are female and, relative to their cohort start date, are between 18 and 85 with at least 30 days of prior observation time in the database. 
+```{r}
+cdm$medications <- cdm$medications %>% 
+  requireDemographics(indexDate = "cohort_start_date", 
+                      ageRange = list(c(18, 85)),
+                      sex = "Female", 
+                      minPriorObservation = 30)
+```
+
+We can then see how many people have people have been excluded based on these demographic requirements.
+```{r}
+cohort_attrition(cdm$medications) %>% 
+  dplyr::filter(reason == "Demographic requirements") %>% 
+  dplyr::glimpse()
+```
+
+
+## Restrictions on calendar dates
+Next we can use `requireInDateRange()` to keep only those records where cohort entry was between a particular date range.
+```{r}
+cdm$medications <- cdm$medications %>% 
+  requireInDateRange(indexDate = "cohort_start_date", 
+                     dateRange = as.Date(c("2000-01-01", "2015-01-01")))
+```
+
+Again, we can track cohort attrition
+```{r}
+cohort_attrition(cdm$medications) %>% 
+  dplyr::filter(reason == "cohort_start_date between 2000-01-01 and 2015-01-01") %>% 
+  dplyr::glimpse()
+```
+
+
+## Restrictions on cohort presence
+We could require that individuals in our medication cohorts have a history of GI bleed. To do this we can use the `requireCohortIntersectFlag()` function.
+
+```{r}
+cdm$medications_gi_bleed <- cdm$medications  %>%
+  requireCohortIntersectFlag(targetCohortTable = "gi_bleed", 
+                             targetCohortId = 1,
+                             indexDate = "cohort_start_date", 
+                             window = c(-Inf, 0))
+cohort_count(cdm$medications_gi_bleed)
+```
+
+Instead of requiring that individuals have history of GI bleed, we could instead require that they are don't have any history of it. In this case we can again use the `requireCohortIntersectFlag()` function, but this time set the negate argument to FALSE to require individuals' absence in this other cohort rather than their presence in it.
+
+```{r}
+cdm$medications_no_gi_bleed <- cdm$medications %>%
+  requireCohortIntersectFlag(targetCohortTable = "gi_bleed", 
+                             targetCohortId = 1,
+                             indexDate = "cohort_start_date", 
+                             window = c(-Inf, 0), 
+                             negate = TRUE)
+cohort_count(cdm$medications_no_gi_bleed)
+```
+
+
+