From 450648a338d14c0bec949775383b7138177a01b7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?N=C3=BAria=20Mercad=C3=A9-Besora?= <61558739+nmercadeb@users.noreply.github.com> Date: Wed, 23 Oct 2024 14:28:53 +0100 Subject: [PATCH] %>% to |> and use of clock functions --- DESCRIPTION | 1 + R/conceptCohort.R | 2 +- R/intersectCohorts.R | 107 ++++++++---------- R/matchCohorts.R | 60 +++++----- R/padCohortEnd.R | 35 +++--- R/padCohortStart.R | 38 +++---- R/requireCohortIntersect.R | 26 ++--- R/requireConceptIntersect.R | 18 +-- R/requireDateRange.R | 16 +-- R/requireDeathFlag.R | 24 ++-- R/requireDemographics.R | 2 +- R/requireTableIntersect.R | 18 +-- R/trimDemographics.R | 48 ++++---- README.Rmd | 30 ++--- README.md | 42 +++---- data-raw/getBenchmarkResults.R | 4 +- man/CohortConstructor-package.Rd | 1 + tests/testthat/test-entryAtColumnDate.R | 26 ++--- tests/testthat/test-exitAtColumnDate.R | 20 ++-- tests/testthat/test-intersectCohorts.R | 19 ++-- tests/testthat/test-matchCohorts.R | 68 +++++------ tests/testthat/test-requireCohortIntersect.R | 36 +++--- tests/testthat/test-requireConceptIntersect.R | 16 +-- tests/testthat/test-requireDateRange.R | 54 ++++----- tests/testthat/test-requireDemographics.R | 20 ++-- tests/testthat/test-requireIsEntry.R | 8 +- tests/testthat/test-unionCohorts.R | 36 +++--- vignettes/a02_cohort_table_requirements.Rmd | 14 +-- vignettes/a03_require_demographics.Rmd | 8 +- vignettes/a04_require_intersections.Rmd | 16 +-- vignettes/a06_concatanate_cohorts.Rmd | 4 +- vignettes/a10_match_cohorts.Rmd | 8 +- 32 files changed, 401 insertions(+), 424 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2ff3b30c..97bc8344 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 461b4887..6cc3c4eb 100644 --- a/R/conceptCohort.R +++ b/R/conceptCohort.R @@ -291,7 +291,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 fc2201df..60e2b8c3 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 a89a4d10..8feac366 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 a61466f8..141851a3 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 121bb552..bbde1776 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 a610120c..0d931fdb 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 99ba2802..5592bfec 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 993f0224..5aaf7c73 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 abb6c8db..09c64d54 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 4502ab14..c64b6f3c 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 af27eb1a..44a7cf36 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 496abbad..733a2f0e 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 d7258743..45a3dfad 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 a3c66a79..99efa067 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 2335eeb7..c0da89e4 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/man/CohortConstructor-package.Rd b/man/CohortConstructor-package.Rd index fd34f5f5..ee542235 100644 --- a/man/CohortConstructor-package.Rd +++ b/man/CohortConstructor-package.Rd @@ -14,6 +14,7 @@ Create and manipulate study cohorts in data mapped to the Observational Medical Useful links: \itemize{ \item \url{https://ohdsi.github.io/CohortConstructor/} + \item \url{https://github.com/OHDSI/CohortConstructor} } } diff --git a/tests/testthat/test-entryAtColumnDate.R b/tests/testthat/test-entryAtColumnDate.R index 07c9778d..4a48605c 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 36e01327..ce21783c 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 eea5f5f0..31a71586 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 a0112bdc..4e102e6b 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 a815b5cb..0fe75c61 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 8d1368b6..b8683d69 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 8d674795..d6517fa5 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 1eb9222b..060d9d5a 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 a312151e..cb24999c 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 999c7139..782bd7f7 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 7a5fa956..cecd4cfa 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 009248d7..848d4d71 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 03dd19e1..2a9ece94 100644 --- a/vignettes/a04_require_intersections.Rmd +++ b/vignettes/a04_require_intersections.Rmd @@ -67,7 +67,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, requiring that individuals have one or more intersections with the GI bleed cohort. ```{r} -cdm$medications_gi_bleed <- cdm$medications %>% +cdm$medications_gi_bleed <- cdm$medications |> requireCohortIntersect(intersections = c(1,Inf), targetCohortTable = "gi_bleed", targetCohortId = 1, @@ -84,7 +84,7 @@ The flow chart above illustrates the changes to cohort 1 (users of acetaminophen Instead of requiring that individuals intersect with the GI bleed cohort, we could instead require that they don't intersect with it. In this case we can again use the `requireCohortIntersect()` function, but this time set the intersections argument to 0 to require individuals' absence in this other cohort rather than their presence in it. ```{r} -cdm$medications_no_gi_bleed <- cdm$medications %>% +cdm$medications_no_gi_bleed <- cdm$medications |> requireCohortIntersect(intersections = 0, targetCohortTable = "gi_bleed", targetCohortId = 1, @@ -115,7 +115,7 @@ cdm$gi_bleed <- conceptCohort(cdm = cdm, ``` ```{r} -cdm$medications_gi_bleed <- cdm$medications %>% +cdm$medications_gi_bleed <- cdm$medications |> requireConceptIntersect(conceptSet = list("gi_bleed" = 192671), indexDate = "cohort_start_date", window = c(-Inf, 0), @@ -130,7 +130,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$medications_no_gi_bleed <- cdm$medications %>% +cdm$medications_no_gi_bleed <- cdm$medications |> requireConceptIntersect(intersections = 0, conceptSet = list("gi_bleed" = 192671), indexDate = "cohort_start_date", @@ -159,7 +159,7 @@ cdm$gi_bleed <- conceptCohort(cdm = cdm, ``` ```{r} -cdm$medications_gi_bleed <- cdm$medications %>% +cdm$medications_gi_bleed <- cdm$medications |> requireTableIntersect(tableName = "gi_bleed", indexDate = "cohort_start_date", window = c(-Inf, 0), @@ -174,7 +174,7 @@ The flow chart above illustrates the changes to cohort 1 when restricted to only Instead of requiring that individuals intersect with the GI bleed clinical table, we could instead require that they don't intersect with it. In this case we can again use the `requireCohortIntersect()` function, but this time set the intersections argument to 0 to require individuals' absence in the GI bleed clinical table. ```{r} -cdm$medications_no_gi_bleed <- cdm$medications %>% +cdm$medications_no_gi_bleed <- cdm$medications |> requireTableIntersect(tableName = "gi_bleed", indexDate = "cohort_start_date", window = c(-Inf, 0), @@ -203,7 +203,7 @@ cdm$gi_bleed <- conceptCohort(cdm = cdm, ``` ```{r} -cdm$medications_deaths <- cdm$medications %>% +cdm$medications_deaths <- cdm$medications |> requireDeathFlag(window = c(0,Inf), name = "medications_deaths") @@ -216,7 +216,7 @@ The flow chart above illustrates the changes to cohort 1 when restricted to only To exclude individuals who died we add the argument 'negate = TRUE' to the function `requireDeathFlag()`. ```{r} -cdm$medications_no_deaths <- cdm$medications %>% +cdm$medications_no_deaths <- cdm$medications |> requireDeathFlag(window = c(0,Inf), name = "medications_no_deaths", negate = TRUE) diff --git a/vignettes/a06_concatanate_cohorts.Rmd b/vignettes/a06_concatanate_cohorts.Rmd index a4d326fe..e056b977 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 369d1925..18dab4ca 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.