diff --git a/CohortConstructor.Rproj b/CohortConstructor.Rproj index bb27d76..69fafd4 100644 --- a/CohortConstructor.Rproj +++ b/CohortConstructor.Rproj @@ -1,5 +1,4 @@ Version: 1.0 -ProjectId: 27e959ec-87b2-4ff1-ac1d-3ea886296a0d RestoreWorkspace: No SaveWorkspace: No diff --git a/R/requireCohortIntersect.R b/R/requireCohortIntersect.R index 510f20c..843d4f9 100644 --- a/R/requireCohortIntersect.R +++ b/R/requireCohortIntersect.R @@ -11,7 +11,7 @@ #' @inheritParams windowDoc #' @inheritParams nameDoc #' -#' @return Cohort table with only those isatisfying the criteria kept +#' @return Cohort table with only those entries satisfying the criteria #' #' @export #' diff --git a/R/requireConceptIntersect.R b/R/requireConceptIntersect.R index c01f6f1..7f1587e 100644 --- a/R/requireConceptIntersect.R +++ b/R/requireConceptIntersect.R @@ -11,6 +11,8 @@ #' @inheritParams windowDoc #' @inheritParams nameDoc #' @inheritParams conceptSetDoc +#' @param inObservation If TRUE only records inside an observation period will +#' be considered. #' #' @return Cohort table with only those with the events in the concept list #' kept (or those without the event if negate = TRUE) @@ -35,6 +37,7 @@ requireConceptIntersect <- function(cohort, indexDate = "cohort_start_date", targetStartDate = "event_start_date", targetEndDate = "event_end_date", + inObservation = TRUE, censorDate = NULL, name = tableName(cohort)) { # checks @@ -82,6 +85,7 @@ requireConceptIntersect <- function(cohort, targetEndDate = targetEndDate, window = window, censorDate = censorDate, + inObservation = inObservation, nameStyle = "intersect_concept", name = subsetName ) diff --git a/man/requireCohortIntersect.Rd b/man/requireCohortIntersect.Rd index 1a8298c..f3846e4 100644 --- a/man/requireCohortIntersect.Rd +++ b/man/requireCohortIntersect.Rd @@ -54,7 +54,7 @@ column date of the cohort.} \item{name}{Name of the new cohort table created in the cdm object.} } \value{ -Cohort table with only those isatisfying the criteria kept +Cohort table with only those entries satisfying the criteria } \description{ \code{requireCohortIntersect()} filters a cohort table based on a requirement diff --git a/man/requireConceptIntersect.Rd b/man/requireConceptIntersect.Rd index 0b46db8..aa47cb8 100644 --- a/man/requireConceptIntersect.Rd +++ b/man/requireConceptIntersect.Rd @@ -13,6 +13,7 @@ requireConceptIntersect( indexDate = "cohort_start_date", targetStartDate = "event_start_date", targetEndDate = "event_end_date", + inObservation = TRUE, censorDate = NULL, name = tableName(cohort) ) @@ -45,6 +46,9 @@ incidence of target event in the window will be considered as intersection, otherwise prevalence of that event will be used as intersection (overlap between cohort and event).} +\item{inObservation}{If TRUE only records inside an observation period will +be considered.} + \item{censorDate}{Whether to censor overlap events at a specific date or a column date of the cohort.} diff --git a/tests/testthat/test-requireConceptIntersect.R b/tests/testthat/test-requireConceptIntersect.R index 0266069..ca81ceb 100644 --- a/tests/testthat/test-requireConceptIntersect.R +++ b/tests/testthat/test-requireConceptIntersect.R @@ -38,6 +38,17 @@ test_that("require flag in concept", { expect_true(all(cdm$cohort3 |> dplyr::pull("cohort_start_date") |> sort() == c("2001-03-24", "2001-11-28", "2002-01-30", "2002-06-13", "2003-05-17", "2004-03-11"))) + cdm$in_obs <- requireConceptIntersect(cohort = cdm$cohort1, + conceptSet = list(a = 1L), + intersections = 2, + window = c(0, Inf), + inObservation = FALSE, + name = "in_obs") + expect_identical( + collectCohort(cdm$in_obs, 1), + dplyr::tibble(subject_id = 2L, cohort_start_date = as.Date("1999-05-03"), cohort_end_date = as.Date("2001-06-15")) + ) + expect_true(all(omopgenerics::attrition(cdm$cohort3)$reason == c("Initial qualifying events", "Concept a between -Inf & Inf days relative to cohort_start_date between 1 and Inf", @@ -45,10 +56,10 @@ test_that("require flag in concept", { "Concept a between -Inf & Inf days relative to cohort_start_date between 1 and Inf"))) # cohort Id cdm$cohort4 <- requireConceptIntersect(cohort = cdm$cohort1, - cohortId = 1, - conceptSet = list(a = 1L), - window = c(-Inf, Inf), - name = "cohort4") + cohortId = 1, + conceptSet = list(a = 1L), + window = c(-Inf, Inf), + name = "cohort4") expect_true(all(cdm$cohort4 |> dplyr::pull("subject_id") == c(rep(1, 6)))) expect_true(all(cdm$cohort4 |> dplyr::pull("cohort_start_date") |> sort() == @@ -83,8 +94,8 @@ test_that("require flag in concept", { # empty concept expect_message( cdm$cohort1 <- requireConceptIntersect(cohort = cdm$cohort1, - conceptSet = list(), - window = list(c(-Inf, Inf))) + conceptSet = list(), + window = list(c(-Inf, Inf))) ) expect_true(all(omopgenerics::attrition(cdm$cohort1)$reason == c("Initial qualifying events", @@ -139,14 +150,14 @@ test_that("requiring absence in another cohort", { cdm <- cdm_local |> copyCdm() cdm$cohort3_inclusion <- requireConceptIntersect(cohort = cdm$cohort1, - conceptSet = list(a = 1L), - window = c(-Inf, Inf), - name = "cohort3_inclusion") + conceptSet = list(a = 1L), + window = c(-Inf, Inf), + name = "cohort3_inclusion") cdm$cohort3_exclusion <- requireConceptIntersect(cohort = cdm$cohort1, - conceptSet = list(a = 1L), - window = c(-Inf, Inf), - intersections = 0, - name = "cohort3_exclusion") + conceptSet = list(a = 1L), + window = c(-Inf, Inf), + intersections = 0, + name = "cohort3_exclusion") in_both <- intersect(cdm$cohort3_inclusion |> dplyr::pull("subject_id") |> unique(), @@ -223,79 +234,80 @@ test_that("different intersection count requirements", { # no intersections - people not in cohort2 expect_identical(sort(cdm$cohort1 |> - requireConceptIntersect(intersections = c(0, 0), - conceptSet = list("a" = 1L), - window = c(-Inf, Inf), - name = "cohort1_test") |> - dplyr::pull("subject_id")), as.integer(c(4,5,6,7,8,9,10))) - + requireConceptIntersect(intersections = c(0, 0), + conceptSet = list("a" = 1), + window = c(-Inf, Inf), + name = "cohort1_test") |> + dplyr::pull("subject_id")), as.integer(c(4,5,6,7,8,9,10))) # only one intersection expect_identical(sort(cdm$cohort1 |> - requireConceptIntersect(intersections = c(1, 1), - conceptSet = list(a = 1L), - window = c(-Inf, Inf), - name = "cohort1_test") |> - dplyr::pull("subject_id")), c(1L)) + requireConceptIntersect(intersections = c(1, 1), + conceptSet = list("a" = 1), + window = c(-Inf, Inf), + name = "cohort1_test") |> + dplyr::pull("subject_id")), c(1L)) expect_identical(sort(cdm$cohort1 |> - requireConceptIntersect(intersections = c(1), - conceptSet = list(a = 1L), - window = c(-Inf, Inf), - name = "cohort1_test") |> - dplyr::pull("subject_id")), c(1L)) + requireConceptIntersect(intersections = c(1), + conceptSet = list("a" = 1), + window = c(-Inf, Inf), + name = "cohort1_test") |> + dplyr::pull("subject_id")), c(1L)) # 2 intersections expect_identical(sort(cdm$cohort1 |> - requireConceptIntersect(intersections = c(2, 2), - conceptSet = list(a = 1L), - window = c(-Inf, Inf), - name = "cohort1_test") |> - dplyr::pull("subject_id")), c(2L)) + requireConceptIntersect(intersections = c(2, 2), + conceptSet = list("a" = 1), + window = c(-Inf, Inf), + name = "cohort1_test") |> + dplyr::pull("subject_id")), c(2L)) expect_identical(sort(cdm$cohort1 |> - requireConceptIntersect(intersections = c(2), - conceptSet = list(a = 1L), - window = c(-Inf, Inf), - name = "cohort1_test") |> - dplyr::pull("subject_id")), c(2L)) + requireConceptIntersect(intersections = c(2), + conceptSet = list("a" = 1), + window = c(-Inf, Inf), + name = "cohort1_test") |> + dplyr::pull("subject_id")), c(2L)) + # 2 or more intersections expect_identical(sort(cdm$cohort1 |> - requireConceptIntersect(intersections = c(2, Inf), - conceptSet = list(a = 1L), - window = c(-Inf, Inf), - name = "cohort1_test") |> - dplyr::pull("subject_id")), c(2L, 3L)) + requireConceptIntersect(intersections = c(2, Inf), + conceptSet = list("a" = 1), + window = c(-Inf, Inf), + name = "cohort1_test") |> + dplyr::pull("subject_id")), c(2L, 3L)) # 2 or 3 intersections expect_identical(sort(cdm$cohort1 |> - requireConceptIntersect(intersections = c(2, 3), - conceptSet = list(a = 1L), - window = c(-Inf, Inf), - name = "cohort1_test") |> - dplyr::pull("subject_id")), c(2L, 3L)) + requireConceptIntersect(intersections = c(2, 3), + conceptSet = list("a" = 1), + window = c(-Inf, Inf), + name = "cohort1_test") |> + dplyr::pull("subject_id")), c(2L, 3L)) + # expected errors expect_error(requireConceptIntersect(cohort = cdm$cohort1, - intersections = c(-10, 10), - conceptSet = list(a = 1L), - window = c(-Inf, Inf))) + intersections = c(-10, 10), + conceptSet = list("a" = 1), + window = c(-Inf, Inf))) expect_error(requireConceptIntersect(cohort = cdm$cohort1, - intersections = c(11, 10), - conceptSet = list(a = 1L), - window = c(-Inf, Inf))) + intersections = c(11, 10), + conceptSet = list("a" = 1), + window = c(-Inf, Inf))) expect_error(requireConceptIntersect(cohort = cdm$cohort1, - intersections = c(Inf, Inf), - conceptSet = list(a = 1L), - window = c(-Inf, Inf))) + intersections = c(Inf, Inf), + conceptSet = list("a" = 1), + window = c(-Inf, Inf))) expect_error(requireConceptIntersect(cohort = cdm$cohort1, - intersections = c(1, 2, 3), - conceptSet = list(a = 1L), - window = c(-Inf, Inf))) + intersections = c(1, 2, 3), + conceptSet = list("a" = 1), + window = c(-Inf, Inf))) PatientProfiles::mockDisconnect(cdm)