diff --git a/DESCRIPTION b/DESCRIPTION index 2ff3b30..97bc834 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,6 +30,7 @@ Imports: CDMConnector (>= 1.3.1), checkmate, cli, + clock, dbplyr (>= 2.5.0), dplyr, glue, diff --git a/R/conceptCohort.R b/R/conceptCohort.R index 5a1f772..175da0e 100644 --- a/R/conceptCohort.R +++ b/R/conceptCohort.R @@ -288,7 +288,7 @@ unerafiedConceptCohort <- function(cdm, } } - cohorts <- cohorts %>% + cohorts <- cohorts |> purrr::discard(is.null) if (length(cohorts) == 0) { diff --git a/R/intersectCohorts.R b/R/intersectCohorts.R index fc2201d..60e2b8c 100644 --- a/R/intersectCohorts.R +++ b/R/intersectCohorts.R @@ -64,9 +64,9 @@ intersectCohorts <- function(cohort, # get intersections between cohorts tblName <- omopgenerics::uniqueTableName(prefix = uniquePrefix) lowerWindow <- ifelse(gap != 0, -gap, gap) - cohortOut <- cohort %>% - dplyr::filter(.data$cohort_definition_id %in% .env$cohortId) %>% - dplyr::select(-"cohort_definition_id") %>% + cohortOut <- cohort |> + dplyr::filter(.data$cohort_definition_id %in% .env$cohortId) |> + dplyr::select(-"cohort_definition_id") |> splitOverlap(by = "subject_id", name = tblName, tmp = paste0(tblName)) |> PatientProfiles::addCohortIntersectFlag( targetCohortTable = omopgenerics::tableName(cohort), @@ -77,13 +77,13 @@ intersectCohorts <- function(cohort, ) # create intersect cohort set - cohortNames <- omopgenerics::settings(cohort) %>% - dplyr::filter(.data$cohort_definition_id %in% .env$cohortId) %>% + cohortNames <- omopgenerics::settings(cohort) |> + dplyr::filter(.data$cohort_definition_id %in% .env$cohortId) |> dplyr::pull("cohort_name") x <- rep(list(c(0, 1)), length(cohortNames)) names(x) <- cohortNames - cohSet <- expand.grid(x) %>% - dplyr::as_tibble() %>% + cohSet <- expand.grid(x) |> + dplyr::as_tibble() |> dplyr::filter(dplyr::if_any(dplyr::everything(), ~ . != 0)) |> addNames() |> dplyr::mutate(cohort_definition_id = as.integer(dplyr::row_number())) |> @@ -124,13 +124,13 @@ intersectCohorts <- function(cohort, name = setName, table = cohSet ) - cohortOut <- cohortOut %>% - dplyr::inner_join(cdm[[setName]], by = cohortNames) %>% + cohortOut <- cohortOut |> + dplyr::inner_join(cdm[[setName]], by = cohortNames) |> dplyr::select("cohort_definition_id", "subject_id", - "cohort_start_date", "cohort_end_date") %>% + "cohort_start_date", "cohort_end_date") |> dplyr::compute(name = tblName, temporary = FALSE) if (cohortOut |> dplyr::tally() |> dplyr::pull("n") > 0) { - cohortOut <- cohortOut %>% + cohortOut <- cohortOut |> PatientProfiles::addObservationPeriodId(name = tblName) |> joinOverlap( name = tblName, gap = gap, @@ -202,7 +202,7 @@ intersectCohorts <- function(cohort, ) cdm <- bind(originalCohorts, cohortOut, name = name) } else { - cohortOut <- cohortOut %>% + cohortOut <- cohortOut |> dplyr::compute(name = name, temporary = FALSE) cdm[[name]] <- omopgenerics::newCohortTable( table = cohortOut, @@ -260,49 +260,49 @@ splitOverlap <- function(x, ie <- ids[3] tmpTable_1 <- paste0(tmp, "_1") - x_a <- x %>% - dplyr::select(dplyr::all_of(by), !!is := dplyr::all_of(start)) %>% + x_a <- x |> + dplyr::select(dplyr::all_of(by), !!is := dplyr::all_of(start)) |> dplyr::union_all( - x %>% - dplyr::select(dplyr::all_of(by), !!is := dplyr::all_of(end)) %>% - dplyr::mutate(!!is := as.Date(!!CDMConnector::dateadd(is, 1))) - ) %>% - dplyr::distinct() %>% + x |> + dplyr::select(dplyr::all_of(by), !!is := dplyr::all_of(end)) |> + dplyr::mutate(!!is := as.Date(clock::add_days(.data[[is]], 1L))) + ) |> + dplyr::distinct() |> dplyr::compute(temporary = FALSE, name = tmpTable_1) tmpTable_2 <- paste0(tmp, "_2") - x_a <- x_a %>% - dplyr::group_by(dplyr::across(dplyr::all_of(by))) %>% - dbplyr::window_order(.data[[is]]) %>% - dplyr::mutate(!!id := dplyr::row_number()) %>% - dbplyr::window_order() %>% - dplyr::ungroup() %>% + x_a <- x_a |> + dplyr::group_by(dplyr::across(dplyr::all_of(by))) |> + dbplyr::window_order(.data[[is]]) |> + dplyr::mutate(!!id := dplyr::row_number()) |> + dbplyr::window_order() |> + dplyr::ungroup() |> dplyr::compute(temporary = FALSE, name = tmpTable_2) tmpTable_3 <- paste0(tmp, "_3") - x_b <- x %>% - dplyr::select(dplyr::all_of(by), !!ie := dplyr::all_of(end)) %>% + x_b <- x |> + dplyr::select(dplyr::all_of(by), !!ie := dplyr::all_of(end)) |> dplyr::union_all( - x %>% - dplyr::select(dplyr::all_of(by), !!ie := dplyr::all_of(start)) %>% - dplyr::mutate(!!ie := as.Date(!!CDMConnector::dateadd(ie, -1))) - ) %>% - dplyr::distinct() %>% - dplyr::group_by(dplyr::across(dplyr::all_of(by))) %>% - dbplyr::window_order(.data[[ie]]) %>% - dplyr::mutate(!!id := dplyr::row_number() - 1) %>% - dbplyr::window_order() %>% - dplyr::ungroup() %>% + x |> + dplyr::select(dplyr::all_of(by), !!ie := dplyr::all_of(start)) |> + dplyr::mutate(!!ie := as.Date(clock::add_days(.data[[ie]], -1L))) + ) |> + dplyr::distinct() |> + dplyr::group_by(dplyr::across(dplyr::all_of(by))) |> + dbplyr::window_order(.data[[ie]]) |> + dplyr::mutate(!!id := dplyr::row_number() - 1) |> + dbplyr::window_order() |> + dplyr::ungroup() |> dplyr::compute(temporary = FALSE, name = tmpTable_3) - x <- x_a %>% + x <- x_a |> dplyr::inner_join( x_b, by = c(by, id) - ) %>% + ) |> dplyr::select(dplyr::all_of(by), !!start := dplyr::all_of(is), - !!end := dplyr::all_of(ie)) %>% + !!end := dplyr::all_of(ie)) |> dplyr::compute(temporary = FALSE, name = name) } @@ -330,6 +330,7 @@ joinOverlap <- function(cohort, return(cohort) } + gap <- as.integer(gap) cdm <- omopgenerics::cdmReference(cohort) start <- cohort |> @@ -339,14 +340,8 @@ joinOverlap <- function(cohort, dplyr::select(by, "date" := !!endDate) |> dplyr::mutate("date_id" = 1) if (gap > 0) { - end <- end %>% - dplyr::mutate("date" = as.Date( - !!CDMConnector::dateadd( - date = "date", - number = gap, - interval = "day" - ) - )) + end <- end |> + dplyr::mutate("date" = as.Date(clock::add_days(x = .data$date, n = gap))) } workingTbl <- omopgenerics::uniqueTableName() x <- start |> @@ -372,14 +367,8 @@ joinOverlap <- function(cohort, dplyr::select(-"era_id") |> dplyr::compute(temporary = FALSE, name = name) if (gap > 0) { - x <- x %>% - dplyr::mutate(!!endDate := as.Date( - !!CDMConnector::dateadd( - date = endDate, - number = -gap, - interval = "day" - ) - )) + x <- x |> + dplyr::mutate(!!endDate := as.Date(clock::add_days(x = .data[[endDate]], n = -gap))) } x <- x |> @@ -469,13 +458,13 @@ getIdentifier <- function(x, getRandom <- function(n) { sample(x = letters, size = n, - replace = TRUE) %>% paste0(collapse = "") + replace = TRUE) |> paste0(collapse = "") } addNames <- function(cs) { cols <- colnames(cs)[colnames(cs) != "cohort_definition_id"] - cs <- cs %>% dplyr::mutate("cohort_name" = NA_character_) + cs <- cs |> dplyr::mutate("cohort_name" = NA_character_) for (col in cols) { - cs <- cs %>% + cs <- cs |> dplyr::mutate( "cohort_name" = dplyr::case_when( .data[[col]] == 1 & is.na(.data$cohort_name) ~ .env$col, diff --git a/R/matchCohorts.R b/R/matchCohorts.R index a89a4d1..8feac36 100644 --- a/R/matchCohorts.R +++ b/R/matchCohorts.R @@ -194,9 +194,9 @@ getNewCohort <- function(cohort, cohortId, control) { name = temp_name, table = dplyr::tibble("cohort_definition_id" = cohortId) ) - controls <- cdm[[temp_name]] %>% + controls <- cdm[[temp_name]] |> dplyr::cross_join( - cdm[["person"]] %>% + cdm[["person"]] |> dplyr::select("subject_id" = "person_id") |> dplyr::inner_join( cdm[["observation_period"]] |> @@ -212,7 +212,7 @@ getNewCohort <- function(cohort, cohortId, control) { dplyr::ungroup(), by = "subject_id" ) - ) %>% + ) |> dplyr::compute(name = control, temporary = FALSE) cdm <- omopgenerics::dropTable(cdm, temp_name) @@ -268,8 +268,8 @@ addMatchCols <- function(x, matchCols) { dplyr::compute(name = omopgenerics::tableName(x), temporary = FALSE) } excludeIndividualsWithNoMatch <- function(cohort, groups, matchCols) { - cohort %>% - dplyr::inner_join(groups, by = c("cohort_definition_id", matchCols)) %>% + cohort |> + dplyr::inner_join(groups, by = c("cohort_definition_id", matchCols)) |> dplyr::select(!dplyr::all_of(matchCols)) |> dplyr::compute(name = tableName(cohort), temporary = FALSE) |> omopgenerics::recordCohortAttrition("Exclude individuals that do not have any match") @@ -302,20 +302,20 @@ excludeNoMatchedIndividuals <- function(cdm, temporary = FALSE) # Exclude individuals that do not have any match - cdm[[target]] <- cdm[[target]] %>% + cdm[[target]] <- cdm[[target]] |> excludeIndividualsWithNoMatch(groups, matchCols) - cdm[[control]] <- cdm[[control]] %>% + cdm[[control]] <- cdm[[control]] |> excludeIndividualsWithNoMatch(groups, matchCols) return(cdm) } addRandPairId <- function(x) { - x %>% - dplyr::mutate("id" = stats::runif(n = dplyr::n())) %>% - dplyr::arrange(.data$id) %>% - dplyr::mutate("pair_id" = dplyr::row_number(), .by = "group_id") %>% - dplyr::select(-"id") %>% + x |> + dplyr::mutate("id" = stats::runif(n = dplyr::n())) |> + dplyr::arrange(.data$id) |> + dplyr::mutate("pair_id" = dplyr::row_number(), .by = "group_id") |> + dplyr::select(-"id") |> dplyr::compute(name = omopgenerics::tableName(x), temporary = FALSE) } addClusterId <- function(x, u) { @@ -333,23 +333,23 @@ clusterId <- function(x) { } infiniteMatching <- function(cdm, target, control) { # Create pair id to perform a random match - cdm[[target]] <- cdm[[target]] %>% addRandPairId() - cdm[[control]] <- cdm[[control]] %>% addRandPairId() + cdm[[target]] <- cdm[[target]] |> addRandPairId() + cdm[[control]] <- cdm[[control]] |> addRandPairId() - cdm[[control]] <- cdm[[control]] %>% + cdm[[control]] <- cdm[[control]] |> dplyr::inner_join( # Calculate the maximum number of cases per group - cdm[[target]] %>% - dplyr::group_by(.data$group_id) %>% + cdm[[target]] |> + dplyr::group_by(.data$group_id) |> dplyr::summarise( "max_id" = max(.data$pair_id, na.rm = TRUE), .groups = "drop" ), by = c("group_id") - ) %>% + ) |> # Calculate the maximum ratio per group - dplyr::mutate("pair_id" = ((.data$pair_id - 1) %% .data$max_id) + 1) %>% - dplyr::select(-"max_id") %>% + dplyr::mutate("pair_id" = ((.data$pair_id - 1) %% .data$max_id) + 1) |> + dplyr::select(-"max_id") |> dplyr::compute(name = control, temporary = FALSE) clusterId <- clusterId(cdm[[target]]) @@ -357,13 +357,13 @@ infiniteMatching <- function(cdm, target, control) { cdm[[target]] <- cdm[[target]] |> addClusterId(clusterId) # assign cohort_start_date and cohort end date to controls - cdm[[control]] <- cdm[[control]] %>% + cdm[[control]] <- cdm[[control]] |> dplyr::inner_join( # Cohort start date and end date of cases - cdm[[target]] %>% + cdm[[target]] |> dplyr::select("cluster_id", "index_date" = "cohort_start_date"), by = c("cluster_id") - ) %>% + ) |> dplyr::compute(name = control, temporary = FALSE) return(cdm) @@ -401,15 +401,15 @@ observationTarget <- function(cdm, target, control) { checkRatio <- function(x, ratio) { if (!is.infinite(ratio)) { - x <- x %>% - dplyr::mutate("id" = stats::runif(n = dplyr::n())) %>% - dplyr::group_by(.data$cluster_id) %>% - dplyr::arrange(.data$id) %>% - dplyr::filter(dplyr::row_number() <= .env$ratio) %>% - dplyr::ungroup() %>% + x <- x |> + dplyr::mutate("id" = stats::runif(n = dplyr::n())) |> + dplyr::group_by(.data$cluster_id) |> + dplyr::arrange(.data$id) |> + dplyr::filter(dplyr::row_number() <= .env$ratio) |> + dplyr::ungroup() |> dplyr::arrange() |> dplyr::select(-"id") |> - dplyr::compute(name = tableName(x), temporary = FALSE) %>% + dplyr::compute(name = tableName(x), temporary = FALSE) |> omopgenerics::recordCohortAttrition("Exclude individuals to fulfil the ratio") } return(x) diff --git a/R/padCohortEnd.R b/R/padCohortEnd.R index a61466f..141851a 100644 --- a/R/padCohortEnd.R +++ b/R/padCohortEnd.R @@ -28,9 +28,9 @@ #' padCohortEnd(days = 10) #' } padCohortEnd <- function(cohort, - days, - cohortId = NULL, - name = tableName(cohort)) { + days, + cohortId = NULL, + name = tableName(cohort)) { # validate input name <- omopgenerics::validateNameArgument(name, validation = "warning") cohort <- omopgenerics::validateCohortArgument(cohort) @@ -52,39 +52,32 @@ padCohortEnd <- function(cohort, PatientProfiles::addFutureObservationQuery( futureObservationType = "date", futureObservationName = futureObsCol - ) + ) } if(length(cohortId) < length(ids)) { # if only a subset of ids are provided then only update these - cohort <- cohort %>% + cohort <- cohort |> dplyr::mutate( !!newEndCol := dplyr::if_else( .data$cohort_definition_id %in% .env$cohortId, - as.Date( - !!CDMConnector::dateadd( - "cohort_end_date", - number = days, - interval = "day" - ) - ), + as.Date(clock::add_days(x = .data$cohort_end_date, n = days)), .data$cohort_end_date ) ) } else { # if all ids are provided then simpler query - update all - cohort <- cohort %>% + cohort <- cohort |> dplyr::mutate( - !!newEndCol := as.Date( - !!CDMConnector::dateadd( - "cohort_end_date", - number = days, - interval = "day"))) + !!newEndCol := as.Date(clock::add_days(x = .data$cohort_end_date, n = days)) + ) } if (days > 0) { - cohort <- cohort %>% - dplyr::mutate(!!diffCol := !!CDMConnector::datediff(newEndCol, futureObsCol)) |> + cohort <- cohort |> + dplyr::mutate( + !!diffCol := clock::date_count_between(.data[[newEndCol]], .data[[futureObsCol]], "day") + ) |> dplyr::mutate(cohort_end_date = dplyr::if_else(!!rlang::ensym(diffCol) >= 0, !!rlang::ensym(newEndCol), !!rlang::ensym(futureObsCol))) @@ -94,7 +87,7 @@ padCohortEnd <- function(cohort, } # drop anyone with end before start - cohort <- cohort %>% + cohort <- cohort |> dplyr::filter(.data$cohort_start_date <= .data$cohort_end_date) |> dplyr::select(!dplyr::any_of(c(futureObsCol, diffCol, newEndCol))) diff --git a/R/padCohortStart.R b/R/padCohortStart.R index 121bb55..bbde177 100644 --- a/R/padCohortStart.R +++ b/R/padCohortStart.R @@ -38,34 +38,26 @@ padCohortStart <- function(cohort, ids <- omopgenerics::settings(cohort)$cohort_definition_id if(length(cohortId) < length(ids)) { - # if only a subset of ids are provided then only update these - cohort <- cohort %>% + # if only a subset of ids are provided then only update these + cohort <- cohort |> dplyr::mutate( cohort_start_date = dplyr::if_else( .data$cohort_definition_id %in% .env$cohortId, - as.Date( - !!CDMConnector::dateadd( - "cohort_start_date", - number = days, - interval = "day" - ) - ), + as.Date(clock::add_days(x = .data$cohort_start_date, n = days)), .data$cohort_start_date ) ) } else { # if all ids are provided then simpler query - update all - cohort <- cohort %>% + cohort <- cohort |> dplyr::mutate( - cohort_start_date = as.Date( - !!CDMConnector::dateadd( - "cohort_start_date", - number = days, - interval = "day"))) + cohort_start_date = as.Date(clock::add_days(x = .data$cohort_start_date, n = days)) + ) + } - cohort <- cohort %>% - dplyr::filter(.data$cohort_start_date <= .data$cohort_end_date) + cohort <- cohort |> + dplyr::filter(.data$cohort_start_date <= .data$cohort_end_date) if (days < 0) { # if days is less than zero then updating start could take the date @@ -74,16 +66,16 @@ padCohortStart <- function(cohort, cohort <- cohort |> PatientProfiles::addPriorObservationQuery( priorObservationType = "date", - priorObservationName = priorObsCol) %>% + priorObservationName = priorObsCol) |> dplyr::filter(.data$cohort_start_date >= .data[[priorObsCol]]) |> dplyr::select(!priorObsCol) } - cdm[[name]] <- cohort |> - dplyr::compute(temporary = FALSE, name = name) |> - omopgenerics::recordCohortAttrition( - reason = "Pad cohort start date by {days} day{?s}") + cdm[[name]] <- cohort |> + dplyr::compute(temporary = FALSE, name = name) |> + omopgenerics::recordCohortAttrition( + reason = "Pad cohort start date by {days} day{?s}") - return(cdm[[name]]) + return(cdm[[name]]) } diff --git a/R/requireCohortIntersect.R b/R/requireCohortIntersect.R index a610120..0d931fd 100644 --- a/R/requireCohortIntersect.R +++ b/R/requireCohortIntersect.R @@ -72,18 +72,18 @@ requireCohortIntersect <- function(cohort, } if (is.null(targetCohortId)) { - targetCohortId <- omopgenerics::settings(cdm[[targetCohortTable]]) %>% + targetCohortId <- omopgenerics::settings(cdm[[targetCohortTable]]) |> dplyr::pull("cohort_definition_id") } - target_name <- cdm[[targetCohortTable]] %>% - omopgenerics::settings() %>% - dplyr::filter(.data$cohort_definition_id == .env$targetCohortId) %>% + target_name <- cdm[[targetCohortTable]] |> + omopgenerics::settings() |> + dplyr::filter(.data$cohort_definition_id == .env$targetCohortId) |> dplyr::pull("cohort_name") subsetName <- omopgenerics::uniqueTableName() - subsetCohort <- cohort %>% - dplyr::select(dplyr::all_of(.env$cols)) %>% + subsetCohort <- cohort |> + dplyr::select(dplyr::all_of(.env$cols)) |> PatientProfiles::addCohortIntersectCount( targetCohortTable = targetCohortTable, targetCohortId = targetCohortId, @@ -96,7 +96,7 @@ requireCohortIntersect <- function(cohort, name = name ) - subsetCohort <- subsetCohort %>% + subsetCohort <- subsetCohort |> dplyr::mutate(lower_limit = .env$lower_limit, upper_limit = .env$upper_limit) |> dplyr::filter(( @@ -104,8 +104,8 @@ requireCohortIntersect <- function(cohort, .data$intersect_cohort <= .data$upper_limit ) | (!.data$cohort_definition_id %in% .env$cohortId) - ) %>% - dplyr::select(cols) %>% + ) |> + dplyr::select(cols) |> dplyr::compute(name = subsetName, temporary = FALSE) # attrition reason @@ -131,10 +131,10 @@ requireCohortIntersect <- function(cohort, reason <- glue::glue("{reason}, censoring at {censorDate}") } - x <- cohort %>% - dplyr::inner_join(subsetCohort, by = c(cols)) %>% - dplyr::compute(name = name, temporary = FALSE) %>% - omopgenerics::newCohortTable(.softValidation = TRUE) %>% + x <- cohort |> + dplyr::inner_join(subsetCohort, by = c(cols)) |> + dplyr::compute(name = name, temporary = FALSE) |> + omopgenerics::newCohortTable(.softValidation = TRUE) |> omopgenerics::recordCohortAttrition(reason = reason, cohortId = cohortId) omopgenerics::dropTable(cdm = cdm, name = subsetName) diff --git a/R/requireConceptIntersect.R b/R/requireConceptIntersect.R index 99ba280..5592bfe 100644 --- a/R/requireConceptIntersect.R +++ b/R/requireConceptIntersect.R @@ -73,8 +73,8 @@ requireConceptIntersect <- function(cohort, cli::cli_inform(c("i" = "Empty codelist provided, returning input cohort")) } else { subsetName <- omopgenerics::uniqueTableName() - subsetCohort <- cohort %>% - dplyr::select(dplyr::all_of(.env$cols)) %>% + subsetCohort <- cohort |> + dplyr::select(dplyr::all_of(.env$cols)) |> PatientProfiles::addConceptIntersectCount( conceptSet = conceptSet, indexDate = indexDate, @@ -86,7 +86,7 @@ requireConceptIntersect <- function(cohort, name = subsetName ) - subsetCohort <- subsetCohort %>% + subsetCohort <- subsetCohort |> dplyr::mutate(lower_limit = .env$lower_limit, upper_limit = .env$upper_limit) |> dplyr::filter(( @@ -94,8 +94,8 @@ requireConceptIntersect <- function(cohort, .data$intersect_concept <= .data$upper_limit ) | (!.data$cohort_definition_id %in% .env$cohortId) - ) %>% - dplyr::select(cols) %>% + ) |> + dplyr::select(cols) |> dplyr::compute(name = subsetName, temporary = FALSE) # attrition reason @@ -121,10 +121,10 @@ requireConceptIntersect <- function(cohort, reason <- glue::glue("{reason}, censoring at {censorDate}") } - cohort <- cohort %>% - dplyr::inner_join(subsetCohort, by = c(cols)) %>% - dplyr::compute(name = name, temporary = FALSE) %>% - omopgenerics::newCohortTable(.softValidation = TRUE) %>% + cohort <- cohort |> + dplyr::inner_join(subsetCohort, by = c(cols)) |> + dplyr::compute(name = name, temporary = FALSE) |> + omopgenerics::newCohortTable(.softValidation = TRUE) |> omopgenerics::recordCohortAttrition(reason = reason, cohortId = cohortId) omopgenerics::dropTable(cdm = cdm, name = subsetName) diff --git a/R/requireDateRange.R b/R/requireDateRange.R index 993f022..5aaf7c7 100644 --- a/R/requireDateRange.R +++ b/R/requireDateRange.R @@ -119,8 +119,8 @@ trimToDateRange <- function(cohort, startDate = startDate, endDate = endDate, minDate = dateRange[1] - ) %>% - dplyr::compute(name = name, temporary = FALSE) %>% + ) |> + dplyr::compute(name = name, temporary = FALSE) |> omopgenerics::recordCohortAttrition(reason = paste0(startDate, " >= ", dateRange[1]), cohortId = cohortId) } @@ -133,8 +133,8 @@ trimToDateRange <- function(cohort, startDate = startDate, endDate = endDate, maxDate = dateRange[2] - ) %>% - dplyr::compute(name = name, temporary = FALSE) %>% + ) |> + dplyr::compute(name = name, temporary = FALSE) |> omopgenerics::recordCohortAttrition(reason = paste0(endDate, " <= ", dateRange[2]), cohortId = cohortId) } @@ -151,7 +151,7 @@ trimStartDate <- function(cohort, endDate, minDate, requirementIds) { - cohort <- cohort %>% + cohort <- cohort |> dplyr::mutate( !!startDate := dplyr::if_else( .data[[startDate]] <= !!minDate & @@ -159,7 +159,7 @@ trimStartDate <- function(cohort, as.Date(minDate), .data[[startDate]] ) - ) %>% + ) |> dplyr::filter(.data[[startDate]] <= .data[[endDate]] | (!.data$cohort_definition_id %in% .env$requirementIds)) return(cohort) @@ -170,13 +170,13 @@ trimEndDate <- function(cohort, endDate, maxDate, requirementIds) { - cohort <- cohort %>% + cohort <- cohort |> dplyr::mutate(!!endDate := dplyr::if_else( .data[[endDate]] >= !!maxDate & (.data$cohort_definition_id %in% .env$requirementIds), as.Date(maxDate), .data[[endDate]] - )) %>% + )) |> dplyr::filter(.data[[startDate]] <= .data[[endDate]] | (!.data$cohort_definition_id %in% requirementIds)) return(cohort) diff --git a/R/requireDeathFlag.R b/R/requireDeathFlag.R index abb6c8d..09c64d5 100644 --- a/R/requireDeathFlag.R +++ b/R/requireDeathFlag.R @@ -59,8 +59,8 @@ requireDeathFlag <- function(cohort, window_end <- window[[1]][2] subsetName <- omopgenerics::uniqueTableName() - subsetCohort <- cohort %>% - dplyr::select(dplyr::all_of(.env$cols)) %>% + subsetCohort <- cohort |> + dplyr::select(dplyr::all_of(.env$cols)) |> PatientProfiles::addDeathFlag( indexDate = indexDate, censorDate = censorDate, @@ -70,20 +70,20 @@ requireDeathFlag <- function(cohort, ) if (isFALSE(negate)) { - subsetCohort <- subsetCohort %>% + subsetCohort <- subsetCohort |> dplyr::filter(.data$death == 1 | - (!.data$cohort_definition_id %in% cohortId)) %>% - dplyr::select(!"death") %>% + (!.data$cohort_definition_id %in% cohortId)) |> + dplyr::select(!"death") |> dplyr::compute(name = subsetName, temporary = FALSE) # attrition reason reason <- glue::glue("Death between {window_start} & ", "{window_end} days relative to {indexDate}") } else { # ie require absence instead of presence - subsetCohort <- subsetCohort %>% + subsetCohort <- subsetCohort |> dplyr::filter(.data$death != 1 | - (!.data$cohort_definition_id %in% cohortId)) %>% - dplyr::select(!"death") %>% + (!.data$cohort_definition_id %in% cohortId)) |> + dplyr::select(!"death") |> dplyr::compute(name = subsetName, temporary = FALSE) # attrition reason reason <- glue::glue("Alive between {window_start} & ", @@ -94,10 +94,10 @@ requireDeathFlag <- function(cohort, reason <- glue::glue("{reason}, censoring at {censorDate}") } - x <- cohort %>% - dplyr::inner_join(subsetCohort, by = c(cols)) %>% - dplyr::compute(name = name, temporary = FALSE) %>% - omopgenerics::newCohortTable(.softValidation = TRUE) %>% + x <- cohort |> + dplyr::inner_join(subsetCohort, by = c(cols)) |> + dplyr::compute(name = name, temporary = FALSE) |> + omopgenerics::newCohortTable(.softValidation = TRUE) |> omopgenerics::recordCohortAttrition(reason = reason, cohortId = cohortId) omopgenerics::dropTable(cdm = cdm, name = subsetName) diff --git a/R/requireDemographics.R b/R/requireDemographics.R index 4502ab1..c64b6f3 100644 --- a/R/requireDemographics.R +++ b/R/requireDemographics.R @@ -284,7 +284,7 @@ demographicsFilter <- function(cohort, "cohort_end_date", indexDate ) - )) %>% + )) |> PatientProfiles::addDemographics( indexDate = indexDate, age = reqAge, diff --git a/R/requireTableIntersect.R b/R/requireTableIntersect.R index af27eb1..44a7cf3 100644 --- a/R/requireTableIntersect.R +++ b/R/requireTableIntersect.R @@ -68,8 +68,8 @@ requireTableIntersect <- function(cohort, } subsetName <- omopgenerics::uniqueTableName() - subsetCohort <- cohort %>% - dplyr::select(dplyr::all_of(.env$cols)) %>% + subsetCohort <- cohort |> + dplyr::select(dplyr::all_of(.env$cols)) |> PatientProfiles::addTableIntersectCount( tableName = tableName, indexDate = indexDate, @@ -81,7 +81,7 @@ requireTableIntersect <- function(cohort, name = subsetName ) - subsetCohort <- subsetCohort %>% + subsetCohort <- subsetCohort |> dplyr::mutate(lower_limit = .env$lower_limit, upper_limit = .env$upper_limit) |> dplyr::filter(( @@ -89,8 +89,8 @@ requireTableIntersect <- function(cohort, .data$intersect_table <= .data$upper_limit ) | (!.data$cohort_definition_id %in% .env$cohortId) - ) %>% - dplyr::select(cols) %>% + ) |> + dplyr::select(cols) |> dplyr::compute(name = subsetName, temporary = FALSE) # attrition reason @@ -116,10 +116,10 @@ requireTableIntersect <- function(cohort, reason <- glue::glue("{reason}, censoring at {censorDate}") } - x <- cohort %>% - dplyr::inner_join(subsetCohort, by = c(cols)) %>% - dplyr::compute(name = name, temporary = FALSE) %>% - omopgenerics::newCohortTable(.softValidation = TRUE) %>% + x <- cohort |> + dplyr::inner_join(subsetCohort, by = c(cols)) |> + dplyr::compute(name = name, temporary = FALSE) |> + omopgenerics::newCohortTable(.softValidation = TRUE) |> omopgenerics::recordCohortAttrition(reason = reason, cohortId = cohortId) omopgenerics::dropTable(cdm = cdm, name = subsetName) diff --git a/R/trimDemographics.R b/R/trimDemographics.R index 496abba..733a2f0 100644 --- a/R/trimDemographics.R +++ b/R/trimDemographics.R @@ -60,9 +60,9 @@ trimDemographics <- function(cohort, omopgenerics::newCohortTable(.softValidation = TRUE) if (!is.null(ageRange) || - !is.null(minPriorObservation) || - !is.null(minFutureObservation) || - !is.null(sex)) { + !is.null(minPriorObservation) || + !is.null(minFutureObservation) || + !is.null(sex)) { cli::cli_inform(c("Adding demographics information")) newCohort <- newCohort |> PatientProfiles::addDemographics( @@ -128,7 +128,7 @@ trimDemographics <- function(cohort, cli::cli_inform(c("Trim sex")) newCohort <- newCohort |> dplyr::filter(.data$sex == .data$sex_req | - .data$sex_req == "Both") |> + .data$sex_req == "Both") |> dplyr::compute(name = tmpNewCohort, temporary = FALSE) # attrition uniqueSex <- unique(newSet$sex) @@ -154,8 +154,8 @@ trimDemographics <- function(cohort, ageRange[[j]][is.infinite(ageRange[[j]])] <- 999L } - newCohort <- newCohort %>% - dplyr::mutate(!!!datesAgeRange(ageRange)) %>% + newCohort <- newCohort |> + dplyr::mutate(!!!datesAgeRange(ageRange)) |> dplyr::mutate( !!!caseAge(ageRange), "cohort_start_date" = dplyr::if_else( @@ -194,7 +194,7 @@ trimDemographics <- function(cohort, } if (!is.null(minPriorObservation)) { cli::cli_inform(c("Trim prior observation")) - newCohort <- newCohort %>% + newCohort <- newCohort |> dplyr::mutate("min_prior_observation" = as.integer(.data$min_prior_observation)) %>% dplyr::mutate( "new_cohort_start_date" = as.Date( @@ -233,12 +233,10 @@ trimDemographics <- function(cohort, } if (!is.null(minFutureObservation)) { cli::cli_inform(c("Trim future observation")) - newCohort <- newCohort %>% + newCohort <- newCohort |> dplyr::filter( - !!CDMConnector::datediff( - start = "cohort_start_date", - end = "future_observation", - interval = "day" + clock::date_count_between( + .data$cohort_start_date, .data$future_observation, "day" ) >= .data$min_future_observation ) |> @@ -308,15 +306,15 @@ trimDemographics <- function(cohort, dplyr::distinct() |> dplyr::rename("target_cohort_rand01" = "cohort_definition_id") |> dplyr::inner_join(newCohort |> - dplyr::select(dplyr::all_of( - c( - "cohort_definition_id", - "subject_id", - "cohort_start_date", - "cohort_end_date", - "target_cohort_rand01" - ) - )), by = unique(c("target_cohort_rand01", "subject_id"))) |> + dplyr::select(dplyr::all_of( + c( + "cohort_definition_id", + "subject_id", + "cohort_start_date", + "cohort_end_date", + "target_cohort_rand01" + ) + )), by = unique(c("target_cohort_rand01", "subject_id"))) |> dplyr::select(!"target_cohort_rand01") |> dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |> dplyr::compute(name = name, temporary = FALSE) |> @@ -342,8 +340,8 @@ datesAgeRange <- function(ageRange) { unlist() |> unique() values <- values[!is.infinite(values)] - values <- values[values != 0] - glue::glue("as.Date(local(CDMConnector::dateadd('date_0', {values}, interval = 'year')))") |> + values <- values[values != 0] |> as.integer() + glue::glue("as.Date(clock::add_years(.data$date_0, {values}))") |> rlang::parse_exprs() |> rlang::set_names(glue::glue("date_{values}")) } @@ -384,9 +382,9 @@ prepareColEnd <- function(x, col) { col, " == ", as.character(num), - " ~ as.Date(local(CDMConnector::dateadd(date = 'date_", + " ~ as.Date(clock::add_days(x = .data$date_", as.character(num + 1), - "', number = -1, interval = 'day')))" + ", n = -1L))" ) if (infFlag) { x <- c( diff --git a/README.Rmd b/README.Rmd index d725874..45a3dfa 100644 --- a/README.Rmd +++ b/README.Rmd @@ -93,9 +93,9 @@ cdm$fractures <- cdm$fractures |> We can see that our starting cohorts, before we add any additional restrictions, have the following associated settings, counts, and attrition. ```{r} -settings(cdm$fractures) %>% glimpse() -cohort_count(cdm$fractures) %>% glimpse() -attrition(cdm$fractures) %>% glimpse() +settings(cdm$fractures) |> glimpse() +cohort_count(cdm$fractures) |> glimpse() +attrition(cdm$fractures) |> glimpse() ``` ### Create an overall fracture cohort @@ -119,16 +119,16 @@ cohortCount(cdm$fractures) Once we have created our base fracture cohort, we can then start applying additional cohort requirements. For example, first we can require that individuals' cohort start date fall within a certain date range. ```{r} -cdm$fractures <- cdm$fractures %>% +cdm$fractures <- cdm$fractures |> requireInDateRange(dateRange = as.Date(c("2000-01-01", "2020-01-01"))) ``` Now that we've applied this date restriction, we can see that our cohort attributes have been updated ```{r} -cohort_count(cdm$fractures) %>% glimpse() -attrition(cdm$fractures) %>% - filter(reason == "cohort_start_date between 2000-01-01 & 2020-01-01") %>% +cohort_count(cdm$fractures) |> glimpse() +attrition(cdm$fractures) |> + filter(reason == "cohort_start_date between 2000-01-01 & 2020-01-01") |> glimpse() ``` @@ -137,7 +137,7 @@ attrition(cdm$fractures) %>% We can also add restrictions on patient characteristics such as age (on cohort start date by default) and sex. ```{r} -cdm$fractures <- cdm$fractures %>% +cdm$fractures <- cdm$fractures |> requireDemographics(ageRange = list(c(40, 65)), sex = "Female") ``` @@ -145,12 +145,12 @@ cdm$fractures <- cdm$fractures %>% Again we can see how many individuals we've lost after applying these criteria. ```{r} -attrition(cdm$fractures) %>% - filter(reason == "Age requirement: 40 to 65") %>% +attrition(cdm$fractures) |> + filter(reason == "Age requirement: 40 to 65") |> glimpse() -attrition(cdm$fractures) %>% - filter(reason == "Sex requirement: Female") %>% +attrition(cdm$fractures) |> + filter(reason == "Sex requirement: Female") |> glimpse() ``` @@ -163,15 +163,15 @@ cdm$gibleed <- cdm |> conceptCohort(conceptSet = list("gibleed" = 192671L), name = "gibleed") -cdm$fractures <- cdm$fractures %>% +cdm$fractures <- cdm$fractures |> requireCohortIntersect(targetCohortTable = "gibleed", intersections = 0, window = c(-Inf, 0)) ``` ```{r} -attrition(cdm$fractures) %>% - filter(reason == "Not in cohort gibleed between -Inf & 0 days relative to cohort_start_date") %>% +attrition(cdm$fractures) |> + filter(reason == "Not in cohort gibleed between -Inf & 0 days relative to cohort_start_date") |> glimpse() ``` diff --git a/README.md b/README.md index a3c66a7..99efa06 100644 --- a/README.md +++ b/README.md @@ -52,6 +52,9 @@ library(CohortCharacteristics) con <- DBI::dbConnect(duckdb::duckdb(), dbdir = eunomia_dir()) cdm <- cdm_from_con(con, cdm_schema = "main", write_schema = c(prefix = "my_study_", schema = "main")) +#> Note: method with signature 'DBIConnection#Id' chosen for function 'dbExistsTable', +#> target signature 'duckdb_connection#Id'. +#> "duckdb_connection#ANY" would also be valid cdm #> #> ── # OMOP CDM reference (duckdb) of Synthea synthetic health database ────────── @@ -76,7 +79,6 @@ synthetic data with a subset of the full vocabularies). ``` r library(CodelistGenerator) -#> Warning: package 'CodelistGenerator' was built under R version 4.4.1 hip_fx_codes <- getCandidateCodes(cdm, "hip fracture") #> Limiting to domains of interest @@ -105,10 +107,10 @@ fx_codes #> - hip_fracture (1 codes) ``` -Now we can quickly create a our cohorts. For this we only need to -provide the codes we have defined and we will get a cohort back, where -we start by setting cohort exit as the same day as event start (the date -of the fracture). +Now we can quickly create our cohorts. For this we only need to provide +the codes we have defined and we will get a cohort back, where we start +by setting cohort exit as the same day as event start (the date of the +fracture). ``` r cdm$fractures <- cdm |> @@ -132,20 +134,20 @@ restrictions, have the following associated settings, counts, and attrition. ``` r -settings(cdm$fractures) %>% glimpse() +settings(cdm$fractures) |> glimpse() #> Rows: 2 #> Columns: 4 #> $ cohort_definition_id 1, 2 #> $ cohort_name "forearm_fracture", "hip_fracture" #> $ cdm_version "5.3", "5.3" #> $ vocabulary_version "v5.0 18-JAN-19", "v5.0 18-JAN-19" -cohort_count(cdm$fractures) %>% glimpse() +cohort_count(cdm$fractures) |> glimpse() #> Rows: 2 #> Columns: 3 #> $ cohort_definition_id 1, 2 #> $ number_records 569, 138 #> $ number_subjects 510, 132 -attrition(cdm$fractures) %>% glimpse() +attrition(cdm$fractures) |> glimpse() #> Rows: 4 #> Columns: 7 #> $ cohort_definition_id 1, 1, 2, 2 @@ -195,7 +197,7 @@ require that individuals’ cohort start date fall within a certain date range. ``` r -cdm$fractures <- cdm$fractures %>% +cdm$fractures <- cdm$fractures |> requireInDateRange(dateRange = as.Date(c("2000-01-01", "2020-01-01"))) ``` @@ -203,14 +205,14 @@ Now that we’ve applied this date restriction, we can see that our cohort attributes have been updated ``` r -cohort_count(cdm$fractures) %>% glimpse() +cohort_count(cdm$fractures) |> glimpse() #> Rows: 3 #> Columns: 3 #> $ cohort_definition_id 1, 2, 3 #> $ number_records 152, 62, 214 #> $ number_subjects 143, 60, 196 -attrition(cdm$fractures) %>% - filter(reason == "cohort_start_date between 2000-01-01 & 2020-01-01") %>% +attrition(cdm$fractures) |> + filter(reason == "cohort_start_date between 2000-01-01 & 2020-01-01") |> glimpse() #> Rows: 0 #> Columns: 7 @@ -229,7 +231,7 @@ We can also add restrictions on patient characteristics such as age (on cohort start date by default) and sex. ``` r -cdm$fractures <- cdm$fractures %>% +cdm$fractures <- cdm$fractures |> requireDemographics(ageRange = list(c(40, 65)), sex = "Female") ``` @@ -238,8 +240,8 @@ Again we can see how many individuals we’ve lost after applying these criteria. ``` r -attrition(cdm$fractures) %>% - filter(reason == "Age requirement: 40 to 65") %>% +attrition(cdm$fractures) |> + filter(reason == "Age requirement: 40 to 65") |> glimpse() #> Rows: 3 #> Columns: 7 @@ -251,8 +253,8 @@ attrition(cdm$fractures) %>% #> $ excluded_records 88, 40, 128 #> $ excluded_subjects 81, 38, 113 -attrition(cdm$fractures) %>% - filter(reason == "Sex requirement: Female") %>% +attrition(cdm$fractures) |> + filter(reason == "Sex requirement: Female") |> glimpse() #> Rows: 3 #> Columns: 7 @@ -277,15 +279,15 @@ cdm$gibleed <- cdm |> conceptCohort(conceptSet = list("gibleed" = 192671L), name = "gibleed") -cdm$fractures <- cdm$fractures %>% +cdm$fractures <- cdm$fractures |> requireCohortIntersect(targetCohortTable = "gibleed", intersections = 0, window = c(-Inf, 0)) ``` ``` r -attrition(cdm$fractures) %>% - filter(reason == "Not in cohort gibleed between -Inf & 0 days relative to cohort_start_date") %>% +attrition(cdm$fractures) |> + filter(reason == "Not in cohort gibleed between -Inf & 0 days relative to cohort_start_date") |> glimpse() #> Rows: 3 #> Columns: 7 diff --git a/data-raw/getBenchmarkResults.R b/data-raw/getBenchmarkResults.R index 2335eeb..c0da89e 100644 --- a/data-raw/getBenchmarkResults.R +++ b/data-raw/getBenchmarkResults.R @@ -47,12 +47,12 @@ mergeData <- function(data, patterns) { mutate(across(.cols = -result_id, as.character)) } } - x[[pat]] <- dataSubset %>% omopgenerics::bind() + x[[pat]] <- dataSubset |> omopgenerics::bind() } else { cli::cli_abort("Not all results with pattern {pat} have class summarised result.") } } else { - x[[pat]] <- dataSubset %>% dplyr::bind_rows() %>% distinct() + x[[pat]] <- dataSubset |> dplyr::bind_rows() |> distinct() } } return(x) diff --git a/tests/testthat/test-entryAtColumnDate.R b/tests/testthat/test-entryAtColumnDate.R index 07c9778..4a48605 100644 --- a/tests/testthat/test-entryAtColumnDate.R +++ b/tests/testthat/test-entryAtColumnDate.R @@ -28,15 +28,15 @@ test_that("entry at first date", { name = "cohort1" ) expect_true(all( - cdm$cohort1 %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort1 |> dplyr::pull("cohort_start_date") |> sort() == c("1989-12-09", "2000-01-01", "2000-06-03", "2000-12-09", "2015-01-15") )) expect_true(all( - cdm$cohort1 %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort1 |> dplyr::pull("cohort_end_date") |> sort() == c("1990-12-09", "2001-01-12", "2001-09-01", "2002-12-09", "2015-02-15") )) - expect_true(all(grepl("cohort_start_date", cdm$cohort1 %>% dplyr::pull("entry_reason")))) - expect_true(sum(grepl("other_date_1", cdm$cohort1 %>% dplyr::pull("entry_reason"))) == 1) + expect_true(all(grepl("cohort_start_date", cdm$cohort1 |> dplyr::pull("entry_reason")))) + expect_true(sum(grepl("other_date_1", cdm$cohort1 |> dplyr::pull("entry_reason"))) == 1) expect_true(all(colnames(cdm$cohort1) == c("cohort_definition_id", "subject_id", "cohort_start_date", "cohort_end_date", "entry_reason"))) @@ -47,11 +47,11 @@ test_that("entry at first date", { returnReason = FALSE ) expect_true(all( - cdm$cohort %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort |> dplyr::pull("cohort_start_date") |> sort() == c("1990-11-09", "2001-01-01", "2001-08-01", "2002-12-09", "2015-01-15") )) expect_true(all( - cdm$cohort %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort |> dplyr::pull("cohort_end_date") |> sort() == c("1990-12-09", "2001-01-12", "2001-09-01", "2002-12-09", "2015-02-15") )) expect_true(all(colnames(cdm$cohort) == @@ -92,17 +92,17 @@ test_that("entry at last date", { name = "cohort1" ) expect_true(all( - cdm$cohort1 %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort1 |> dplyr::pull("cohort_start_date") |> sort() == c("1989-12-09", "2000-12-09", "2001-04-15", "2001-10-01", "2015-01-15") )) expect_true(all( - cdm$cohort1 %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort1 |> dplyr::pull("cohort_end_date") |> sort() == c("1990-12-09", "2001-04-15", "2001-10-01", "2002-12-09", "2015-02-15") )) expect_true(all(colnames(cdm$cohort1) == c("cohort_definition_id", "subject_id", "cohort_start_date", "cohort_end_date", "entry_reason"))) expect_true(all( - cdm$cohort1 %>% dplyr::pull("entry_reason") %>% sort() == + cdm$cohort1 |> dplyr::pull("entry_reason") |> sort() == c("cohort_end_date", "cohort_end_date", "cohort_start_date", "cohort_start_date", "cohort_start_date") )) @@ -115,11 +115,11 @@ test_that("entry at last date", { name = "cohort1" )) expect_true(all( - cdm$cohort1 %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort1 |> dplyr::pull("cohort_start_date") |> sort() == c("1990-12-09", "2000-01-01", "2000-06-03", "2002-12-09", "2015-02-15") )) expect_true(all( - cdm$cohort1 %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort1 |> dplyr::pull("cohort_end_date") |> sort() == c("1990-12-09", "2001-04-15", "2001-10-01", "2002-12-09", "2015-02-15") )) @@ -130,11 +130,11 @@ test_that("entry at last date", { returnReason = FALSE ) expect_true(all( - cdm$cohort %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort |> dplyr::pull("cohort_start_date") |> sort() == c("1990-11-09", "2001-01-01", "2001-09-02", "2002-12-09", "2015-02-15") )) expect_true(all( - cdm$cohort %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort |> dplyr::pull("cohort_end_date") |> sort() == c("1990-12-09", "2001-04-15", "2001-10-01", "2002-12-09", "2015-02-15") )) expect_true(all(colnames(cdm$cohort) == diff --git a/tests/testthat/test-exitAtColumnDate.R b/tests/testthat/test-exitAtColumnDate.R index 36e0132..ce21783 100644 --- a/tests/testthat/test-exitAtColumnDate.R +++ b/tests/testthat/test-exitAtColumnDate.R @@ -27,16 +27,16 @@ test_that("exit at first date", { name = "cohort1" ) expect_true(all( - cdm$cohort1 %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort1 |> dplyr::pull("cohort_start_date") |> sort() == c("1989-12-09", "2000-01-01", "2000-06-03", "2000-12-09", "2015-01-15") )) expect_true(all( - cdm$cohort1 %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort1 |> dplyr::pull("cohort_end_date") |> sort() == c("1990-12-09", "2001-01-01", "2001-08-01", "2002-12-09", "2015-01-15") )) # activate test when arrange works for duckdb # expect_true(all( - # cdm$cohort1 %>% dplyr::pull("exit_reason") %>% sort() == + # cdm$cohort1 |> dplyr::pull("exit_reason") |> sort() == # c('cohort_end_date', 'other_date_1', 'other_date_1', # 'other_date_2; cohort_end_date; other_date_1', 'other_date_2; other_date_1') # )) @@ -50,11 +50,11 @@ test_that("exit at first date", { returnReason = FALSE ) expect_true(all( - cdm$cohort %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort |> dplyr::pull("cohort_start_date") |> sort() == c("1989-12-09", "2000-01-01", "2000-06-03", "2000-12-09", "2015-01-15") )) expect_true(all( - cdm$cohort %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort |> dplyr::pull("cohort_end_date") |> sort() == c("1990-12-09", "2001-01-01", "2001-08-01", "2002-12-09", "2015-01-15") )) expect_true(all(colnames(cdm$cohort) == @@ -93,11 +93,11 @@ test_that("exit at last date", { name = "cohort1" ) expect_true(all( - cdm$cohort1 %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort1 |> dplyr::pull("cohort_start_date") |> sort() == c("1989-12-09", "2000-01-01", "2000-06-03", "2000-12-09", "2015-01-15") )) expect_true(all( - cdm$cohort1 %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort1 |> dplyr::pull("cohort_end_date") |> sort() == c("1990-12-09", "2001-01-12", "2001-09-02", "2002-12-09", "2015-02-15") )) expect_true(all(colnames(cdm$cohort1) == @@ -120,16 +120,16 @@ test_that("exit at last date", { returnReason = TRUE ) expect_true(all( - cdm$cohort %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort |> dplyr::pull("cohort_start_date") |> sort() == c("1989-12-09", "2000-01-01", "2000-06-03", "2000-12-09", "2015-01-15") )) expect_true(all( - cdm$cohort %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort |> dplyr::pull("cohort_end_date") |> sort() == c("2000-11-09", "2001-01-01", "2001-09-02", "2002-12-10", "2015-04-15") )) expect_true(all(colnames(cdm$cohort) == c("cohort_definition_id", "subject_id", "cohort_start_date", "cohort_end_date", "exit_reason"))) - expect_true(all(cdm$cohort %>% dplyr::pull("exit_reason") %in% c("other_date_1", "other_date_2"))) + expect_true(all(cdm$cohort |> dplyr::pull("exit_reason") %in% c("other_date_1", "other_date_2"))) PatientProfiles::mockDisconnect(cdm) }) diff --git a/tests/testthat/test-intersectCohorts.R b/tests/testthat/test-intersectCohorts.R index eea5f5f..31a7158 100644 --- a/tests/testthat/test-intersectCohorts.R +++ b/tests/testthat/test-intersectCohorts.R @@ -24,6 +24,7 @@ test_that("intersect example - two cohorts", { "2020-01-10")) )) cdm <- cdm_local |> copyCdm() + cdm$my_cohort <- cdm$my_cohort |> omopgenerics::newCohortTable() @@ -461,15 +462,15 @@ test_that("codelist", { # intersect concept generated cohort cdm$cohort2 <- intersectCohorts(cdm$cohort1, name = "cohort2") expect_true(all( - cdm$cohort2 %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort2 |> dplyr::pull("cohort_start_date") |> sort() == c("2012-01-21", "2014-02-09") )) expect_true(all( - cdm$cohort2 %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort2 |> dplyr::pull("cohort_end_date") |> sort() == c("2012-03-11", "2014-03-31") )) expect_true(all( - cdm$cohort2 %>% dplyr::pull("subject_id") %>% sort() == c(1, 1) + cdm$cohort2 |> dplyr::pull("subject_id") |> sort() == c(1, 1) )) codes <- attr(cdm$cohort2, "cohort_codelist") expect_true(all(codes |> dplyr::pull("codelist_name") |> sort() == c(rep("c1", 2), "c2"))) @@ -481,17 +482,17 @@ test_that("codelist", { cdm$cohort3 <- intersectCohorts(cdm$cohort1, returnNonOverlappingCohorts = TRUE, name = "cohort3") expect_identical(collectCohort(cdm$cohort3, 1), collectCohort(cdm$cohort2, 1)) expect_true(all( - cdm$cohort3 %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort3 |> dplyr::pull("cohort_start_date") |> sort() == c('2009-12-22', '2010-01-01', '2010-01-11', '2010-05-31', '2012-01-21', '2012-03-12', '2012-09-27', '2014-02-09', '2014-04-01', '2014-12-06') )) expect_true(all( - cdm$cohort3 %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort3 |> dplyr::pull("cohort_end_date") |> sort() == c('2010-05-04', '2011-08-24', '2012-01-20', '2012-03-11', '2014-02-08', '2014-02-09', '2014-03-31', '2014-05-20', '2014-12-10', '2015-06-24') )) expect_true(all( - cdm$cohort3 %>% dplyr::pull("subject_id") %>% sort() == c(1, 1, 1, 1, 1, 1, 2, 3, 3, 3) + cdm$cohort3 |> dplyr::pull("subject_id") |> sort() == c(1, 1, 1, 1, 1, 1, 2, 3, 3, 3) )) codes <- attr(cdm$cohort3, "cohort_codelist") expect_true(all(codes |> dplyr::pull("codelist_name") |> sort() == c(rep("c1", 4), rep("c2", 2)))) @@ -502,15 +503,15 @@ test_that("codelist", { # only comb cdm$cohort4 <- intersectCohorts(cdm$cohort1, keepOriginalCohorts = FALSE, name = "cohort4") expect_true(all( - cdm$cohort4 %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort4 |> dplyr::pull("cohort_start_date") |> sort() == c("2012-01-21", "2014-02-09") )) expect_true(all( - cdm$cohort4 %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort4 |> dplyr::pull("cohort_end_date") |> sort() == c("2012-03-11", "2014-03-31") )) expect_true(all( - cdm$cohort4 %>% dplyr::pull("subject_id") %>% sort() == c(1, 1) + cdm$cohort4 |> dplyr::pull("subject_id") |> sort() == c(1, 1) )) codes <- attr(cdm$cohort4, "cohort_codelist") expect_true(all(codes |> dplyr::pull("codelist_name") |> sort() == c(rep("c1", 2), "c2"))) diff --git a/tests/testthat/test-matchCohorts.R b/tests/testthat/test-matchCohorts.R index a0112bd..4e102e6 100644 --- a/tests/testthat/test-matchCohorts.R +++ b/tests/testthat/test-matchCohorts.R @@ -91,9 +91,9 @@ test_that("matchCohorts, no duplicated people within a cohort", { matchYearOfBirth = TRUE, ratio = 1) - p1 <- cdm$new_cohort %>% - dplyr::filter(cohort_definition_id == 1) %>% - dplyr::select(subject_id) %>% + p1 <- cdm$new_cohort |> + dplyr::filter(cohort_definition_id == 1) |> + dplyr::select(subject_id) |> dplyr::pull() expect_true(anyDuplicated(p1) == 0L) @@ -109,9 +109,9 @@ test_that("matchCohorts, no duplicated people within a cohort", { matchSex = TRUE, matchYearOfBirth = TRUE, ratio = 5) - p1 <- cdm$new_cohort %>% - dplyr::filter(cohort_definition_id == 2) %>% - dplyr::select(subject_id) %>% + p1 <- cdm$new_cohort |> + dplyr::filter(cohort_definition_id == 2) |> + dplyr::select(subject_id) |> dplyr::pull() expect_true(anyDuplicated(p1) == 0L) @@ -136,41 +136,41 @@ test_that("check that we obtain expected result when ratio is 1", { matchYearOfBirth = TRUE, ratio = 1) - expect_true(nrow(omopgenerics::cohortCount(matched_cohorts) %>% + expect_true(nrow(omopgenerics::cohortCount(matched_cohorts) |> dplyr::left_join(omopgenerics::settings(matched_cohorts), - by = "cohort_definition_id") %>% - dplyr::filter(stringr::str_detect(cohort_name, "cohort_1")) %>% - dplyr::select("number_records") %>% + by = "cohort_definition_id") |> + dplyr::filter(stringr::str_detect(cohort_name, "cohort_1")) |> + dplyr::select("number_records") |> dplyr::distinct()) == 1) - expect_true(nrow(omopgenerics::cohortCount(matched_cohorts) %>% + expect_true(nrow(omopgenerics::cohortCount(matched_cohorts) |> dplyr::left_join(omopgenerics::settings(matched_cohorts), - by = "cohort_definition_id") %>% - dplyr::filter(stringr::str_detect(cohort_name, "cohort_2")) %>% - dplyr::select("number_records") %>% + by = "cohort_definition_id") |> + dplyr::filter(stringr::str_detect(cohort_name, "cohort_2")) |> + dplyr::select("number_records") |> dplyr::distinct()) == 1) # Everybody has a match - n <- matched_cohorts %>% - dplyr::summarise(n = max(.data$cohort_definition_id, na.rm = TRUE)/2) %>% + n <- matched_cohorts |> + dplyr::summarise(n = max(.data$cohort_definition_id, na.rm = TRUE)/2) |> dplyr::pull() - cohorts <- matched_cohorts %>% - dplyr::select("person_id" = "subject_id", "cohort_definition_id") %>% + cohorts <- matched_cohorts |> + dplyr::select("person_id" = "subject_id", "cohort_definition_id") |> dplyr::inner_join( - cdm$person %>% + cdm$person |> dplyr::select("person_id", "gender_concept_id", "year_of_birth"), by = "person_id" ) - expect_true(is.na(nrow(cohorts %>% - dplyr::filter(.data$cohort_definition_id %in% c(1,2,3)) %>% + expect_true(is.na(nrow(cohorts |> + dplyr::filter(.data$cohort_definition_id %in% c(1,2,3)) |> dplyr::left_join( - cohorts %>% - dplyr::filter(.data$cohort_definition_id %in% c(4,5,6)) %>% + cohorts |> + dplyr::filter(.data$cohort_definition_id %in% c(4,5,6)) |> dplyr::mutate("cohort_definition_id" = .data$cohort_definition_id-n), by = c("cohort_definition_id", "gender_concept_id", "year_of_birth") - ) %>% + ) |> dplyr::filter( is.na(person_id.y) )))) @@ -233,44 +233,44 @@ test_that("test exactMatchingCohort with a ratio bigger than 1", { ratio = 4) expect_true( - cdm[["new_cohort"]] %>% + cdm[["new_cohort"]] |> cohortCount() |> dplyr::filter(.data$cohort_definition_id %in% omopgenerics::getCohortId( cdm$new_cohort, "cohort_1_matched" - )) %>% + )) |> dplyr::pull("number_subjects") |> sum() == 2 ) expect_true( - cdm[["new_cohort"]] %>% + cdm[["new_cohort"]] |> cohortCount() |> dplyr::filter(.data$cohort_definition_id %in% omopgenerics::getCohortId( cdm$new_cohort, "matched_to_cohort_1" - )) %>% + )) |> dplyr::pull("number_subjects") |> sum() == 8 ) expect_true( - cdm[["new_cohort"]] %>% + cdm[["new_cohort"]] |> cohortCount() |> dplyr::filter(.data$cohort_definition_id %in% omopgenerics::getCohortId( cdm$new_cohort, "cohort_2_matched" - )) %>% + )) |> dplyr::pull("number_subjects") |> sum() == 2 ) expect_true( - cdm[["new_cohort"]] %>% + cdm[["new_cohort"]] |> cohortCount() |> dplyr::filter(.data$cohort_definition_id %in% omopgenerics::getCohortId( cdm$new_cohort, "matched_to_cohort_2" - )) %>% + )) |> dplyr::pull("number_subjects") |> sum() == 8 ) - outc <- cdm[["new_cohort"]] %>% - dplyr::filter(subject_id == 5) %>% dplyr::reframe(cohort_start_date) %>% + outc <- cdm[["new_cohort"]] |> + dplyr::filter(subject_id == 5) |> dplyr::reframe(cohort_start_date) |> dplyr::pull() %in% as.Date(c("2017-10-30","2003-01-04","2014-12-15","2010-09-09")) expect_true(unique(outc) == TRUE) diff --git a/tests/testthat/test-requireCohortIntersect.R b/tests/testthat/test-requireCohortIntersect.R index a815b5c..0fe75c6 100644 --- a/tests/testthat/test-requireCohortIntersect.R +++ b/tests/testthat/test-requireCohortIntersect.R @@ -14,15 +14,15 @@ test_that("requiring presence in another cohort", { name = "cohort3") expect_identical(colnames(cdm$cohort3), colnames(cdm$cohort1)) - expect_true(all(cdm$cohort3 %>% - dplyr::distinct(subject_id) %>% + expect_true(all(cdm$cohort3 |> + dplyr::distinct(subject_id) |> dplyr::pull() %in% - intersect(cdm$cohort1 %>% - dplyr::distinct(subject_id) %>% + intersect(cdm$cohort1 |> + dplyr::distinct(subject_id) |> dplyr::pull(), - cdm$cohort2 %>% - dplyr::filter(cohort_definition_id == 1) %>% - dplyr::distinct(subject_id) %>% + cdm$cohort2 |> + dplyr::filter(cohort_definition_id == 1) |> + dplyr::distinct(subject_id) |> dplyr::pull()))) expect_true(all(omopgenerics::attrition(cdm$cohort3)$reason == c("Initial qualifying events", @@ -35,15 +35,15 @@ test_that("requiring presence in another cohort", { targetCohortId = 2, window = list(c(-Inf, Inf)), name = "cohort4") - expect_true(all(cdm$cohort4 %>% - dplyr::distinct(subject_id) %>% + expect_true(all(cdm$cohort4 |> + dplyr::distinct(subject_id) |> dplyr::pull() %in% - intersect(cdm$cohort1 %>% - dplyr::distinct(subject_id) %>% + intersect(cdm$cohort1 |> + dplyr::distinct(subject_id) |> dplyr::pull(), - cdm$cohort2 %>% - dplyr::filter(cohort_definition_id == 2) %>% - dplyr::distinct(subject_id) %>% + cdm$cohort2 |> + dplyr::filter(cohort_definition_id == 2) |> + dplyr::distinct(subject_id) |> dplyr::pull()))) expect_true(all(omopgenerics::attrition(cdm$cohort4)$reason == c("Initial qualifying events", @@ -159,11 +159,11 @@ test_that("requiring absence in another cohort", { targetCohortId = 1, window = c(-Inf, Inf), name = "cohort3_exclusion") - in_both <- intersect(cdm$cohort3_inclusion %>% - dplyr::pull("subject_id") %>% + in_both <- intersect(cdm$cohort3_inclusion |> + dplyr::pull("subject_id") |> unique(), - cdm$cohort3_exclusion %>% - dplyr::pull("subject_id") %>% + cdm$cohort3_exclusion |> + dplyr::pull("subject_id") |> unique()) expect_true(length(in_both) == 0) expect_true(all(omopgenerics::attrition(cdm$cohort3_exclusion)$reason == diff --git a/tests/testthat/test-requireConceptIntersect.R b/tests/testthat/test-requireConceptIntersect.R index 8d1368b..b8683d6 100644 --- a/tests/testthat/test-requireConceptIntersect.R +++ b/tests/testthat/test-requireConceptIntersect.R @@ -146,18 +146,18 @@ test_that("requiring absence in another cohort", { window = c(-Inf, Inf), intersections = 0, name = "cohort3_exclusion") - in_both <- intersect(cdm$cohort3_inclusion %>% - dplyr::pull("subject_id") %>% + in_both <- intersect(cdm$cohort3_inclusion |> + dplyr::pull("subject_id") |> unique(), - cdm$cohort3_exclusion %>% - dplyr::pull("subject_id") %>% + cdm$cohort3_exclusion |> + dplyr::pull("subject_id") |> unique()) expect_true(length(in_both) == 0) - in_both <- intersect(cdm$cohort3_inclusion %>% - dplyr::pull("cohort_start_date") %>% + in_both <- intersect(cdm$cohort3_inclusion |> + dplyr::pull("cohort_start_date") |> sort(), - cdm$cohort3_exclusion %>% - dplyr::pull("cohort_start_date") %>% + cdm$cohort3_exclusion |> + dplyr::pull("cohort_start_date") |> sort()) expect_true(length(in_both) == 0) expect_true(all(omopgenerics::attrition(cdm$cohort3_exclusion)$reason == diff --git a/tests/testthat/test-requireDateRange.R b/tests/testthat/test-requireDateRange.R index 8d67479..d6517fa 100644 --- a/tests/testthat/test-requireDateRange.R +++ b/tests/testthat/test-requireDateRange.R @@ -8,32 +8,32 @@ test_that("requireDateRange", { cdm <- cdm_local |> copyCdm() # empty result - cdm$cohort1 <- cdm$cohort1 %>% + cdm$cohort1 <- cdm$cohort1 |> requireInDateRange(dateRange = as.Date(c("2010-01-01", "2011-01-01"))) expect_true(all(cohortCount(cdm$cohort1)$number_records == c(0, 0))) expect_true(all(cohortCount(cdm$cohort1)$number_subjects == c(0, 0))) expect_true(cdm$cohort1 |> dplyr::tally() |> dplyr::pull("n") == 0) - cdm$cohort1 <- cdm$cohort2 %>% + cdm$cohort1 <- cdm$cohort2 |> requireInDateRange(dateRange = as.Date(c("2010-01-01", "2020-01-01")), name = "cohort1") - expect_true(cdm$cohort1 %>% + expect_true(cdm$cohort1 |> dplyr::pull("subject_id") |> unique() == 3L) - expect_true(all(cdm$cohort1 %>% - dplyr::arrange(.data$cohort_start_date) %>% + expect_true(all(cdm$cohort1 |> + dplyr::arrange(.data$cohort_start_date) |> dplyr::pull("cohort_start_date") == c("2015-01-25", "2015-02-02"))) # index date - cdm$cohort3 <- cdm$cohort2 %>% - dplyr::mutate(new_index_date = as.Date("2000-03-30")) %>% + cdm$cohort3 <- cdm$cohort2 |> + dplyr::mutate(new_index_date = as.Date("2000-03-30")) |> requireInDateRange(dateRange = as.Date(c("2000-01-01", "2001-01-01")), name = "cohort3", indexDate = "new_index_date") expect_identical(cdm$cohort3 |> dplyr::pull("cohort_start_date"), cdm$cohort2 |> dplyr::pull("cohort_start_date")) # 1 cohort id - cdm$cohort4 <- cdm$cohort2 %>% + cdm$cohort4 <- cdm$cohort2 |> requireInDateRange(dateRange = as.Date(c("2000-01-01", "2001-01-01")), cohortId = 1, name = "cohort4") @@ -48,7 +48,7 @@ test_that("requireDateRange", { c("1999-07-11", "2000-01-11", "2000-05-28", "2000-06-17", "2004-12-12", "2015-02-02"))) # NA expect_no_error( - cdm$cohort5 <- cdm$cohort2 %>% + cdm$cohort5 <- cdm$cohort2 |> requireInDateRange(dateRange = as.Date(c(NA, "2010-01-01")), name = "cohort5") ) expect_true(all(cdm$cohort5 |> dplyr::pull("cohort_start_date") |> sort() == @@ -60,7 +60,7 @@ test_that("requireDateRange", { "cohort_start_date before 2010-01-01"))) expect_no_error( - cdm$cohort6 <- cdm$cohort2 %>% + cdm$cohort6 <- cdm$cohort2 |> requireInDateRange(dateRange = as.Date(c("2000-01-01", NA)), name = "cohort6") ) expect_true(all(cdm$cohort6 |> dplyr::pull("cohort_start_date") |> sort() == @@ -71,26 +71,26 @@ test_that("requireDateRange", { "Initial qualifying events", "cohort_start_date after 2000-01-01"))) expect_no_error( - cdm$cohort7 <- cdm$cohort2 %>% + cdm$cohort7 <- cdm$cohort2 |> requireInDateRange(dateRange = as.Date(c(NA, NA)), name = "cohort7") ) expect_identical(cdm$cohort7 |> dplyr::collect(), cdm$cohort2 |> dplyr::collect()) # expect error expect_error(requireInDateRange(cohort = "a")) - expect_error(cdm$cohort1 %>% + expect_error(cdm$cohort1 |> requireInDateRange(dateRange = as.Date(c("2010-01-01")))) - expect_error(cdm$cohort1 %>% + expect_error(cdm$cohort1 |> requireInDateRange(dateRange = as.Date(c("2010-01-01", "2010-01-01", "2009-01-01")))) - expect_error(cdm$cohort1 %>% + expect_error(cdm$cohort1 |> requireInDateRange(dateRange = c("a", "b"))) expect_error( - cdm$cohort1 %>% + cdm$cohort1 |> requireInDateRange(dateRange = as.Date(c("2010-01-01", "2010-01-01")), indexDate = "subject_id") ) expect_error( - cdm$cohort1 %>% + cdm$cohort1 |> requireInDateRange(dateRange = as.Date(c("2011-01-01", "2010-01-01"))) ) @@ -106,25 +106,25 @@ test_that("trim cohort dates", { omock::mockCohort(name = c("cohort2"), numberCohorts = 2, seed = 2) cdm <- cdm_local |> copyCdm() - cdm$cohort1 <- cdm$cohort1 %>% + cdm$cohort1 <- cdm$cohort1 |> trimToDateRange(dateRange = as.Date(c("2001-01-01", "2005-01-01"))) - expect_identical(sort(cdm$cohort1 %>% + expect_identical(sort(cdm$cohort1 |> dplyr::pull("subject_id")), as.integer(c(1, 1, 1, 1, 1, 1, 2))) - expect_true(all(cdm$cohort1 %>% + expect_true(all(cdm$cohort1 |> dplyr::pull("cohort_start_date") == c("2003-05-17", "2004-03-11", "2001-01-01", "2001-03-24", "2001-11-28", "2002-01-30", "2002-06-13"))) - expect_true(all(cdm$cohort1 %>% + expect_true(all(cdm$cohort1 |> dplyr::pull("cohort_end_date") == c("2004-03-10", "2005-01-01", "2001-06-15", "2001-11-27", "2002-01-29", "2002-06-12", "2005-01-01"))) # cohort id - cdm$cohort3 <- cdm$cohort2 %>% + cdm$cohort3 <- cdm$cohort2 |> trimToDateRange(dateRange = as.Date(c("2001-01-01", "2005-01-01")), cohortId = "cohort_1", name = "cohort3") expect_true(omopgenerics::cohortCount(cdm$cohort3)$number_records[1] == 2) - expect_identical(sort(cdm$cohort3 %>% + expect_identical(sort(cdm$cohort3 |> dplyr::pull("subject_id")), as.integer(c(1, 1, 1, 2, 2, 3))) expect_identical(omopgenerics::attrition(cdm$cohort3)$reason[ omopgenerics::attrition(cdm$cohort3)$cohort_definition_id == 1], c("Initial qualifying events", "cohort_start_date >= 2001-01-01", "cohort_end_date <= 2005-01-01")) @@ -132,21 +132,21 @@ test_that("trim cohort dates", { omopgenerics::attrition(cdm$cohort3)$cohort_definition_id == 2], "Initial qualifying events") # NA - cdm$cohort4 <- cdm$cohort2 %>% + cdm$cohort4 <- cdm$cohort2 |> trimToDateRange(dateRange = as.Date(c(NA, "2005-01-01")), cohortId = 1, name = "cohort4") - expect_identical(sort(cdm$cohort4 %>% dplyr::pull("cohort_end_date")), as.Date(c("2000-05-27", "2001-09-08", "2002-03-26", "2004-12-11", "2005-01-01", "2007-09-06", "2015-08-12"))) + expect_identical(sort(cdm$cohort4 |> dplyr::pull("cohort_end_date")), as.Date(c("2000-05-27", "2001-09-08", "2002-03-26", "2004-12-11", "2005-01-01", "2007-09-06", "2015-08-12"))) expect_identical(omopgenerics::attrition(cdm$cohort4)$reason, c("Initial qualifying events", "cohort_end_date <= 2005-01-01", "Initial qualifying events")) - cdm$cohort5 <- cdm$cohort2 %>% + cdm$cohort5 <- cdm$cohort2 |> trimToDateRange(dateRange = as.Date(c("2005-01-01", NA)), cohortId = 1, name = "cohort5") - expect_identical(sort(cdm$cohort5 %>% dplyr::pull("cohort_start_date")), as.Date(c("1999-07-11", "2000-06-17", "2004-12-12", "2005-01-01", "2015-01-25", "2015-02-02"))) + expect_identical(sort(cdm$cohort5 |> dplyr::pull("cohort_start_date")), as.Date(c("1999-07-11", "2000-06-17", "2004-12-12", "2005-01-01", "2015-01-25", "2015-02-02"))) expect_identical(omopgenerics::attrition(cdm$cohort5)$reason, c("Initial qualifying events", "cohort_start_date >= 2005-01-01", "Initial qualifying events")) - cdm$cohort6 <- cdm$cohort2 %>% + cdm$cohort6 <- cdm$cohort2 |> trimToDateRange(dateRange = as.Date(c(NA, NA)), cohortId = 1, name = "cohort6") diff --git a/tests/testthat/test-requireDemographics.R b/tests/testthat/test-requireDemographics.R index 1eb9222..060d9d5 100644 --- a/tests/testthat/test-requireDemographics.R +++ b/tests/testthat/test-requireDemographics.R @@ -9,7 +9,7 @@ test_that("test it works and expected errors", { dplyr::mutate(dplyr::across(dplyr::ends_with("of_birth"), ~ as.numeric(.x))) cdm <- cdm_local |> copyCdm() - cdm$cohort1 <- cdm$cohort %>% + cdm$cohort1 <- cdm$cohort |> requireDemographics( ageRange = c(0, 35), indexDate = "cohort_start_date", @@ -37,10 +37,10 @@ test_that("test it works and expected errors", { 'Future observation requirement: 40 days') )) - cdm$cohort <- cdm$cohort %>% - requireAge(ageRange = list(c(0, 35))) %>% - requireSex(sex = "Both") %>% - requirePriorObservation(minPriorObservation = 10) %>% + cdm$cohort <- cdm$cohort |> + requireAge(ageRange = list(c(0, 35))) |> + requireSex(sex = "Both") |> + requirePriorObservation(minPriorObservation = 10) |> requireFutureObservation(minFutureObservation = 40) expect_true(inherits(cdm$cohort, "cohort_table")) @@ -129,9 +129,9 @@ test_that("restrictions applied to single cohort", { cdm_local$person <- cdm_local$person |> dplyr::mutate(dplyr::across(dplyr::ends_with("of_birth"), ~ as.numeric(.x))) cdm <- cdm_local |> copyCdm() - cdm$cohort1 <- cdm$cohort %>% + cdm$cohort1 <- cdm$cohort |> requireDemographics(ageRange = list(c(0, 5)), name = "cohort1") - expect_true(all(c("2001-03-30", "2003-06-15") == cdm$cohort1 %>% dplyr::pull("cohort_start_date"))) + expect_true(all(c("2001-03-30", "2003-06-15") == cdm$cohort1 |> dplyr::pull("cohort_start_date"))) expect_true(all( c("Initial qualifying events", "Age requirement: 0 to 5", "Sex requirement: Both", "Prior observation requirement: 0 days", "Future observation requirement: 0 days") == @@ -145,7 +145,7 @@ test_that("restrictions applied to single cohort", { expect_true(settings(cdm$cohort1)$min_prior_observation == 0) expect_true(settings(cdm$cohort1)$min_future_observation == 0) - cdm$cohort2 <- cdm$cohort %>% + cdm$cohort2 <- cdm$cohort |> requireDemographics(sex = "Male", name = "cohort2") expect_identical(dplyr::collect(cdm$cohort)$cohort_start_date, dplyr::collect(cdm$cohort2)$cohort_start_date) expect_true(all( @@ -209,7 +209,7 @@ test_that("external columns kept after requireDemographics", { omock::mockPerson(n = 1,seed = 1) |> omock::mockObservationPeriod(seed = 1) |> omock::mockCohort(recordPerson = 3,seed = 1) - cdm_local$cohort <- cdm_local$cohort %>% + cdm_local$cohort <- cdm_local$cohort |> dplyr::mutate( col_extra1 = as.numeric(subject_id) + 1, col_extra2 = as.numeric(subject_id) + 2, @@ -220,7 +220,7 @@ test_that("external columns kept after requireDemographics", { dplyr::mutate(dplyr::across(dplyr::ends_with("of_birth"), ~ as.numeric(.x))) cdm <- cdm_local |> copyCdm() - cdm$cohort <- cdm$cohort %>% + cdm$cohort <- cdm$cohort |> requireDemographics(indexDate = "new_index_date", ageRange = list(c(0,5))) expect_true(all(c("col_extra1", "col_extra2", "new_index_date") %in% colnames(cdm$cohort))) diff --git a/tests/testthat/test-requireIsEntry.R b/tests/testthat/test-requireIsEntry.R index a312151..cb24999 100644 --- a/tests/testthat/test-requireIsEntry.R +++ b/tests/testthat/test-requireIsEntry.R @@ -38,8 +38,8 @@ test_that("requireIsFirstEntry, cohortIds & name arguments", { counts_new <- omopgenerics::cohortCount(cdm$new_cohort) expect_identical(counts |> dplyr::filter(cohort_definition_id %in% 2:3), counts_new |> dplyr::filter(cohort_definition_id %in% 2:3)) - expect_false(counts |> dplyr::filter(cohort_definition_id == 1) %>% dplyr::pull(number_records) == - counts_new |> dplyr::filter(cohort_definition_id == 1) %>% dplyr::pull(number_records)) + expect_false(counts |> dplyr::filter(cohort_definition_id == 1) |> dplyr::pull(number_records) == + counts_new |> dplyr::filter(cohort_definition_id == 1) |> dplyr::pull(number_records)) expect_identical(counts_new |> dplyr::filter(cohort_definition_id == 1), dplyr::tibble(cohort_definition_id = 1L, number_records = 3L, number_subjects = 3L)) expect_true(all(cdm$new_cohort |> dplyr::pull(cohort_start_date) == c("2001-05-29", "1999-07-30", "2015-01-23", "2002-10-09", "2003-09-12", @@ -88,8 +88,8 @@ test_that("requireIsLastEntry", { counts_new <- omopgenerics::cohortCount(cdm$new_cohort) expect_identical(counts |> dplyr::filter(cohort_definition_id %in% 2:3), counts_new |> dplyr::filter(cohort_definition_id %in% 2:3)) - expect_false(counts |> dplyr::filter(cohort_definition_id == 1) %>% dplyr::pull(number_records) == - counts_new |> dplyr::filter(cohort_definition_id == 1) %>% dplyr::pull(number_records)) + expect_false(counts |> dplyr::filter(cohort_definition_id == 1) |> dplyr::pull(number_records) == + counts_new |> dplyr::filter(cohort_definition_id == 1) |> dplyr::pull(number_records)) expect_identical(counts_new |> dplyr::filter(cohort_definition_id == 1), dplyr::tibble(cohort_definition_id = 1L, number_records = 3L, number_subjects = 3L)) expect_true(all(cdm$new_cohort |> dplyr::pull(cohort_start_date) == c("2004-01-08", "1999-07-30", "2015-02-17", "2002-10-09", "2003-09-12", diff --git a/tests/testthat/test-unionCohorts.R b/tests/testthat/test-unionCohorts.R index 999c713..782bd7f 100644 --- a/tests/testthat/test-unionCohorts.R +++ b/tests/testthat/test-unionCohorts.R @@ -7,15 +7,15 @@ test_that("unionCohorts works", { # simple example cdm$cohort2 <- unionCohorts(cdm$cohort1, name = "cohort2") expect_true(all( - cdm$cohort2 %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort2 |> dplyr::pull("cohort_start_date") |> sort() == c("1999-05-03", "2001-03-24", "2015-01-22") )) expect_true(all( - cdm$cohort2 %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort2 |> dplyr::pull("cohort_end_date") |> sort() == c("2002-06-07", "2009-06-12", "2015-06-22") )) expect_true(all( - cdm$cohort2 %>% dplyr::pull("subject_id") %>% sort() == 1:3 + cdm$cohort2 |> dplyr::pull("subject_id") |> sort() == 1:3 )) expect_true(all(attrition(cdm$cohort2) == dplyr::tibble( @@ -32,15 +32,15 @@ test_that("unionCohorts works", { # choose cohort Id cdm$cohort3 <- unionCohorts(cdm$cohort1, cohortId = 1:2, name = "cohort3") expect_true(all( - cdm$cohort3 %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort3 |> dplyr::pull("cohort_start_date") |> sort() == c("1999-05-03", "2001-03-24", "2001-11-28", "2002-01-30", "2002-06-13", "2015-02-25") )) expect_true(all( - cdm$cohort3 %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort3 |> dplyr::pull("cohort_end_date") |> sort() == c("2001-06-15", "2001-11-27", "2002-01-29", "2002-06-12", "2005-07-19", "2015-04-30") )) expect_true(all( - cdm$cohort3 %>% dplyr::pull("subject_id") %>% sort() == c(1, 1, 1, 1, 2, 3) + cdm$cohort3 |> dplyr::pull("subject_id") |> sort() == c(1, 1, 1, 1, 2, 3) )) expect_true(all( attrition(cdm$cohort3) == @@ -93,15 +93,15 @@ test_that("gap and name works", { # gap cdm$cohort2 <- unionCohorts(cdm$cohort1, gap = 2, name = "cohort2") expect_true(all( - cdm$cohort2 %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort2 |> dplyr::pull("cohort_start_date") |> sort() == c("2000-07-01", "2000-07-10") )) expect_true(all( - cdm$cohort2 %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort2 |> dplyr::pull("cohort_end_date") |> sort() == c("2000-07-02", "2000-08-22") )) expect_true(all( - cdm$cohort2 %>% dplyr::pull("subject_id") %>% sort() == 1 + cdm$cohort2 |> dplyr::pull("subject_id") |> sort() == 1 )) expect_true(all(attrition(cdm$cohort2) == dplyr::tibble( @@ -119,17 +119,17 @@ test_that("gap and name works", { # names cdm$cohort <- unionCohorts(cdm$cohort, gap = 2, cohortName = "test") expect_true(all( - cdm$cohort %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort |> dplyr::pull("cohort_start_date") |> sort() == c("1991-07-14", "1991-10-21", "1995-01-27", "1999-07-26", "1999-08-22", "2002-08-29", "2003-02-07", "2015-02-04", "2015-02-16", "2015-03-07") )) expect_true(all( - cdm$cohort %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort |> dplyr::pull("cohort_end_date") |> sort() == c("1991-08-14", "1994-05-05", "1995-09-11", "1999-08-15", "2001-07-23", "2002-12-29", "2007-06-11", "2015-02-12", "2015-02-26", "2015-07-28") )) expect_true(all( - cdm$cohort %>% dplyr::pull("subject_id") %>% sort() == c(1, 1, rep(2, 2), rep(3, 3), rep(4, 3)) + cdm$cohort |> dplyr::pull("subject_id") |> sort() == c(1, 1, rep(2, 2), rep(3, 3), rep(4, 3)) )) expect_true(all(attrition(cdm$cohort) == dplyr::tibble( @@ -237,15 +237,15 @@ test_that("test codelist", { # Union concept generated cohort cdm$cohort2 <- unionCohorts(cdm$cohort1, name = "cohort2") expect_true(all( - cdm$cohort2 %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort2 |> dplyr::pull("cohort_start_date") |> sort() == c("2009-12-22", "2010-01-01", "2010-01-11", "2010-05-31", "2012-09-27", "2014-12-06") )) expect_true(all( - cdm$cohort2 %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort2 |> dplyr::pull("cohort_end_date") |> sort() == c("2010-05-04", "2011-08-24", "2014-02-09", "2014-05-20", "2014-12-10", "2015-06-24") )) expect_true(all( - cdm$cohort2 %>% dplyr::pull("subject_id") %>% sort() == c(1, 1, 2, 3, 3, 4) + cdm$cohort2 |> dplyr::pull("subject_id") |> sort() == c(1, 1, 2, 3, 3, 4) )) codes <- attr(cdm$cohort2, "cohort_codelist") expect_true(all(codes |> dplyr::pull("codelist_name") |> sort() == c(rep("c1", 2), "c2"))) @@ -257,15 +257,15 @@ test_that("test codelist", { cdm <- omopgenerics::bind(cdm$cohort, cdm$cohort1, name = "cohort3") cdm$cohort4 <- unionCohorts(cdm$cohort3, name = "cohort4") expect_true(all( - cdm$cohort4 %>% dplyr::pull("cohort_start_date") %>% sort() == + cdm$cohort4 |> dplyr::pull("cohort_start_date") |> sort() == c("1999-05-03", "2003-05-17", "2004-03-11", "2009-12-22", "2010-01-01", "2010-01-11", "2010-05-31", "2012-09-27", "2014-12-06", "2015-02-25") )) expect_true(all( - cdm$cohort4 %>% dplyr::pull("cohort_end_date") %>% sort() == + cdm$cohort4 |> dplyr::pull("cohort_end_date") |> sort() == c("2001-06-15", "2004-03-10", "2005-07-19", "2010-05-04", "2011-08-24", "2014-02-09", "2014-05-20", "2014-12-10", "2015-04-30", "2015-06-24") )) expect_true(all( - cdm$cohort4 %>% dplyr::pull("subject_id") %>% sort() == c(1, 1, 1, 1, 2, 2, 3, 3, 3, 4) + cdm$cohort4 |> dplyr::pull("subject_id") |> sort() == c(1, 1, 1, 1, 2, 2, 3, 3, 3, 4) )) codes <- attr(cdm$cohort4, "cohort_codelist") expect_true(all(codes |> dplyr::pull("codelist_name") |> sort() == c(rep("c1", 2), "c2"))) diff --git a/vignettes/a02_cohort_table_requirements.Rmd b/vignettes/a02_cohort_table_requirements.Rmd index 7a5fa95..cecd4cf 100644 --- a/vignettes/a02_cohort_table_requirements.Rmd +++ b/vignettes/a02_cohort_table_requirements.Rmd @@ -66,7 +66,7 @@ plotCohortAttrition(summary_attrition) We can see that in our starting cohort individuals have multiple entries for each use of acetaminophen. However, we could keep only their earliest cohort entry by using `requireIsFirstEntry()` from CohortConstructor. ```{r} -cdm$acetaminophen <- cdm$acetaminophen %>% +cdm$acetaminophen <- cdm$acetaminophen |> requireIsFirstEntry() summary_attrition <- summariseCohortAttrition(cdm$acetaminophen) @@ -88,7 +88,7 @@ cdm$acetaminophen <- conceptCohort(cdm = cdm, ``` ```{r} -cdm$acetaminophen <- cdm$acetaminophen %>% +cdm$acetaminophen <- cdm$acetaminophen |> requireInDateRange(dateRange = as.Date(c("2010-01-01", "2015-01-01"))) summary_attrition <- summariseCohortAttrition(cdm$acetaminophen) @@ -102,14 +102,14 @@ Multiple restrictions can be applied to a cohort, however it is important to not ```{r} cdm$acetaminophen_1 <- conceptCohort(cdm = cdm, conceptSet = acetaminophen_codes, - name = "acetaminophen_1") %>% - requireIsFirstEntry() %>% + name = "acetaminophen_1") |> + requireIsFirstEntry() |> requireInDateRange(dateRange = as.Date(c("2010-01-01", "2016-01-01"))) cdm$acetaminophen_2 <- conceptCohort(cdm = cdm, conceptSet = acetaminophen_codes, - name = "acetaminophen_2") %>% - requireInDateRange(dateRange = as.Date(c("2010-01-01", "2016-01-01"))) %>% + name = "acetaminophen_2") |> + requireInDateRange(dateRange = as.Date(c("2010-01-01", "2016-01-01"))) |> requireIsFirstEntry() ``` @@ -163,7 +163,7 @@ cohortCount(cdm$medications) |> If we apply a minimum cohort count of 500, we end up with far fewer cohorts that all have a sufficient number of study participants. ```{r} -cdm$medications <- cdm$medications %>% +cdm$medications <- cdm$medications |> requireMinCohortCount(minCohortCount = 500) cohortCount(cdm$medications) |> diff --git a/vignettes/a03_require_demographics.Rmd b/vignettes/a03_require_demographics.Rmd index 009248d..848d4d7 100644 --- a/vignettes/a03_require_demographics.Rmd +++ b/vignettes/a03_require_demographics.Rmd @@ -64,7 +64,7 @@ plotCohortAttrition(summary_attrition) We can choose a specific age range for individuals in our cohort using `requireAge()` from CohortConstructor. ```{r} -cdm$fracture <- cdm$fracture %>% +cdm$fracture <- cdm$fracture |> requireAge(indexDate = "cohort_start_date", ageRange = list(c(18, 100))) @@ -79,7 +79,7 @@ Note that by default individuals are filtered based on the age they were when th We can also specify a sex criteria for individuals in our cohort using `requireSex()` from CohortConstructor. ```{r} -cdm$fracture <- cdm$fracture %>% +cdm$fracture <- cdm$fracture |> requireSex(sex = "Female") summary_attrition <- summariseCohortAttrition(cdm$fracture) @@ -91,7 +91,7 @@ plotCohortAttrition(summary_attrition) We can also specify a minimum number of days of prior observations for each individual using `requirePriorObservation()` from CohortConstructor. ```{r} -cdm$fracture <- cdm$fracture %>% +cdm$fracture <- cdm$fracture |> requirePriorObservation(indexDate = "cohort_start_date", minPriorObservation = 365) @@ -108,7 +108,7 @@ We can implement multiple demographic requirements at the same time by using the ```{r} cdm$fracture <- conceptCohort(cdm = cdm, conceptSet = fracture_codes, - name = "fracture") %>% + name = "fracture") |> requireDemographics(indexDate = "cohort_start_date", ageRange = c(18,100), sex = "Female", diff --git a/vignettes/a04_require_intersections.Rmd b/vignettes/a04_require_intersections.Rmd index e04671c..7c58717 100644 --- a/vignettes/a04_require_intersections.Rmd +++ b/vignettes/a04_require_intersections.Rmd @@ -69,7 +69,7 @@ cdm$gi_bleed <- conceptCohort(cdm = cdm, We could require that individuals in our medication cohorts are seen (or not seen) in another cohort. To do this we can use the `requireCohortIntersect()` function. Here, for example, we require that individuals have one or more intersections with the GI bleed cohort. ```{r} -cdm$warfarin_gi_bleed <- cdm$warfarin %>% +cdm$warfarin_gi_bleed <- cdm$warfarin |> requireCohortIntersect(intersections = c(1,Inf), targetCohortTable = "gi_bleed", targetCohortId = 1, @@ -86,7 +86,7 @@ The flow chart above illustrates the changes to the cohort of users of acetamino Instead of requiring that individuals have a record in the GI bleed cohort, we could instead require that they don't. In this case we can again use the `requireCohortIntersect()` function, but this time we set the intersections argument to 0 so as to require individuals' absence in this other cohort. ```{r} -cdm$warfarin_no_gi_bleed <- cdm$warfarin %>% +cdm$warfarin_no_gi_bleed <- cdm$warfarin |> requireCohortIntersect(intersections = 0, targetCohortTable = "gi_bleed", targetCohortId = 1, @@ -103,7 +103,7 @@ plotCohortAttrition(summary_attrition) We could require that individuals in our medication cohorts have been seen (or not seen) to have events related to a concept list. To do this we can use the `requireConceptIntersect()` function, allowing us to filter our cohort based on whether they have or have not had events of GI bleeding before they entered the cohort. ```{r} -cdm$warfarin_gi_bleed <- cdm$warfarin %>% +cdm$warfarin_gi_bleed <- cdm$warfarin |> requireConceptIntersect(conceptSet = list("gi_bleed" = 192671), indexDate = "cohort_start_date", window = c(-Inf, 0), @@ -118,7 +118,7 @@ The flow chart above illustrates the changes to cohort 1 when restricted to onl Instead of requiring that individuals have events of GI bleeding, we could instead require that they don't have any events of it. In this case we can again use the `requireConceptIntersect()` function, but this time set the intersections argument to 0 to require individuals without past events of GI bleeding. ```{r} -cdm$warfarin_no_gi_bleed <- cdm$warfarin %>% +cdm$warfarin_no_gi_bleed <- cdm$warfarin |> requireConceptIntersect(intersections = 0, conceptSet = list("gi_bleed" = 192671), indexDate = "cohort_start_date", @@ -134,7 +134,7 @@ plotCohortAttrition(summary_attrition) We can also impose requirements around individuals presence (or absence) in clinical tables in the OMOP CDM using the `requireTableIntersect()` function. Here for example we reuire that individuals in our warfarin cohort have at least one prior record in the visit occurrence table. ```{r} -cdm$warfarin_visit <- cdm$warfarin %>% +cdm$warfarin_visit <- cdm$warfarin |> requireTableIntersect(tableName = "visit_occurrence", indexDate = "cohort_start_date", window = c(-Inf, -1), diff --git a/vignettes/a06_concatanate_cohorts.Rmd b/vignettes/a06_concatanate_cohorts.Rmd index 3f222e3..fecce8c 100644 --- a/vignettes/a06_concatanate_cohorts.Rmd +++ b/vignettes/a06_concatanate_cohorts.Rmd @@ -69,9 +69,9 @@ cdm$medications_collapsed <- collapseCohorts( Let's compare how this function would change the records of a single individual. ```{r} -cdm$medications %>% +cdm$medications |> filter(subject_id == 1) -cdm$medications_collapsed %>% +cdm$medications_collapsed |> filter(subject_id == 1) ``` Subject 1 initially had 4 records between 1971 and 1982. After specifying that records within three years of each other are to be merged, the number of records decreases to three. The record from 1980-03-15 to 1980-03-29 and the record from 1982-09-11 to 1982-10-02 are merged to create a new record from 1980-03-15 to 1982-10-02. diff --git a/vignettes/a10_match_cohorts.Rmd b/vignettes/a10_match_cohorts.Rmd index 6af4629..f0252d7 100644 --- a/vignettes/a10_match_cohorts.Rmd +++ b/vignettes/a10_match_cohorts.Rmd @@ -49,10 +49,10 @@ Notice that in the generated tibble, there are two cohorts: `cohort_definition_i Check the exclusion criteria applied to generate the new cohorts by using `cohort_attrition()` from CDMConnector package: ```{r, eval = FALSE} # Original cohort -CDMConnector::cohort_attrition(cdm$matched_cohort1) %>% filter(cohort_definition_id == 1) +CDMConnector::cohort_attrition(cdm$matched_cohort1) |> filter(cohort_definition_id == 1) # Matched cohort -CDMConnector::cohort_attrition(cdm$matched_cohort1) %>% filter(cohort_definition_id == 4) +CDMConnector::cohort_attrition(cdm$matched_cohort1) |> filter(cohort_definition_id == 4) ``` Briefly, from the original cohort, we exclude first those individuals that do not have a match, and then individuals that their matching pair is not in observation during the assigned *cohort_start_date*. From the matched cohort, we start from the whole database and we first exclude individuals that are in the original cohort. Afterwards, we exclude individuals that do not have a match, then individuals that are not in observation during the assigned *cohort_start_date*, and finally we remove as many individuals as required to fulfill the ratio. @@ -95,9 +95,9 @@ cdm$matched_cohort3 <- matchCohorts( name = "matched_cohort3", ratio = 2) -CDMConnector::cohort_set(cdm$matched_cohort3) %>% arrange(cohort_definition_id) +CDMConnector::cohort_set(cdm$matched_cohort3) |> arrange(cohort_definition_id) -CDMConnector::cohort_count(cdm$matched_cohort3) %>% arrange(cohort_definition_id) +CDMConnector::cohort_count(cdm$matched_cohort3) |> arrange(cohort_definition_id) ``` Notice that each cohort has their own (and independent of other cohorts) matched cohort.