From 2ed4319bfcfc3662bbec6cc011b7b0c1361a5253 Mon Sep 17 00:00:00 2001 From: catalamarti Date: Thu, 19 Dec 2024 14:12:26 +0100 Subject: [PATCH] v1.2.3 --- .gitignore | 1 + DESCRIPTION | 6 +- NAMESPACE | 3 +- NEWS.md | 19 ++ R/PatientProfiles-package.R | 1 + R/addCategories.R | 35 ++- R/addCohortIntersect.R | 27 +- R/addConceptIntersect.R | 44 ++- R/addDeath.R | 12 +- R/addDemographics.R | 22 +- R/addDemographicsQuery.R | 31 +- R/addIntersect.R | 127 ++++---- R/addObservationPeriodId.R | 9 +- R/addTableIntersect.R | 21 +- R/checks.R | 24 +- R/formats.R | 10 +- R/summariseResult.R | 26 +- R/utilities.R | 8 +- R/utils-pipe.R | 30 -- README.Rmd | 62 ++-- README.md | 62 ++-- cran-comments.md | 4 +- extras/benchmark.R | 2 +- extras/shinysummary.R | 26 +- man/addAgeQuery.Rd | 1 + man/addCategories.Rd | 7 +- man/addCdmName.Rd | 2 +- man/addCohortIntersectCount.Rd | 3 +- man/addCohortIntersectDate.Rd | 7 +- man/addCohortIntersectDays.Rd | 7 +- man/addCohortIntersectFlag.Rd | 2 +- man/addCohortName.Rd | 2 +- man/addConceptIntersectCount.Rd | 11 +- man/addConceptIntersectDate.Rd | 11 +- man/addConceptIntersectDays.Rd | 11 +- man/addConceptIntersectFlag.Rd | 11 +- man/addDateOfBirth.Rd | 4 +- man/addDateOfBirthQuery.Rd | 4 +- man/addDeathDate.Rd | 4 +- man/addDeathDays.Rd | 4 +- man/addDeathFlag.Rd | 4 +- man/addDemographics.Rd | 4 +- man/addDemographicsQuery.Rd | 4 +- man/addFutureObservation.Rd | 3 +- man/addFutureObservationQuery.Rd | 3 +- man/addInObservation.Rd | 4 +- man/addInObservationQuery.Rd | 4 +- man/addObservationPeriodId.Rd | 4 +- man/addObservationPeriodIdQuery.Rd | 4 +- man/addPriorObservation.Rd | 3 +- man/addPriorObservationQuery.Rd | 3 +- man/addSex.Rd | 4 +- man/addSexQuery.Rd | 4 +- man/addTableIntersectCount.Rd | 2 +- man/addTableIntersectDate.Rd | 2 +- man/addTableIntersectDays.Rd | 2 +- man/addTableIntersectField.Rd | 2 +- man/addTableIntersectFlag.Rd | 3 +- man/pipe.Rd | 20 -- man/summariseResult.Rd | 4 +- tests/manual/test-sqltest.R | 24 +- tests/testthat/test-addAttributes.R | 4 +- tests/testthat/test-addCategories.R | 46 +-- tests/testthat/test-addCohortIntersect.R | 200 ++++++------ tests/testthat/test-addConceptIntersect.R | 24 +- tests/testthat/test-addDemographics.R | 306 +++++++++---------- tests/testthat/test-addFutureObservation.R | 36 +-- tests/testthat/test-addInObservation.R | 28 +- tests/testthat/test-addIntersect.R | 232 +++++++------- tests/testthat/test-addObservationPeriodId.R | 76 +++++ tests/testthat/test-addPriorObservation.R | 24 +- tests/testthat/test-addSex.R | 10 +- tests/testthat/test-addTableIntersect.R | 192 ++++++------ tests/testthat/test-checks.R | 22 +- tests/testthat/test-format.R | 30 +- tests/testthat/test-summariseResult.R | 120 ++++---- vignettes/cohort-intersect.Rmd | 28 +- vignettes/concept-intersect.Rmd | 24 +- vignettes/demographics.rmd | 68 ++--- vignettes/table-intersect.Rmd | 2 +- 80 files changed, 1192 insertions(+), 1090 deletions(-) delete mode 100644 R/utils-pipe.R delete mode 100644 man/pipe.Rd diff --git a/.gitignore b/.gitignore index 5ca6b8ae..fb9c3d09 100644 --- a/.gitignore +++ b/.gitignore @@ -55,3 +55,4 @@ inst/doc .Rdata .DS_Store .quarto +/revdep/ diff --git a/DESCRIPTION b/DESCRIPTION index 9d380256..c602246f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: PatientProfiles Type: Package Title: Identify Characteristics of Patients in the OMOP Common Data Model -Version: 1.2.1.900 +Version: 1.2.3 Authors@R: c( person("Marti", "Catala", , "marti.catalasabate@ndorms.ox.ac.uk", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-3308-9905")), @@ -47,15 +47,13 @@ Suggests: withr, scales Imports: - magrittr, CDMConnector (>= 1.3.1), dplyr, tidyr, rlang, cli, stringr, - omopgenerics (>= 0.2.0), - visOmopResults (>= 0.2.0), + omopgenerics (>= 0.4.0), purrr, lifecycle URL: https://darwin-eu.github.io/PatientProfiles/ diff --git a/NAMESPACE b/NAMESPACE index bd8d438b..0e486cd0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -export("%>%") export(addAge) export(addAgeQuery) export(addCategories) @@ -47,7 +46,7 @@ export(startDateColumn) export(summariseResult) export(suppress) export(variableTypes) -importFrom(magrittr,"%>%") +importFrom(dplyr,"%>%") importFrom(omopgenerics,settings) importFrom(omopgenerics,suppress) importFrom(rlang,"%||%") diff --git a/NEWS.md b/NEWS.md index 1e9a76fd..79fedb79 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,22 @@ + +# PatientProfiles 1.2.3 + +* Bug fix to correct NA columns when not in observation by @catalamarti + +# PatientProfiles 1.2.2 + +* Update links and codecoverage by @catalamarti +* Distinct individuals in addObservationPeriodId() by @martaalcalde +* Remove dependencies on visOmopResults and magrittr @catalamarti + +# PatientProfiles 1.2.1 + +* edge case where no concept in concept table by @edward-burn +* update assertions in addDeath functions by @catalamarti +* increase test coverage by @catalamarti +* add internal compute to addInObservation by @edward-burn +* conceptIntersect inObservation argument by @edward-burn + # PatientProfiles 1.2.0 * `addObservationPeriodId()` is a new function that adds the number of diff --git a/R/PatientProfiles-package.R b/R/PatientProfiles-package.R index a9966848..e6f8d490 100644 --- a/R/PatientProfiles-package.R +++ b/R/PatientProfiles-package.R @@ -18,6 +18,7 @@ "_PACKAGE" ## usethis namespace: start +#' @importFrom dplyr %>% #' @importFrom rlang %||% #' @importFrom rlang .data #' @importFrom rlang .env diff --git a/R/addCategories.R b/R/addCategories.R index e058d7d2..47527a78 100644 --- a/R/addCategories.R +++ b/R/addCategories.R @@ -21,8 +21,7 @@ #' @param categories List of lists of named categories with lower and upper #' limit. #' @param missingCategoryValue Value to assign to those individuals not in -#' any named category. If NULL or NA, missing will values will be -#' given. +#' any named category. If NULL or NA, missing values will not be changed. #' @param overlap TRUE if the categories given overlap. #' @param name Name of the new table, if NULL a temporary table is returned. #' @@ -34,8 +33,8 @@ #' \donttest{ #' cdm <- mockPatientProfiles() #' -#' result <- cdm$cohort1 %>% -#' addAge() %>% +#' result <- cdm$cohort1 |> +#' addAge() |> #' addCategories( #' variable = "age", #' categories = list("age_group" = list( @@ -80,15 +79,15 @@ addCategories <- function(x, x <- warnOverwriteColumns(x, nameStyle = nam) if ( - utils::head(x, 1) %>% - dplyr::pull(dplyr::all_of(variable)) %>% + utils::head(x, 1) |> + dplyr::pull(dplyr::all_of(variable)) |> inherits("Date") ) { - rand1 <- paste0("extra_", sample(letters, 5, TRUE) %>% paste0(collapse = "")) - rand2 <- paste0("extra_", sample(letters, 6, TRUE) %>% paste0(collapse = "")) - x <- x %>% + rand1 <- paste0("extra_", sample(letters, 5, TRUE) |> paste0(collapse = "")) + rand2 <- paste0("extra_", sample(letters, 6, TRUE) |> paste0(collapse = "")) + x <- x |> dplyr::mutate(!!rand1 := as.Date("1970-01-01")) %>% - dplyr::mutate(!!rand2 := !!CDMConnector::datediff(rand1, variable)) %>% + dplyr::mutate(!!rand2 := !!CDMConnector::datediff(rand1, variable)) |> dplyr::select(-dplyr::all_of(rand1)) variable <- rand2 categories <- lapply(categories, function(x) { @@ -109,7 +108,7 @@ addCategories <- function(x, overlap = overlap ) if (date & is.null(names(categories[[k]]))) { - categoryTibble[[nam[k]]] <- categoryTibble[[nam[k]]] %>% + categoryTibble[[nam[k]]] <- categoryTibble[[nam[k]]] |> dplyr::mutate(category_label = paste( as.Date(.data$lower_bound, origin = "1970-01-01"), "to", as.Date(.data$lower_bound, origin = "1970-01-01") @@ -163,10 +162,10 @@ addCategories <- function(x, is.null(missingCategoryValue), NA, missingCategoryValue ), "\""), sqlCategories) } - sqlCategories <- sqlCategories %>% - rlang::parse_exprs() %>% + sqlCategories <- sqlCategories |> + rlang::parse_exprs() |> rlang::set_names(glue::glue(nm)) - x <- x %>% + x <- x |> dplyr::mutate(!!!sqlCategories) } else { x <- dplyr::mutate(x, !!nm := as.character(NA)) @@ -174,7 +173,7 @@ addCategories <- function(x, lower <- categoryTibbleK$lower_bound[i] upper <- categoryTibbleK$upper_bound[i] category <- categoryTibbleK$category_label[i] - x <- x %>% + x <- x |> dplyr::mutate(!!nm := dplyr::if_else( is.na(.data[[nm]]) & .data[[variable]] >= .env$lower & @@ -191,7 +190,7 @@ addCategories <- function(x, } # add missing as category if (!is.null(missingCategoryValue) && !is.na(missingCategoryValue)) { - x <- x %>% + x <- x |> dplyr::mutate(!!nm := dplyr::if_else(!is.na(.data[[nm]]), .data[[nm]], .env$missingCategoryValue @@ -199,14 +198,14 @@ addCategories <- function(x, } } - x <- x %>% + x <- x |> dplyr::compute( name = omopgenerics::uniqueTableName(tablePrefix), temporary = FALSE ) } if (date) { - x <- x %>% dplyr::select(-dplyr::all_of(variable)) + x <- x |> dplyr::select(-dplyr::all_of(variable)) } x <- x |> dplyr::compute(name = comp$name, temporary = comp$temporary) diff --git a/R/addCohortIntersect.R b/R/addCohortIntersect.R index 14bb45fb..661279dc 100644 --- a/R/addCohortIntersect.R +++ b/R/addCohortIntersect.R @@ -39,7 +39,7 @@ #' \donttest{ #' cdm <- mockPatientProfiles() #' -#' cdm$cohort1 %>% +#' cdm$cohort1 |> #' addCohortIntersectFlag( #' targetCohortTable = "cohort2" #' ) @@ -63,7 +63,7 @@ addCohortIntersectFlag <- function(x, parameters <- checkCohortNames(cdm[[targetCohortTable]], targetCohortId, targetCohortTable) nameStyle <- gsub("\\{cohort_name\\}", "\\{id_name\\}", nameStyle) - x <- x %>% + x <- x |> .addIntersect( tableName = targetCohortTable, filterVariable = parameters$filter_variable, @@ -108,10 +108,11 @@ addCohortIntersectFlag <- function(x, #' \donttest{ #' cdm <- mockPatientProfiles() #' -#' cdm$cohort1 %>% +#' cdm$cohort1 |> #' addCohortIntersectCount( #' targetCohortTable = "cohort2" #' ) +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -132,7 +133,7 @@ addCohortIntersectCount <- function(x, parameters <- checkCohortNames(cdm[[targetCohortTable]], targetCohortId, targetCohortTable) nameStyle <- gsub("\\{cohort_name\\}", "\\{id_name\\}", nameStyle) - x <- x %>% + x <- x |> .addIntersect( tableName = targetCohortTable, filterVariable = parameters$filter_variable, @@ -180,10 +181,9 @@ addCohortIntersectCount <- function(x, #' \donttest{ #' cdm <- mockPatientProfiles() #' -#' cdm$cohort1 %>% -#' addCohortIntersectDays( -#' targetCohortTable = "cohort2" -#' ) +#' cdm$cohort1 |> +#' addCohortIntersectDays(targetCohortTable = "cohort2") +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -204,7 +204,7 @@ addCohortIntersectDays <- function(x, parameters <- checkCohortNames(cdm[[targetCohortTable]], targetCohortId, targetCohortTable) nameStyle <- gsub("\\{cohort_name\\}", "\\{id_name\\}", nameStyle) - x <- x %>% + x <- x |> .addIntersect( tableName = targetCohortTable, indexDate = indexDate, @@ -253,10 +253,9 @@ addCohortIntersectDays <- function(x, #' \donttest{ #' cdm <- mockPatientProfiles() #' -#' cdm$cohort1 %>% -#' addCohortIntersectDate( -#' targetCohortTable = "cohort2" -#' ) +#' cdm$cohort1 |> +#' addCohortIntersectDate(targetCohortTable = "cohort2") +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -277,7 +276,7 @@ addCohortIntersectDate <- function(x, parameters <- checkCohortNames(cdm[[targetCohortTable]], targetCohortId, targetCohortTable) nameStyle <- gsub("\\{cohort_name\\}", "\\{id_name\\}", nameStyle) - x <- x %>% + x <- x |> .addIntersect( tableName = targetCohortTable, indexDate = indexDate, diff --git a/R/addConceptIntersect.R b/R/addConceptIntersect.R index 1ebde09d..648cb720 100644 --- a/R/addConceptIntersect.R +++ b/R/addConceptIntersect.R @@ -189,14 +189,13 @@ subsetTable <- function(x) { #' valid_start_date = as.Date("1900-01-01"), #' valid_end_date = as.Date("2099-01-01"), #' invalid_reason = NA_character_ -#' ) %>% +#' ) |> #' dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id)) #' cdm <- CDMConnector::insertTable(cdm, "concept", concept) -#' result <- cdm$cohort1 %>% -#' addConceptIntersectFlag( -#' conceptSet = list("acetaminophen" = 1125315) -#' ) %>% -#' dplyr::collect() +#' +#' cdm$cohort1 |> +#' addConceptIntersectFlag(conceptSet = list("acetaminophen" = 1125315)) +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -261,14 +260,13 @@ addConceptIntersectFlag <- function(x, #' valid_start_date = as.Date("1900-01-01"), #' valid_end_date = as.Date("2099-01-01"), #' invalid_reason = NA_character_ -#' ) %>% +#' ) |> #' dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id)) #' cdm <- CDMConnector::insertTable(cdm, "concept", concept) -#' result <- cdm$cohort1 %>% -#' addConceptIntersectCount( -#' conceptSet = list("acetaminophen" = 1125315) -#' ) %>% -#' dplyr::collect() +#' +#' cdm$cohort1 |> +#' addConceptIntersectCount(conceptSet = list("acetaminophen" = 1125315)) +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -333,14 +331,13 @@ addConceptIntersectCount <- function(x, #' valid_start_date = as.Date("1900-01-01"), #' valid_end_date = as.Date("2099-01-01"), #' invalid_reason = NA_character_ -#' ) %>% +#' ) |> #' dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id)) #' cdm <- CDMConnector::insertTable(cdm, "concept", concept) -#' result <- cdm$cohort1 %>% -#' addConceptIntersectDate( -#' conceptSet = list("acetaminophen" = 1125315) -#' ) %>% -#' dplyr::collect() +#' +#' cdm$cohort1 |> +#' addConceptIntersectDate(conceptSet = list("acetaminophen" = 1125315)) +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -405,14 +402,13 @@ addConceptIntersectDate <- function(x, #' valid_start_date = as.Date("1900-01-01"), #' valid_end_date = as.Date("2099-01-01"), #' invalid_reason = NA_character_ -#' ) %>% +#' ) |> #' dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id)) #' cdm <- CDMConnector::insertTable(cdm, "concept", concept) -#' result <- cdm$cohort1 %>% -#' addConceptIntersectDays( -#' conceptSet = list("acetaminophen" = 1125315) -#' ) %>% -#' dplyr::collect() +#' +#' cdm$cohort1 |> +#' addConceptIntersectDays(conceptSet = list("acetaminophen" = 1125315)) +#' #' mockDisconnect(cdm = cdm) #' } #' diff --git a/R/addDeath.R b/R/addDeath.R index bdfed777..01375913 100644 --- a/R/addDeath.R +++ b/R/addDeath.R @@ -30,8 +30,10 @@ #' @examples #' \donttest{ #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' +#' cdm$cohort1 |> #' addDeathDate() +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -68,8 +70,10 @@ addDeathDate <- function(x, #' @examples #' \donttest{ #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' +#' cdm$cohort1 |> #' addDeathDays() +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -107,8 +111,10 @@ addDeathDays <- function(x, #' @examples #' \donttest{ #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' +#' cdm$cohort1 |> #' addDeathFlag() +#' #' mockDisconnect(cdm = cdm) #' } #' diff --git a/R/addDemographics.R b/R/addDemographics.R index 70c75c06..0c30b96f 100644 --- a/R/addDemographics.R +++ b/R/addDemographics.R @@ -57,8 +57,10 @@ #' \donttest{ #' library(PatientProfiles) #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' +#' cdm$cohort1 |> #' addDemographics() +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -195,8 +197,9 @@ addAge <- function(x, #' \donttest{ #' cdm <- mockPatientProfiles() #' -#' cdm$cohort1 %>% +#' cdm$cohort1 |> #' addFutureObservation() +#' #' mockDisconnect(cdm = cdm) #' } addFutureObservation <- function(x, @@ -251,8 +254,9 @@ addFutureObservation <- function(x, #' \donttest{ #' cdm <- mockPatientProfiles() #' -#' cdm$cohort1 %>% +#' cdm$cohort1 |> #' addPriorObservation() +#' #' mockDisconnect(cdm = cdm) #' } addPriorObservation <- function(x, @@ -304,8 +308,10 @@ addPriorObservation <- function(x, #' @examples #' \donttest{ #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' +#' cdm$cohort1 |> #' addInObservation() +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -349,8 +355,10 @@ addInObservation <- function(x, #' @examples #' \donttest{ #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' +#' cdm$cohort1 |> #' addSex() +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -405,8 +413,10 @@ addSex <- function(x, #' \donttest{ #' library(PatientProfiles) #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' +#' cdm$cohort1 |> #' addDateOfBirth() +#' #' mockDisconnect(cdm = cdm) #' } addDateOfBirth <- function(x, diff --git a/R/addDemographicsQuery.R b/R/addDemographicsQuery.R index 698f0c6f..8257ce4a 100644 --- a/R/addDemographicsQuery.R +++ b/R/addDemographicsQuery.R @@ -60,8 +60,10 @@ #' \donttest{ #' library(PatientProfiles) #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' +#' cdm$cohort1 |> #' addDemographicsQuery() +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -140,6 +142,7 @@ addDemographicsQuery <- function(x, #' #' cdm$cohort1 |> #' addAgeQuery() +#' #' mockDisconnect(cdm = cdm) #' } addAgeQuery <- function(x, @@ -198,8 +201,9 @@ addAgeQuery <- function(x, #' \donttest{ #' cdm <- mockPatientProfiles() #' -#' cdm$cohort1 %>% +#' cdm$cohort1 |> #' addFutureObservationQuery() +#' #' mockDisconnect(cdm = cdm) #' } addFutureObservationQuery <- function(x, @@ -254,8 +258,9 @@ addFutureObservationQuery <- function(x, #' \donttest{ #' cdm <- mockPatientProfiles() #' -#' cdm$cohort1 %>% +#' cdm$cohort1 |> #' addPriorObservationQuery() +#' #' mockDisconnect(cdm = cdm) #' } addPriorObservationQuery <- function(x, @@ -304,8 +309,10 @@ addPriorObservationQuery <- function(x, #' @examples #' \donttest{ #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' +#' cdm$cohort1 |> #' addSexQuery() +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -360,8 +367,10 @@ addSexQuery <- function(x, #' \donttest{ #' library(PatientProfiles) #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' +#' cdm$cohort1 |> #' addDateOfBirthQuery() +#' #' mockDisconnect(cdm = cdm) #' } addDateOfBirthQuery <- function(x, @@ -476,8 +485,8 @@ addDateOfBirthQuery <- function(x, } else { pHQ <- ".data$start_date" } - pHQ <- pHQ %>% - rlang::parse_exprs() %>% + pHQ <- pHQ |> + rlang::parse_exprs() |> rlang::set_names(glue::glue(priorObservationName)) } else { pHQ <- NULL @@ -493,7 +502,7 @@ addDateOfBirthQuery <- function(x, fOQ <- ".data$end_date" } fOQ <- fOQ |> - rlang::parse_exprs() %>% + rlang::parse_exprs() |> rlang::set_names(futureObservationName) } else { fOQ <- NULL @@ -606,7 +615,7 @@ addDateOfBirthQuery <- function(x, ageName[age], names(ageGroup), sexName, dateOfBirthName[dateOfBirth] ) - person <- person %>% + person <- person |> dplyr::mutate(!!!dtBQ) %>% dplyr::mutate(!!!c(aQ, agQ, sQ)) |> dplyr::select(dplyr::all_of(c(personVariable, indexDate, newColumns2))) @@ -673,8 +682,10 @@ ageGroupQuery <- function(ageName, ageGroup, missingAgeGroupValue) { #' @examples #' \donttest{ #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' +#' cdm$cohort1 |> #' addInObservationQuery() +#' #' mockDisconnect(cdm = cdm) #' } #' diff --git a/R/addIntersect.R b/R/addIntersect.R index 5ad280d1..d35e3286 100644 --- a/R/addIntersect.R +++ b/R/addIntersect.R @@ -65,7 +65,7 @@ # define overlapTable that contains the events of interest overlapTable <- cdm[[tableName]] if (!is.null(filterTbl)) { - overlapTable <- overlapTable %>% + overlapTable <- overlapTable |> dplyr::filter(.data[[filterVariable]] %in% .env$filterId) } else { filterVariable <- "id" @@ -86,24 +86,24 @@ value = value, id_name = filterTbl$id_name, window_name = names(window) - ) %>% - dplyr::as_tibble() %>% + ) |> + dplyr::as_tibble() |> dplyr::mutate(colnam = as.character(glue::glue( nameStyle, value = .data$value, id_name = .data$id_name, window_name = .data$window_name - ))) %>% + ))) |> dplyr::mutate(colnam = checkSnakeCase(.data$colnam, verbose = F)) - overlapTable <- overlapTable %>% + overlapTable <- overlapTable |> dplyr::select( !!personVariable := dplyr::all_of(personVariableTable), "id" = dplyr::all_of(filterVariable), "start_date" = dplyr::all_of(targetStartDate), "end_date" = dplyr::all_of(targetEndDate %||% targetStartDate), dplyr::all_of(extraValue) - ) %>% + ) |> dplyr::mutate(end_date = dplyr::if_else( is.na(.data$end_date), .data$start_date, .data$end_date )) @@ -171,18 +171,18 @@ if (is.infinite(win[2])) { resultW <- result } else { - resultW <- result %>% dplyr::filter(.data$start <= !!win[2]) + resultW <- result |> dplyr::filter(.data$start <= !!win[2]) } } else { if (is.infinite(win[2])) { - resultW <- result %>% dplyr::filter(.data$end >= !!win[1]) + resultW <- result |> dplyr::filter(.data$end >= !!win[1]) } else { - resultW <- result %>% + resultW <- result |> dplyr::filter(.data$end >= !!win[1] & .data$start <= !!win[2]) } } - resultW <- resultW %>% + resultW <- resultW |> dplyr::select(-"end") |> dplyr::compute( name = omopgenerics::uniqueTableName(tablePrefix), @@ -197,21 +197,21 @@ # add count or flag if ("count" %in% value | "flag" %in% value) { - resultCF <- resultW %>% - dplyr::group_by(.data[[personVariable]], .data$index_date, .data$id) %>% - dplyr::summarise(count = dplyr::n(), .groups = "drop") %>% - dplyr::left_join(cdm[[filterTblName]], by = "id") %>% - dplyr::select(-"id") %>% + resultCF <- resultW |> + dplyr::group_by(.data[[personVariable]], .data$index_date, .data$id) |> + dplyr::summarise(count = dplyr::n(), .groups = "drop") |> + dplyr::left_join(cdm[[filterTblName]], by = "id") |> + dplyr::select(-"id") |> dplyr::mutate("window_name" = !!tolower(names(window)[i])) if ("flag" %in% value) { - resultCF <- resultCF %>% dplyr::mutate(flag = 1) + resultCF <- resultCF |> dplyr::mutate(flag = 1) } if (!("count" %in% value)) { resultCF <- resultCF |> dplyr::select(-"count") } if (i == 1) { - resultCountFlag <- resultCF %>% + resultCountFlag <- resultCF |> dplyr::compute( name = omopgenerics::uniqueTableName(tablePrefix), temporary = FALSE, @@ -229,23 +229,23 @@ } # add date, time or other if (length(value[!(value %in% c("count", "flag"))]) > 0) { - resultDTO <- resultW %>% + resultDTO <- resultW |> dplyr::group_by(.data[[personVariable]], .data$index_date, .data$id) if (order == "first") { - resultDTO <- resultDTO %>% + resultDTO <- resultDTO |> dplyr::summarise( days = min(.data$start, na.rm = TRUE), .groups = "drop" ) } else { - resultDTO <- resultDTO %>% + resultDTO <- resultDTO |> dplyr::summarise( days = max(.data$start, na.rm = TRUE), .groups = "drop" ) } - resultDTO <- resultDTO %>% + resultDTO <- resultDTO |> dplyr::right_join( - resultW %>% - dplyr::select(dplyr::all_of(c(personVariable, "index_date", "id"))) %>% + resultW |> + dplyr::select(dplyr::all_of(c(personVariable, "index_date", "id"))) |> dplyr::distinct(), by = c(personVariable, "index_date", "id") ) @@ -254,21 +254,21 @@ dplyr::mutate(date = as.Date(!!CDMConnector::dateadd("index_date", "days"))) } if (length(extraValue) > 0) { - resultDTO <- resultDTO %>% + resultDTO <- resultDTO |> dplyr::left_join( - resultW %>% + resultW |> dplyr::select( dplyr::all_of(personVariable), "index_date", "id", "days" = "start", dplyr::all_of(extraValue) - ) %>% + ) |> dplyr::inner_join( - resultDTO %>% + resultDTO |> dplyr::select(dplyr::all_of( c(personVariable, "index_date", "id", "days") )), by = c(personVariable, "index_date", "id", "days") - ) %>% - dplyr::group_by(.data[[personVariable]], .data$index_date, .data$id) %>% + ) |> + dplyr::group_by(.data[[personVariable]], .data$index_date, .data$id) |> dplyr::summarise( dplyr::across( dplyr::all_of(extraValue), ~ str_flatten(.x, collapse = "; ") @@ -279,15 +279,15 @@ ) } - resultDTO <- resultDTO %>% - dplyr::left_join(cdm[[filterTblName]], by = "id") %>% - dplyr::select(-"id") %>% + resultDTO <- resultDTO |> + dplyr::left_join(cdm[[filterTblName]], by = "id") |> + dplyr::select(-"id") |> dplyr::mutate("window_name" = !!tolower(names(window)[i])) if (!("days" %in% value)) { resultDTO <- dplyr::select(resultDTO, -"days") } if (i == 1) { - resultDateTimeOther <- resultDTO %>% + resultDateTimeOther <- resultDTO |> dplyr::compute( name = omopgenerics::uniqueTableName(tablePrefix), temporary = FALSE, @@ -306,19 +306,19 @@ } if (any(c("flag", "count") %in% value)) { - resultCountFlagPivot <- resultCountFlag %>% + resultCountFlagPivot <- resultCountFlag |> tidyr::pivot_longer( dplyr::any_of(c("count", "flag")), names_to = "value", values_to = "values" - ) %>% + ) |> tidyr::pivot_wider( names_from = c("value", "id_name", "window_name"), values_from = "values", names_glue = nameStyle, values_fill = 0 - ) %>% - dplyr::rename(!!indexDate := "index_date") %>% + ) |> + dplyr::rename(!!indexDate := "index_date") |> dplyr::rename_all(tolower) |> dplyr::compute( name = omopgenerics::uniqueTableName(tablePrefix), @@ -329,7 +329,7 @@ newColCountFlag <- colnames(resultCountFlagPivot) newColCountFlag <- newColCountFlag[newColCountFlag %in% newCols$colnam] - x <- x %>% + x <- x |> dplyr::left_join( resultCountFlagPivot, by = c(personVariable, indexDate) @@ -340,7 +340,7 @@ overwrite = TRUE ) - x <- x %>% + x <- x |> dplyr::mutate(dplyr::across( dplyr::all_of(newColCountFlag), ~ dplyr::if_else(is.na(.x), 0, .x) )) |> @@ -354,32 +354,32 @@ if (length(value[!(value %in% c("count", "flag"))]) > 0) { values <- value[!(value %in% c("count", "flag"))] for (val in values) { - resultDateTimeOtherX <- resultDateTimeOther %>% + resultDateTimeOtherX <- resultDateTimeOther |> dplyr::select( dplyr::all_of(personVariable), "index_date", dplyr::all_of(val), "id_name", "window_name" - ) %>% + ) |> tidyr::pivot_longer( dplyr::all_of(val), names_to = "value", values_to = "values" - ) %>% + ) |> tidyr::pivot_wider( names_from = c("value", "id_name", "window_name"), values_from = "values", names_glue = nameStyle - ) %>% - dplyr::rename(!!indexDate := "index_date") %>% + ) |> + dplyr::rename(!!indexDate := "index_date") |> dplyr::rename_all(tolower) - x <- x %>% + x <- x |> dplyr::left_join( resultDateTimeOtherX, by = c(personVariable, indexDate) ) } - x <- x %>% + x <- x |> dplyr::compute( name = omopgenerics::uniqueTableName(tablePrefix), temporary = FALSE, @@ -388,11 +388,10 @@ } # missing columns - newCols <- newCols %>% + missingCols <- newCols |> dplyr::filter(!.data$colnam %in% colnames(x)) - - for (val in as.character(unique(newCols$value))) { - cols <- newCols$colnam[newCols$value == val] + for (val in as.character(unique(missingCols$value))) { + cols <- missingCols$colnam[missingCols$value == val] valk <- switch(val, flag = 0, count = 0, @@ -468,11 +467,12 @@ #' } #' startDateColumn <- function(tableName) { - if (tableName %in% namesTable$table_name) { - return(namesTable$start_date_name[namesTable$table_name == tableName]) + if (tableName %in% omopgenerics::omopTables()) { + col <- omopgenerics::omopColumns(table = tableName, field = "start_date") } else { - return("cohort_start_date") + col <- "cohort_start_date" } + return(col) } #' Get the name of the end date column for a certain table in the cdm @@ -490,11 +490,12 @@ startDateColumn <- function(tableName) { #' } #' endDateColumn <- function(tableName) { - if (tableName %in% namesTable$table_name) { - return(namesTable$end_date_name[namesTable$table_name == tableName]) + if (tableName %in% omopgenerics::omopTables()) { + col <- omopgenerics::omopColumns(table = tableName, field = "end_date") } else { - return("cohort_end_date") + col <- "cohort_end_date" } + return(col) } #' Get the name of the standard concept_id column for a certain table in the cdm @@ -512,11 +513,12 @@ endDateColumn <- function(tableName) { #' } #' standardConceptIdColumn <- function(tableName) { - if (tableName %in% namesTable$table_name) { - return(namesTable$concept_id_name[namesTable$table_name == tableName]) + if (tableName %in% omopgenerics::omopTables()) { + col <- omopgenerics::omopColumns(table = tableName, field = "standard_concept") } else { - return("cohort_definition_id") + col <- "cohort_definition_id" } + return(col) } #' Get the name of the source concept_id column for a certain table in the cdm @@ -534,9 +536,10 @@ standardConceptIdColumn <- function(tableName) { #' } #' sourceConceptIdColumn <- function(tableName) { - if (tableName %in% namesTable$table_name) { - return(namesTable$source_concept_id_name[namesTable$table_name == tableName]) + if (tableName %in% omopgenerics::omopTables()) { + col <- omopgenerics::omopColumns(table = tableName, field = "source_concept") } else { - return(as.character(NA)) + col <- NA_character_ } + return(col) } diff --git a/R/addObservationPeriodId.R b/R/addObservationPeriodId.R index 451aa5cc..4cde53a4 100644 --- a/R/addObservationPeriodId.R +++ b/R/addObservationPeriodId.R @@ -29,8 +29,10 @@ #' @examples #' \donttest{ #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' +#' cdm$cohort1 |> #' addObservationPeriodId() +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -67,8 +69,10 @@ addObservationPeriodId <- function(x, #' @examples #' \donttest{ #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' +#' cdm$cohort1 |> #' addObservationPeriodIdQuery() +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -110,6 +114,7 @@ addObservationPeriodIdQuery <- function(x, currentObsId <- x |> dplyr::select(dplyr::all_of(c(personVariable, indexDate))) |> + dplyr::distinct() |> dplyr::inner_join( cdm$observation_period |> dplyr::select( diff --git a/R/addTableIntersect.R b/R/addTableIntersect.R index 10a76f75..b12bbce2 100644 --- a/R/addTableIntersect.R +++ b/R/addTableIntersect.R @@ -40,8 +40,9 @@ #' \donttest{ #' cdm <- mockPatientProfiles() #' -#' cdm$cohort1 %>% +#' cdm$cohort1 |> #' addTableIntersectFlag(tableName = "visit_occurrence") +#' #' mockDisconnect(cdm = cdm) #' } #' @@ -59,7 +60,7 @@ addTableIntersectFlag <- function(x, checkCdm(cdm, tables = tableName) nameStyle <- gsub("\\{table_name\\}", tableName, nameStyle) - x <- x %>% + x <- x |> .addIntersect( tableName = tableName, filterVariable = NULL, @@ -105,7 +106,7 @@ addTableIntersectFlag <- function(x, #' \donttest{ #' cdm <- mockPatientProfiles() #' -#' cdm$cohort1 %>% +#' cdm$cohort1 |> #' addTableIntersectCount(tableName = "visit_occurrence") #' #' mockDisconnect(cdm = cdm) @@ -125,7 +126,7 @@ addTableIntersectCount <- function(x, checkCdm(cdm, tables = tableName) nameStyle <- gsub("\\{table_name\\}", tableName, nameStyle) - x <- x %>% + x <- x |> .addIntersect( tableName = tableName, filterVariable = NULL, @@ -171,7 +172,7 @@ addTableIntersectCount <- function(x, #' \donttest{ #' cdm <- mockPatientProfiles() #' -#' cdm$cohort1 %>% +#' cdm$cohort1 |> #' addTableIntersectDate(tableName = "visit_occurrence") #' #' mockDisconnect(cdm = cdm) @@ -191,7 +192,7 @@ addTableIntersectDate <- function(x, checkCdm(cdm, tables = tableName) nameStyle <- gsub("\\{table_name\\}", tableName, nameStyle) - x <- x %>% + x <- x |> .addIntersect( tableName = tableName, filterVariable = NULL, @@ -237,7 +238,7 @@ addTableIntersectDate <- function(x, #' \donttest{ #' cdm <- mockPatientProfiles() #' -#' cdm$cohort1 %>% +#' cdm$cohort1 |> #' addTableIntersectDays(tableName = "visit_occurrence") #' #' mockDisconnect(cdm = cdm) @@ -257,7 +258,7 @@ addTableIntersectDays <- function(x, checkCdm(cdm, tables = tableName) nameStyle <- gsub("\\{table_name\\}", tableName, nameStyle) - x <- x %>% + x <- x |> .addIntersect( tableName = tableName, filterVariable = NULL, @@ -307,7 +308,7 @@ addTableIntersectDays <- function(x, #' @examples #' \donttest{ #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' cdm$cohort1 |> #' addTableIntersectField( #' tableName = "visit_occurrence", #' field = "visit_concept_id", @@ -333,7 +334,7 @@ addTableIntersectField <- function(x, nameStyle <- gsub("\\{table_name\\}", tableName, nameStyle) nameStyle <- gsub("\\{extra_value\\}", "\\{value\\}", nameStyle) - x <- x %>% + x <- x |> .addIntersect( tableName = tableName, filterVariable = NULL, diff --git a/R/checks.R b/R/checks.R index c385650d..c0ac99b1 100644 --- a/R/checks.R +++ b/R/checks.R @@ -73,7 +73,7 @@ checkFilter <- function(filterVariable, filterId, idName, x) { } else { checkVariableInX(filterVariable, x, FALSE, "filterVariable") omopgenerics::assertNumeric(filterId, na = FALSE) - omopgenerics::assertNumeric(utils::head(x, 1) %>% + omopgenerics::assertNumeric(utils::head(x, 1) |> dplyr::pull(dplyr::all_of(filterVariable))) if (is.null(idName)) { idName <- paste0("id", filterId) @@ -123,12 +123,12 @@ checkCohortNames <- function(x, targetCohortId, name) { idName <- cohort$cohort_name targetCohortId <- cohort$cohort_definition_id } else { - idName <- cohort %>% + idName <- cohort |> dplyr::filter( as.integer(.data$cohort_definition_id) %in% as.integer(.env$targetCohortId) - ) %>% - dplyr::arrange(.data$cohort_definition_id) %>% + ) |> + dplyr::arrange(.data$cohort_definition_id) |> dplyr::pull("cohort_name") if (length(idName) != length(targetCohortId)) { cli::cli_abort( @@ -294,10 +294,10 @@ checkVariablesFunctions <- function(variables, estimates, table) { #' @noRd checkCensorDate <- function(x, censorDate) { - check <- x %>% - dplyr::select(dplyr::all_of(censorDate)) %>% - utils::head(1) %>% - dplyr::pull() %>% + check <- x |> + dplyr::select(dplyr::all_of(censorDate)) |> + utils::head(1) |> + dplyr::pull() |> inherits("Date") if (!check) { cli::cli_abort("{censorDate} is not a date variable") @@ -508,9 +508,9 @@ checkCategory <- function(category, overlap = FALSE, type = "numeric", call = pa # built tibble result <- lapply(category, function(x) { dplyr::tibble(lower_bound = x[1], upper_bound = x[2]) - }) %>% - dplyr::bind_rows() %>% - dplyr::mutate(category_label = names(.env$category)) %>% + }) |> + dplyr::bind_rows() |> + dplyr::mutate(category_label = names(.env$category)) |> dplyr::mutate(category_label = dplyr::if_else( .data$category_label == "", dplyr::case_when( @@ -520,7 +520,7 @@ checkCategory <- function(category, overlap = FALSE, type = "numeric", call = pa TRUE ~ paste(.data$lower_bound, "to", .data$upper_bound) ), .data$category_label - )) %>% + )) |> dplyr::arrange(.data$lower_bound) # check overlap diff --git a/R/formats.R b/R/formats.R index 82cf41d0..ff81db9a 100644 --- a/R/formats.R +++ b/R/formats.R @@ -40,13 +40,13 @@ variableTypes <- function(table) { x <- dplyr::tibble( "variable_name" = colnames(table), "variable_type" = lapply(colnames(table), function(x) { - table %>% - dplyr::select(dplyr::all_of(x)) %>% - utils::head(1) %>% - dplyr::pull() %>% + table |> + dplyr::select(dplyr::all_of(x)) |> + utils::head(1) |> + dplyr::pull() |> dplyr::type_sum() |> assertClassification() - }) %>% unlist() + }) |> unlist() ) } else { x <- dplyr::tibble( diff --git a/R/summariseResult.R b/R/summariseResult.R index e3d90636..6fe16b79 100644 --- a/R/summariseResult.R +++ b/R/summariseResult.R @@ -40,8 +40,8 @@ #' library(dplyr) #' #' cdm <- mockPatientProfiles() -#' x <- cdm$cohort1 %>% -#' addDemographics() %>% +#' x <- cdm$cohort1 |> +#' addDemographics() |> #' collect() #' result <- summariseResult(x) #' mockDisconnect(cdm = cdm) @@ -74,8 +74,8 @@ summariseResult <- function(table, } # create the summary for overall - if (table %>% - dplyr::count() %>% + if (table |> + dplyr::count() |> dplyr::pull() == 0) { if (counts) { result <- dplyr::tibble( @@ -124,15 +124,15 @@ summariseResult <- function(table, )))) # collect if necessary - collectFlag <- functions %>% - dplyr::filter(grepl("q", .data$estimate_name)) %>% + collectFlag <- functions |> + dplyr::filter(grepl("q", .data$estimate_name)) |> nrow() > 0 if (collectFlag) { cli::cli_inform(c( "!" = "Table is collected to memory as not all requested estimates are supported on the database side" )) - table <- table %>% dplyr::collect() + table <- table |> dplyr::collect() } # correct dates and logicals @@ -249,10 +249,10 @@ summariseInternal <- function(table, groupk, stratak, functions, counts, personV # format group strata strataGroup <- strataGroup |> dplyr::collect() |> - visOmopResults::uniteGroup( + omopgenerics::uniteGroup( cols = groupk, keep = TRUE, ignore = character() ) |> - visOmopResults::uniteStrata( + omopgenerics::uniteStrata( cols = stratak, keep = TRUE, ignore = character() ) |> dplyr::select( @@ -293,21 +293,21 @@ summariseInternal <- function(table, groupk, stratak, functions, counts, personV countSubjects <- function(x, personVariable) { result <- list() - result$record <- x %>% + result$record <- x |> dplyr::summarise( "estimate_value" = dplyr::n(), .groups = "drop" - ) %>% + ) |> dplyr::collect() |> dplyr::mutate( "variable_name" = "number_records" ) if (!is.null(personVariable)) { - result$subject <- x %>% + result$subject <- x |> dplyr::summarise( "estimate_value" = dplyr::n_distinct(.data[[personVariable]]), .groups = "drop" - ) %>% + ) |> dplyr::collect() |> dplyr::mutate( "variable_name" = "number_subjects" diff --git a/R/utilities.R b/R/utilities.R index 047d2121..07e07f21 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -27,7 +27,7 @@ #' library(PatientProfiles) #' #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' cdm$cohort1 |> #' addCohortName() #' } #' @@ -38,7 +38,7 @@ addCohortName <- function(cohort) { cli::cli_inform(c("!" = "`cohort_name` will be overwrite")) cohort <- cohort |> dplyr::select(!"cohort_name") } - cohort %>% + cohort |> dplyr::left_join( attr(cohort, "cohort_set") |> dplyr::select("cohort_definition_id", "cohort_name"), @@ -60,7 +60,7 @@ addCohortName <- function(cohort) { #' library(PatientProfiles) #' #' cdm <- mockPatientProfiles() -#' cdm$cohort1 %>% +#' cdm$cohort1 |> #' addCdmName() #' } #' @@ -69,7 +69,7 @@ addCdmName <- function(table, cdm = omopgenerics::cdmReference(table)) { if ("cdm_name" %in% colnames(table)) { cli::cli_inform(c("!" = "`cdm_name` will be overwrite")) } - table %>% dplyr::mutate("cdm_name" = .env$name) + table |> dplyr::mutate("cdm_name" = .env$name) } newTable <- function(name, call = parent.frame()) { diff --git a/R/utils-pipe.R b/R/utils-pipe.R deleted file mode 100644 index a6955be4..00000000 --- a/R/utils-pipe.R +++ /dev/null @@ -1,30 +0,0 @@ -# Copyright 2024 DARWIN EU (C) -# -# This file is part of PatientProfiles -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. - -#' Pipe operator -#' -#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. -#' -#' @name %>% -#' @rdname pipe -#' @keywords internal -#' @export -#' @importFrom magrittr %>% -#' @usage lhs \%>\% rhs -#' @param lhs A value or the magrittr placeholder. -#' @param rhs A function call using the magrittr semantics. -#' @return The result of calling `rhs(lhs)`. -NULL diff --git a/README.Rmd b/README.Rmd index 70d2a449..8dd30bf3 100644 --- a/README.Rmd +++ b/README.Rmd @@ -76,21 +76,21 @@ cdm <- mockPatientProfiles(numberIndividuals = 1000) Say we wanted to get individuals´sex and age at condition start date for records in the condition occurrence table. We can use the `addAge` and `addSex` functions to do this: ```{r} -cdm$condition_occurrence %>% +cdm$condition_occurrence |> glimpse() -cdm$condition_occurrence <- cdm$condition_occurrence %>% - addAge(indexDate = "condition_start_date") %>% +cdm$condition_occurrence <- cdm$condition_occurrence |> + addAge(indexDate = "condition_start_date") |> addSex() -cdm$condition_occurrence %>% +cdm$condition_occurrence |> glimpse() ``` We could, for example, then limit our data to only males aged between 18 and 65 ```{r} -cdm$condition_occurrence %>% - filter(age >= 18 & age <= 65) %>% +cdm$condition_occurrence |> + filter(age >= 18 & age <= 65) |> filter(sex == "Male") ``` @@ -98,27 +98,27 @@ cdm$condition_occurrence %>% As with other tables in the OMOP CDM, we can work in a similar way with cohort tables. For example, say we have the below cohort table ```{r} -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() ``` We can add age, age groups, sex, and days of prior observation to a cohort like so ```{r} -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addAge( indexDate = "cohort_start_date", ageGroup = list(c(0, 18), c(19, 65), c(66, 100)) - ) %>% - addSex() %>% + ) |> + addSex() |> addPriorObservation() -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() ``` We could use this information to subset the cohort. For example limiting to those with at least 365 days of prior observation available before their cohort start date like so ```{r} -cdm$cohort1 %>% +cdm$cohort1 |> filter(prior_observation >= 365) ``` @@ -131,16 +131,16 @@ We can use `addCohortIntersectFlag` to add a flag for the presence (or not) of a cdm <- mockPatientProfiles() ``` ```{r} -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectFlag( targetCohortTable = "cohort2", window = c(-Inf, -1) ) -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() ``` @@ -151,17 +151,17 @@ If we wanted the number of appearances, we could instead use the `addCohortInter cdm <- mockPatientProfiles() ``` ```{r} -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectCount( targetCohortTable = "cohort2", targetCohortId = 1, window = list("short_term" = c(1, 30), "mid_term" = c(31, 180)) ) -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() ``` @@ -173,10 +173,10 @@ First occurrence: cdm <- mockPatientProfiles() ``` ```{r} -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectDate( targetCohortTable = "cohort2", targetCohortId = 1, @@ -184,7 +184,7 @@ cdm$cohort1 <- cdm$cohort1 %>% window = c(-Inf, Inf) ) -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() ``` @@ -193,10 +193,10 @@ Last occurrence: cdm <- mockPatientProfiles() ``` ```{r} -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectDate( targetCohortTable = "cohort2", targetCohortId = 1, @@ -204,7 +204,7 @@ cdm$cohort1 <- cdm$cohort1 %>% window = c(-Inf, Inf) ) -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() ``` @@ -215,10 +215,10 @@ Instead of returning a date, we could return the days to the intersection by usi cdm <- mockPatientProfiles() ``` ```{r} -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectDays( targetCohortTable = "cohort2", targetCohortId = 1, @@ -226,7 +226,7 @@ cdm$cohort1 <- cdm$cohort1 %>% window = c(-Inf, Inf) ) -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() ``` @@ -238,23 +238,23 @@ If we want to combine multiple cohort intersects we can concatenate the operatio cdm <- mockPatientProfiles() ``` ```{r} -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectDate( targetCohortTable = "cohort2", targetCohortId = 1, order = "last", window = c(-Inf, Inf) - ) %>% + ) |> addCohortIntersectCount( targetCohortTable = "cohort2", targetCohortId = 1, window = c(-Inf, Inf) ) -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() ``` diff --git a/README.md b/README.md index acd8c1bf..0f7a7892 100644 --- a/README.md +++ b/README.md @@ -102,7 +102,7 @@ records in the condition occurrence table. We can use the `addAge` and `addSex` functions to do this: ``` r -cdm$condition_occurrence %>% +cdm$condition_occurrence |> glimpse() #> Rows: ?? #> Columns: 6 @@ -114,11 +114,11 @@ cdm$condition_occurrence %>% #> $ condition_concept_id 2, 5, 5, 5, 7, 7, 10, 4, 10, 5, 6, 7, 2, 4, … #> $ condition_type_concept_id 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,… -cdm$condition_occurrence <- cdm$condition_occurrence %>% - addAge(indexDate = "condition_start_date") %>% +cdm$condition_occurrence <- cdm$condition_occurrence |> + addAge(indexDate = "condition_start_date") |> addSex() -cdm$condition_occurrence %>% +cdm$condition_occurrence |> glimpse() #> Rows: ?? #> Columns: 8 @@ -137,8 +137,8 @@ We could, for example, then limit our data to only males aged between 18 and 65 ``` r -cdm$condition_occurrence %>% - filter(age >= 18 & age <= 65) %>% +cdm$condition_occurrence |> + filter(age >= 18 & age <= 65) |> filter(sex == "Male") #> # Source: SQL [?? x 8] #> # Database: DuckDB v1.1.1 [martics@Windows 10 x64:R 4.2.1/:memory:] @@ -165,7 +165,7 @@ As with other tables in the OMOP CDM, we can work in a similar way with cohort tables. For example, say we have the below cohort table ``` r -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() #> Rows: ?? #> Columns: 4 @@ -180,15 +180,15 @@ We can add age, age groups, sex, and days of prior observation to a cohort like so ``` r -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addAge( indexDate = "cohort_start_date", ageGroup = list(c(0, 18), c(19, 65), c(66, 100)) - ) %>% - addSex() %>% + ) |> + addSex() |> addPriorObservation() -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() #> Rows: ?? #> Columns: 8 @@ -208,7 +208,7 @@ to those with at least 365 days of prior observation available before their cohort start date like so ``` r -cdm$cohort1 %>% +cdm$cohort1 |> filter(prior_observation >= 365) #> # Source: SQL [?? x 8] #> # Database: DuckDB v1.1.1 [martics@Windows 10 x64:R 4.2.1/:memory:] @@ -236,7 +236,7 @@ We can use `addCohortIntersectFlag` to add a flag for the presence (or not) of a cohort in a certain window. ``` r -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() #> Rows: ?? #> Columns: 4 @@ -246,13 +246,13 @@ cdm$cohort1 %>% #> $ cohort_start_date 1974-02-03, 1918-10-07, 1967-07-21, 1951-05-19, 1… #> $ cohort_end_date 1974-12-26, 1920-03-27, 1967-12-09, 1953-09-30, 1… -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectFlag( targetCohortTable = "cohort2", window = c(-Inf, -1) ) -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() #> Rows: ?? #> Columns: 7 @@ -272,7 +272,7 @@ If we wanted the number of appearances, we could instead use the `addCohortIntersectCount` function ``` r -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() #> Rows: ?? #> Columns: 4 @@ -282,14 +282,14 @@ cdm$cohort1 %>% #> $ cohort_start_date 1961-04-27, 1997-02-08, 1956-03-09, 1980-07-04, 1… #> $ cohort_end_date 1970-08-24, 2011-04-10, 1956-12-19, 1989-02-23, 1… -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectCount( targetCohortTable = "cohort2", targetCohortId = 1, window = list("short_term" = c(1, 30), "mid_term" = c(31, 180)) ) -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() #> Rows: ?? #> Columns: 6 @@ -312,7 +312,7 @@ the last appearance in that cohort. First occurrence: ``` r -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() #> Rows: ?? #> Columns: 4 @@ -322,7 +322,7 @@ cdm$cohort1 %>% #> $ cohort_start_date 1972-05-17, 1936-05-20, 1954-03-09, 1935-10-23, 2… #> $ cohort_end_date 1988-05-11, 1945-08-14, 1966-11-09, 1937-04-23, 2… -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectDate( targetCohortTable = "cohort2", targetCohortId = 1, @@ -330,7 +330,7 @@ cdm$cohort1 <- cdm$cohort1 %>% window = c(-Inf, Inf) ) -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() #> Rows: ?? #> Columns: 5 @@ -345,7 +345,7 @@ cdm$cohort1 %>% Last occurrence: ``` r -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() #> Rows: ?? #> Columns: 4 @@ -355,7 +355,7 @@ cdm$cohort1 %>% #> $ cohort_start_date 1921-12-06, 1989-08-06, 1992-06-11, 1981-10-14, 1… #> $ cohort_end_date 1928-08-03, 1995-01-24, 1997-09-11, 1982-11-12, 1… -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectDate( targetCohortTable = "cohort2", targetCohortId = 1, @@ -363,7 +363,7 @@ cdm$cohort1 <- cdm$cohort1 %>% window = c(-Inf, Inf) ) -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() #> Rows: ?? #> Columns: 5 @@ -381,7 +381,7 @@ Instead of returning a date, we could return the days to the intersection by using `addCohortIntersectDays` ``` r -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() #> Rows: ?? #> Columns: 4 @@ -391,7 +391,7 @@ cdm$cohort1 %>% #> $ cohort_start_date 1966-12-06, 1955-09-03, 1963-11-24, 1995-11-30, 1… #> $ cohort_end_date 1990-01-06, 1977-12-24, 1978-05-27, 1996-07-27, 2… -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectDays( targetCohortTable = "cohort2", targetCohortId = 1, @@ -399,7 +399,7 @@ cdm$cohort1 <- cdm$cohort1 %>% window = c(-Inf, Inf) ) -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() #> Rows: ?? #> Columns: 5 @@ -417,7 +417,7 @@ If we want to combine multiple cohort intersects we can concatenate the operations using the `pipe` operator: ``` r -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() #> Rows: ?? #> Columns: 4 @@ -427,20 +427,20 @@ cdm$cohort1 %>% #> $ cohort_start_date 1945-02-11, 1955-06-28, 1957-11-19, 1986-03-17, 1… #> $ cohort_end_date 1980-06-10, 1962-08-23, 1958-05-22, 1992-08-12, 1… -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectDate( targetCohortTable = "cohort2", targetCohortId = 1, order = "last", window = c(-Inf, Inf) - ) %>% + ) |> addCohortIntersectCount( targetCohortTable = "cohort2", targetCohortId = 1, window = c(-Inf, Inf) ) -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() #> Rows: ?? #> Columns: 5 diff --git a/cran-comments.md b/cran-comments.md index e7ab6ec5..c31fff61 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,3 +1,5 @@ ## R CMD check results -This is a new release. +0 errors | 0 warnings | 0 notes + +* This is a new release. diff --git a/extras/benchmark.R b/extras/benchmark.R index bc4a6861..7e6c3abb 100644 --- a/extras/benchmark.R +++ b/extras/benchmark.R @@ -29,7 +29,7 @@ window <- list( devtools::load_all() -cdm$index_sex <- cdm$index %>% addSex() +cdm$index_sex <- cdm$index |> addSex() tictoc::tic() lsc <- summariseLargeScaleCharacteristics(cohort = cdm$index, window = window) diff --git a/extras/shinysummary.R b/extras/shinysummary.R index 23498aba..3e02816d 100644 --- a/extras/shinysummary.R +++ b/extras/shinysummary.R @@ -10,7 +10,7 @@ library(DT) # read results from data folder ---- devtools::load_all() cdm <- DrugUtilisation::mockDrugUtilisation(numberIndividuals = 100) -cdm$cohort1 <- cdm$cohort1 %>% addSex() +cdm$cohort1 <- cdm$cohort1 |> addSex() summaryCharacteristics <- summariseCharacteristics( cohort = cdm$cohort1, strata = list("sex" = "sex"), @@ -26,10 +26,10 @@ summaryCharacteristics <- summariseCharacteristics( ) ), minCellCount = 1 -) %>% - mutate(group = paste0(.data$group_name, ": ", .data$group_level)) %>% - mutate(strata = paste0(.data$strata_name, ": ", .data$strata_level)) %>% - select(-c("group_name", "group_level", "strata_name", "strata_level")) %>% +) |> + mutate(group = paste0(.data$group_name, ": ", .data$group_level)) |> + mutate(strata = paste0(.data$strata_name, ": ", .data$strata_level)) |> + select(-c("group_name", "group_level", "strata_name", "strata_level")) |> relocate("cdm_name", "group", "strata") # ui shiny ---- @@ -115,7 +115,7 @@ ui <- dashboardPage( outputId = "summary_characteristics_download_raw_filtered", label = "Download table as csv" ), - DTOutput("summary_characteristics_table_raw") %>% withSpinner() + DTOutput("summary_characteristics_table_raw") |> withSpinner() ), tabPanel( "Tidy table", @@ -123,7 +123,7 @@ ui <- dashboardPage( outputId = "summary_characteristics_download_tidy_word", label = "Download table as word" ), - gt_output("summary_characteristics_table_tidy") %>% withSpinner() + gt_output("summary_characteristics_table_tidy") |> withSpinner() ) ) ) @@ -136,11 +136,11 @@ server <- function(input, output, session) { ## summary characteristics ---- ### get data ---- get_summary_characteristics_data <- reactive({ - summaryCharacteristics %>% - filter(variable %in% input$summary_characteristics_variable) %>% - filter(cdm_name %in% input$summary_characteristics_cdm_name) %>% - filter(estimate_type %in% input$summary_characteristics_estimate_type) %>% - filter(group %in% input$summary_characteristics_group) %>% + summaryCharacteristics |> + filter(variable %in% input$summary_characteristics_variable) |> + filter(cdm_name %in% input$summary_characteristics_cdm_name) |> + filter(estimate_type %in% input$summary_characteristics_estimate_type) |> + filter(group %in% input$summary_characteristics_group) |> filter(strata %in% input$summary_characteristics_strata) }) ### get raw table ---- @@ -148,7 +148,7 @@ server <- function(input, output, session) { summaryResult <- get_summary_characteristics_data() validate(need(nrow(summaryResult) > 0, "No results for selected inputs")) datatable( - summaryResult %>% select(-"result_type"), + summaryResult |> select(-"result_type"), rownames = FALSE, extensions = "Buttons", options = list(scrollX = TRUE, scrollCollapse = TRUE) diff --git a/man/addAgeQuery.Rd b/man/addAgeQuery.Rd index 4837390b..c182341e 100644 --- a/man/addAgeQuery.Rd +++ b/man/addAgeQuery.Rd @@ -52,6 +52,7 @@ cdm <- mockPatientProfiles() cdm$cohort1 |> addAgeQuery() + mockDisconnect(cdm = cdm) } } diff --git a/man/addCategories.Rd b/man/addCategories.Rd index f0c518eb..80155a56 100644 --- a/man/addCategories.Rd +++ b/man/addCategories.Rd @@ -22,8 +22,7 @@ addCategories( limit.} \item{missingCategoryValue}{Value to assign to those individuals not in -any named category. If NULL or NA, missing will values will be -given.} +any named category. If NULL or NA, missing values will not be changed.} \item{overlap}{TRUE if the categories given overlap.} @@ -39,8 +38,8 @@ Categorize a numeric variable \donttest{ cdm <- mockPatientProfiles() -result <- cdm$cohort1 \%>\% - addAge() \%>\% +result <- cdm$cohort1 |> + addAge() |> addCategories( variable = "age", categories = list("age_group" = list( diff --git a/man/addCdmName.Rd b/man/addCdmName.Rd index ddda6efb..0a529e97 100644 --- a/man/addCdmName.Rd +++ b/man/addCdmName.Rd @@ -22,7 +22,7 @@ Add cdm name library(PatientProfiles) cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% +cdm$cohort1 |> addCdmName() } diff --git a/man/addCohortIntersectCount.Rd b/man/addCohortIntersectCount.Rd index ec9b5f84..bba19a9a 100644 --- a/man/addCohortIntersectCount.Rd +++ b/man/addCohortIntersectCount.Rd @@ -55,10 +55,11 @@ cohort \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% +cdm$cohort1 |> addCohortIntersectCount( targetCohortTable = "cohort2" ) + mockDisconnect(cdm = cdm) } diff --git a/man/addCohortIntersectDate.Rd b/man/addCohortIntersectDate.Rd index 30abb7b3..c7189f79 100644 --- a/man/addCohortIntersectDate.Rd +++ b/man/addCohortIntersectDate.Rd @@ -56,10 +56,9 @@ Date of cohorts that are present in a certain window \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% - addCohortIntersectDate( - targetCohortTable = "cohort2" - ) +cdm$cohort1 |> + addCohortIntersectDate(targetCohortTable = "cohort2") + mockDisconnect(cdm = cdm) } diff --git a/man/addCohortIntersectDays.Rd b/man/addCohortIntersectDays.Rd index 6878222e..ea14df72 100644 --- a/man/addCohortIntersectDays.Rd +++ b/man/addCohortIntersectDays.Rd @@ -58,10 +58,9 @@ and a target cohort \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% - addCohortIntersectDays( - targetCohortTable = "cohort2" - ) +cdm$cohort1 |> + addCohortIntersectDays(targetCohortTable = "cohort2") + mockDisconnect(cdm = cdm) } diff --git a/man/addCohortIntersectFlag.Rd b/man/addCohortIntersectFlag.Rd index 7b573466..938959e1 100644 --- a/man/addCohortIntersectFlag.Rd +++ b/man/addCohortIntersectFlag.Rd @@ -53,7 +53,7 @@ It creates columns to indicate the presence of cohorts \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% +cdm$cohort1 |> addCohortIntersectFlag( targetCohortTable = "cohort2" ) diff --git a/man/addCohortName.Rd b/man/addCohortName.Rd index e06ef4ff..f8f95ecb 100644 --- a/man/addCohortName.Rd +++ b/man/addCohortName.Rd @@ -20,7 +20,7 @@ Add cohort name for each cohort_definition_id library(PatientProfiles) cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% +cdm$cohort1 |> addCohortName() } diff --git a/man/addConceptIntersectCount.Rd b/man/addConceptIntersectCount.Rd index 5a8d3459..6cf28540 100644 --- a/man/addConceptIntersectCount.Rd +++ b/man/addConceptIntersectCount.Rd @@ -63,14 +63,13 @@ concept <- dplyr::tibble( valid_start_date = as.Date("1900-01-01"), valid_end_date = as.Date("2099-01-01"), invalid_reason = NA_character_ -) \%>\% +) |> dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id)) cdm <- CDMConnector::insertTable(cdm, "concept", concept) -result <- cdm$cohort1 \%>\% - addConceptIntersectCount( - conceptSet = list("acetaminophen" = 1125315) - ) \%>\% - dplyr::collect() + +cdm$cohort1 |> + addConceptIntersectCount(conceptSet = list("acetaminophen" = 1125315)) + mockDisconnect(cdm = cdm) } diff --git a/man/addConceptIntersectDate.Rd b/man/addConceptIntersectDate.Rd index ea0527be..b484b3cd 100644 --- a/man/addConceptIntersectDate.Rd +++ b/man/addConceptIntersectDate.Rd @@ -63,14 +63,13 @@ concept <- dplyr::tibble( valid_start_date = as.Date("1900-01-01"), valid_end_date = as.Date("2099-01-01"), invalid_reason = NA_character_ -) \%>\% +) |> dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id)) cdm <- CDMConnector::insertTable(cdm, "concept", concept) -result <- cdm$cohort1 \%>\% - addConceptIntersectDate( - conceptSet = list("acetaminophen" = 1125315) - ) \%>\% - dplyr::collect() + +cdm$cohort1 |> + addConceptIntersectDate(conceptSet = list("acetaminophen" = 1125315)) + mockDisconnect(cdm = cdm) } diff --git a/man/addConceptIntersectDays.Rd b/man/addConceptIntersectDays.Rd index 3e0b287f..d61babec 100644 --- a/man/addConceptIntersectDays.Rd +++ b/man/addConceptIntersectDays.Rd @@ -63,14 +63,13 @@ concept <- dplyr::tibble( valid_start_date = as.Date("1900-01-01"), valid_end_date = as.Date("2099-01-01"), invalid_reason = NA_character_ -) \%>\% +) |> dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id)) cdm <- CDMConnector::insertTable(cdm, "concept", concept) -result <- cdm$cohort1 \%>\% - addConceptIntersectDays( - conceptSet = list("acetaminophen" = 1125315) - ) \%>\% - dplyr::collect() + +cdm$cohort1 |> + addConceptIntersectDays(conceptSet = list("acetaminophen" = 1125315)) + mockDisconnect(cdm = cdm) } diff --git a/man/addConceptIntersectFlag.Rd b/man/addConceptIntersectFlag.Rd index 29901225..1f8faf60 100644 --- a/man/addConceptIntersectFlag.Rd +++ b/man/addConceptIntersectFlag.Rd @@ -63,14 +63,13 @@ concept <- dplyr::tibble( valid_start_date = as.Date("1900-01-01"), valid_end_date = as.Date("2099-01-01"), invalid_reason = NA_character_ -) \%>\% +) |> dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id)) cdm <- CDMConnector::insertTable(cdm, "concept", concept) -result <- cdm$cohort1 \%>\% - addConceptIntersectFlag( - conceptSet = list("acetaminophen" = 1125315) - ) \%>\% - dplyr::collect() + +cdm$cohort1 |> + addConceptIntersectFlag(conceptSet = list("acetaminophen" = 1125315)) + mockDisconnect(cdm = cdm) } diff --git a/man/addDateOfBirth.Rd b/man/addDateOfBirth.Rd index aea43c17..530159e2 100644 --- a/man/addDateOfBirth.Rd +++ b/man/addDateOfBirth.Rd @@ -41,8 +41,10 @@ Add a column with the individual birth date \donttest{ library(PatientProfiles) cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% + +cdm$cohort1 |> addDateOfBirth() + mockDisconnect(cdm = cdm) } } diff --git a/man/addDateOfBirthQuery.Rd b/man/addDateOfBirthQuery.Rd index 42f7c3c9..a30945bf 100644 --- a/man/addDateOfBirthQuery.Rd +++ b/man/addDateOfBirthQuery.Rd @@ -39,8 +39,10 @@ Same as `addDateOfBirth()`, except query is not computed to a table. \donttest{ library(PatientProfiles) cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% + +cdm$cohort1 |> addDateOfBirthQuery() + mockDisconnect(cdm = cdm) } } diff --git a/man/addDeathDate.Rd b/man/addDeathDate.Rd index 7fd17cb9..8bc72f32 100644 --- a/man/addDeathDate.Rd +++ b/man/addDeathDate.Rd @@ -37,8 +37,10 @@ period than `indexDate` will be observed. \examples{ \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% + +cdm$cohort1 |> addDeathDate() + mockDisconnect(cdm = cdm) } diff --git a/man/addDeathDays.Rd b/man/addDeathDays.Rd index b8efc304..97af8461 100644 --- a/man/addDeathDays.Rd +++ b/man/addDeathDays.Rd @@ -37,8 +37,10 @@ period than `indexDate` will be observed. \examples{ \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% + +cdm$cohort1 |> addDeathDays() + mockDisconnect(cdm = cdm) } diff --git a/man/addDeathFlag.Rd b/man/addDeathFlag.Rd index c62d8adf..83ffce3b 100644 --- a/man/addDeathFlag.Rd +++ b/man/addDeathFlag.Rd @@ -37,8 +37,10 @@ period than `indexDate` will be observed. \examples{ \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% + +cdm$cohort1 |> addDeathFlag() + mockDisconnect(cdm = cdm) } diff --git a/man/addDemographics.Rd b/man/addDemographics.Rd index f71ff7fe..2d6a1dc1 100644 --- a/man/addDemographics.Rd +++ b/man/addDemographics.Rd @@ -95,8 +95,10 @@ Compute demographic characteristics at a certain date \donttest{ library(PatientProfiles) cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% + +cdm$cohort1 |> addDemographics() + mockDisconnect(cdm = cdm) } diff --git a/man/addDemographicsQuery.Rd b/man/addDemographicsQuery.Rd index 05bb6b79..9718b296 100644 --- a/man/addDemographicsQuery.Rd +++ b/man/addDemographicsQuery.Rd @@ -93,8 +93,10 @@ Same as `addDemographics()`, except query is not computed to a table. \donttest{ library(PatientProfiles) cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% + +cdm$cohort1 |> addDemographicsQuery() + mockDisconnect(cdm = cdm) } diff --git a/man/addFutureObservation.Rd b/man/addFutureObservation.Rd index 218cdc56..088f0bd3 100644 --- a/man/addFutureObservation.Rd +++ b/man/addFutureObservation.Rd @@ -38,8 +38,9 @@ certain date \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% +cdm$cohort1 |> addFutureObservation() + mockDisconnect(cdm = cdm) } } diff --git a/man/addFutureObservationQuery.Rd b/man/addFutureObservationQuery.Rd index 6087a715..4d8c77b5 100644 --- a/man/addFutureObservationQuery.Rd +++ b/man/addFutureObservationQuery.Rd @@ -35,8 +35,9 @@ Same as `addFutureObservation()`, except query is not computed to a table. \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% +cdm$cohort1 |> addFutureObservationQuery() + mockDisconnect(cdm = cdm) } } diff --git a/man/addInObservation.Rd b/man/addInObservation.Rd index 6949dbfe..07674685 100644 --- a/man/addInObservation.Rd +++ b/man/addInObservation.Rd @@ -37,8 +37,10 @@ Indicate if a certain record is within the observation period \examples{ \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% + +cdm$cohort1 |> addInObservation() + mockDisconnect(cdm = cdm) } diff --git a/man/addInObservationQuery.Rd b/man/addInObservationQuery.Rd index 7cfe3ef4..99cc4ded 100644 --- a/man/addInObservationQuery.Rd +++ b/man/addInObservationQuery.Rd @@ -36,8 +36,10 @@ Same as `addInObservation()`, except query is not computed to a table. \examples{ \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% + +cdm$cohort1 |> addInObservationQuery() + mockDisconnect(cdm = cdm) } diff --git a/man/addObservationPeriodId.Rd b/man/addObservationPeriodId.Rd index 411e270f..f6f5ada6 100644 --- a/man/addObservationPeriodId.Rd +++ b/man/addObservationPeriodId.Rd @@ -32,8 +32,10 @@ is in. \examples{ \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% + +cdm$cohort1 |> addObservationPeriodId() + mockDisconnect(cdm = cdm) } diff --git a/man/addObservationPeriodIdQuery.Rd b/man/addObservationPeriodIdQuery.Rd index e81c8702..1975a01f 100644 --- a/man/addObservationPeriodIdQuery.Rd +++ b/man/addObservationPeriodIdQuery.Rd @@ -29,8 +29,10 @@ is in. Result is not computed, only query is added. \examples{ \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% + +cdm$cohort1 |> addObservationPeriodIdQuery() + mockDisconnect(cdm = cdm) } diff --git a/man/addPriorObservation.Rd b/man/addPriorObservation.Rd index 7df153c8..2b640f5b 100644 --- a/man/addPriorObservation.Rd +++ b/man/addPriorObservation.Rd @@ -38,8 +38,9 @@ at a certain date \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% +cdm$cohort1 |> addPriorObservation() + mockDisconnect(cdm = cdm) } } diff --git a/man/addPriorObservationQuery.Rd b/man/addPriorObservationQuery.Rd index 8b5f5e6c..39f1a6ec 100644 --- a/man/addPriorObservationQuery.Rd +++ b/man/addPriorObservationQuery.Rd @@ -35,8 +35,9 @@ Same as `addPriorObservation()`, except query is not computed to a table. \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% +cdm$cohort1 |> addPriorObservationQuery() + mockDisconnect(cdm = cdm) } } diff --git a/man/addSex.Rd b/man/addSex.Rd index 454f096b..a7a14a42 100644 --- a/man/addSex.Rd +++ b/man/addSex.Rd @@ -24,8 +24,10 @@ Compute the sex of the individuals \examples{ \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% + +cdm$cohort1 |> addSex() + mockDisconnect(cdm = cdm) } diff --git a/man/addSexQuery.Rd b/man/addSexQuery.Rd index 056ef79c..9988111a 100644 --- a/man/addSexQuery.Rd +++ b/man/addSexQuery.Rd @@ -23,8 +23,10 @@ Same as `addSex()`, except query is not computed to a table. \examples{ \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% + +cdm$cohort1 |> addSexQuery() + mockDisconnect(cdm = cdm) } diff --git a/man/addTableIntersectCount.Rd b/man/addTableIntersectCount.Rd index 424b3885..a49d9b1a 100644 --- a/man/addTableIntersectCount.Rd +++ b/man/addTableIntersectCount.Rd @@ -51,7 +51,7 @@ Compute number of intersect with an omop table. \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% +cdm$cohort1 |> addTableIntersectCount(tableName = "visit_occurrence") mockDisconnect(cdm = cdm) diff --git a/man/addTableIntersectDate.Rd b/man/addTableIntersectDate.Rd index 89309305..540e5519 100644 --- a/man/addTableIntersectDate.Rd +++ b/man/addTableIntersectDate.Rd @@ -52,7 +52,7 @@ Compute date of intersect with an omop table. \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% +cdm$cohort1 |> addTableIntersectDate(tableName = "visit_occurrence") mockDisconnect(cdm = cdm) diff --git a/man/addTableIntersectDays.Rd b/man/addTableIntersectDays.Rd index d39a883f..832e2612 100644 --- a/man/addTableIntersectDays.Rd +++ b/man/addTableIntersectDays.Rd @@ -52,7 +52,7 @@ Compute time to intersect with an omop table. \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% +cdm$cohort1 |> addTableIntersectDays(tableName = "visit_occurrence") mockDisconnect(cdm = cdm) diff --git a/man/addTableIntersectField.Rd b/man/addTableIntersectField.Rd index f7466001..bbb567f0 100644 --- a/man/addTableIntersectField.Rd +++ b/man/addTableIntersectField.Rd @@ -60,7 +60,7 @@ entries with the target columns in a window of the user's choice. \examples{ \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% +cdm$cohort1 |> addTableIntersectField( tableName = "visit_occurrence", field = "visit_concept_id", diff --git a/man/addTableIntersectFlag.Rd b/man/addTableIntersectFlag.Rd index 0efdec7d..d0bbd5ba 100644 --- a/man/addTableIntersectFlag.Rd +++ b/man/addTableIntersectFlag.Rd @@ -51,8 +51,9 @@ Compute a flag intersect with an omop table. \donttest{ cdm <- mockPatientProfiles() -cdm$cohort1 \%>\% +cdm$cohort1 |> addTableIntersectFlag(tableName = "visit_occurrence") + mockDisconnect(cdm = cdm) } diff --git a/man/pipe.Rd b/man/pipe.Rd deleted file mode 100644 index 1f8f237b..00000000 --- a/man/pipe.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils-pipe.R -\name{\%>\%} -\alias{\%>\%} -\title{Pipe operator} -\usage{ -lhs \%>\% rhs -} -\arguments{ -\item{lhs}{A value or the magrittr placeholder.} - -\item{rhs}{A function call using the magrittr semantics.} -} -\value{ -The result of calling `rhs(lhs)`. -} -\description{ -See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. -} -\keyword{internal} diff --git a/man/summariseResult.Rd b/man/summariseResult.Rd index ab32ea25..855a7d6d 100644 --- a/man/summariseResult.Rd +++ b/man/summariseResult.Rd @@ -50,8 +50,8 @@ library(PatientProfiles) library(dplyr) cdm <- mockPatientProfiles() -x <- cdm$cohort1 \%>\% - addDemographics() \%>\% +x <- cdm$cohort1 |> + addDemographics() |> collect() result <- summariseResult(x) mockDisconnect(cdm = cdm) diff --git a/tests/manual/test-sqltest.R b/tests/manual/test-sqltest.R index d9c40d39..310e3b91 100644 --- a/tests/manual/test-sqltest.R +++ b/tests/manual/test-sqltest.R @@ -28,13 +28,13 @@ test_that("test methods against sql test server", { ) # add age and add sex - cdm$condition_occurrence <- cdm$condition_occurrence %>% - addAge(indexDate = "condition_start_date") %>% + cdm$condition_occurrence <- cdm$condition_occurrence |> + addAge(indexDate = "condition_start_date") |> addSex() expect_true(all(c("sex", "age") %in% colnames(cdm$condition_occurrence))) - cdm$condition_occurrence %>% addDemographics( + cdm$condition_occurrence |> addDemographics( age = TRUE, ageName = "age", ageGroup = NULL, @@ -53,7 +53,7 @@ test_that("test methods against sql test server", { # add cohort intersect - cohort <- cdm$cohort %>% addIntersect( + cohort <- cdm$cohort |> addIntersect( tableName = "cohort1", window = list(c(-Inf, 0)), value = "date" ) @@ -62,32 +62,32 @@ test_that("test methods against sql test server", { # add cohort occurrences - cohort <- cdm$cohort %>% - addCohortIntersectCount(targetCohortTable = "cohort1") %>% + cohort <- cdm$cohort |> + addCohortIntersectCount(targetCohortTable = "cohort1") |> dplyr::arrange(subject_id, cohort_start_date) expect_true(all(c("all_0_to_inf") %in% colnames(cohort))) # countflag - cohort <- cdm$cohort %>% - addCohortIntersectFlag(targetCohortTable = "cohort1") %>% + cohort <- cdm$cohort |> + addCohortIntersectFlag(targetCohortTable = "cohort1") |> dplyr::arrange(subject_id, cohort_start_date) expect_true(all(c("all_0_to_inf") %in% colnames(cohort))) # time to cohort - cohort <- cdm$cohort %>% - addCohortIntersectTime(targetCohortTable = "cohort1") %>% + cohort <- cdm$cohort |> + addCohortIntersectTime(targetCohortTable = "cohort1") |> dplyr::arrange(subject_id, cohort_start_date) expect_true(all(c("all_0_to_inf") %in% colnames(cohort))) # dateOfCohort - cohort <- cdm$cohort %>% - addCohortIntersectDate(targetCohortTable = "cohort1") %>% + cohort <- cdm$cohort |> + addCohortIntersectDate(targetCohortTable = "cohort1") |> dplyr::arrange(subject_id, cohort_start_date) expect_true(all(c("all_0_to_inf") %in% colnames(cohort))) diff --git a/tests/testthat/test-addAttributes.R b/tests/testthat/test-addAttributes.R index 42346820..d34506d9 100644 --- a/tests/testthat/test-addAttributes.R +++ b/tests/testthat/test-addAttributes.R @@ -3,7 +3,7 @@ test_that("attributes and classes are kept", { cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) oldCohort <- cdm$cohort1 - newCohort <- cdm$cohort1 %>% addDemographics() + newCohort <- cdm$cohort1 |> addDemographics() expect_true(length(attributes(newCohort)) == length(attributes(oldCohort))) for (i in names(attributes(newCohort))) { @@ -19,7 +19,7 @@ test_that("attributes and classes are kept", { } oldCohort <- cdm$cohort1 - newCohort <- cdm$cohort1 %>% + newCohort <- cdm$cohort1 |> addCohortIntersectFlag(targetCohortTable = "cohort2") |> addTableIntersectCount(tableName = "condition_occurrence") diff --git a/tests/testthat/test-addCategories.R b/tests/testthat/test-addCategories.R index 48b62a6e..3f6aa75b 100644 --- a/tests/testthat/test-addCategories.R +++ b/tests/testthat/test-addCategories.R @@ -14,32 +14,32 @@ test_that("addCategories, functionality", { "cohort_end_date" = as.Date(c("2045-01-01", "2052-01-01", "2060-01-01")) ) ) - agegroup <- cdm$cohort1 %>% - addAge() %>% + agegroup <- cdm$cohort1 |> + addAge() |> addCategories( variable = "age", categories = list("age_group" = list(c(0, 49), c(50, 120))) - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) - agegroupOverlap <- cdm$cohort1 %>% - addAge() %>% + agegroupOverlap <- cdm$cohort1 |> + addAge() |> addCategories( variable = "age", categories = list("age_group" = list(c(0, 55), c(50, 120))), overlap = TRUE - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) expect_true(all( - agegroup %>% + agegroup |> dplyr::pull(age_group) == c("0 to 49", "50 to 120", "50 to 120") )) expect_true(all( - agegroupOverlap %>% + agegroupOverlap |> dplyr::pull(age_group) == c("0 to 55", "0 to 55 and 50 to 120", "50 to 120") )) @@ -50,14 +50,14 @@ test_that("addCategories, functionality", { ) expect_no_error( - agegroupOverlap <- cdm$cohort1 %>% - addAge() %>% + agegroupOverlap <- cdm$cohort1 |> + addAge() |> addCategories( variable = "age", categories = list("age_group" = list(c(0, 55), c(50, 120))), overlap = TRUE, missingCategoryValue = NA_character_ - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) ) @@ -69,33 +69,33 @@ test_that("addCategory with both upper and lower infinite, age", { skip_on_cran() cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) expect_no_error( - agegroup <- cdm$cohort1 %>% - addAge() %>% + agegroup <- cdm$cohort1 |> + addAge() |> addCategories( variable = "age", categories = list("age_group" = list(c(-Inf, Inf))) - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) ) expect_true( - all(agegroup %>% + all(agegroup |> dplyr::pull("age_group") == "any") ) expect_no_error( - agegroup2 <- cdm$cohort1 %>% - addAge() %>% + agegroup2 <- cdm$cohort1 |> + addAge() |> addCategories( variable = "age", categories = list("age_group" = list(c(-Inf, 50), c(51, 120))) - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) ) expect_true( "50 or below" %in% ( - agegroup2 %>% dplyr::pull("age_group") + agegroup2 |> dplyr::pull("age_group") ) ) @@ -118,12 +118,12 @@ test_that("addCategories with infinity", { numberIndividuals = 10 ) cdm <- omopgenerics::insertTable(cdm = cdm, name = "table", table = table) - table <- cdm$table %>% + table <- cdm$table |> addCategories( variable = "prior_history", categories = list( "prior_group" = list(c(1, 10), c(11, Inf)) ), missingCategoryValue = "None", overlap = FALSE - ) %>% + ) |> addCategories( variable = "date_infection", categories = list( "period1" = list( @@ -131,8 +131,8 @@ test_that("addCategories with infinity", { as.Date(c("2023-01-01", "2028-12-31")) ) ), missingCategoryValue = "None", overlap = FALSE - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> dplyr::arrange(.data$subject_id) # check inf worked expect_true("prior_group" %in% colnames(table)) diff --git a/tests/testthat/test-addCohortIntersect.R b/tests/testthat/test-addCohortIntersect.R index fb570517..5ae05adc 100644 --- a/tests/testthat/test-addCohortIntersect.R +++ b/tests/testthat/test-addCohortIntersect.R @@ -8,7 +8,7 @@ test_that("output format - one outcome cohort", { seed = 1 ) - cdm$cohort1a <- cdm$cohort1 %>% + cdm$cohort1a <- cdm$cohort1 |> addCohortIntersectDays( targetCohortId = 1, targetDate = "cohort_start_date", @@ -17,7 +17,7 @@ test_that("output format - one outcome cohort", { expect_true(ncol(cdm$cohort1a) == 5) - cdm$cohort1b <- cdm$cohort1 %>% + cdm$cohort1b <- cdm$cohort1 |> addCohortIntersectDate( targetCohortId = 1, targetDate = "cohort_start_date", @@ -29,7 +29,7 @@ test_that("output format - one outcome cohort", { # additional columns (one per outcome cohort) should be added # with the name as specified - cdm$cohort1a <- cdm$cohort1 %>% + cdm$cohort1a <- cdm$cohort1 |> addCohortIntersectDays( window = c(0, Inf), targetCohortId = NULL, @@ -37,7 +37,7 @@ test_that("output format - one outcome cohort", { targetCohortTable = "cohort2" ) expect_true("cohort_2_0_to_inf" %in% colnames(cdm$cohort1a)) - cdm$cohort1b <- cdm$cohort1 %>% + cdm$cohort1b <- cdm$cohort1 |> addCohortIntersectDate( window = c(0, Inf), targetCohortId = NULL, @@ -47,7 +47,7 @@ test_that("output format - one outcome cohort", { expect_true("cohort_1_0_to_inf" %in% colnames(cdm$cohort1b)) expect_true("cohort_2_0_to_inf" %in% colnames(cdm$cohort1b)) - cdm$cohort1c <- cdm$cohort1 %>% + cdm$cohort1c <- cdm$cohort1 |> addCohortIntersectDays( window = c(-Inf, Inf), targetCohortId = NULL, @@ -57,7 +57,7 @@ test_that("output format - one outcome cohort", { expect_true("cohort_1_minf_to_inf" %in% colnames(cdm$cohort1c)) expect_true("cohort_2_minf_to_inf" %in% colnames(cdm$cohort1c)) - cdm$cohort1d <- cdm$cohort1 %>% + cdm$cohort1d <- cdm$cohort1 |> addCohortIntersectDate( window = c(-Inf, Inf), targetCohortId = NULL, @@ -103,79 +103,79 @@ test_that("first vs last event - cohort table", { ) # first - cdm$cohort1a <- cdm$cohort1 %>% + cdm$cohort1a <- cdm$cohort1 |> addCohortIntersectDays( targetCohortId = 1, indexDate = "cohort_start_date", targetCohortTable = "cohort2", order = "first" ) - expect_true(cdm$cohort1a %>% - dplyr::filter(subject_id == 1) %>% + expect_true(cdm$cohort1a |> + dplyr::filter(subject_id == 1) |> dplyr::pull(5) == as.numeric(difftime(as.Date("2010-03-03"), as.Date("2010-03-01"), units = "days" ))) - expect_true(cdm$cohort1a %>% - dplyr::filter(subject_id == 2) %>% + expect_true(cdm$cohort1a |> + dplyr::filter(subject_id == 2) |> dplyr::pull(5) == as.numeric(difftime(as.Date("2013-01-03"), as.Date("2011-02-01"), units = "days" ))) - cdm$cohort1b <- cdm$cohort1 %>% + cdm$cohort1b <- cdm$cohort1 |> addCohortIntersectDate( targetCohortId = 1, indexDate = "cohort_start_date", targetCohortTable = "cohort2", order = "first" ) - expect_true(cdm$cohort1b %>% - dplyr::filter(subject_id == 1) %>% + expect_true(cdm$cohort1b |> + dplyr::filter(subject_id == 1) |> dplyr::pull(5) == as.Date("2010-03-03")) - expect_true(cdm$cohort1b %>% - dplyr::filter(subject_id == 2) %>% + expect_true(cdm$cohort1b |> + dplyr::filter(subject_id == 2) |> dplyr::pull(5) == as.Date("2013-01-03")) # last - cdm$cohort1c <- cdm$cohort1 %>% + cdm$cohort1c <- cdm$cohort1 |> addCohortIntersectDays( targetCohortId = 1, indexDate = "cohort_start_date", targetCohortTable = "cohort2", order = "last" ) - expect_true(cdm$cohort1c %>% - dplyr::filter(subject_id == 1) %>% + expect_true(cdm$cohort1c |> + dplyr::filter(subject_id == 1) |> dplyr::pull(5) == as.numeric(difftime(as.Date("2010-03-25"), as.Date("2010-03-01"), units = "days" ))) - expect_true(cdm$cohort1c %>% - dplyr::filter(subject_id == 2) %>% + expect_true(cdm$cohort1c |> + dplyr::filter(subject_id == 2) |> dplyr::pull(5) == as.numeric(difftime(as.Date("2013-01-03"), as.Date("2011-02-01"), units = "days" ))) - cdm$cohort1d <- cdm$cohort1 %>% + cdm$cohort1d <- cdm$cohort1 |> addCohortIntersectDate( targetCohortId = 1, indexDate = "cohort_start_date", targetCohortTable = "cohort2", order = "last" ) - expect_true(cdm$cohort1d %>% - dplyr::filter(subject_id == 1) %>% + expect_true(cdm$cohort1d |> + dplyr::filter(subject_id == 1) |> dplyr::pull(5) == as.Date("2010-03-25")) - expect_true(cdm$cohort1d %>% - dplyr::filter(subject_id == 2) %>% + expect_true(cdm$cohort1d |> + dplyr::filter(subject_id == 2) |> dplyr::pull(5) == as.Date("2013-01-03")) mockDisconnect(cdm) @@ -218,7 +218,7 @@ test_that("multiple cohort entries per person", { ) # 100 days from index - cdm$cohort1a <- cdm$cohort1 %>% + cdm$cohort1a <- cdm$cohort1 |> addCohortIntersectDays( window = c(0, 100), indexDate = "cohort_start_date", @@ -226,10 +226,10 @@ test_that("multiple cohort entries per person", { order = "first" ) - expect_true(all(cdm$cohort1a %>% - dplyr::filter(subject_id == 1) %>% + expect_true(all(cdm$cohort1a |> + dplyr::filter(subject_id == 1) |> dplyr::collect() |> - dplyr::arrange(cohort_start_date) %>% + dplyr::arrange(cohort_start_date) |> dplyr::pull(5) == c( as.numeric(difftime(as.Date("2010-03-03"), @@ -243,11 +243,11 @@ test_that("multiple cohort entries per person", { ))) expect_equal( - cdm$cohort1 %>% dplyr::tally() %>% dplyr::pull("n"), - cdm$cohort1a %>% dplyr::tally() %>% dplyr::pull("n") + cdm$cohort1 |> dplyr::tally() |> dplyr::pull("n"), + cdm$cohort1a |> dplyr::tally() |> dplyr::pull("n") ) - cdm$cohort1b <- cdm$cohort1 %>% + cdm$cohort1b <- cdm$cohort1 |> addCohortIntersectDate( window = c(0, 100), indexDate = "cohort_start_date", @@ -255,10 +255,10 @@ test_that("multiple cohort entries per person", { order = "first" ) - expect_true(all(cdm$cohort1b %>% - dplyr::filter(subject_id == 1) %>% + expect_true(all(cdm$cohort1b |> + dplyr::filter(subject_id == 1) |> dplyr::collect() |> - dplyr::arrange(cohort_start_date) %>% + dplyr::arrange(cohort_start_date) |> dplyr::pull(5) == c( as.Date("2010-03-03"), @@ -266,8 +266,8 @@ test_that("multiple cohort entries per person", { ))) expect_equal( - cdm$cohort1 %>% dplyr::tally() %>% dplyr::pull("n"), - cdm$cohort1b %>% dplyr::tally() %>% dplyr::pull("n") + cdm$cohort1 |> dplyr::tally() |> dplyr::pull("n"), + cdm$cohort1b |> dplyr::tally() |> dplyr::pull("n") ) mockDisconnect(cdm) @@ -284,7 +284,7 @@ test_that("output names", { ) # default naming - cdm$cohort1a <- cdm$cohort1 %>% + cdm$cohort1a <- cdm$cohort1 |> addCohortIntersectDays( window = c(10, 50), targetCohortId = 1, @@ -296,7 +296,7 @@ test_that("output names", { colnames(cdm$cohort1a) )) - cdm$cohort1b <- cdm$cohort1 %>% + cdm$cohort1b <- cdm$cohort1 |> addCohortIntersectDate( window = c(10, 50), targetCohortId = c(1,2), @@ -309,7 +309,7 @@ test_that("output names", { )) # new names - cdm$cohort1c <- cdm$cohort1 %>% + cdm$cohort1c <- cdm$cohort1 |> addCohortIntersectDays( window = c(10, 50), targetCohortId = c(1, 2), @@ -323,7 +323,7 @@ test_that("output names", { )) # new names - cdm$cohort1d <- cdm$cohort1 %>% + cdm$cohort1d <- cdm$cohort1 |> addCohortIntersectDate( window = c(10, 50), targetCohortId = 2, @@ -337,7 +337,7 @@ test_that("output names", { )) # bad naming - expect_error(cdm$cohort1 %>% + expect_error(cdm$cohort1 |> addCohortIntersectDate( window = list(c(0, 3), c(10, 50)), targetCohortId = NULL, @@ -354,20 +354,20 @@ test_that("expected errors ", { cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) # missing outcome table - expect_error(cdm$cohort1 %>% + expect_error(cdm$cohort1 |> addCohortIntersectDays( targetCohortId = 1, indexDate = "cohort_start_date", targetCohortTable = "table_x" )) - expect_error(cdm$cohort1 %>% + expect_error(cdm$cohort1 |> addCohortIntersectDate( targetCohortId = 1, indexDate = "cohort_start_date", targetCohortTable = "table_x" )) - expect_error(cdm$cohort1 %>% + expect_error(cdm$cohort1 |> addCohortIntersectDays( targetCohortId = 1, indexDate = "cohort_start_date", @@ -375,7 +375,7 @@ test_that("expected errors ", { window = c(300, 100) )) - expect_error(cdm$cohort1 %>% + expect_error(cdm$cohort1 |> addCohortIntersectDate( targetCohortId = 1, indexDate = "cohort_start_date", @@ -383,7 +383,7 @@ test_that("expected errors ", { censorDate = as.Date("2020-01-01") )) - expect_error(cdm$cohort1 %>% + expect_error(cdm$cohort1 |> addCohortIntersectDate( targetCohortId = 1, indexDate = "cohort_start_date", @@ -455,33 +455,33 @@ test_that("working examples", { numberIndividuals = 2 ) - result0 <- cdm$cohort1 %>% - addCohortIntersectCount(targetCohortTable = "cohort2") %>% - dplyr::collect() %>% + result0 <- cdm$cohort1 |> + addCohortIntersectCount(targetCohortTable = "cohort2") |> + dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) - result1 <- cdm$cohort1 %>% - addCohortIntersectCount(targetCohortTable = "cohort2", targetCohortId = 1) %>% - dplyr::collect() %>% + result1 <- cdm$cohort1 |> + addCohortIntersectCount(targetCohortTable = "cohort2", targetCohortId = 1) |> + dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) - result2 <- cdm$cohort1 %>% - addCohortIntersectCount(targetCohortTable = "cohort2", targetCohortId = 2) %>% - dplyr::collect() %>% + result2 <- cdm$cohort1 |> + addCohortIntersectCount(targetCohortTable = "cohort2", targetCohortId = 2) |> + dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) - result3 <- cdm$cohort1 %>% - addCohortIntersectCount(targetCohortTable = "cohort2", targetCohortId = 3) %>% - dplyr::collect() %>% + result3 <- cdm$cohort1 |> + addCohortIntersectCount(targetCohortTable = "cohort2", targetCohortId = 3) |> + dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) expect_true(all(result0$cohort_1_0_to_inf == result1$cohort_1_0_to_inf)) expect_true(all(result0$cohort_2_0_to_inf == result2$cohort_2_0_to_inf)) expect_true(all(result0$cohort_3_0_to_inf == result3$cohort_3_0_to_inf)) - result1 <- cdm$cohort1 %>% + result1 <- cdm$cohort1 |> addCohortIntersectCount( targetCohortTable = "cohort2", targetCohortId = c(2, 3), window = list(c(-Inf, 0)) - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) expect_true(all(result1$cohort_2_minf_to_0 == c(0, 0, 0, 0, 1))) @@ -491,12 +491,12 @@ test_that("working examples", { cohort_definition_id = as.integer(c(1, 2, 3)), cohort_name = c("asthma", "covid", "tb") ) - result2 <- cdm$cohort1 %>% + result2 <- cdm$cohort1 |> addCohortIntersectCount( targetCohortTable = "cohort2", targetCohortId = c(2, 3), window = list(c(-Inf, 0)) - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) expect_true(all(result2$covid_minf_to_0 == c(0, 0, 0, 0, 1))) @@ -565,30 +565,30 @@ test_that("working examples", { numberIndividuals = 2 ) - result0 <- cdm$cohort1 %>% - addCohortIntersectFlag(targetCohortTable = "cohort2") %>% - dplyr::collect() %>% + result0 <- cdm$cohort1 |> + addCohortIntersectFlag(targetCohortTable = "cohort2") |> + dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) - result1 <- cdm$cohort1 %>% - addCohortIntersectFlag(targetCohortTable = "cohort2", targetCohortId = 1) %>% - dplyr::collect() %>% + result1 <- cdm$cohort1 |> + addCohortIntersectFlag(targetCohortTable = "cohort2", targetCohortId = 1) |> + dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) - result2 <- cdm$cohort1 %>% - addCohortIntersectFlag(targetCohortTable = "cohort2", targetCohortId = 2) %>% - dplyr::collect() %>% + result2 <- cdm$cohort1 |> + addCohortIntersectFlag(targetCohortTable = "cohort2", targetCohortId = 2) |> + dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) - result3 <- cdm$cohort1 %>% - addCohortIntersectFlag(targetCohortTable = "cohort2", targetCohortId = 3) %>% - dplyr::collect() %>% + result3 <- cdm$cohort1 |> + addCohortIntersectFlag(targetCohortTable = "cohort2", targetCohortId = 3) |> + dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) expect_true(all(result0$cohort_1_0_to_inf == result1$cohort_1_0_to_inf)) expect_true(all(result0$cohort_2_0_to_inf == result2$cohort_2_0_to_inf)) expect_true(all(result0$cohort_3_0_to_inf == result3$cohort_3_0_to_inf)) - result1 <- cdm$cohort1 %>% - addCohortIntersectFlag(targetCohortTable = "cohort2", targetCohortId = 2) %>% - dplyr::collect() %>% + result1 <- cdm$cohort1 |> + addCohortIntersectFlag(targetCohortTable = "cohort2", targetCohortId = 2) |> + dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) expect_true(all(result1$cohort_2_0_to_inf == c(1, 1, 1, 1, 0))) @@ -632,24 +632,24 @@ test_that("working examples", { ) expect_no_error( - result2 <- cdm$cohort1 %>% + result2 <- cdm$cohort1 |> addCohortIntersectCount( targetCohortTable = "cohort2", nameStyle = "{value}_{cohort_name}_{window_name}" - ) %>% + ) |> addCohortIntersectFlag( targetCohortTable = "cohort2", nameStyle = "{value}_{cohort_name}_{window_name}" - ) %>% + ) |> addCohortIntersectDate( targetCohortTable = "cohort2", nameStyle = "{value}_{cohort_name}_{window_name}" - ) %>% + ) |> addCohortIntersectDays( targetCohortTable = "cohort2", nameStyle = "{value}_{cohort_name}_{window_name}" - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) ) @@ -696,33 +696,33 @@ test_that("censorDate functionality", { return(same) } - result1 <- cdm$cohort1 %>% + result1 <- cdm$cohort1 |> addCohortIntersectFlag( targetCohortTable = "cohort2", censorDate = "cohort_end_date", nameStyle = "{value}_{window_name}" - ) %>% + ) |> addCohortIntersectCount( targetCohortTable = "cohort2", censorDate = "cohort_end_date", nameStyle = "{value}_{window_name}" - ) %>% + ) |> addCohortIntersectDate( targetCohortTable = "cohort2", censorDate = "cohort_end_date", nameStyle = "{value}_{window_name}" - ) %>% + ) |> addCohortIntersectDays( targetCohortTable = "cohort2", censorDate = "cohort_end_date", nameStyle = "{value}_{window_name}" - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) expect_true(all(compareNA( - result1 %>% dplyr::filter(subject_id == 4) %>% - dplyr::select(dplyr::ends_with("inf")) %>% dplyr::arrange("subject_id") %>% + result1 |> dplyr::filter(subject_id == 4) |> + dplyr::select(dplyr::ends_with("inf")) |> dplyr::arrange("subject_id") |> unlist(use.names = F), c(0, 0, NA, NA) ))) @@ -736,12 +736,12 @@ test_that("casing of empty dates", { con = connection(), writeSchema = writeSchema(), numberIndividuals = 3, seed = 1 ) - cdm$cohort1 <- cdm$cohort1 %>% dplyr::filter(cohort_definition_id == 1) + cdm$cohort1 <- cdm$cohort1 |> dplyr::filter(cohort_definition_id == 1) expect_false( - cdm$cohort2 %>% - addCohortIntersectDate(targetCohortTable = "cohort1") %>% - head(1) %>% - dplyr::pull("cohort_2_0_to_inf") %>% + cdm$cohort2 |> + addCohortIntersectDate(targetCohortTable = "cohort1") |> + head(1) |> + dplyr::pull("cohort_2_0_to_inf") |> is.numeric() ) diff --git a/tests/testthat/test-addConceptIntersect.R b/tests/testthat/test-addConceptIntersect.R index c0bbc62a..17cd6338 100644 --- a/tests/testthat/test-addConceptIntersect.R +++ b/tests/testthat/test-addConceptIntersect.R @@ -105,14 +105,14 @@ test_that("unsupported domain name", { valid_start_date = as.Date("1900-01-01"), valid_end_date = as.Date("2099-01-01"), invalid_reason = NA_character_ - ) %>% + ) |> dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id)) cdm <- CDMConnector::insertTable(cdm, "concept", concept) - expect_no_warning(result <- cdm$cohort1 %>% + expect_no_warning(result <- cdm$cohort1 |> addConceptIntersectFlag( conceptSet = list("random" = 1125315L) - ) %>% + ) |> dplyr::collect()) expect_true( @@ -122,7 +122,7 @@ test_that("unsupported domain name", { ) expect_no_error( - cdm$cohort1a <- cdm$cohort1 %>% + cdm$cohort1a <- cdm$cohort1 |> addConceptIntersectFlag( conceptSet = list("not_in_concept_table" = 99L), nameStyle = "new_col" @@ -146,14 +146,14 @@ test_that("NA domain name", { valid_start_date = as.Date("1900-01-01"), valid_end_date = as.Date("2099-01-01"), invalid_reason = NA_character_ - ) %>% + ) |> dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id)) cdm <- CDMConnector::insertTable(cdm, "concept", concept) - expect_no_warning(result <- cdm$cohort1 %>% + expect_no_warning(result <- cdm$cohort1 |> addConceptIntersectFlag( conceptSet = list("random2" = 1125315L) - ) %>% + ) |> dplyr::collect()) expect_true( @@ -176,14 +176,14 @@ test_that("domain name not in cdm", { valid_start_date = as.Date("1900-01-01"), valid_end_date = as.Date("2099-01-01"), invalid_reason = NA_character_ - ) %>% + ) |> dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id)) cdm <- CDMConnector::insertTable(cdm, "concept", concept) - expect_no_warning(result <- cdm$cohort1 %>% + expect_no_warning(result <- cdm$cohort1 |> addConceptIntersectFlag( conceptSet = list("random3" = 1125315L) - ) %>% + ) |> dplyr::collect()) expect_true( @@ -223,11 +223,11 @@ test_that("missing event end date", { cohort_tables = "cohort" ) - cdm <- cdm %>% + cdm <- cdm |> CDMConnector::cdm_subset(person_id = 273L) - expect_true(cdm$cohort %>% + expect_true(cdm$cohort |> PatientProfiles::addConceptIntersectFlag( conceptSet = list(a = 192671L), window = c(-Inf, 0) diff --git a/tests/testthat/test-addDemographics.R b/tests/testthat/test-addDemographics.R index 99890f58..7b8d3f9f 100644 --- a/tests/testthat/test-addDemographics.R +++ b/tests/testthat/test-addDemographics.R @@ -2,7 +2,7 @@ test_that("addInObservtaion, Inf windows, completeInterval T", { skip_on_cran() cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) expect_no_error( - cdm$cohort1 %>% + cdm$cohort1 |> PatientProfiles::addInObservation( window = c(0, Inf), completeInterval = T @@ -10,7 +10,7 @@ test_that("addInObservtaion, Inf windows, completeInterval T", { ) expect_no_error( - cdm$cohort1 %>% + cdm$cohort1 |> PatientProfiles::addInObservation( window = c(-Inf, 0), completeInterval = T @@ -50,9 +50,9 @@ test_that("addDemographics, cohort and condition_occurrence", { ) oldcohort <- cdm$cohort1 - cdm$cohort1 <- cdm$cohort1 %>% + cdm$cohort1 <- cdm$cohort1 |> addDemographics(ageImposeMonth = TRUE, ageImposeDay = TRUE) - cdm$condition_occurrence <- cdm$condition_occurrence %>% + cdm$condition_occurrence <- cdm$condition_occurrence |> addDemographics( indexDate = "condition_start_date", ageImposeMonth = TRUE, @@ -107,7 +107,7 @@ test_that("addDemographics, parameters", { period_type_concept_id = 0L ) ) - cdm$cohort1 <- cdm$cohort1 %>% + cdm$cohort1 <- cdm$cohort1 |> addDemographics( indexDate = "cohort_end_date", ageGroup = list("age_group" = list(c(0, 40), c(41, Inf))), @@ -118,26 +118,26 @@ test_that("addDemographics, parameters", { expect_true(all( c("age", "sex", "prior_observation", "age_group") %in% colnames(cdm$cohort1) )) - s <- cdm$cohort1 %>% + s <- cdm$cohort1 |> dplyr::filter( .data$subject_id == 1 & .data$cohort_start_date == as.Date("2020-01-01") - ) %>% + ) |> dplyr::collect() expect_true(s$age == 22) expect_true(s$sex == "Female") expect_true(s$prior_observation == 4985) expect_true(s$age_group == "0 to 40") - s <- cdm$cohort1 %>% + s <- cdm$cohort1 |> dplyr::filter( .data$subject_id == 1 & .data$cohort_start_date == as.Date("2020-06-01") - ) %>% + ) |> dplyr::collect() expect_true(s$age == 22) expect_true(s$sex == "Female") expect_true(s$prior_observation == 5137) expect_true(s$age_group == "0 to 40") - s <- cdm$cohort1 %>% - dplyr::filter(.data$subject_id == 3) %>% + s <- cdm$cohort1 |> + dplyr::filter(.data$subject_id == 3) |> dplyr::collect() expect_true(s$age == 52) expect_true(s$sex == "Female") @@ -154,7 +154,7 @@ test_that("partial demographics - cohorts", { ) # only age - cdm$cohort1a <- cdm$cohort1 %>% + cdm$cohort1a <- cdm$cohort1 |> addDemographics( indexDate = "cohort_end_date", age = TRUE, @@ -173,7 +173,7 @@ test_that("partial demographics - cohorts", { ) # only sex - cdm$cohort1b <- cdm$cohort1 %>% + cdm$cohort1b <- cdm$cohort1 |> addDemographics( indexDate = "cohort_end_date", age = FALSE, @@ -191,7 +191,7 @@ test_that("partial demographics - cohorts", { ) # only prior history - cdm$cohort1c <- cdm$cohort1 %>% + cdm$cohort1c <- cdm$cohort1 |> addDemographics( indexDate = "cohort_end_date", age = FALSE, @@ -209,7 +209,7 @@ test_that("partial demographics - cohorts", { ) # only future observation - cdm$cohort1d <- cdm$cohort1 %>% + cdm$cohort1d <- cdm$cohort1 |> addDemographics( indexDate = "cohort_end_date", age = FALSE, @@ -228,7 +228,7 @@ test_that("partial demographics - cohorts", { # all - cdm$cohort1e <- cdm$cohort1 %>% + cdm$cohort1e <- cdm$cohort1 |> addDemographics( indexDate = "cohort_end_date", age = TRUE, @@ -257,7 +257,7 @@ test_that("partial demographics - omop tables", { ) # only age - cdm$condition_occurrence1a <- cdm$condition_occurrence %>% + cdm$condition_occurrence1a <- cdm$condition_occurrence |> addDemographics( indexDate = "condition_start_date", age = TRUE, @@ -271,7 +271,7 @@ test_that("partial demographics - omop tables", { colnames(cdm$condition_occurrence1a))) # only sex - cdm$cohort1b <- cdm$cohort1 %>% + cdm$cohort1b <- cdm$cohort1 |> addDemographics( indexDate = "cohort_end_date", age = FALSE, @@ -284,7 +284,7 @@ test_that("partial demographics - omop tables", { colnames(cdm$cohort1b))) # only prior history - cdm$cohort1c <- cdm$cohort1 %>% + cdm$cohort1c <- cdm$cohort1 |> addDemographics( indexDate = "cohort_end_date", age = FALSE, @@ -297,7 +297,7 @@ test_that("partial demographics - omop tables", { colnames(cdm$cohort1c))) # all - cdm$condition_occurrence1d <- cdm$condition_occurrence %>% + cdm$condition_occurrence1d <- cdm$condition_occurrence |> addDemographics( indexDate = "condition_start_date", age = TRUE, @@ -334,7 +334,7 @@ test_that("priorObservation and future_observation - outside of observation peri ) ) - cdm$condition_occurrence <- cdm$condition_occurrence %>% + cdm$condition_occurrence <- cdm$condition_occurrence |> addDemographics( indexDate = "condition_start_date", age = FALSE, @@ -344,8 +344,8 @@ test_that("priorObservation and future_observation - outside of observation peri futureObservation = TRUE ) # both should be missing - expect_true(all(is.na(cdm$condition_occurrence %>% dplyr::pull(prior_observation)))) - expect_true(all(is.na(cdm$condition_occurrence %>% dplyr::pull(future_observation)))) + expect_true(all(is.na(cdm$condition_occurrence |> dplyr::pull(prior_observation)))) + expect_true(all(is.na(cdm$condition_occurrence |> dplyr::pull(future_observation)))) }) test_that("priorObservation - multiple observation periods", { @@ -393,7 +393,7 @@ test_that("priorObservation - multiple observation periods", { cohort2 = cohort1 ) - cdm$cohort1a <- cdm$cohort1 %>% + cdm$cohort1a <- cdm$cohort1 |> addDemographics( indexDate = "cohort_start_date", age = FALSE, @@ -402,13 +402,13 @@ test_that("priorObservation - multiple observation periods", { priorObservation = TRUE, futureObservation = TRUE ) - expect_true(nrow(cdm$cohort1a %>% dplyr::collect()) == 2) - expect_true(all(cdm$cohort1a %>% dplyr::pull(prior_observation) == + expect_true(nrow(cdm$cohort1a |> dplyr::collect()) == 2) + expect_true(all(cdm$cohort1a |> dplyr::pull(prior_observation) == as.numeric(difftime(as.Date("2012-02-01"), as.Date("2010-01-01"), units = "days" )))) - expect_true(all(cdm$cohort1a %>% dplyr::pull(future_observation) == + expect_true(all(cdm$cohort1a |> dplyr::pull(future_observation) == as.numeric(difftime(as.Date("2015-01-01"), as.Date("2012-02-01"), units = "days" @@ -438,7 +438,7 @@ test_that("check that no extra rows are added", { cohort2 = cohort1 ) # using temp - cdm$cohort1_new <- cdm$cohort1 %>% + cdm$cohort1_new <- cdm$cohort1 |> addDemographics( indexDate = "cohort_start_date", age = TRUE, @@ -450,14 +450,14 @@ test_that("check that no extra rows are added", { # temp tables created by dbplyr expect_true( - cdm$cohort1_new %>% dplyr::tally() %>% dplyr::pull() == - cdm$cohort1 %>% - dplyr::tally() %>% + cdm$cohort1_new |> dplyr::tally() |> dplyr::pull() == + cdm$cohort1 |> + dplyr::tally() |> dplyr::pull() ) # using temp - cdm$cohort1_new <- cdm$cohort1 %>% + cdm$cohort1_new <- cdm$cohort1 |> addDemographics( indexDate = "cohort_start_date", age = FALSE, @@ -468,14 +468,14 @@ test_that("check that no extra rows are added", { # temp tables created by dbplyr expect_true( - cdm$cohort1_new %>% dplyr::tally() %>% dplyr::pull() == - cdm$cohort1 %>% - dplyr::tally() %>% + cdm$cohort1_new |> dplyr::tally() |> dplyr::pull() == + cdm$cohort1 |> + dplyr::tally() |> dplyr::pull() ) # using temp - cdm$cohort1_new <- cdm$cohort1 %>% + cdm$cohort1_new <- cdm$cohort1 |> addDemographics( indexDate = "cohort_start_date", age = FALSE, @@ -486,14 +486,14 @@ test_that("check that no extra rows are added", { # temp tables created by dbplyr expect_true( - cdm$cohort1_new %>% dplyr::tally() %>% dplyr::pull() == - cdm$cohort1 %>% - dplyr::tally() %>% + cdm$cohort1_new |> dplyr::tally() |> dplyr::pull() == + cdm$cohort1 |> + dplyr::tally() |> dplyr::pull() ) # using temp - cdm$cohort1_new <- cdm$cohort1 %>% + cdm$cohort1_new <- cdm$cohort1 |> addDemographics( indexDate = "cohort_start_date", age = FALSE, @@ -504,9 +504,9 @@ test_that("check that no extra rows are added", { # temp tables created by dbplyr expect_true( - cdm$cohort1_new %>% dplyr::tally() %>% dplyr::pull() == - cdm$cohort1 %>% - dplyr::tally() %>% + cdm$cohort1_new |> dplyr::tally() |> dplyr::pull() == + cdm$cohort1 |> + dplyr::tally() |> dplyr::pull() ) }) @@ -549,27 +549,27 @@ test_that("age at cohort end, no missing, check age computation", { # check if exact age is computed, ie, dob 2000-01-01, target date 2000-12-01 --> age 0 # dob 2000-01-01, target date 2001-01-02 --> age 1 result <- cdm[["cohort1"]] |> - addAge(ageImposeMonth = FALSE, ageImposeDay = FALSE) %>% + addAge(ageImposeMonth = FALSE, ageImposeDay = FALSE) |> dplyr::collect() - expect_true(result %>% - dplyr::filter(subject_id == 1) %>% + expect_true(result |> + dplyr::filter(subject_id == 1) |> dplyr::pull("age") == 0) - expect_true(result %>% - dplyr::filter(subject_id == 2) %>% + expect_true(result |> + dplyr::filter(subject_id == 2) |> dplyr::pull("age") == 1) result <- addDemographics( x = cdm[["cohort1"]], ageImposeMonth = FALSE, ageImposeDay = FALSE - ) %>% + ) |> dplyr::collect() - expect_true(result %>% - dplyr::filter(subject_id == 1) %>% + expect_true(result |> + dplyr::filter(subject_id == 1) |> dplyr::pull("age") == 0) - expect_true(result %>% - dplyr::filter(subject_id == 2) %>% + expect_true(result |> + dplyr::filter(subject_id == 2) |> dplyr::pull("age") == 1) }) @@ -611,7 +611,7 @@ test_that("age at cohort entry, missing year/month/day of birth", { result <- addAge( x = cdm$cohort1, ageImposeMonth = FALSE, ageImposeDay = FALSE, ageMissingMonth = 4, ageMissingDay = 4 - ) %>% dplyr::collect() + ) |> dplyr::collect() expect_true(all(c(colnames(cohort1), "age") %in% colnames(result))) expect_equal(nrow(result), 3) @@ -622,7 +622,7 @@ test_that("age at cohort entry, missing year/month/day of birth", { ageMissingMonth = 4, ageMissingDay = 4, sex = FALSE, priorObservation = FALSE, futureObservation = FALSE, - ) %>% dplyr::collect() + ) |> dplyr::collect() expect_equal(result, resultB) }) @@ -675,7 +675,7 @@ test_that("multiple cohortIds, check age at cohort end", { sex = FALSE, priorObservation = FALSE, futureObservation = FALSE, - ) %>% + ) |> dplyr::collect() expect_equal(result, resultB) @@ -716,57 +716,57 @@ test_that("age group checks", { observation_period = observation_period ) - x <- cdm$cohort1 %>% + x <- cdm$cohort1 |> addAge() - result1a <- x %>% + result1a <- x |> addCategories( variable = "age", categories = list("age_group" = list(c(1, 20), c(21, 30), c(31, 40))) - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> dplyr::arrange(age) result1b <- addDemographics( cdm$cohort1, ageGroup = list("age_group" = list(c(1, 20), c(21, 30), c(31, 40))), sex = FALSE, priorObservation = FALSE, futureObservation = FALSE - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> dplyr::arrange(age) expect_true(all(result1a$age_group == c("1 to 20", "21 to 30", "31 to 40"))) expect_equal(result1a, result1b) # change the order of ageGroup provided, result should be the same - result2a <- x %>% + result2a <- x |> addCategories( variable = "age", categories = list("age_group" = list(c(21, 30), c(1, 20), c(31, 40))) - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> dplyr::arrange(age) - result3a <- cdm$cohort1 %>% - addAge(ageGroup = list(c(1, 20), c(21, 30), c(31, 40))) %>% - dplyr::collect() %>% + result3a <- cdm$cohort1 |> + addAge(ageGroup = list(c(1, 20), c(21, 30), c(31, 40))) |> + dplyr::collect() |> dplyr::arrange(.data$age) expect_true(identical(result1a, result2a)) expect_true(identical(result1a, result3a)) - result2b <- cdm$cohort1 %>% + result2b <- cdm$cohort1 |> addDemographics( ageGroup = list("age_group" = list(c(21, 30), c(1, 20), c(31, 40))), sex = FALSE, priorObservation = FALSE, futureObservation = FALSE - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> dplyr::arrange(age) result3b <- addDemographics( cdm$cohort1, ageGroup = list("age_group" = list(c(1, 20), c(21, 30), c(31, 40))), sex = FALSE, priorObservation = FALSE, futureObservation = FALSE - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> dplyr::arrange(age) expect_true(identical(result1b, result2b)) expect_true(identical(result1b, result3b)) @@ -802,31 +802,31 @@ test_that("age group checks", { cohort2 = cohort1, observation_period = observation_period ) - result1 <- cdm$cohort1 %>% - addAge() %>% + result1 <- cdm$cohort1 |> + addAge() |> addCategories( "age", list("age_group" = list(c(1, 20), c(21, 30), c(31, 40))) - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> dplyr::arrange(age) expect_true( - result1 %>% - dplyr::filter(is.na(age)) %>% - dplyr::pull("age_group") %>% + result1 |> + dplyr::filter(is.na(age)) |> + dplyr::pull("age_group") |> is.na() ) # not all ages in age group - result2 <- cdm$cohort1 %>% - addAge() %>% + result2 <- cdm$cohort1 |> + addAge() |> addCategories( "age", list("age_group" = list(c(35, 45))) - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> dplyr::arrange(age) - expect_true(result2 %>% - dplyr::filter(age == 10) %>% + expect_true(result2 |> + dplyr::filter(age == 10) |> dplyr::pull("age_group") == "None") }) @@ -838,12 +838,12 @@ test_that("age variable names", { x = cdm[["cohort1"]], ageName = "current_age", indexDate = "cohort_end_date" - ) %>% + ) |> addDemographics( ageName = "working_age", sex = FALSE, priorObservation = FALSE, futureObservation = FALSE - ) %>% + ) |> dplyr::collect() expect_true(all(c("current_age", "working_age") %in% colnames(result))) }) @@ -936,7 +936,7 @@ test_that("expected errors", { observation_period = observation_period ) - cdm$cohort1 <- cdm$cohort1 %>% addAge() + cdm$cohort1 <- cdm$cohort1 |> addAge() # error if overlapping ageGroups expect_error(addCategories( @@ -971,8 +971,8 @@ test_that("addCategories input", { # overwrite when categories named same as variable, throw warning expect_error( - cdm$cohort1 %>% - addAge() %>% + cdm$cohort1 |> + addAge() |> addCategories( variable = "age", categories = list("age" = list(c(1, 30), c(31, 99))) @@ -980,7 +980,7 @@ test_that("addCategories input", { ) expect_error( - cdm$cohort1 %>% + cdm$cohort1 |> addDemographics( sex = FALSE, priorObservation = FALSE, @@ -990,31 +990,31 @@ test_that("addCategories input", { ) # default group name when no input - expect_true("category_1" %in% colnames(cdm$cohort1 %>% addAge() %>% + expect_true("category_1" %in% colnames(cdm$cohort1 |> addAge() |> addCategories( variable = "age", categories = list(list(c(1, 30), c(31, 40))) ))) # Error when x is not a tibble - expect_error(c(1, 2, 3, 4) %>% addCategories( + expect_error(c(1, 2, 3, 4) |> addCategories( variable = "age", categories = list(list(c(1, 30), c(31, 40))) )) - result <- cdm$cohort1 %>% - addAge() %>% + result <- cdm$cohort1 |> + addAge() |> addCategories( variable = "age", categories = list( list(c(1, 30), c(31, 40)), list(c(0, 50), c(51, 100)) ) - ) %>% + ) |> dplyr::collect() expect_true(all(c("category_1", "category_2") %in% colnames(result))) # ERROR when repeat group name - expect_error(cdm$cohort1 %>% addAge() %>% + expect_error(cdm$cohort1 |> addAge() |> addCategories( variable = "age", categories = list( @@ -1024,7 +1024,7 @@ test_that("addCategories input", { )) expect_error( - cdm$cohort1 %>% + cdm$cohort1 |> addDemographics( sex = FALSE, priorObservation = FALSE, @@ -1112,8 +1112,8 @@ test_that("test if column exist, overwrite", { ) expect_warning( - result <- cdm$cohort1 %>% - addDemographics() %>% + result <- cdm$cohort1 |> + addDemographics() |> dplyr::collect() ) @@ -1122,32 +1122,32 @@ test_that("test if column exist, overwrite", { expect_true(sum(colnames(result) == "prior_observation") == 1) expect_true(sum(colnames(result) == "future_observation") == 1) - expect_true(all(result %>% dplyr::arrange(cohort_start_date, subject_id) %>% + expect_true(all(result |> dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(age) != - cohort1 %>% + cohort1 |> dplyr::collect() |> - dplyr::arrange(cohort_start_date, subject_id) %>% + dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(age), na.rm = TRUE)) - expect_true(all(result %>% dplyr::arrange(cohort_start_date, subject_id) %>% + expect_true(all(result |> dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(sex) != - cohort1 %>% + cohort1 |> dplyr::collect() |> - dplyr::arrange(cohort_start_date, subject_id) %>% + dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(sex), na.rm = TRUE)) - expect_true(all(result %>% dplyr::arrange(cohort_start_date, subject_id) %>% + expect_true(all(result |> dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(prior_observation) != - cohort1 %>% + cohort1 |> dplyr::collect() |> - dplyr::arrange(cohort_start_date, subject_id) %>% + dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(prior_observation), na.rm = TRUE)) - expect_true(all(result %>% dplyr::arrange(cohort_start_date, subject_id) %>% + expect_true(all(result |> dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(future_observation) != - cohort1 %>% + cohort1 |> dplyr::collect() |> - dplyr::arrange(cohort_start_date, subject_id) %>% + dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(future_observation), na.rm = TRUE)) }) @@ -1166,53 +1166,53 @@ test_that("date of birth", { con = connection(), writeSchema = writeSchema(), person = person ) - personDOB <- cdm$person %>% - addDateOfBirth() %>% + personDOB <- cdm$person |> + addDateOfBirth() |> dplyr::collect() - expect_true(personDOB %>% dplyr::filter(person_id == 1) %>% dplyr::pull(date_of_birth) == + expect_true(personDOB |> dplyr::filter(person_id == 1) |> dplyr::pull(date_of_birth) == "2001-12-01") - expect_true(personDOB %>% dplyr::filter(person_id == 2) %>% dplyr::pull(date_of_birth) == + expect_true(personDOB |> dplyr::filter(person_id == 2) |> dplyr::pull(date_of_birth) == "2005-06-15") - drug_exposure_dob <- cdm$drug_exposure %>% - addDateOfBirth() %>% + drug_exposure_dob <- cdm$drug_exposure |> + addDateOfBirth() |> dplyr::collect() - expect_true(all(drug_exposure_dob %>% dplyr::filter(person_id == 1) %>% dplyr::pull(date_of_birth) == + expect_true(all(drug_exposure_dob |> dplyr::filter(person_id == 1) |> dplyr::pull(date_of_birth) == "2001-12-01")) - expect_true(all(drug_exposure_dob %>% dplyr::filter(person_id == 2) %>% dplyr::pull(date_of_birth) == + expect_true(all(drug_exposure_dob |> dplyr::filter(person_id == 2) |> dplyr::pull(date_of_birth) == "2005-06-15")) - cohort_dob <- cdm$cohort1 %>% - addDateOfBirth() %>% + cohort_dob <- cdm$cohort1 |> + addDateOfBirth() |> dplyr::collect() - expect_true(cohort_dob %>% dplyr::filter(subject_id == 1) %>% dplyr::pull(date_of_birth) == + expect_true(cohort_dob |> dplyr::filter(subject_id == 1) |> dplyr::pull(date_of_birth) == "2001-12-01") - expect_true(cohort_dob %>% dplyr::filter(subject_id == 2) %>% dplyr::pull(date_of_birth) == + expect_true(cohort_dob |> dplyr::filter(subject_id == 2) |> dplyr::pull(date_of_birth) == "2005-06-15") - personDOB2 <- cdm$person %>% - addDateOfBirth(imposeDay = TRUE, imposeMonth = TRUE) %>% + personDOB2 <- cdm$person |> + addDateOfBirth(imposeDay = TRUE, imposeMonth = TRUE) |> dplyr::collect() - expect_true(personDOB2 %>% dplyr::filter(person_id == 1) %>% dplyr::pull(date_of_birth) == + expect_true(personDOB2 |> dplyr::filter(person_id == 1) |> dplyr::pull(date_of_birth) == "2001-01-01") - expect_true(personDOB2 %>% dplyr::filter(person_id == 2) %>% dplyr::pull(date_of_birth) == + expect_true(personDOB2 |> dplyr::filter(person_id == 2) |> dplyr::pull(date_of_birth) == "2005-01-01") - drug_exposure_dob2 <- cdm$drug_exposure %>% - addDateOfBirth(imposeDay = TRUE, imposeMonth = TRUE) %>% + drug_exposure_dob2 <- cdm$drug_exposure |> + addDateOfBirth(imposeDay = TRUE, imposeMonth = TRUE) |> dplyr::collect() - expect_true(all(drug_exposure_dob2 %>% dplyr::filter(person_id == 1) %>% dplyr::pull(date_of_birth) == + expect_true(all(drug_exposure_dob2 |> dplyr::filter(person_id == 1) |> dplyr::pull(date_of_birth) == "2001-01-01")) - expect_true(all(drug_exposure_dob2 %>% dplyr::filter(person_id == 2) %>% dplyr::pull(date_of_birth) == + expect_true(all(drug_exposure_dob2 |> dplyr::filter(person_id == 2) |> dplyr::pull(date_of_birth) == "2005-01-01")) - cohortDOB2 <- cdm$cohort1 %>% - addDateOfBirth(imposeDay = TRUE, imposeMonth = TRUE) %>% + cohortDOB2 <- cdm$cohort1 |> + addDateOfBirth(imposeDay = TRUE, imposeMonth = TRUE) |> dplyr::collect() - expect_true(cohortDOB2 %>% dplyr::filter(subject_id == 1) %>% dplyr::pull(date_of_birth) == + expect_true(cohortDOB2 |> dplyr::filter(subject_id == 1) |> dplyr::pull(date_of_birth) == "2001-01-01") - expect_true(cohortDOB2 %>% dplyr::filter(subject_id == 2) %>% dplyr::pull(date_of_birth) == + expect_true(cohortDOB2 |> dplyr::filter(subject_id == 2) |> dplyr::pull(date_of_birth) == "2005-01-01") }) @@ -1220,24 +1220,24 @@ test_that("missing levels", { skip_on_cran() cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) - result <- cdm[["cohort1"]] %>% + result <- cdm[["cohort1"]] |> addDemographics( ageGroup = list(c(0, 25)), sex = FALSE, priorObservation = FALSE, futureObservation = FALSE - ) %>% + ) |> dplyr::collect() expect_true("None" %in% result$age_group) expect_true(all(is.na(result$age_group[is.na(result$age)]))) - result <- cdm$cohort1 %>% - addSex() %>% + result <- cdm$cohort1 |> + addSex() |> dplyr::collect() expect_true(all(!is.na(result$sex))) - result <- cdm$person %>% - dplyr::mutate(gender_concept_id = "111") %>% - addSex() %>% + result <- cdm$person |> + dplyr::mutate(gender_concept_id = "111") |> + addSex() |> dplyr::collect() expect_true(all(!is.na(result$sex))) }) @@ -1246,14 +1246,14 @@ test_that("overwriting obs period variables", { skip_on_cran() cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) - cdm$cohort1 <- cdm$cohort1 %>% + cdm$cohort1 <- cdm$cohort1 |> addDateOfBirth() |> addDemographics() expect_true(all(c( "date_of_birth", "age", "sex", "prior_observation", "future_observation" ) %in% colnames(cdm$cohort1))) - cdm$cohort2 <- cdm$cohort2 %>% + cdm$cohort2 <- cdm$cohort2 |> dplyr::mutate(observation_period_start_date = "a") |> addPriorObservation() |> addFutureObservation() |> @@ -1318,13 +1318,13 @@ test_that("query gives same result as main function", { skip_on_cran() cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) # we should get the same results if compute was internal or not - result_1 <- cdm$cohort1 %>% - PatientProfiles::addDemographics() %>% + result_1 <- cdm$cohort1 |> + PatientProfiles::addDemographics() |> dplyr::collect()|> dplyr::arrange(cohort_definition_id, subject_id, cohort_start_date) - result_2 <- cdm$cohort1 %>% + result_2 <- cdm$cohort1 |> addDemographicsQuery() |> dplyr::collect()|> dplyr::arrange(cohort_definition_id, @@ -1334,7 +1334,7 @@ test_that("query gives same result as main function", { # check no tables are created along the way with query start_tables <- CDMConnector::listSourceTables(cdm) - cdm$cohort1 %>% + cdm$cohort1 |> addDemographicsQuery() end_tables <- CDMConnector::listSourceTables(cdm) expect_equal(start_tables, end_tables) @@ -1348,14 +1348,14 @@ test_that("table names", { # we should get the same results if compute was internal or not # by default will create a temp table if no name supplied - expect_no_error(cdm$cohort2 <- cdm$cohort1 %>% + expect_no_error(cdm$cohort2 <- cdm$cohort1 |> PatientProfiles::addDemographics()) # providing a name will create a table with that name # must be the same on both sides of assinment - expect_error(cdm$cohort2 <- cdm$cohort1 %>% + expect_error(cdm$cohort2 <- cdm$cohort1 |> PatientProfiles::addDemographics(name = "cohort_3")) - expect_no_error(cdm$cohort_3 <- cdm$cohort1 %>% + expect_no_error(cdm$cohort_3 <- cdm$cohort1 |> PatientProfiles::addDemographics(name = "cohort_3")) mockDisconnect(cdm) diff --git a/tests/testthat/test-addFutureObservation.R b/tests/testthat/test-addFutureObservation.R index f0dc8b77..786840db 100644 --- a/tests/testthat/test-addFutureObservation.R +++ b/tests/testthat/test-addFutureObservation.R @@ -14,11 +14,11 @@ test_that("check condition_occurrence and cohort1 work", { # mock data cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) # check it works with cohort1 table in mockdb - expect_true(typeof(cdm$cohort1 %>% addFutureObservation() %>% dplyr::collect()) == "list") - expect_true("future_observation" %in% colnames(cdm$cohort1 %>% addFutureObservation())) + expect_true(typeof(cdm$cohort1 |> addFutureObservation() |> dplyr::collect()) == "list") + expect_true("future_observation" %in% colnames(cdm$cohort1 |> addFutureObservation())) # check it works with condition_occurrence table in mockdb - expect_true(typeof(cdm$condition_occurrence %>% addFutureObservation(indexDate = "condition_start_date") %>% dplyr::collect()) == "list") - expect_true("future_observation" %in% colnames(cdm$condition_occurrence %>% addFutureObservation(indexDate = "condition_start_date"))) + expect_true(typeof(cdm$condition_occurrence |> addFutureObservation(indexDate = "condition_start_date") |> dplyr::collect()) == "list") + expect_true("future_observation" %in% colnames(cdm$condition_occurrence |> addFutureObservation(indexDate = "condition_start_date"))) mockDisconnect(cdm = cdm) }) @@ -54,13 +54,13 @@ test_that("check working example with cohort1", { cohort2 = cohort1 ) - result <- cdm$cohort1 %>% - addFutureObservation() %>% + result <- cdm$cohort1 |> + addFutureObservation() |> dplyr::collect() expect_true(all(colnames(cohort1) %in% colnames(result))) - expect_true(all(result %>% + expect_true(all(result |> dplyr::select("future_observation") == dplyr::tibble( future_observation = @@ -115,12 +115,12 @@ test_that("check working example with condition_occurrence", { observation_period = obs1 ) - result <- cdm$condition_occurrence %>% - addFutureObservation(indexDate = "condition_start_date") %>% + result <- cdm$condition_occurrence |> + addFutureObservation(indexDate = "condition_start_date") |> dplyr::collect() expect_true(all( - result %>% dplyr::select("future_observation") == + result |> dplyr::select("future_observation") == dplyr::tibble( future_observation = c( @@ -175,7 +175,7 @@ test_that("different name", { observation_period = obs1 ) - cdm$condition_occurrence <- cdm$condition_occurrence %>% + cdm$condition_occurrence <- cdm$condition_occurrence |> addFutureObservation( indexDate = "condition_start_date", futureObservationName = "fh" ) @@ -241,10 +241,10 @@ test_that("priorHistory and future_observation - outside of observation period", condition_occurrence = co ) - cdm$cohort1a <- cdm$condition_occurrence %>% + cdm$cohort1a <- cdm$condition_occurrence |> addFutureObservation(indexDate = "condition_start_date") # both should be NA - expect_true(all(is.na(cdm$cohort1a %>% dplyr::pull(future_observation)))) + expect_true(all(is.na(cdm$cohort1a |> dplyr::pull(future_observation)))) mockDisconnect(cdm = cdm) }) @@ -289,23 +289,23 @@ test_that("multiple observation periods", { cohort1 = cohort1 ) - cdm$cohort1a <- cdm$cohort1 %>% + cdm$cohort1a <- cdm$cohort1 |> addFutureObservation(indexDate = "cohort_start_date") - expect_true(nrow(cdm$cohort1a %>% dplyr::collect()) == 2) - expect_true(all(cdm$cohort1a %>% dplyr::pull(future_observation) == + expect_true(nrow(cdm$cohort1a |> dplyr::collect()) == 2) + expect_true(all(cdm$cohort1a |> dplyr::pull(future_observation) == as.numeric(difftime(as.Date("2015-01-01"), as.Date("2012-02-01"), units = "days" )))) # from cohort end date - cdm$cohort1a <- cdm$cohort1 %>% + cdm$cohort1a <- cdm$cohort1 |> addFutureObservation( indexDate = "cohort_end_date", futureObservationName = "fh_from_c_end" ) - expect_true(all(cdm$cohort1a %>% dplyr::pull("fh_from_c_end") == + expect_true(all(cdm$cohort1a |> dplyr::pull("fh_from_c_end") == as.numeric(difftime(as.Date("2015-01-01"), as.Date("2013-02-01"), units = "days" diff --git a/tests/testthat/test-addInObservation.R b/tests/testthat/test-addInObservation.R index b8e6cecf..9a82212d 100644 --- a/tests/testthat/test-addInObservation.R +++ b/tests/testthat/test-addInObservation.R @@ -19,26 +19,26 @@ test_that("addInObservation, cohort and condition_occurrence", { result1 <- addInObservation(cdm$cohort1) expect_true("in_observation" %in% colnames(result1)) expect_true(all( - result1 %>% - dplyr::collect() %>% - dplyr::arrange(cohort_definition_id, cohort_start_date) %>% - dplyr::select(in_observation) %>% + result1 |> + dplyr::collect() |> + dplyr::arrange(cohort_definition_id, cohort_start_date) |> + dplyr::select(in_observation) |> dplyr::pull() == c(1, 1) )) result2 <- addInObservation(cdm$cohort2) expect_true("in_observation" %in% colnames(result2)) - expect_true(all(result2 %>% dplyr::collect() |> dplyr::arrange(cohort_definition_id, cohort_start_date) %>% dplyr::select(in_observation) %>% dplyr::pull() == 1)) + expect_true(all(result2 |> dplyr::collect() |> dplyr::arrange(cohort_definition_id, cohort_start_date) |> dplyr::select(in_observation) |> dplyr::pull() == 1)) - result3 <- addInObservation(cdm$cohort1 %>% dplyr::rename(person_id = subject_id)) + result3 <- addInObservation(cdm$cohort1 |> dplyr::rename(person_id = subject_id)) expect_true("in_observation" %in% colnames(result3)) - expect_true(all(result1 %>% dplyr::select(in_observation) %>% dplyr::pull() == result3 %>% - dplyr::select(in_observation) %>% + expect_true(all(result1 |> dplyr::select(in_observation) |> dplyr::pull() == result3 |> + dplyr::select(in_observation) |> dplyr::pull())) result4 <- addInObservation(cdm$condition_occurrence, indexDate = "condition_start_date") expect_true("in_observation" %in% colnames(result4)) - expect_true(all(result4 %>% dplyr::collect() |> dplyr::arrange(condition_occurrence_id, condition_start_date) %>% dplyr::select(in_observation) %>% dplyr::pull() == 1)) + expect_true(all(result4 |> dplyr::collect() |> dplyr::arrange(condition_occurrence_id, condition_start_date) |> dplyr::select(in_observation) |> dplyr::pull() == 1)) mockDisconnect(cdm = cdm) }) @@ -51,7 +51,7 @@ test_that("addInObservation, parameters", { expect_true("observ" %in% colnames(result1)) expect_false("in_observation" %in% colnames(result1)) - expect_true(all(result1 %>% dplyr::collect() |> dplyr::arrange(condition_occurrence_id, condition_start_date) %>% dplyr::select(observ) %>% dplyr::pull() == 1)) + expect_true(all(result1 |> dplyr::collect() |> dplyr::arrange(condition_occurrence_id, condition_start_date) |> dplyr::select(observ) |> dplyr::pull() == 1)) mockDisconnect(cdm = cdm) }) @@ -170,13 +170,13 @@ test_that("query gives same result as main function", { skip_on_cran() cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) # we should get the same results if compute was internal or not - result_1 <- cdm$cohort1 %>% - addInObservation() %>% + result_1 <- cdm$cohort1 |> + addInObservation() |> dplyr::collect() |> dplyr::arrange(cohort_definition_id, subject_id, cohort_start_date) - result_2 <- cdm$cohort1 %>% + result_2 <- cdm$cohort1 |> addInObservationQuery() |> dplyr::collect() |> dplyr::arrange(cohort_definition_id, @@ -186,7 +186,7 @@ test_that("query gives same result as main function", { # check no tables are created along the way with query start_tables <- CDMConnector::listSourceTables(cdm) - cdm$cohort1 %>% + cdm$cohort1 |> addInObservationQuery() end_tables <- CDMConnector::listSourceTables(cdm) expect_equal(start_tables, end_tables) diff --git a/tests/testthat/test-addIntersect.R b/tests/testthat/test-addIntersect.R index c3253a5e..beeb1097 100644 --- a/tests/testthat/test-addIntersect.R +++ b/tests/testthat/test-addIntersect.R @@ -68,7 +68,7 @@ test_that("working examples", { numberIndividuals = 2 ) - result <- cdm$cohort1 %>% + result <- cdm$cohort1 |> .addIntersect(tableName = "cohort2", value = "date", nameStyle = "xx") expect_true(length(attributes(cdm$cohort1)) == length(attributes(result))) @@ -84,7 +84,7 @@ test_that("working examples", { } } - result <- result %>% + result <- result |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -93,12 +93,12 @@ test_that("working examples", { expect_true(colnames(result)[3] == "cohort_start_date") expect_true(colnames(result)[4] == "cohort_end_date") - expect_true(all(result %>% dplyr::pull("xx") == as.Date(c("2020-01-15", "2020-01-15", "2020-01-25", "2020-01-24", "2020-03-15")))) + expect_true(all(result |> dplyr::pull("xx") == as.Date(c("2020-01-15", "2020-01-15", "2020-01-25", "2020-01-24", "2020-03-15")))) - result1 <- cdm$cohort1 %>% - .addIntersect(tableName = "cohort2", value = "count") %>% - .addIntersect(tableName = "cohort2", value = "days") %>% - .addIntersect(tableName = "cohort2", value = "flag") %>% + result1 <- cdm$cohort1 |> + .addIntersect(tableName = "cohort2", value = "count") |> + .addIntersect(tableName = "cohort2", value = "days") |> + .addIntersect(tableName = "cohort2", value = "flag") |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -107,17 +107,17 @@ test_that("working examples", { expect_true(all(result1$flag_all_0_to_inf == c(1, 1, 1, 1, 1))) result2 <- - cdm$cohort1 %>% - .addIntersect(tableName = "cohort2", value = "count", order = "last") %>% - .addIntersect(tableName = "cohort2", value = "flag", order = "last") %>% - .addIntersect(tableName = "cohort2", value = "date", order = "last") %>% - .addIntersect(tableName = "cohort2", value = "days", order = "last") %>% + cdm$cohort1 |> + .addIntersect(tableName = "cohort2", value = "count", order = "last") |> + .addIntersect(tableName = "cohort2", value = "flag", order = "last") |> + .addIntersect(tableName = "cohort2", value = "date", order = "last") |> + .addIntersect(tableName = "cohort2", value = "days", order = "last") |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) result6 <- - cdm$cohort1 %>% - .addIntersect(tableName = "cohort2", value = c("date", "count", "days", "flag"), order = "last") %>% + cdm$cohort1 |> + .addIntersect(tableName = "cohort2", value = c("date", "count", "days", "flag"), order = "last") |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -133,23 +133,23 @@ test_that("working examples", { expect_true(all(result2$flag_all_0_to_inf == c(1, 1, 1, 1, 1))) result3 <- - cdm$cohort1 %>% + cdm$cohort1 |> .addIntersect( tableName = "cohort2", window = list(c(-Inf, 0)), value = "date" - ) %>% + ) |> .addIntersect( tableName = "cohort2", window = list(c(-Inf, 0)), value = "days" - ) %>% + ) |> .addIntersect( tableName = "cohort2", window = list(c(-Inf, 0)), value = "count" - ) %>% + ) |> .addIntersect( tableName = "cohort2", window = list(c(-Inf, 0)), value = "flag" - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -160,19 +160,19 @@ test_that("working examples", { expect_true(all(result3$count_all_minf_to_0 == c(0, 1, 1, 0, 2))) expect_true(all(result3$flag_all_minf_to_0 == c(0, 1, 1, 0, 1))) - result4 <- cdm$cohort1 %>% + result4 <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", window = list(c(-30, 30)), value = "date" - ) %>% + ) |> .addIntersect( tableName = "cohort2", window = list(c(-30, 30)), value = "days" - ) %>% + ) |> .addIntersect( tableName = "cohort2", window = list(c(-30, 30)), value = "count" - ) %>% + ) |> .addIntersect( tableName = "cohort2", window = list(c(-30, 30)), value = "flag" - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -183,32 +183,32 @@ test_that("working examples", { expect_true(all(result4$count_all_m30_to_30 == c(3, 3, 4, 2, 2))) expect_true(all(result4$flag_all_m30_to_30 == c(1, 1, 1, 1, 1))) - result5 <- cdm$cohort1 %>% + result5 <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", window = list(c(-30, 30)), value = "date", order = "last" - ) %>% + ) |> .addIntersect( tableName = "cohort2", window = list(c(-30, 30)), value = "days", order = "last" - ) %>% + ) |> .addIntersect( tableName = "cohort2", window = list(c(-30, 30)), value = "count", order = "last" - ) %>% + ) |> .addIntersect( tableName = "cohort2", window = list(c(-30, 30)), value = "flag", order = "last" - ) %>% - dplyr::arrange(subject_id, cohort_start_date) %>% + ) |> + dplyr::arrange(subject_id, cohort_start_date) |> dplyr::collect() @@ -257,10 +257,10 @@ test_that("working examples with cohort_end_date", { numberIndividuals = 2 ) - result <- cdm$cohort1 %>% + result <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", value = "date", indexDate = "cohort_end_date" - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -308,15 +308,15 @@ test_that("working examples with extra column", { numberIndividuals = 2 ) - cdm$cohort2 <- cdm$cohort2 %>% + cdm$cohort2 <- cdm$cohort2 |> dbplyr::window_order( .data$cohort_definition_id, .data$subject_id, .data$cohort_start_date - ) %>% - dplyr::mutate(measurment_result = dplyr::row_number()) %>% - dbplyr::window_order() %>% + ) |> + dplyr::mutate(measurment_result = dplyr::row_number()) |> + dbplyr::window_order() |> dplyr::compute() - result <- cdm$cohort1 %>% + result <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", value = c("flag", "measurment_result"), @@ -324,11 +324,11 @@ test_that("working examples with extra column", { filterId = 1, idName = "covid", window = list(c(0, Inf)) - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) - result1 <- cdm$cohort1 %>% + result1 <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", value = "measurment_result", @@ -336,7 +336,7 @@ test_that("working examples with extra column", { filterId = 2, idName = "covid", window = list(c(0, Inf)) - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -361,28 +361,28 @@ test_that("working examples with extra column", { numberIndividuals = 2 ) - cdm$cohort2 <- cdm$cohort2 %>% + cdm$cohort2 <- cdm$cohort2 |> dbplyr::window_order( .data$cohort_definition_id, .data$subject_id, .data$cohort_start_date - ) %>% - dplyr::mutate(measurment_result = dplyr::row_number()) %>% - dbplyr::window_order() %>% + ) |> + dplyr::mutate(measurment_result = dplyr::row_number()) |> + dbplyr::window_order() |> dplyr::compute() - result2 <- cdm$cohort1 %>% + result2 <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", value = "measurment_result", nameStyle = "{value}_{window_name}" - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) - result3 <- cdm$cohort1 %>% + result3 <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", value = c("flag", "measurment_result"), nameStyle = "{value}_{window_name}", window = list(c(-400, -200)) - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -435,11 +435,11 @@ test_that("working examples with multiple cohort Ids", { return(same) } - result <- cdm$cohort1 %>% + result <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", filterVariable = "cohort_definition_id", filterId = 1, value = "date" - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -447,37 +447,37 @@ test_that("working examples with multiple cohort Ids", { "2020-01-15", "2020-01-15", "2020-01-25", NA, NA ))))) - result1 <- cdm$cohort1 %>% + result1 <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", filterVariable = "cohort_definition_id", filterId = 2, value = "count" - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) expect_true(all(result1$count_id2_0_to_inf == c(1, 1, 1, 1, 0))) - result2 <- cdm$cohort1 %>% + result2 <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", filterVariable = "cohort_definition_id", filterId = c(1, 3), value = "flag" - ) %>% + ) |> .addIntersect( tableName = "cohort2", filterVariable = "cohort_definition_id", filterId = c(1, 3), value = "count" - ) %>% + ) |> .addIntersect( tableName = "cohort2", filterVariable = "cohort_definition_id", filterId = c(1, 3), value = "days" - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) - result3 <- cdm$cohort1 %>% + result3 <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", filterVariable = "cohort_definition_id", filterId = c(1, 3), value = c("count", "days", "flag") - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -528,23 +528,23 @@ test_that("working examples calculating as incidence target cohort", { return(same) } - result <- cdm$cohort1 %>% + result <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", window = c(-Inf, Inf), value = "date", nameStyle = "test_{id_name}_{window_name}" - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) - result1 <- cdm$cohort1 %>% + result1 <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", window = c(-Inf, Inf), value = "date", targetEndDate = NULL - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -595,20 +595,20 @@ test_that("working examples with more than one window", { return(same) } - result <- cdm$cohort1 %>% - .addIntersect(tableName = "cohort2", value = "date") %>% + result <- cdm$cohort1 |> + .addIntersect(tableName = "cohort2", value = "date") |> .addIntersect( tableName = "cohort2", value = "date", window = list(c(-Inf, 0)) - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) - result1 <- cdm$cohort1 %>% + result1 <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", value = "date", window = list(c(0, Inf), c(-Inf, 0)) - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -701,25 +701,25 @@ test_that("working examples with tables, not cohorts", { return(same) } - result <- cdm$cohort1 %>% + result <- cdm$cohort1 |> .addIntersect( tableName = "condition_occurrence", value = "date", targetStartDate = "condition_start_date", targetEndDate = "condition_end_date", window = list(c(0, Inf), c(-Inf, 0)) - ) %>% + ) |> dplyr::collect() expect_true(all(result$date_all_0_to_inf %in% as.Date(c("2020-01-15", "2020-01-15", "2020-01-25", "2020-01-24", "2020-03-15")))) - result1 <- cdm$condition_occurrence %>% + result1 <- cdm$condition_occurrence |> .addIntersect( tableName = "drug_exposure", value = "count", indexDate = "condition_start_date", targetStartDate = "drug_exposure_start_date", targetEndDate = NULL, window = list(c(0, Inf), c(-Inf, 0)), filterVariable = "drug_concept_id", filterId = c(1, 2) - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(person_id, condition_start_date) @@ -729,40 +729,40 @@ test_that("working examples with tables, not cohorts", { expect_true(all(result1$count_id1_minf_to_0 == c(0, 0, 0, 1, 0, 0, 0))) expect_true(all(result1$count_id2_minf_to_0 == c(1, 1, 1, 1, 0, 0, 0))) - result2 <- cdm$condition_occurrence %>% + result2 <- cdm$condition_occurrence |> .addIntersect( tableName = "drug_exposure", value = "count", indexDate = "condition_start_date", targetStartDate = "drug_exposure_start_date", targetEndDate = NULL, window = list(c(0, Inf), c(-Inf, 0)) - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(person_id, condition_start_date) expect_true(all(result1$count_id1_0_to_inf + result1$count_id2_0_to_inf == result2$count_all_0_to_inf)) expect_true(all(result1$count_id1_minf_to_0 + result1$count_id2_minf_to_0 == result2$count_all_minf_to_0)) - result3 <- cdm$condition_occurrence %>% + result3 <- cdm$condition_occurrence |> .addIntersect( tableName = "drug_exposure", value = "date", indexDate = "condition_start_date", targetStartDate = "drug_exposure_start_date", targetEndDate = NULL, window = list(c(0, Inf)), filterVariable = "drug_concept_id", filterId = c(1, 2) - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(person_id, condition_start_date) # test output all zero column when no result found expect_true(all(is.na(result3$date_id2_0_to_inf))) - result4 <- cdm$condition_occurrence %>% + result4 <- cdm$condition_occurrence |> .addIntersect( tableName = "drug_exposure", value = "days", indexDate = "condition_start_date", targetStartDate = "drug_exposure_start_date", targetEndDate = NULL, window = list(c(0, Inf)), filterVariable = "drug_concept_id", filterId = c(1, 2) - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(person_id, condition_start_date) # test output all zero column when no result found @@ -856,7 +856,7 @@ test_that("test checkWindow function", { skip_on_cran() cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) - expect_error(cdm$cohort1 %>% + expect_error(cdm$cohort1 |> .addIntersect( value = "days", filterId = 1, @@ -900,37 +900,37 @@ test_that("test if column exist, overwrite", { ) expect_message( - result <- cdm$cohort1 %>% + result <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", value = c("flag", "date", "days", "count"), window = list(c(0, 30)) - ) %>% + ) |> dplyr::collect() ) expect_true(sum(colnames(result) == "flag_all_0_to_30") == 1) - expect_true(all(result %>% dplyr::arrange(cohort_start_date, subject_id) %>% + expect_true(all(result |> dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(flag_all_0_to_30) != - cohort1 %>% - dplyr::arrange(cohort_start_date, subject_id) %>% + cohort1 |> + dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(flag_all_0_to_30), na.rm = TRUE)) - expect_true(all(result %>% dplyr::arrange(cohort_start_date, subject_id) %>% + expect_true(all(result |> dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(count_all_0_to_30) != - cohort1 %>% - dplyr::arrange(cohort_start_date, subject_id) %>% + cohort1 |> + dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(count_all_0_to_30), na.rm = TRUE)) - expect_true(all(result %>% dplyr::arrange(cohort_start_date, subject_id) %>% + expect_true(all(result |> dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(days_all_0_to_30) != - cohort1 %>% - dplyr::arrange(cohort_start_date, subject_id) %>% + cohort1 |> + dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(days_all_0_to_30), na.rm = TRUE)) - expect_true(all(result %>% dplyr::arrange(cohort_start_date, subject_id) %>% + expect_true(all(result |> dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(date_all_0_to_30) != - cohort1 %>% - dplyr::arrange(cohort_start_date, subject_id) %>% + cohort1 |> + dplyr::arrange(cohort_start_date, subject_id) |> dplyr::select(date_all_0_to_30), na.rm = TRUE)) mockDisconnect(cdm = cdm) @@ -998,12 +998,12 @@ test_that("overlapTable is empty, check return columns", { ) - result <- cdm$cohort1 %>% + result <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", value = c("date", "days", "count", "flag"), filterVariable = "cohort_definition_id", filterId = 2 - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -1092,10 +1092,10 @@ test_that("overlap is empty or not, multiple ids, check return columns", { return(same) } - result <- cdm$cohort1 %>% + result <- cdm$cohort1 |> addCohortIntersectCount( targetCohortTable = "cohort2" - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -1103,10 +1103,10 @@ test_that("overlap is empty or not, multiple ids, check return columns", { expect_true(all(result$cohort_1_0_to_inf == 0)) - result <- cdm$cohort1 %>% + result <- cdm$cohort1 |> addCohortIntersectFlag( targetCohortTable = "cohort2" - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -1114,10 +1114,10 @@ test_that("overlap is empty or not, multiple ids, check return columns", { expect_true(all(result$cohort_1_0_to_inf == 0)) - result <- cdm$cohort1 %>% + result <- cdm$cohort1 |> addCohortIntersectDate( targetCohortTable = "cohort2" - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -1125,10 +1125,10 @@ test_that("overlap is empty or not, multiple ids, check return columns", { expect_true(all(is.na(result$cohort_1_0_to_inf))) - result <- cdm$cohort1 %>% + result <- cdm$cohort1 |> addCohortIntersectDays( targetCohortTable = "cohort2" - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -1136,7 +1136,7 @@ test_that("overlap is empty or not, multiple ids, check return columns", { expect_true(all(is.na(result$cohort_1_0_to_inf))) - result <- cdm$cohort1 %>% + result <- cdm$cohort1 |> .addIntersect( tableName = "cohort2", value = c("flag", "date"), @@ -1144,7 +1144,7 @@ test_that("overlap is empty or not, multiple ids, check return columns", { filterId = c(1, 2, 3), window = list(c(0, Inf), c(-30, -1)), idName = c("num1", "num2", "num3") - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -1171,21 +1171,21 @@ test_that("overlap is empty or not, multiple ids, check return columns", { expect_true(all(is.na(result$date_num2_m30_to_m1))) expect_true(all(is.na(result$date_num1_m30_to_m1))) - expect_error(cdm$cohort1 %>% + expect_error(cdm$cohort1 |> addCohortIntersectDate( targetCohortTable = "cohort2", targetCohortId = c(1, 2, 3), window = list(c(0, Inf), c(-30, -1)) - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date)) - result <- cdm$cohort1 %>% + result <- cdm$cohort1 |> addCohortIntersectDate( targetCohortTable = "cohort2", targetCohortId = c(1, 3), window = list(c(0, Inf), c(-30, -1)) - ) %>% + ) |> dplyr::collect() |> dplyr::arrange(subject_id, cohort_start_date) @@ -1207,8 +1207,8 @@ test_that("overlap is empty or not, multiple ids, check return columns", { test_that("non snake columns not repeated in output", { skip_on_cran() cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) - attr(cdm$cohort1, "cohort_set") <- attr(cdm$cohort1, "cohort_set") %>% dplyr::mutate(cohort_name = toupper(cohort_name)) - cdm$cohort2 <- cdm$cohort2 %>% + attr(cdm$cohort1, "cohort_set") <- attr(cdm$cohort1, "cohort_set") |> dplyr::mutate(cohort_name = toupper(cohort_name)) + cdm$cohort2 <- cdm$cohort2 |> addCohortIntersectFlag(targetCohortTable = "cohort1") expect_true("cohort_1_0_to_inf" %in% colnames(cdm$cohort2)) @@ -1224,7 +1224,7 @@ test_that("no NA when overwrite column", { ) # Presence in characteristis 'cohort 1' in 180 days before cohort start - cdm$cohort1 <- cdm$cohort1 %>% + cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectFlag( targetCohortTable = "cohort2", window = list(c(-180, -1)), @@ -1235,7 +1235,7 @@ test_that("no NA when overwrite column", { # Trying to overwrite the previous created variable, for example because the characteristics cohort has changed. expect_message( - cdm$cohort1 <- cdm$cohort1 %>% + cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectFlag( targetCohortTable = "cohort2", window = list(c(-180, -1)), @@ -1244,16 +1244,16 @@ test_that("no NA when overwrite column", { ) ) - expect_true(!any(is.na(cdm$cohort1 %>% dplyr::pull("cohort_1")))) + expect_true(!any(is.na(cdm$cohort1 |> dplyr::pull("cohort_1")))) # subject 2, who has no record for cohort_definition_id 1 in the characteristics cohort, now gets a "NA" # Moving the "cohort_definition_id == 1" records from subject 1 to subject 2: - cdm$cohort2 <- cdm$cohort2 %>% + cdm$cohort2 <- cdm$cohort2 |> dplyr::mutate(subject_id = dplyr::if_else(cohort_definition_id == 1 & subject_id == 1, 2, subject_id)) expect_message( - cdm$cohort1 <- cdm$cohort1 %>% + cdm$cohort1 <- cdm$cohort1 |> addCohortIntersectFlag( targetCohortTable = "cohort2", window = list(c(-180, -1)), @@ -1262,7 +1262,7 @@ test_that("no NA when overwrite column", { ) ) - expect_true(!any(is.na(cdm$cohort1 %>% dplyr::pull("cohort_1")))) + expect_true(!any(is.na(cdm$cohort1 |> dplyr::pull("cohort_1")))) mockDisconnect(cdm = cdm) }) diff --git a/tests/testthat/test-addObservationPeriodId.R b/tests/testthat/test-addObservationPeriodId.R index a4e02126..fac1c489 100644 --- a/tests/testthat/test-addObservationPeriodId.R +++ b/tests/testthat/test-addObservationPeriodId.R @@ -168,3 +168,79 @@ test_that("add observation period id", { mockDisconnect(cdm = cdm) }) + +test_that("check when there is the same record in multiple cohorts", { + person <- dplyr::tibble( + person_id = c(1L, 2L, 3L), + gender_concept_id = 1L, + year_of_birth = 1990L, + race_concept_id = 1L, + ethnicity_concept_id = 1L + ) + + observation_period <- dplyr::tibble( + person_id = c(1L, 1L, 2L, 3L), + observation_period_start_date = as.Date(c( + "2010-01-01", "2019-01-01", "2019-01-01", "2019-01-01" + )), + observation_period_end_date = as.Date(c( + "2016-01-01", "2021-01-01", "2022-01-01", "2019-01-01" + )), + observation_period_id = c(1L, 2L, 3L, 4L), + period_type_concept_id = 0L + ) + + cdm <- mockPatientProfiles( + con = connection(), + writeSchema = writeSchema(), + person = person, + observation_period = observation_period + ) + + my_cohort <- dplyr::tibble( + cohort_definition_id = c(1L, 2L, 1L, 2L), + subject_id = c(1L, 1L, 2L, 1L), + cohort_start_date = as.Date(c( + "2020-01-01", "2015-05-12", "2020-01-01", "2020-01-01" + )), + cohort_end_date = as.Date(c( + "2020-01-01", "2015-05-12", "2020-01-01", "2020-01-01" + )) + ) + + cdm <- omopgenerics::insertTable( + cdm = cdm, name = "my_cohort", table = my_cohort + ) + + # note we have a cohort entry outside of observation to test expected NA + cdm$my_cohort <- omopgenerics::newCohortTable(cdm$my_cohort, + .softValidation = TRUE + ) + + cdm$my_cohort_obs <- cdm$my_cohort |> + addObservationPeriodId() + + expect_true( + cdm$my_cohort_obs |> + dplyr::filter(subject_id == 1L, + cohort_start_date == as.Date("2020-01-01"), + cohort_definition_id == 1) |> + dplyr::pull("observation_period_id") == 2 + ) + + expect_true( + cdm$my_cohort_obs |> + dplyr::filter(subject_id == 1L, + cohort_start_date == as.Date("2020-01-01"), + cohort_definition_id == 2) |> + dplyr::pull("observation_period_id") == 2 + ) + + expect_identical( + cdm$my_cohort_obs |> dplyr::summarise(n = dplyr::n()) |> dplyr::pull("n") |> as.character(), + cdm$my_cohort |> dplyr::summarise(n = dplyr::n()) |> dplyr::pull("n") |> as.character() + ) + +}) + + diff --git a/tests/testthat/test-addPriorObservation.R b/tests/testthat/test-addPriorObservation.R index 8f7260a0..d5c6429f 100644 --- a/tests/testthat/test-addPriorObservation.R +++ b/tests/testthat/test-addPriorObservation.R @@ -14,11 +14,11 @@ test_that("check condition_occurrence and cohort1 work", { # mock data cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) # check it works with cohort1 table in mockdb - expect_true(typeof(cdm$cohort1 %>% addPriorObservation() %>% dplyr::collect()) == "list") - expect_true("prior_observation" %in% colnames(cdm$cohort1 %>% addPriorObservation())) + expect_true(typeof(cdm$cohort1 |> addPriorObservation() |> dplyr::collect()) == "list") + expect_true("prior_observation" %in% colnames(cdm$cohort1 |> addPriorObservation())) # check it works with condition_occurrence table in mockdb - expect_true(typeof(cdm$condition_occurrence %>% addPriorObservation(indexDate = "condition_start_date") %>% dplyr::collect()) == "list") - expect_true("prior_observation" %in% colnames(cdm$condition_occurrence %>% addPriorObservation(indexDate = "condition_start_date"))) + expect_true(typeof(cdm$condition_occurrence |> addPriorObservation(indexDate = "condition_start_date") |> dplyr::collect()) == "list") + expect_true("prior_observation" %in% colnames(cdm$condition_occurrence |> addPriorObservation(indexDate = "condition_start_date"))) mockDisconnect(cdm = cdm) }) @@ -54,8 +54,8 @@ test_that("check working example with cohort1", { cohort2 = cohort1 ) - result <- cdm$cohort1 %>% - addPriorObservation() %>% + result <- cdm$cohort1 |> + addPriorObservation() |> dplyr::collect() expect_true(all(colnames(cohort1) %in% colnames(result))) @@ -101,8 +101,8 @@ test_that("check working example with condition_occurrence", { observation_period = obs1 ) - result <- cdm$condition_occurrence %>% - addPriorObservation(indexDate = "condition_start_date") %>% + result <- cdm$condition_occurrence |> + addPriorObservation(indexDate = "condition_start_date") |> dplyr::collect() expect_true(all( @@ -146,7 +146,7 @@ test_that("different name", { observation_period = obs1 ) - cdm$condition_occurrence <- cdm$condition_occurrence %>% + cdm$condition_occurrence <- cdm$condition_occurrence |> addPriorObservation( indexDate = "condition_start_date", priorObservationName = "ph" ) @@ -216,12 +216,12 @@ test_that("multiple observation periods", { cohort1 = cohort1 ) - cdm$cohort1a <- cdm$cohort1 %>% + cdm$cohort1a <- cdm$cohort1 |> addPriorObservation(indexDate = "cohort_start_date") - expect_true(nrow(cdm$cohort1a %>% dplyr::collect()) == 2) + expect_true(nrow(cdm$cohort1a |> dplyr::collect()) == 2) expect_true(all( - cdm$cohort1a %>% + cdm$cohort1a |> dplyr::pull(prior_observation) == as.numeric(difftime( as.Date("2012-02-01"), as.Date("2010-01-01"), units = "days" diff --git a/tests/testthat/test-addSex.R b/tests/testthat/test-addSex.R index e07b0d74..11da8a45 100644 --- a/tests/testthat/test-addSex.R +++ b/tests/testthat/test-addSex.R @@ -12,12 +12,12 @@ test_that("addSex, check imput length and type", { test_that("addSex, works in both cohort and condition tables", { skip_on_cran() cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) - cdm$cohort1 <- cdm$cohort1 %>% addSex() - cdm$condition_occurrence <- cdm$condition_occurrence %>% addSex() + cdm$cohort1 <- cdm$cohort1 |> addSex() + cdm$condition_occurrence <- cdm$condition_occurrence |> addSex() expect_true("sex" %in% colnames(cdm$cohort1)) - expect_true(all(cdm$cohort1 %>% dplyr::pull("sex") %in% c("Female", "Male"))) + expect_true(all(cdm$cohort1 |> dplyr::pull("sex") %in% c("Female", "Male"))) expect_true("sex" %in% colnames(cdm$condition_occurrence)) - expect_true(all(cdm$condition_occurrence %>% dplyr::pull("sex") %in% c("Female", "Male"))) + expect_true(all(cdm$condition_occurrence |> dplyr::pull("sex") %in% c("Female", "Male"))) mockDisconnect(cdm = cdm) }) @@ -40,7 +40,7 @@ test_that("addSex, desired result for all parameters", { cohort_end_date = as.Date("2020-01-01") ) ) - cdm$cohort1 <- cdm$cohort1 %>% addSex() + cdm$cohort1 <- cdm$cohort1 |> addSex() expect_true("sex" %in% colnames(cdm$cohort1)) expect_true(all( cdm$cohort1 |> diff --git a/tests/testthat/test-addTableIntersect.R b/tests/testthat/test-addTableIntersect.R index 6b26c3fb..a2d19204 100644 --- a/tests/testthat/test-addTableIntersect.R +++ b/tests/testthat/test-addTableIntersect.R @@ -27,79 +27,79 @@ test_that("basic structures", { test_that("input validation", { skip_on_cran() cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) - expect_error(expect_warning(cdm$cohort1 %>% + expect_error(expect_warning(cdm$cohort1 |> addTableIntersect( tableName = "visit_occurrence", indexDate = "index_date" ))) - expect_error(expect_warning(cdm$cohort1 %>% + expect_error(expect_warning(cdm$cohort1 |> addTableIntersect( tableName = "visit_occurrence", censorDate = "index_date" ))) - expect_error(expect_warning(cdm$cohort1 %>% + expect_error(expect_warning(cdm$cohort1 |> addTableIntersect( tableName = "visit_occurrence", censorDate = 42 ))) - expect_error(expect_warning(cdm$cohort1 %>% + expect_error(expect_warning(cdm$cohort1 |> addTableIntersect( tableName = "visit_occurrence", window = c(90, 0) ))) - expect_error(expect_warning(cdm$cohort1 %>% + expect_error(expect_warning(cdm$cohort1 |> addTableIntersect( tableName = "visit_occurrence", order = 42 ))) - expect_error(expect_warning(cdm$cohort1 %>% + expect_error(expect_warning(cdm$cohort1 |> addTableIntersect( tableName = "visit_occurrence", targetStartDate = "drug_exposure_start_date" ))) - expect_error(expect_warning(cdm$cohort1 %>% + expect_error(expect_warning(cdm$cohort1 |> addTableIntersect( tableName = "visit_occurrence", targetEndDate = "condition_end_date" ))) - expect_error(expect_warning(cdm$cohort1 %>% + expect_error(expect_warning(cdm$cohort1 |> addTableIntersect( tableName = "visit_occurrence", flag = 1 ))) - expect_error(expect_warning(cdm$cohort1 %>% + expect_error(expect_warning(cdm$cohort1 |> addTableIntersect( tableName = "visit_occurrence", count = 1 ))) - expect_error(expect_warning(cdm$cohort1 %>% + expect_error(expect_warning(cdm$cohort1 |> addTableIntersect( tableName = "visit_occurrence", date = 1 ))) - expect_error(expect_warning(cdm$cohort1 %>% + expect_error(expect_warning(cdm$cohort1 |> addTableIntersect( tableName = "visit_occurrence", days = 1 ))) - expect_error(expect_warning(cdm$cohort1 %>% + expect_error(expect_warning(cdm$cohort1 |> addTableIntersect( tableName = "visit_occurrence", field = "condition_start_date" ))) - expect_error(expect_warning(cdm$cohort1 %>% + expect_error(expect_warning(cdm$cohort1 |> addTableIntersect( tableName = "visit_occurrence", nameStyle = "table_name_value_window_name" @@ -169,11 +169,11 @@ test_that("addTableIntersectCount example", { PatientProfiles::addTableIntersectCount( tableName = "drug_exposure", window = list(c(-50, 50)) - ) %>% + ) |> dplyr::collect() expect_identical( - de_count |> nrow() %>% as.numeric(), + de_count |> nrow() |> as.numeric(), 10 ) @@ -181,21 +181,21 @@ test_that("addTableIntersectCount example", { (colnames(de_count))) expect_identical( - de_count %>% dplyr::filter(cohort_definition_id == 1) %>% - dplyr::filter(cohort_start_date == "2020-01-01") %>% - dplyr::pull("drug_exposure_m50_to_50") %>% + de_count |> dplyr::filter(cohort_definition_id == 1) |> + dplyr::filter(cohort_start_date == "2020-01-01") |> + dplyr::pull("drug_exposure_m50_to_50") |> as.numeric(), 6 ) - expect_true(all((de_count %>% - dplyr::filter(!cohort_start_date == "2020-01-01") %>% - dplyr::filter(cohort_start_date == "2020-01-01") %>% - dplyr::pull("drug_exposure_m50_to_50") %>% + expect_true(all((de_count |> + dplyr::filter(!cohort_start_date == "2020-01-01") |> + dplyr::filter(cohort_start_date == "2020-01-01") |> + dplyr::pull("drug_exposure_m50_to_50") |> as.numeric()) == 0)) expect_identical( - de_count %>% dplyr::filter(cohort_start_date == "2020-01-01") %>% + de_count |> dplyr::filter(cohort_start_date == "2020-01-01") |> dplyr::filter(cohort_start_date == "2009-01-01") |> nrow() |> as.numeric(), @@ -266,47 +266,47 @@ test_that("addTableIntersectFlag example", { c(-50, 50), c(-Inf, 0) ) - ) %>% + ) |> dplyr::collect() expect_identical( - de_flag |> nrow() %>% as.numeric(), + de_flag |> nrow() |> as.numeric(), 5 ) expect_true(all(c("drug_exposure_m50_to_50", "drug_exposure_minf_to_0") %in% (colnames(de_flag)))) - expect_true(all((de_flag %>% dplyr::select("drug_exposure_m50_to_50") %>% + expect_true(all((de_flag |> dplyr::select("drug_exposure_m50_to_50") |> dplyr::pull()) %in% c(0, 1))) - expect_true(all((de_flag %>% dplyr::select("drug_exposure_minf_to_0") %>% + expect_true(all((de_flag |> dplyr::select("drug_exposure_minf_to_0") |> dplyr::pull()) %in% c(0, 1))) expect_identical( - de_flag %>% - dplyr::filter(cohort_start_date == "2020-01-01") %>% - dplyr::pull("drug_exposure_m50_to_50") %>% + de_flag |> + dplyr::filter(cohort_start_date == "2020-01-01") |> + dplyr::pull("drug_exposure_m50_to_50") |> as.numeric(), 1 ) - expect_true(all((de_flag %>% - dplyr::filter(!cohort_start_date == "2020-01-01") %>% - dplyr::pull("drug_exposure_m50_to_50") %>% + expect_true(all((de_flag |> + dplyr::filter(!cohort_start_date == "2020-01-01") |> + dplyr::pull("drug_exposure_m50_to_50") |> as.numeric()) == 0)) expect_identical( - de_flag %>% - dplyr::filter(cohort_start_date == "2020-01-01") %>% - dplyr::pull("drug_exposure_minf_to_0") %>% + de_flag |> + dplyr::filter(cohort_start_date == "2020-01-01") |> + dplyr::pull("drug_exposure_minf_to_0") |> as.numeric(), 0 ) - expect_true(all((de_flag %>% - dplyr::filter(!cohort_start_date == "2020-01-01") %>% - dplyr::pull("drug_exposure_minf_to_0") %>% + expect_true(all((de_flag |> + dplyr::filter(!cohort_start_date == "2020-01-01") |> + dplyr::pull("drug_exposure_minf_to_0") |> as.numeric()) == 1)) mockDisconnect(cdm = cdm) @@ -370,37 +370,37 @@ test_that("addTableIntersectDate example", { PatientProfiles::addTableIntersectDate( tableName = "drug_exposure", window = list(c(-Inf, 0)) - ) %>% + ) |> dplyr::collect() expect_identical( - de_date |> nrow() %>% as.numeric(), + de_date |> nrow() |> as.numeric(), 5 ) expect_true(all(c("drug_exposure_minf_to_0") %in% (colnames(de_date)))) - expect_true(is.na(de_date %>% - dplyr::filter(cohort_start_date == "2020-01-01") %>% + expect_true(is.na(de_date |> + dplyr::filter(cohort_start_date == "2020-01-01") |> dplyr::pull("drug_exposure_minf_to_0"))) - expect_true(all(!is.na(de_date %>% - dplyr::filter(!cohort_start_date == "2020-01-01") %>% + expect_true(all(!is.na(de_date |> + dplyr::filter(!cohort_start_date == "2020-01-01") |> dplyr::pull("drug_exposure_minf_to_0")))) expect_identical( - de_date %>% - dplyr::filter(cohort_start_date == "2022-01-20") %>% - dplyr::pull("drug_exposure_minf_to_0") %>% + de_date |> + dplyr::filter(cohort_start_date == "2022-01-20") |> + dplyr::pull("drug_exposure_minf_to_0") |> as.Date(), as.Date("2020-01-15") ) expect_identical( - de_date %>% - dplyr::filter(cohort_start_date == "2024-02-01") %>% - dplyr::pull("drug_exposure_minf_to_0") %>% + de_date |> + dplyr::filter(cohort_start_date == "2024-02-01") |> + dplyr::pull("drug_exposure_minf_to_0") |> as.Date(), as.Date("2020-01-15") ) @@ -409,37 +409,37 @@ test_that("addTableIntersectDate example", { tableName = "drug_exposure", window = list(c(-Inf, 0)), order = "last" - ) %>% + ) |> dplyr::collect() expect_identical( - de_date2 |> nrow() %>% as.numeric(), + de_date2 |> nrow() |> as.numeric(), 5 ) expect_true(all(c("drug_exposure_minf_to_0") %in% (colnames(de_date2)))) - expect_true(is.na(de_date2 %>% - dplyr::filter(cohort_start_date == "2020-01-01") %>% + expect_true(is.na(de_date2 |> + dplyr::filter(cohort_start_date == "2020-01-01") |> dplyr::pull("drug_exposure_minf_to_0"))) - expect_true(all(!is.na(de_date2 %>% - dplyr::filter(!cohort_start_date == "2020-01-01") %>% + expect_true(all(!is.na(de_date2 |> + dplyr::filter(!cohort_start_date == "2020-01-01") |> dplyr::pull("drug_exposure_minf_to_0")))) expect_identical( - de_date2 %>% - dplyr::filter(cohort_start_date == "2022-01-20") %>% - dplyr::pull("drug_exposure_minf_to_0") %>% + de_date2 |> + dplyr::filter(cohort_start_date == "2022-01-20") |> + dplyr::pull("drug_exposure_minf_to_0") |> as.Date(), as.Date("2021-01-29") ) expect_identical( - de_date2 %>% - dplyr::filter(cohort_start_date == "2024-02-01") %>% - dplyr::pull("drug_exposure_minf_to_0") %>% + de_date2 |> + dplyr::filter(cohort_start_date == "2024-02-01") |> + dplyr::pull("drug_exposure_minf_to_0") |> as.Date(), as.Date("2023-02-16") ) @@ -505,34 +505,34 @@ test_that("addTableIntersectDays example", { PatientProfiles::addTableIntersectDays( tableName = "drug_exposure", window = list(c(-Inf, 0)) - ) %>% + ) |> dplyr::collect() expect_identical( - de_days |> nrow() %>% as.numeric(), + de_days |> nrow() |> as.numeric(), 5 ) expect_true(all(c("drug_exposure_minf_to_0") %in% (colnames(de_days)))) - expect_true(is.na(de_days %>% - dplyr::filter(cohort_start_date == "2020-01-01") %>% + expect_true(is.na(de_days |> + dplyr::filter(cohort_start_date == "2020-01-01") |> dplyr::pull("drug_exposure_minf_to_0"))) - expect_true(all(!is.na(de_days %>% - dplyr::filter(!cohort_start_date == "2020-01-01") %>% + expect_true(all(!is.na(de_days |> + dplyr::filter(!cohort_start_date == "2020-01-01") |> dplyr::pull("drug_exposure_minf_to_0")))) - expect_true(all(de_days %>% - dplyr::filter(!is.na(drug_exposure_minf_to_0)) %>% - dplyr::select("drug_exposure_minf_to_0") %>% + expect_true(all(de_days |> + dplyr::filter(!is.na(drug_exposure_minf_to_0)) |> + dplyr::select("drug_exposure_minf_to_0") |> dplyr::pull("drug_exposure_minf_to_0") <= 0)) expect_identical( - de_days %>% - dplyr::filter(cohort_start_date == "2024-02-01") %>% - dplyr::pull("drug_exposure_minf_to_0") %>% + de_days |> + dplyr::filter(cohort_start_date == "2024-02-01") |> + dplyr::pull("drug_exposure_minf_to_0") |> as.numeric(), -as.numeric(as.Date("2024-02-01") - as.Date("2020-01-15")) ) @@ -542,34 +542,34 @@ test_that("addTableIntersectDays example", { tableName = "drug_exposure", window = list(c(0, Inf)), order = "last" - ) %>% + ) |> dplyr::collect() expect_identical( - de_days2 |> nrow() %>% as.numeric(), + de_days2 |> nrow() |> as.numeric(), 5 ) expect_true(all(c("drug_exposure_0_to_inf") %in% (colnames(de_days2)))) - expect_true(is.na(de_days2 %>% - dplyr::filter(cohort_start_date == "2024-02-01") %>% + expect_true(is.na(de_days2 |> + dplyr::filter(cohort_start_date == "2024-02-01") |> dplyr::pull("drug_exposure_0_to_inf"))) - expect_true(all(!is.na(de_days2 %>% - dplyr::filter(!cohort_start_date == "2024-02-01") %>% + expect_true(all(!is.na(de_days2 |> + dplyr::filter(!cohort_start_date == "2024-02-01") |> dplyr::pull("drug_exposure_0_to_inf")))) - expect_true(all(de_days2 %>% - dplyr::filter(!is.na(drug_exposure_0_to_inf)) %>% - dplyr::select("drug_exposure_0_to_inf") %>% + expect_true(all(de_days2 |> + dplyr::filter(!is.na(drug_exposure_0_to_inf)) |> + dplyr::select("drug_exposure_0_to_inf") |> dplyr::pull("drug_exposure_0_to_inf") >= 0)) expect_identical( - de_days2 %>% - dplyr::filter(cohort_start_date == "2020-01-01") %>% - dplyr::pull("drug_exposure_0_to_inf") %>% + de_days2 |> + dplyr::filter(cohort_start_date == "2020-01-01") |> + dplyr::pull("drug_exposure_0_to_inf") |> as.numeric(), as.numeric(as.Date("2023-02-16") - as.Date("2020-01-01")) ) @@ -637,28 +637,28 @@ test_that("addTableIntersectFields example", { tableName = "drug_exposure", window = list(c(-Inf, 0)), field = "drug_concept_id" - ) %>% + ) |> dplyr::collect() expect_identical( - de_field |> nrow() %>% as.numeric(), + de_field |> nrow() |> as.numeric(), 5 ) expect_true(all(c("drug_exposure_drug_concept_id_minf_to_0") %in% (colnames(de_field)))) - expect_true(is.na(de_field %>% - dplyr::filter(cohort_start_date == "2020-01-01") %>% + expect_true(is.na(de_field |> + dplyr::filter(cohort_start_date == "2020-01-01") |> dplyr::pull("drug_exposure_drug_concept_id_minf_to_0"))) - expect_true(all(!is.na(de_field %>% - dplyr::filter(!cohort_start_date == "2020-01-01") %>% + expect_true(all(!is.na(de_field |> + dplyr::filter(!cohort_start_date == "2020-01-01") |> dplyr::pull("drug_exposure_drug_concept_id_minf_to_0")))) - expect_true(all((de_field %>% - dplyr::filter(!is.na(drug_exposure_drug_concept_id_minf_to_0)) %>% - dplyr::select("drug_exposure_drug_concept_id_minf_to_0") %>% + expect_true(all((de_field |> + dplyr::filter(!is.na(drug_exposure_drug_concept_id_minf_to_0)) |> + dplyr::select("drug_exposure_drug_concept_id_minf_to_0") |> dplyr::pull("drug_exposure_drug_concept_id_minf_to_0") |> as.integer()) %in% c(1, 2, 3))) diff --git a/tests/testthat/test-checks.R b/tests/testthat/test-checks.R index 4c29d19b..58a22f17 100644 --- a/tests/testthat/test-checks.R +++ b/tests/testthat/test-checks.R @@ -39,9 +39,9 @@ test_that("test checkCategory with length 1 ", { categories <- list("age_group" = list(c(0, 69), c(70))) - a <- cdm$cohort1 %>% - addAge(indexDate = "cohort_start_date") %>% - addCategories("age", categories) %>% + a <- cdm$cohort1 |> + addAge(indexDate = "cohort_start_date") |> + addCategories("age", categories) |> dplyr::collect() expect_true(a[a$subject_id == 2, ]$age_group == "70 to 70") @@ -49,7 +49,7 @@ test_that("test checkCategory with length 1 ", { categories <- list("age_group" = list(c(69, 0), c(70))) - expect_error(cdm$cohort1 %>% addAge(indexDate = "cohort_start_date") %>% + expect_error(cdm$cohort1 |> addAge(indexDate = "cohort_start_date") |> addCategories("age", categories)) expect_error(checkX(dplyr::tibble())) @@ -162,13 +162,13 @@ test_that(" test checkWindow in addIntersect", { numberIndividuals = 2 ) - expect_error(cdm$cohort1 %>% .addIntersect(tableName = "cohort2", window = list(c(-NA, 0)), value = "date")) - expect_error(cdm$cohort1 %>% .addIntersect(tableName = "cohort2", window = list(c(-365, 0, 1)), value = "date")) - expect_warning(cdm$cohort1 %>% .addIntersect(tableName = "cohort2", window = list(c(-365), -c(0), -c(30)), value = "date")) + expect_error(cdm$cohort1 |> .addIntersect(tableName = "cohort2", window = list(c(-NA, 0)), value = "date")) + expect_error(cdm$cohort1 |> .addIntersect(tableName = "cohort2", window = list(c(-365, 0, 1)), value = "date")) + expect_warning(cdm$cohort1 |> .addIntersect(tableName = "cohort2", window = list(c(-365), -c(0), -c(30)), value = "date")) - expect_error(cdm$cohort1 %>% .addIntersect(tableName = "cohort2", window = list(c(30, -365)), value = "date")) - expect_error(cdm$cohort1 %>% .addIntersect(tableName = "cohort2", window = list(c(Inf, Inf)), value = "date")) - expect_error(cdm$cohort1 %>% .addIntersect(tableName = "cohort2", window = list(c(-Inf, -Inf)), value = "date")) + expect_error(cdm$cohort1 |> .addIntersect(tableName = "cohort2", window = list(c(30, -365)), value = "date")) + expect_error(cdm$cohort1 |> .addIntersect(tableName = "cohort2", window = list(c(Inf, Inf)), value = "date")) + expect_error(cdm$cohort1 |> .addIntersect(tableName = "cohort2", window = list(c(-Inf, -Inf)), value = "date")) mockDisconnect(cdm = cdm) }) @@ -227,7 +227,7 @@ test_that("checkNameStyle", { cohort2 = cohort2 ) - expect_true(all(c("count_all", "flag_all") %in% colnames(cdm$cohort1 %>% .addIntersect( + expect_true(all(c("count_all", "flag_all") %in% colnames(cdm$cohort1 |> .addIntersect( tableName = "cohort2", value = c("flag", "count"), nameStyle = "{value}_{id_name}" )))) diff --git a/tests/testthat/test-format.R b/tests/testthat/test-format.R index 2574844b..73cf59ea 100644 --- a/tests/testthat/test-format.R +++ b/tests/testthat/test-format.R @@ -36,50 +36,50 @@ test_that("test variableTypes", { vt <- variableTypes(y) expect_identical( - vt %>% - dplyr::filter(variable_name == "x1") %>% + vt |> + dplyr::filter(variable_name == "x1") |> dplyr::pull("variable_type"), "numeric" ) expect_identical( - vt %>% - dplyr::filter(variable_name == "x2") %>% + vt |> + dplyr::filter(variable_name == "x2") |> dplyr::pull("variable_type"), "date" ) expect_identical( - vt %>% - dplyr::filter(variable_name == "x3") %>% + vt |> + dplyr::filter(variable_name == "x3") |> dplyr::pull("variable_type"), "categorical" ) expect_identical( - vt %>% - dplyr::filter(variable_name == "x4") %>% + vt |> + dplyr::filter(variable_name == "x4") |> dplyr::pull("variable_type"), "categorical" ) expect_identical( - vt %>% - dplyr::filter(variable_name == "x5") %>% + vt |> + dplyr::filter(variable_name == "x5") |> dplyr::pull("variable_type"), "date" ) expect_identical( - vt %>% - dplyr::filter(variable_name == "x6") %>% + vt |> + dplyr::filter(variable_name == "x6") |> dplyr::pull("variable_type"), "integer" ) expect_identical( - vt %>% - dplyr::filter(variable_name == "x7") %>% + vt |> + dplyr::filter(variable_name == "x7") |> dplyr::pull("variable_type"), "numeric" ) @@ -101,7 +101,7 @@ test_that("test available functions", { num_test <- availableEstimates("numeric") expect_true(all( c("sd", "median", "mean") %in% ( - num_test %>% dplyr::pull("estimate_name") + num_test |> dplyr::pull("estimate_name") ) )) }) diff --git a/tests/testthat/test-summariseResult.R b/tests/testthat/test-summariseResult.R index 987dfeb4..94090ac1 100644 --- a/tests/testthat/test-summariseResult.R +++ b/tests/testthat/test-summariseResult.R @@ -88,41 +88,41 @@ test_that("groups and strata", { con = connection(), writeSchema = writeSchema(), numberIndividuals = 1000 ) - result <- cdm$condition_occurrence %>% + result <- cdm$condition_occurrence |> addDemographics( indexDate = "condition_start_date", ageGroup = list(c(0, 30), c(31, 60)) - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> summariseResult(strata = list("sex")) expect_true( - result %>% + result |> dplyr::filter( group_name == "overall" & group_level == "overall" & strata_name == "overall" & strata_level == "overall" & variable_name == "number subjects" - ) %>% + ) |> dplyr::pull("estimate_value") |> as.numeric() <= 1000 ) - result <- cdm$condition_occurrence %>% + result <- cdm$condition_occurrence |> addDemographics( indexDate = "condition_start_date", ageGroup = list(c(0, 30), c(31, 60)) - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> summariseResult(strata = list(c("age_group", "sex"))) - expect_true(all(result %>% - dplyr::select("strata_name") %>% - dplyr::distinct() %>% + expect_true(all(result |> + dplyr::select("strata_name") |> + dplyr::distinct() |> dplyr::pull() %in% c("overall", "age_group &&& sex"))) - expect_true(all(result %>% - dplyr::select("strata_level") %>% - dplyr::distinct() %>% + expect_true(all(result |> + dplyr::select("strata_level") |> + dplyr::distinct() |> dplyr::pull() %in% c( "overall", "0 to 30 &&& Female", "0 to 30 &&& Male", @@ -130,21 +130,21 @@ test_that("groups and strata", { "None &&& Male" ))) - result <- cdm$condition_occurrence %>% + result <- cdm$condition_occurrence |> addDemographics( indexDate = "condition_start_date", ageGroup = list(c(0, 30), c(31, 60)) - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> summariseResult(group = c("age_group", "sex")) - expect_true(all(result %>% - dplyr::select("group_name") %>% - dplyr::distinct() %>% + expect_true(all(result |> + dplyr::select("group_name") |> + dplyr::distinct() |> dplyr::pull() %in% c("overall", "age_group &&& sex"))) - expect_true(all(result %>% - dplyr::select("group_level") %>% - dplyr::distinct() %>% + expect_true(all(result |> + dplyr::select("group_level") |> + dplyr::distinct() |> dplyr::pull() %in% c( "overall", "0 to 30 &&& Female", "0 to 30 &&& Male", @@ -153,8 +153,8 @@ test_that("groups and strata", { ))) expect_no_error( - result <- cdm$condition_occurrence %>% - dplyr::collect() %>% + result <- cdm$condition_occurrence |> + dplyr::collect() |> dplyr::mutate("sex" = "Missing") |> summariseResult(group = "sex") ) @@ -168,22 +168,22 @@ test_that("table in db or local", { ) # in db - expect_no_error(cdm$condition_occurrence %>% + expect_no_error(cdm$condition_occurrence |> addDemographics( indexDate = "condition_start_date", ageGroup = list(c(0, 30), c(31, 60)) - ) %>% + ) |> summariseResult(strata = "sex")) # already collected expect_warning( expect_no_error( - cdm$condition_occurrence %>% + cdm$condition_occurrence |> addDemographics( indexDate = "condition_start_date", ageGroup = list(c(0, 30), c(31, 60)) - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> dplyr::mutate("subject_id" = .data$person_id) |> summariseResult(strata = list("sex")) ) @@ -207,40 +207,40 @@ test_that("with and with overall groups and strata", { con = connection(), writeSchema = writeSchema(), numberIndividuals = 1000 ) - test_data <- cdm$condition_occurrence %>% + test_data <- cdm$condition_occurrence |> addDemographics( indexDate = "condition_start_date", ageGroup = list(c(0, 30), c(31, 60)) - ) %>% + ) |> dplyr::collect() - expect_false(any(test_data %>% + expect_false(any(test_data |> summariseResult( strata = list("sex"), includeOverallStrata = FALSE - ) %>% + ) |> dplyr::pull("strata_name") %in% c("overall"))) - expect_true(any(test_data %>% + expect_true(any(test_data |> summariseResult( strata = list("sex"), includeOverallStrata = TRUE - ) %>% + ) |> dplyr::pull("strata_name") %in% c("overall"))) - expect_false(any(test_data %>% + expect_false(any(test_data |> summariseResult( group = list("sex"), includeOverallGroup = FALSE - ) %>% + ) |> dplyr::pull("group_name") %in% c("overall"))) - expect_true(any(test_data %>% + expect_true(any(test_data |> summariseResult( group = list("sex"), includeOverallGroup = TRUE - ) %>% + ) |> dplyr::pull("group_name") %in% c("overall"))) @@ -265,43 +265,43 @@ test_that("obscure", { suppress(minCellCount = 1) expect_true(nrow(s) == 34) expect_true(sum(s$estimate_value[!is.na(s$estimate_value)] == "<1") == 0) - expect_true(sum(is.na(s$estimate_value)) == 0) + expect_true(sum(s$estimate_value == "-") == 0) # minCellCount = 2 s <- summariseResult(x) |> suppress(minCellCount = 2) expect_true(nrow(s) == 34) - expect_true(sum(is.na(s$estimate_value)) == 8) + expect_true(sum(s$estimate_value == "-") == 8) # minCellCount = 3 s <- summariseResult(x) |> suppress(minCellCount = 3) expect_true(nrow(s) == 34) - expect_true(sum(is.na(s$estimate_value)) == 16) + expect_true(sum(s$estimate_value == "-") == 16) # minCellCount = 4 s <- summariseResult(x) |> suppress(minCellCount = 4) expect_true(nrow(s) == 34) - expect_true(sum(is.na(s$estimate_value)) == 23) + expect_true(sum(s$estimate_value == "-") == 23) # minCellCount = 5 s <- summariseResult(x) |> suppress(minCellCount = 5) expect_true(nrow(s) == 34) - expect_true(sum(is.na(s$estimate_value)) == 23) + expect_true(sum(s$estimate_value == "-") == 23) # minCellCount = 6 s <- summariseResult(x) |> suppress(minCellCount = 6) expect_true(nrow(s) == 34) - expect_true(sum(is.na(s$estimate_value)) == 23) + expect_true(sum(s$estimate_value == "-") == 23) # minCellCount = 7 s <- summariseResult(x) |> suppress(minCellCount = 7) expect_true(nrow(s) == 34) - expect_true(sum(is.na(s$estimate_value)) == 34) + expect_true(sum(s$estimate_value == "-") == 34) }) test_that("test empty cohort", { @@ -309,7 +309,7 @@ test_that("test empty cohort", { cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) expect_no_error( - cdm$cohort1 %>% dplyr::filter(cohort_definition_id == 0) %>% + cdm$cohort1 |> dplyr::filter(cohort_definition_id == 0) |> summariseResult( group = list("cohort_name"), includeOverallGroup = FALSE, @@ -318,7 +318,7 @@ test_that("test empty cohort", { ) expect_no_error( - cdm$cohort1 %>% dplyr::filter(cohort_definition_id == 0) %>% + cdm$cohort1 |> dplyr::filter(cohort_definition_id == 0) |> summariseResult( group = list("cohort_name"), includeOverallGroup = TRUE, @@ -328,7 +328,7 @@ test_that("test empty cohort", { expect_no_error( - cdm$cohort1 %>% dplyr::filter(cohort_definition_id == 0) %>% + cdm$cohort1 |> dplyr::filter(cohort_definition_id == 0) |> summariseResult( group = list("cohort_name"), includeOverallGroup = FALSE, @@ -337,7 +337,7 @@ test_that("test empty cohort", { ) expect_no_error( - cdm$cohort1 %>% dplyr::filter(cohort_definition_id == 0) %>% + cdm$cohort1 |> dplyr::filter(cohort_definition_id == 0) |> summariseResult( group = list("cohort_name"), includeOverallGroup = TRUE, @@ -353,13 +353,13 @@ test_that("test summary table naming", { cdm <- mockPatientProfiles(con = connection(), writeSchema = writeSchema()) dat <- - cdm$cohort1 %>% - addDemographics() %>% + cdm$cohort1 |> + addDemographics() |> dplyr::mutate( age_age = age, age_age_age = age, age_age_age_age = age - ) %>% + ) |> summariseResult() expect_true(all( @@ -411,13 +411,13 @@ test_that("misisng counts", { "Female", "age", 1, 100, "Female", "number_visits", 0, 0, "Female", "prior_history", 0, 0, - ) %>% + ) |> dplyr::mutate( count = as.character(.data$count), percentage = as.character(.data$percentage) ) for (k in seq_len(nrow(expected))) { - x <- result %>% + x <- result |> dplyr::filter( .data$strata_level == .env$expected$strata[k], .data$variable_name == .env$expected$variable_name[k] @@ -429,15 +429,15 @@ test_that("misisng counts", { } # female age is all na expect_true( - result %>% + result |> dplyr::filter( .data$variable_name == "age", .data$strata_level == "Female", is.na(.data$variable_level), !.data$estimate_name %in% c("count_missing", "percentage_missing") - ) %>% - dplyr::pull("estimate_value") %>% - is.na() %>% + ) |> + dplyr::pull("estimate_value") |> + is.na() |> all() ) DBI::dbRemoveTable(con, name = name) diff --git a/vignettes/cohort-intersect.Rmd b/vignettes/cohort-intersect.Rmd index dd2cbe97..0ecf2415 100644 --- a/vignettes/cohort-intersect.Rmd +++ b/vignettes/cohort-intersect.Rmd @@ -28,11 +28,11 @@ library(ggplot2) cdm <- mockPatientProfiles(numberIndividuals = 1000) -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() settings(cdm$cohort1) -cdm$cohort2 %>% +cdm$cohort2 |> glimpse() settings(cdm$cohort2) ``` @@ -46,7 +46,7 @@ We can see each of these below. Note that they add variables to our cohort table Let's start by adding flag and count variables using a window of 180 days before to 180 days after the cohort start date in our table of interest. By default the cohort start date of our cohort of interest will be used as the index date, with the cohort start to cohort end date of the target cohort then used to check for an intersection. ```{r, message= FALSE, warning=FALSE} -cdm$cohort1 %>% +cdm$cohort1 |> addCohortIntersectFlag( indexDate = "cohort_start_date", targetCohortTable = "cohort2", @@ -56,7 +56,7 @@ cdm$cohort1 %>% ) |> glimpse() -cdm$cohort1 %>% +cdm$cohort1 |> addCohortIntersectCount( indexDate = "cohort_start_date", targetCohortTable = "cohort2", @@ -70,7 +70,7 @@ cdm$cohort1 %>% Next we can add the date of the intersection and the days to the intersection. When identifying these variables we use only one date in our target table, which by default will be the cohort start date. In addition by default the first intersection that occurs within our window will be used. ```{r, message= FALSE, warning=FALSE} -cdm$cohort1 %>% +cdm$cohort1 |> addCohortIntersectDate( indexDate = "cohort_start_date", targetCohortTable = "cohort2", @@ -80,7 +80,7 @@ cdm$cohort1 %>% ) |> glimpse() -cdm$cohort1 %>% +cdm$cohort1 |> addCohortIntersectDays( indexDate = "cohort_start_date", targetCohortTable = "cohort2", @@ -150,7 +150,7 @@ cdm <- mockPatientProfiles( If we consider the intersection relative to the cohort start date for common cold with a window of 0 to 0 (ie only the index date) then no intersection will be identified as the individual did not have an ongoing record for aspirin on that date. ```{r, message= FALSE, warning=FALSE} -cdm$cohort1 %>% +cdm$cohort1 |> addCohortIntersectFlag( targetCohortTable = "cohort2", indexDate = "cohort_start_date", @@ -164,7 +164,7 @@ cdm$cohort1 %>% We could, however, change the index date to cohort end date in which case an intersection would be found. ```{r, message= FALSE, warning=FALSE} -cdm$cohort1 %>% +cdm$cohort1 |> addCohortIntersectFlag( targetCohortTable = "cohort2", indexDate = "cohort_end_date", @@ -178,7 +178,7 @@ cdm$cohort1 %>% Or we could also extend the window to include more time before or after which in both cases would lead to cohort intersections being found. ```{r, message= FALSE, warning=FALSE} -cdm$cohort1 %>% +cdm$cohort1 |> addCohortIntersectFlag( targetCohortTable = "cohort2", indexDate = "cohort_start_date", @@ -192,7 +192,7 @@ cdm$cohort1 %>% With a window of 90 days before to 90 days after cohort start, the person would have a count of two cohort intersections. ```{r, message= FALSE, warning=FALSE} -cdm$cohort1 %>% +cdm$cohort1 |> addCohortIntersectCount( targetCohortTable = "cohort2", indexDate = "cohort_start_date", @@ -206,7 +206,7 @@ cdm$cohort1 %>% With this same window, if we add the first cohort intersect date we will get the start date of the first record of aspirin. ```{r, message= FALSE, warning=FALSE} -cdm$cohort1 %>% +cdm$cohort1 |> addCohortIntersectDate( targetCohortTable = "cohort2", indexDate = "cohort_start_date", @@ -219,7 +219,7 @@ cdm$cohort1 %>% But if we instead set order to last, we get the start date of the second record of aspirin. ```{r, message= FALSE, warning=FALSE} -cdm$cohort1 %>% +cdm$cohort1 |> addCohortIntersectDate( targetCohortTable = "cohort2", indexDate = "cohort_start_date", @@ -235,7 +235,7 @@ cdm$cohort1 %>% One last option relates to the naming convention used to for the new variables. ```{r, message= FALSE, warning=FALSE} -cdm$cohort1 %>% +cdm$cohort1 |> addCohortIntersectDate( targetCohortTable = "cohort2", indexDate = "cohort_start_date", @@ -250,7 +250,7 @@ cdm$cohort1 %>% We can instead choose a specific name (but this will only work if only one new variable will be added, otherwise we will get an error to avoid duplicate names). ```{r, message= FALSE, warning=FALSE} -cdm$cohort1 %>% +cdm$cohort1 |> addCohortIntersectDate( targetCohortTable = "cohort2", indexDate = "cohort_start_date", diff --git a/vignettes/concept-intersect.Rmd b/vignettes/concept-intersect.Rmd index 341abb86..8e9c847e 100644 --- a/vignettes/concept-intersect.Rmd +++ b/vignettes/concept-intersect.Rmd @@ -82,50 +82,50 @@ Once we have our codes for acetaminophen we can create variables based on these. First, we can add a binary flag variable indicating whether an individual had a record of acetaminophen on the day of their ankle sprain or up to 30 days afterwards. ```{r} -cdm$ankle_sprain %>% +cdm$ankle_sprain |> addConceptIntersectFlag( conceptSet = acetaminophen_cs, indexDate = "cohort_start_date", window = c(0, 30) - ) %>% + ) |> dplyr::glimpse() ``` Second, we can count the number of records of acetaminophen in this same window for each individual. ```{r} -cdm$ankle_sprain %>% +cdm$ankle_sprain |> addConceptIntersectCount( conceptSet = acetaminophen_cs, indexDate = "cohort_start_date", window = c(0, 30) - ) %>% + ) |> dplyr::glimpse() ``` Third, we could identify the first start date of acetaminophen in this window. ```{r} -cdm$ankle_sprain %>% +cdm$ankle_sprain |> addConceptIntersectDate( conceptSet = acetaminophen_cs, indexDate = "cohort_start_date", window = c(0, 30), order = "first" - ) %>% + ) |> dplyr::glimpse() ``` Or fourth, we can get the number of days to the start date of acetaminophen in the window. ```{r} -cdm$ankle_sprain %>% +cdm$ankle_sprain |> addConceptIntersectDays( conceptSet = acetaminophen_cs, indexDate = "cohort_start_date", window = c(0, 30), order = "first" - ) %>% + ) |> dplyr::glimpse() ``` @@ -134,7 +134,7 @@ cdm$ankle_sprain %>% We can add more than one variable at a time when using these functions. For example, we might want to add variables for multiple time windows. ```{r} -cdm$ankle_sprain %>% +cdm$ankle_sprain |> addConceptIntersectFlag( conceptSet = acetaminophen_cs, indexDate = "cohort_start_date", @@ -143,7 +143,7 @@ cdm$ankle_sprain %>% c(0, 0), c(1, Inf) ) - ) %>% + ) |> dplyr::glimpse() ``` @@ -163,7 +163,7 @@ meds_cs <- getDrugIngredientCodes( ) ) -cdm$ankle_sprain %>% +cdm$ankle_sprain |> addConceptIntersectFlag( conceptSet = meds_cs, indexDate = "cohort_start_date", @@ -171,7 +171,7 @@ cdm$ankle_sprain %>% c(-Inf, -1), c(0, 0) ) - ) %>% + ) |> dplyr::glimpse() ``` diff --git a/vignettes/demographics.rmd b/vignettes/demographics.rmd index 7535f907..5da6300a 100644 --- a/vignettes/demographics.rmd +++ b/vignettes/demographics.rmd @@ -23,14 +23,14 @@ library(dplyr) cdm <- mockPatientProfiles(numberIndividuals = 10000) -cdm$person %>% +cdm$person |> dplyr::glimpse() ``` As well as the person table, every CDM reference will include an observation period table. This table contains spans of times during which an individual is considered to being under observation. Individuals can have multiple observation periods, but they cannot overlap. ```{r, message= FALSE, warning=FALSE} -cdm$observation_period %>% +cdm$observation_period |> dplyr::glimpse() ``` @@ -41,24 +41,24 @@ When performing analyses we will often be interested in working with the person Let's say we're working with the condition occurrence table. ```{r, message= FALSE, warning=FALSE} -cdm$condition_occurrence %>% +cdm$condition_occurrence |> glimpse() ``` This table contains diagnoses of individuals and we might, for example, want to identify their age on their date of diagnosis. This involves linking back to the person table which contains their date of birth (split across three different columns). PatientProfiles provides a simple function for this. `addAge()` will add a new column to the table containing each patient's age relative to the specified index date. ```{r, message= FALSE, warning=FALSE} -cdm$condition_occurrence <- cdm$condition_occurrence %>% +cdm$condition_occurrence <- cdm$condition_occurrence |> addAge(indexDate = "condition_start_date") -cdm$condition_occurrence %>% +cdm$condition_occurrence |> glimpse() ``` As well as calculating age, we can also create age groups at the same time. Here we create three age groups: those aged 0 to 17, those 18 to 65, and those 66 or older. ```{r, message= FALSE, warning=FALSE} -cdm$condition_occurrence <- cdm$condition_occurrence %>% +cdm$condition_occurrence <- cdm$condition_occurrence |> addAge( indexDate = "condition_start_date", ageGroup = list( @@ -68,7 +68,7 @@ cdm$condition_occurrence <- cdm$condition_occurrence %>% ) ) -cdm$condition_occurrence %>% +cdm$condition_occurrence |> glimpse() ``` @@ -76,7 +76,7 @@ cdm$condition_occurrence %>% By default, when adding age the new column will have been called "age" and will have been calculated using all available information on date of birth contained in the person. We can though also alter these defaults. Here, for example, we impose that month of birth is January and day of birth is the 1st for all individuals. ```{r, message= FALSE, warning=FALSE} -cdm$condition_occurrence <- cdm$condition_occurrence %>% +cdm$condition_occurrence <- cdm$condition_occurrence |> addAge( indexDate = "condition_start_date", ageName = "age_from_year_of_birth", @@ -86,29 +86,29 @@ cdm$condition_occurrence <- cdm$condition_occurrence %>% ageImposeDay = TRUE ) -cdm$condition_occurrence %>% +cdm$condition_occurrence |> glimpse() ``` As well as age at diagnosis, we might also want identify patients' sex. PatientProfiles provides the `addSex()` function that will add this for us. Because this is treated as time-invariant, we will not have to specify any index variable. ```{r, message= FALSE, warning=FALSE} -cdm$condition_occurrence <- cdm$condition_occurrence %>% +cdm$condition_occurrence <- cdm$condition_occurrence |> addSex() -cdm$condition_occurrence %>% +cdm$condition_occurrence |> glimpse() ``` Similarly, we could also identify whether an individual was in observation at the time of their diagnosis (i.e. had an observation period that overlaps with their diagnosis date), as well as identifying how much prior observation time they had on this date and how much they have following it. ```{r, message= FALSE, warning=FALSE} -cdm$condition_occurrence <- cdm$condition_occurrence %>% - addInObservation(indexDate = "condition_start_date") %>% - addPriorObservation(indexDate = "condition_start_date") %>% +cdm$condition_occurrence <- cdm$condition_occurrence |> + addInObservation(indexDate = "condition_start_date") |> + addPriorObservation(indexDate = "condition_start_date") |> addFutureObservation(indexDate = "condition_start_date") -cdm$condition_occurrence %>% +cdm$condition_occurrence |> glimpse() ``` @@ -117,22 +117,22 @@ For these functions which work with information from the observation table, it i When checking whether someone is in observation the default is that we are checking whether someone was in observation on the index date. We could though expand this and consider a window of time around this date. For example here we add a variable indicating whether someone was in observation from 180 days before the index date to 30 days following it. ```{r, message= FALSE, warning=FALSE} -cdm$condition_occurrence %>% +cdm$condition_occurrence |> addInObservation( indexDate = "condition_start_date", window = c(-180, 30) - ) %>% + ) |> glimpse() ``` We can also specify a window and require that an individual is present for only some days within it. Here we add a variable indicating whether the individual was in observation at least a year in the future, ```{r, message= FALSE, warning=FALSE} -cdm$condition_occurrence %>% +cdm$condition_occurrence |> addInObservation( indexDate = "condition_start_date", window = c(365, Inf), completeInterval = FALSE - ) %>% + ) |> glimpse() ``` @@ -141,21 +141,21 @@ cdm$condition_occurrence %>% The above functions can be used on both standard OMOP CDM tables and cohort tables. Note as the default index date in the functions is "cohort_start_date" we can now omit this. ```{r, message= FALSE, warning=FALSE} -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() -cdm$cohort1 <- cdm$cohort1 %>% +cdm$cohort1 <- cdm$cohort1 |> addAge(ageGroup = list( "0 to 17" = c(0, 17), "18 to 65" = c(18, 65), ">= 66" = c(66, Inf) - )) %>% - addSex() %>% - addInObservation() %>% - addPriorObservation() %>% + )) |> + addSex() |> + addInObservation() |> + addPriorObservation() |> addFutureObservation() -cdm$cohort1 %>% +cdm$cohort1 |> glimpse() ``` @@ -165,24 +165,24 @@ cdm$cohort1 %>% The above functions, which are chained together, each fetch the related information one by one. In the cases where we are interested in adding multiple characteristics, we can add these all at the same time using the more general `addDemographics()` functions. This will be more efficient that adding characteristics as it requires fewer joins between our table of interest and the person and observation period tables. ```{r, message= FALSE, warning=FALSE} -cdm$cohort2 %>% +cdm$cohort2 |> glimpse() tictoc::tic() -cdm$cohort2 %>% +cdm$cohort2 |> addAge(ageGroup = list( "0 to 17" = c(0, 17), "18 to 65" = c(18, 65), ">= 66" = c(66, Inf) - )) %>% - addSex() %>% - addInObservation() %>% - addPriorObservation() %>% + )) |> + addSex() |> + addInObservation() |> + addPriorObservation() |> addFutureObservation() tictoc::toc() tictoc::tic() -cdm$cohort2 %>% +cdm$cohort2 |> addDemographics( age = TRUE, ageName = "age", @@ -196,7 +196,7 @@ cdm$cohort2 %>% priorObservation = TRUE, priorObservationName = "prior_observation", futureObservation = FALSE, - ) %>% + ) |> glimpse() tictoc::toc() ``` diff --git a/vignettes/table-intersect.Rmd b/vignettes/table-intersect.Rmd index 620045a4..5b099445 100644 --- a/vignettes/table-intersect.Rmd +++ b/vignettes/table-intersect.Rmd @@ -64,7 +64,7 @@ cdm <- generateConceptCohortSet( cdm$ankle_sprain -cdm$ankle_sprain %>% +cdm$ankle_sprain |> addTableIntersectFlag( tableName = "condition_occurrence", window = c(-30, -1)