Update generateMatchedCohortSet()

R/generateMatchedCohortSet.R

@@ -19,13 +19,17 @@
 #' @examples
 #' library(DrugUtilisation)
 #' library(CohortConstructor)
+#' library(dplyr)
 #' cdm <- mockDrugUtilisation(numberIndividuals = 100)
-#' cdm$cohort1 %>%
-#'   requireCohortIntersectFlag(targetCohortTable = "cohort2",
-#'                              targetCohortId = 1,
-#'                              indexDate = "cohort_start_date",
-#'                              window = c(-Inf, 0))
-
+#' cdm <- cdm %>%
+#'   generateMatchedCohortSet(name = "new_matched_cohort",
+#'                            targetCohortName = "cohort1",
+#'                            targetCohortId = c(1,2),
+#'                            matchSex = TRUE,
+#'                            matchYearOfBirth = TRUE,
+#'                            ratio = 2)
+#' cdm$new_matched_cohort
+#'
 generateMatchedCohortSet <- function(cdm,
                                      name,
                                      targetCohortName,
@@ -75,7 +79,7 @@ generateMatchedCohortSet <- function(cdm,
     cdm <- checkCohortSetRef(cdm, name, targetCohortName, matchSex, matchYearOfBirth, targetCohortId, n)
 
     # Rename cohort definition ids
-    cdm <- renameCohortDefinitionIds(cdm)
+    cdm <- renameCohortDefinitionIds(cdm, name)
   }
   # Return
   return(cdm)
@@ -456,51 +460,53 @@ checkCohortSetRef <- function(cdm, name, targetCohortName, matchSex, matchYearOf
 renameCohortDefinitionIds <- function(cdm, name){
   new_cohort_set <- cdm[[name]] %>%
     CDMConnector::cohort_set() %>%
-    dplyr::mutate(cohort_definition_id_new = target_cohort_id) %>%
-    arrange(cohort_definition_id_new) %>%
+    dplyr::mutate(cohort_definition_id_new = .data$target_cohort_id) %>%
+    dplyr::arrange(.data$cohort_definition_id_new) %>%
     dplyr::mutate(cohort_definition_id_new = dplyr::row_number())
 
   new_cohort_attrition <- cdm[[name]] %>%
     CDMConnector::cohort_attrition() %>%
-    inner_join(
+    dplyr::inner_join(
       new_cohort_set %>% dplyr::select("cohort_definition_id","cohort_definition_id_new"),
       by = "cohort_definition_id"
     ) %>%
     dplyr::select(-"cohort_definition_id") %>%
     dplyr::rename("cohort_definition_id" = "cohort_definition_id_new") %>%
-    dplyr::relocate(cohort_definition_id)
+    dplyr::relocate(.data$cohort_definition_id)
 
   new_cohort_count <- cdm[[name]] %>%
     CDMConnector::cohort_count() %>%
-    inner_join(
+    dplyr::inner_join(
       new_cohort_set %>% dplyr::select("cohort_definition_id","cohort_definition_id_new"),
       by = "cohort_definition_id"
     ) %>%
     dplyr::select(-"cohort_definition_id") %>%
     dplyr::rename("cohort_definition_id" = "cohort_definition_id_new") %>%
-    dplyr::relocate(cohort_definition_id)
+    dplyr::relocate(.data$cohort_definition_id)
 
   new_cohort <- cdm[[name]] %>%
-    inner_join(
+    dplyr::inner_join(
       new_cohort_set %>% dplyr::select("cohort_definition_id","cohort_definition_id_new"),
       by = "cohort_definition_id",
       copy = TRUE
     ) %>%
     dplyr::select(-"cohort_definition_id") %>%
     dplyr::rename("cohort_definition_id" = "cohort_definition_id_new") %>%
-    dplyr::relocate(cohort_definition_id) %>%
+    dplyr::relocate(.data$cohort_definition_id) %>%
     CDMConnector::compute_query() %>%
     CDMConnector::compute_query(name = name, temporary = FALSE, schema = attr(cdm, "write_schema"), overwrite = TRUE)
 
   new_cohort_set <- new_cohort_set %>%
     dplyr::select(-"cohort_definition_id") %>%
     dplyr::rename("cohort_definition_id" = "cohort_definition_id_new") %>%
-    dplyr::relocate(cohort_definition_id)
+    dplyr::relocate(.data$cohort_definition_id)
 
   cdm[[name]] <- CDMConnector::new_generated_cohort_set(
     cohort_ref = new_cohort,
     cohort_attrition_ref =  new_cohort_attrition ,
     cohort_set_ref = new_cohort_set,
     cohort_count_ref = new_cohort_count,
     overwrite = TRUE)
+
+  return(cdm)
 }

tests/testthat/test-generateMatchedCohortSet.R

@@ -291,19 +291,19 @@ test_that("test exactMatchingCohort with a ratio bigger than 1", {
                                 ratio = 4)
 
   expect_true(a[["new_cohort"]] %>%
-                dplyr::filter(cohort_definition_id %in% c(1,3)) %>%
+                dplyr::filter(cohort_definition_id %in% c(1,2)) %>%
                 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::filter(cohort_definition_id %in% c(3,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::filter(cohort_definition_id %in% c(1,2)) %>%
                 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::filter(cohort_definition_id %in% c(3,4)) %>%
                 dplyr::summarise(cohort_start_date) %>%
                 dplyr::distinct() %>% dplyr::pull() %>% length() == 2)
 

vignettes/a03_age_sex_matching.Rmd

@@ -33,7 +33,6 @@ As we will use `cohort1` to explore `generateMatchedCohortSet()`, let us first u
 ```{r}
 CDMConnector::cohort_set(cdm$cohort1)
 ```
-Notice that there are three cohorts within this tibble, with id's going from 1 to 3. 
 
 # Use generateMatchedCohortSet() to create an age-sex matched cohort
 Let us first see an example of how this function works. For its usage, we need to provide a `cdm` object, the `targetCohortName`, which is the name of the table containing the cohort of interest, and the `name` of the new generated tibble containing the cohort and the matched cohort. We will also use the argument `targetCohortId` to specify that we only want a matched cohort for `cohort_definition_id = 1`.