Merge pull request #17 from oxford-pharmacoepi/mike_dev

restrict

NAMESPACE

@@ -9,6 +9,7 @@ export(requireDemographics)
 export(requireFutureObservation)
 export(requirePriorObservation)
 export(requireSex)
+export(restrictToFirstEntry)
 export(splitOverlap)
 importFrom(magrittr,"%>%")
 importFrom(rlang,":=")

R/restrictToFirstEntry.R

@@ -0,0 +1,40 @@
+#' Restrict cohort to first entry by index date
+#'
+#' @param cohort A cohort table in a cdm reference
+#' @param indexDate indexDate Variable in cohort that contains the date to
+#' restrict on
+#' @return a cohort table in a cdm reference
+#' @export
+#'
+#'
+restrictToFirstEntry <- function(cohort,
+                                 indexDate = "cohort_start_date"){
+
+  cdm <- attr(cohort, "cdm_reference")
+  #validate input
+  if (!isTRUE(inherits(cdm, "cdm_reference"))) {
+    cli::cli_abort("cohort must be part of a cdm reference")
+  }
+
+  if(!"GeneratedCohortSet" %in% class(cohort) ||
+     !all(c("cohort_definition_id", "subject_id",
+            "cohort_start_date", "cohort_end_date") %in%
+          colnames(cohort))){
+    cli::cli_abort("cohort must be a GeneratedCohortSet")
+  }
+
+  if(!indexDate %in% colnames(cohort)){
+    cli::cli_abort("indexDate must be a date column in the cohort table")
+  }
+
+  #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")
+
+  return(cohort)
+
+}

tests/testthat/test-restrictToFirstEntry.R

@@ -0,0 +1,28 @@
+test_that("test restrict to first entry works", {
+
+  cohort1 <- dplyr::tibble(cohort_definition_id = c(1,1,1,1),
+                           subject_id = c(1,1,2,2),
+                           cohort_start_date = as.Date(c("2020-09-21","2020-09-20","2020-09-21","2020-09-20")),
+                           cohort_end_date = as.Date(c("2021-09-21","2021-09-20","2021-09-21","2021-09-20")))
+
+  cohort2 <- dplyr::tibble(cohort_definition_id = c(1,1,2,2),
+                           subject_id = c(1,1,1,1),
+                           cohort_start_date = as.Date(c("2020-09-21","2020-09-20","2020-09-21","2020-09-20")),
+                           cohort_end_date = as.Date(c("2021-09-21","2021-09-20","2021-09-21","2021-09-20")))
+
+  cdm <- DrugUtilisation::mockDrugUtilisation(cohort1 = cohort1, cohort2 = cohort2)
+
+  expect_true(all(cdm$cohort1 |> CohortConstructor::restrictToFirstEntry() |>
+    dplyr::pull(cohort_start_date) == c("2020-09-20", "2020-09-20")))
+
+  expect_true(all(cdm$cohort1 |> CohortConstructor::restrictToFirstEntry() |>
+                    dplyr::pull(subject_id) %in% c(1,2)))
+
+  expect_true(all(cdm$cohort2 |> CohortConstructor::restrictToFirstEntry() |>
+                    dplyr::pull(cohort_start_date) == c("2020-09-20", "2020-09-20")))
+
+  expect_true(all(cdm$cohort2 |> CohortConstructor::restrictToFirstEntry() |>
+                    dplyr::pull(subject_id) == c(1,1)))
+
+
+})