Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add inObservation argument in requireConceptIntersect #412

Merged
merged 2 commits into from
Dec 20, 2024
Merged

Add inObservation argument in requireConceptIntersect #412

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
0f455ab
add inObservation argument
nmercadeb Dec 19, 2024
eb80694
Merge branch 'main' into inObservation-param
edward-burn Dec 20, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion CohortConstructor.Rproj
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop

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
Open in desktop

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
Open in desktop
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
Loading