From 7b74759f54dffb821063b0a1c7bdc2862a8eb774 Mon Sep 17 00:00:00 2001 From: Marta Alcalde-Herraiz Date: Tue, 5 Dec 2023 17:48:19 +0000 Subject: [PATCH 1/2] add test to check that ratio > 1 works --- .../testthat/test-generateMatchedCohortSet.R | 93 ++++++++++++------- 1 file changed, 61 insertions(+), 32 deletions(-) diff --git a/tests/testthat/test-generateMatchedCohortSet.R b/tests/testthat/test-generateMatchedCohortSet.R index a7fa3070..0b0c58ec 100644 --- a/tests/testthat/test-generateMatchedCohortSet.R +++ b/tests/testthat/test-generateMatchedCohortSet.R @@ -237,37 +237,66 @@ test_that("test exactMatchingCohort with a ratio bigger than 1", { test_that("test exactMatchingCohort with a ratio bigger than 1", { # Generate mock data - # cdm[["person"]] <- tibble::tibble("person_id" ) - # # Generate mock data - # cdm[["person"]] <- tibble::tibble("person_id" = c(1,2)) - # cdm <- DrugUtilisation::generateConceptCohortSet( - # cdm = DrugUtilisation::mockDrugUtilisation(numberIndividuals = 1000), - # conceptSet = list(c1 = 317009, c2 = 432526), - # name = "cases", - # end = "observation_period_end_date", - # requiredObservation = c(followback,followback), - # overwrite = TRUE - # ) - # - # - # - # expect_no_error( - # a <- generateMatchedCohortSet(cdm, - # name = "new_cohort", - # targetCohortName = "cases", - # targetCohortId = NULL, - # matchSex = TRUE, - # matchYearOfBirth = TRUE, - # ratio = 5) - # ) + cdmMock <- DrugUtilisation::mockDrugUtilisation( + numberIndividuals = 10, + person = tibble::tibble("person_id" = seq(1,10,1), + "gender_concept_id" = rep(8532,10), + "year_of_birth" = rep(1980, 10), + "day_of_birth" = rep(1, 10), + "birth_date_time" = rep(as.Date(1980,04,01),10), + "month_of_birth" = rep(4, 10)), + condition_occurrence = tibble::tibble("condition_ocurrence_id" = seq(1,10,1), + "person_id" = seq(1,10,1), + "condition_concept_id" = c(317009,317009,4266367,4266367,rep(1,6)), + "condition_start_date" = as.Date(c("2017-10-30","2003-01-04","2014-12-15","2010-09-09","2004-08-26","1985-03-31","1985-03-13","1985-07-11","1983-11-07","2020-01-13")), + "condition_end_date" = as.Date(c("2017-11-01","2003-01-05","2014-12-16","2010-09-10","2004-08-27","1985-04-01","1985-03-14","1985-07-12","1983-11-08","2020-01-14")), + "condition_type_concept_id" = rep(32020,10)), + observation_period = tibble::tibble("observation_period_id" = seq(1,10,1), + "person_id" = seq(1,10,1), + "observation_period_start_date" = as.Date(rep("1984-01-01",10)), + "observation_period_end_date" = as.Date(rep("2021-01-01",10)), + "period_type_concept_id" = 44814724) + ) + + cdm <- DrugUtilisation::generateConceptCohortSet( + cdm = cdmMock, + conceptSet = list(c1 = 317009, c2 = 4266367), + name = "cases", + end = "observation_period_end_date", + requiredObservation = c(0,0), + overwrite = TRUE + ) + + a <- generateMatchedCohortSet(cdm, + name = "new_cohort", + targetCohortName = "cases", + targetCohortId = NULL, + matchSex = TRUE, + matchYearOfBirth = TRUE, + ratio = 4) + + expect_true(a[["new_cohort"]] %>% + dplyr::filter(cohort_definition_id %in% c(1,3)) %>% + dplyr::summarise(subject_id) %>% + dplyr::distinct() %>% dplyr::pull() %>% length() == 10) + expect_true(a[["new_cohort"]] %>% + dplyr::filter(cohort_definition_id %in% c(2,4)) %>% + dplyr::summarise(subject_id) %>% + dplyr::distinct() %>% dplyr::pull() %>% length() == 10) + expect_true(a[["new_cohort"]] %>% + dplyr::filter(cohort_definition_id %in% c(1,3)) %>% + dplyr::summarise(cohort_start_date) %>% + dplyr::distinct() %>% dplyr::pull() %>% length() == 2) + expect_true(a[["new_cohort"]] %>% + dplyr::filter(cohort_definition_id %in% c(2,4)) %>% + dplyr::summarise(cohort_start_date) %>% + dplyr::distinct() %>% dplyr::pull() %>% length() == 2) + + + outc <- a[["new_cohort"]] %>% + dplyr::filter(subject_id == 5) %>% dplyr::summarise(cohort_start_date) %>% dplyr::pull() %in% c("2017-10-30","2003-01-04","2014-12-15","2010-09-09") + expect_true(unique(outc) == TRUE) + }) -# -# -# a[["new_cohort"]] %>% -# dplyr::inner_join(a[["person"]] %>% -# dplyr::select("subject_id" = "person_id", "gender_concept_id", "year_of_birth"), -# by = "subject_id") %>% -# dplyr::filter(cohort_definition_id %in% c(1,3)) %>% -# dplyr::group_by(gender_concept_id, year_of_birth) %>% -# dplyr::mutate(n = dplyr::row_number()) %>% print(n = 100) + From 073ce0cdb5bdb2b8cef023a45c78831ead3346f4 Mon Sep 17 00:00:00 2001 From: Marta Alcalde-Herraiz Date: Tue, 5 Dec 2023 17:52:27 +0000 Subject: [PATCH 2/2] add tibble as a sugested package --- DESCRIPTION | 3 ++- tests/testthat/test-generateMatchedCohortSet.R | 1 - 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c046c00e..c2a5fc72 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -28,6 +28,7 @@ Suggests: DBI, DrugUtilisation, duckdb, - testthat (>= 3.0.0) + testthat (>= 3.0.0), + tibble Config/testthat/edition: 3 Config/testthat/parallel: true diff --git a/tests/testthat/test-generateMatchedCohortSet.R b/tests/testthat/test-generateMatchedCohortSet.R index 0b0c58ec..868fad9b 100644 --- a/tests/testthat/test-generateMatchedCohortSet.R +++ b/tests/testthat/test-generateMatchedCohortSet.R @@ -296,7 +296,6 @@ test_that("test exactMatchingCohort with a ratio bigger than 1", { outc <- a[["new_cohort"]] %>% dplyr::filter(subject_id == 5) %>% dplyr::summarise(cohort_start_date) %>% dplyr::pull() %in% c("2017-10-30","2003-01-04","2014-12-15","2010-09-09") expect_true(unique(outc) == TRUE) - })