Skip to content

Commit

Permalink
Merge pull request #412 from OHDSI/inObservation-param
Browse files Browse the repository at this point in the history 
Add `inObservation` argument in `requireConceptIntersect`
  • Loading branch information
@edward-burn
edward-burn authored Dec 20, 2024
2 parents 21088e6 + eb80694 commit 7837abc
Show file tree
Hide file tree
Showing 6 changed files with 83 additions and 64 deletions.
1 change: 0 additions & 1 deletion CohortConstructor.Rproj
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
Version: 1.0
ProjectId: 27e959ec-87b2-4ff1-ac1d-3ea886296a0d

RestoreWorkspace: No
SaveWorkspace: No
Expand Down
2 changes: 1 addition & 1 deletion R/requireCohortIntersect.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
#'
Expand Down
4 changes: 4 additions & 0 deletions R/requireConceptIntersect.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -82,6 +85,7 @@ requireConceptIntersect <- function(cohort,
targetEndDate = targetEndDate,
window = window,
censorDate = censorDate,
inObservation = inObservation,
nameStyle = "intersect_concept",
name = subsetName
)
Expand Down
2 changes: 1 addition & 1 deletion man/requireCohortIntersect.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

4 changes: 4 additions & 0 deletions man/requireConceptIntersect.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

134 changes: 73 additions & 61 deletions tests/testthat/test-requireConceptIntersect.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,17 +38,28 @@ 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",
"Initial qualifying events",
"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() ==
Expand Down Expand Up @@ -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",
Expand Down Expand Up @@ -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(),
Expand Down Expand Up @@ -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)

Expand Down

0 comments on commit 7837abc

Please sign in to comment.