Merge pull request #28 from oxford-pharmacoepi/dev_eb

updates
OHDSI · Dec 27, 2023 · d4abf0c · d4abf0c
2 parents f3233f3 + 6a5688b
commit d4abf0c
Show file tree

Hide file tree

Showing 28 changed files with 400 additions and 62 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,14 +1,19 @@
 Package: CohortConstructor
-Title: Generate Cohorts of Individuals in the OMOP Common Data Model
+Title: Work With Cohorts Using a Common Data Model
 Version: 0.0.1
 Authors@R: c(
+    person("Edward", "Burn", , "[email protected]", 
+    role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9286-1128")),
     person("Marti", "Catala", , "[email protected]", 
     role = c("aut"), comment = c(ORCID = "0000-0003-3308-9905")),
-    person("Edward", "Burn", , "[email protected]", 
-    role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9286-1128"))
+    person("Marta", "Alcalde", , "[email protected]", 
+    role = c("aut"), comment = c(ORCID = "0000-0000-0000-0000")),
+    person("Yuchen", "Guo", email = "[email protected]", 
+    role = c("aut"), comment = c(ORCID = "0000-0002-0847-4855"))
     )
-Description: This package aims to provide functionalities to create cohorts in
-    the OMOP Common Data Model.
+Description: This package aims to provide functionalities to manipulate
+    and evaluate cohorts in data mapped to the Observational Medical 
+    Outcomes Partnership Common Data Model.
 License: Apache License (>= 2)
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,6 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
-export(generateCombinationCohortSet)
+export(generateIntersectCohortSet)
 export(generateMatchedCohortSet)
 export(getIdentifier)
 export(joinOverlap)

diff --git a/R/generateCombinationCohorts.R → R/generateIntersectCohorts.R b/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,
@@ -178,7 +178,7 @@ generateCombinationCohortSet <- function(cdm,
 #' @export
 #'
 #' @return Table in the cdm with start, end and by as columns. Periods are not
-#' going to overlpa between each other.
+#' going to overlap between each other.
 #'
 splitOverlap <- function(x,
                          start = "cohort_start_date",
@@ -244,7 +244,7 @@ splitOverlap <- function(x,
 #' @export
 #'
 #' @return Table in the cdm with start, end and by as columns. Periods are not
-#' going to overlpa between each other.
+#' going to overlap between each other.
 #'
 joinOverlap <- function(x,
                         start = "cohort_start_date",
@@ -302,7 +302,7 @@ joinOverlap <- function(x,
     CDMConnector::computeQuery()
 }
 
-#' Get ramdon identifies not present in a table based on a prefix.
+#' Get random identifiers not present in a table based on a prefix.
 #'
 #' @param x Table.
 #' @param len Number of identifiers.

diff --git a/R/generateUnionCohortSet.R b/R/generateUnionCohortSet.R
@@ -0,0 +1,4 @@
+
+generateUnionCohortSet <- function(){
+
+}
diff --git a/R/requireCohortIntersectFlag.R b/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,

diff --git a/R/requireDateRange.R b/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,

diff --git a/R/requireDemographics.R b/R/requireDemographics.R
@@ -8,15 +8,25 @@
 #' @param ageRange A list of minimum and maximum age
 #' @param sex Can be "Both", "Male" or "Female". If one of the latter, only
 #' those with that sex will be included.
-#' @param minPriorObservation A mimimum number of prior observation days in
+#' @param minPriorObservation A minimum number of prior observation days in
 #' the database.
 #' @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(
@@ -124,13 +147,20 @@ requireSex <- function(cohort,
 #' @param cohort A cohort table in a cdm reference
 #' @param indexDate Variable in cohort that contains the date to compute the
 #' demographics characteristics on which to restrict on.
-#' @param minPriorObservation A mimimum number of prior observation days in
+#' @param minPriorObservation A minimum 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) {

diff --git a/R/restrictToFirstEntry.R b/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)
 

diff --git a/README.Rmd b/README.Rmd
@@ -16,8 +16,6 @@ knitr::opts_chunk$set(
 # CohortConstructor
 
 <!-- badges: start -->
-[![CRAN status](https://www.r-pkg.org/badges/version/CohortConstructor)](https://CRAN.R-project.org/package=CohortConstructor)
-[![codecov.io](https://codecov.io/github/oxford-pharmacoepi/CohortConstructor/coverage.svg?branch=main)](https://app.codecov.io/github/oxford-pharmacoepi/CohortConstructor?branch=main)
 [![R-CMD-check](https://github.com/oxford-pharmacoepi/CohortConstructor/workflows/R-CMD-check/badge.svg)](https://github.com/oxford-pharmacoepi/CohortConstructor/actions)
 [![Lifecycle:Experimental](https://img.shields.io/badge/Lifecycle-Experimental-339999)](https://lifecycle.r-lib.org/articles/stages.html#experimental)
 <!-- badges: end -->
@@ -130,7 +128,7 @@ Both diclofenac and acetaminophen
 Generate a combination cohort.
 
 ```{r}
-cdm <- generateCombinationCohortSet(cdm = cdm, 
+cdm <- generateIntersectCohortSet(cdm = cdm, 
                                     name = "combinations", 
                                     targetCohortName = "medications")
 

diff --git a/README.md b/README.md
@@ -5,9 +5,6 @@
 
 <!-- badges: start -->
 
-[![CRAN
-status](https://www.r-pkg.org/badges/version/CohortConstructor)](https://CRAN.R-project.org/package=CohortConstructor)
-[![codecov.io](https://codecov.io/github/oxford-pharmacoepi/CohortConstructor/coverage.svg?branch=main)](https://app.codecov.io/github/oxford-pharmacoepi/CohortConstructor?branch=main)
 [![R-CMD-check](https://github.com/oxford-pharmacoepi/CohortConstructor/workflows/R-CMD-check/badge.svg)](https://github.com/oxford-pharmacoepi/CohortConstructor/actions)
 [![Lifecycle:Experimental](https://img.shields.io/badge/Lifecycle-Experimental-339999)](https://lifecycle.r-lib.org/articles/stages.html#experimental)
 <!-- badges: end -->
@@ -214,7 +211,7 @@ Both diclofenac and acetaminophen
 Generate a combination cohort.
 
 ``` r
-cdm <- generateCombinationCohortSet(cdm = cdm, 
+cdm <- generateIntersectCohortSet(cdm = cdm, 
                                     name = "combinations", 
                                     targetCohortName = "medications")
 

diff --git a/inst/WORDLIST b/inst/WORDLIST
@@ -0,0 +1,17 @@
+CDMConnector
+CMD
+DrugUtilisation
+Eunomia
+Lifecycle
+OMOP
+ORCID
+cdm
+codecov
+diclofenac
+generateDrugUtilisationCohortSet
+indexDate
+individuals’
+io
+matchSex
+matchYearOfBirth
+overlaping
diff --git a/man/CohortConstructor-package.Rd b/man/CohortConstructor-package.Rd