Skip to content

Commit

Permalink
Merge pull request #398 from OHDSI/match_names
Browse files Browse the repository at this point in the history
match cohort names
  • Loading branch information
edward-burn authored Dec 8, 2024
2 parents 173ed7e + ed057ad commit 0e4c83b
Show file tree
Hide file tree
Showing 2 changed files with 11 additions and 11 deletions.
6 changes: 3 additions & 3 deletions R/matchCohorts.R
Original file line number Diff line number Diff line change
Expand Up @@ -131,7 +131,7 @@ matchCohorts <- function(cohort,
dplyr::left_join(
settings(cdm[[target]]) |>
dplyr::mutate(
"cohort_name" = paste0(.data$cohort_name, "_matched")) |>
"cohort_name" = paste0(.data$cohort_name, "_sampled")) |>
dplyr::select("cohort_definition_id", "target_cohort_name" = "cohort_name"),
by = "cohort_definition_id"
) |>
Expand All @@ -154,7 +154,7 @@ matchCohorts <- function(cohort,
cohortSetRef = settings(cdm[[target]]) |>
dplyr::select("cohort_definition_id", "cohort_name") |>
dplyr::mutate(
"cohort_name" = paste0(.data$cohort_name, "_matched")) |>
"cohort_name" = paste0(.data$cohort_name, "_sampled")) |>
dplyr::mutate(
"target_table_name" = omopgenerics::tableName(cohort),
"target_cohort_id" = .data$cohort_definition_id,
Expand Down Expand Up @@ -224,7 +224,7 @@ getNewCohort <- function(cohort, cohortId, control) {
dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |>
omopgenerics::newCohortTable(
cohortSetRef = settings(cohort) |>
dplyr::mutate("cohort_name" = paste0("matched_to_", .data$cohort_name)),
dplyr::mutate("cohort_name" = paste0(.data$cohort_name, "_matched")),
cohortAttritionRef = dplyr::tibble(
"cohort_definition_id" = as.integer(cohortId),
"number_records" = controls |> dplyr::tally() |> dplyr::pull() |> as.integer(),
Expand Down
16 changes: 8 additions & 8 deletions tests/testthat/test-matchCohorts.R
Original file line number Diff line number Diff line change
Expand Up @@ -239,7 +239,7 @@ test_that("test exactMatchingCohort with a ratio bigger than 1", {
cdm[["new_cohort"]] |>
cohortCount() |>
dplyr::filter(.data$cohort_definition_id %in% omopgenerics::getCohortId(
cdm$new_cohort, "cohort_1_matched"
cdm$new_cohort, "cohort_1_sampled"
)) |>
dplyr::pull("number_subjects") |>
sum() == 2
Expand All @@ -248,7 +248,7 @@ test_that("test exactMatchingCohort with a ratio bigger than 1", {
cdm[["new_cohort"]] |>
cohortCount() |>
dplyr::filter(.data$cohort_definition_id %in% omopgenerics::getCohortId(
cdm$new_cohort, "matched_to_cohort_1"
cdm$new_cohort, "cohort_1_matched"
)) |>
dplyr::pull("number_subjects") |>
sum() == 8
Expand All @@ -257,7 +257,7 @@ test_that("test exactMatchingCohort with a ratio bigger than 1", {
cdm[["new_cohort"]] |>
cohortCount() |>
dplyr::filter(.data$cohort_definition_id %in% omopgenerics::getCohortId(
cdm$new_cohort, "cohort_2_matched"
cdm$new_cohort, "cohort_2_sampled"
)) |>
dplyr::pull("number_subjects") |>
sum() == 2
Expand All @@ -266,7 +266,7 @@ test_that("test exactMatchingCohort with a ratio bigger than 1", {
cdm[["new_cohort"]] |>
cohortCount() |>
dplyr::filter(.data$cohort_definition_id %in% omopgenerics::getCohortId(
cdm$new_cohort, "matched_to_cohort_2"
cdm$new_cohort, "cohort_2_matched"
)) |>
dplyr::pull("number_subjects") |>
sum() == 8
Expand All @@ -287,21 +287,21 @@ test_that("keepOriginalCohorts works" , {
cohort <- cdm$cohort2 |> matchCohorts(cohortId = 1, keepOriginalCohorts = TRUE, name = "new_cohort")
expect_identical(settings(cohort), dplyr::tibble(
cohort_definition_id = as.integer(1:3),
cohort_name = c("cohort_1", "cohort_1_matched", "matched_to_cohort_1"),
cohort_name = c("cohort_1", "cohort_1_sampled", "cohort_1_matched"),
target_table_name = c(NA, rep("cohort2", 2)),
target_cohort_id = c(NA, 1L, 1L),
target_cohort_name = c(NA, "cohort_1_matched", "cohort_1_matched"),
target_cohort_name = c(NA, "cohort_1_sampled", "cohort_1_sampled"),
match_sex = c(NA, rep(TRUE, 2)),
match_year_of_birth = c(NA, rep(TRUE, 2)),
match_status = c(NA, "target", "control")
))
cohort <- cdm$cohort2 |> matchCohorts(keepOriginalCohorts = TRUE)
expect_identical(settings(cohort), dplyr::tibble(
cohort_definition_id = as.integer(1:6),
cohort_name = c("cohort_1", "cohort_2", "cohort_1_matched", "cohort_2_matched", "matched_to_cohort_1", "matched_to_cohort_2"),
cohort_name = c("cohort_1", "cohort_2", "cohort_1_sampled", "cohort_2_sampled", "cohort_1_matched", "cohort_2_matched"),
target_table_name = c(NA, NA, rep("cohort2", 4)),
target_cohort_id = c(NA, NA, 1L, 2L, 1L, 2L),
target_cohort_name = c(NA, NA, "cohort_1_matched", "cohort_2_matched", "cohort_1_matched", "cohort_2_matched"),
target_cohort_name = c(NA, NA, "cohort_1_sampled", "cohort_2_sampled", "cohort_1_sampled", "cohort_2_sampled"),
match_sex = c(NA, NA, rep(TRUE, 4)),
match_year_of_birth = c(NA, NA, rep(TRUE, 4)),
match_status = c(NA, NA, "target", "target", "control", "control")
Expand Down

0 comments on commit 0e4c83b

Please sign in to comment.