diff --git a/DESCRIPTION b/DESCRIPTION index 95e57487..93dfccfe 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: CodelistGenerator Title: Identify Relevant Clinical Codes and Evaluate Their Use -Version: 3.3.0 +Version: 3.3.1 Authors@R: c( person("Edward", "Burn", email = "edward.burn@ndorms.ox.ac.uk", role = c("aut", "cre"), @@ -30,8 +30,7 @@ Imports: checkmate (>= 2.0.0), DBI (>= 1.1.0), dplyr (>= 1.1.0), - magrittr (>= 2.0.0), - omopgenerics (>= 0.2.2), + omopgenerics (>= 0.4.0), rlang (>= 1.0.0), glue (>= 1.5.0), stringr (>= 1.4.0), @@ -42,7 +41,7 @@ Imports: lubridate, PatientProfiles (>= 1.1.0), vctrs, - visOmopResults (>= 0.3.0), + visOmopResults (>= 0.5.0), RJSONIO Suggests: covr, diff --git a/NAMESPACE b/NAMESPACE index f423558a..5839410d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -export("%>%") export(availableATC) export(availableICD10) export(availableIngredients) @@ -41,7 +40,6 @@ export(tableCodeUse) export(tableCohortCodeUse) export(tableOrphanCodes) export(tableUnmappedCodes) -importFrom(magrittr,"%>%") importFrom(rlang,":=") importFrom(rlang,.data) importFrom(rlang,.env) diff --git a/R/codesFromConceptSet.R b/R/codesFromConceptSet.R index 91680fc7..4fac529b 100644 --- a/R/codesFromConceptSet.R +++ b/R/codesFromConceptSet.R @@ -50,14 +50,14 @@ codesFromConceptSet <- function(path, } else { conceptSets <- dplyr::tibble(concept_set_path = .env$path) } - conceptSets <- conceptSets %>% - dplyr::filter(tools::file_ext(.data$concept_set_path) == "json") %>% + conceptSets <- conceptSets |> + dplyr::filter(tools::file_ext(.data$concept_set_path) == "json") |> dplyr::mutate( concept_set_name = tools::file_path_sans_ext(basename(.data$concept_set_path)) - ) %>% + ) |> dplyr::mutate(cohort_definition_id = dplyr::row_number()) - if (conceptSets %>% nrow() == 0) { + if (conceptSets |> nrow() == 0) { cli::cli_abort(glue::glue("No 'json' file found in {path}")) } @@ -94,8 +94,8 @@ codesFromConceptSet <- function(path, if(any(conceptList$include_mapped == TRUE)){ - exc <- paste(conceptList %>% - dplyr::filter(.data$include_mapped == TRUE) %>% + exc <- paste(conceptList |> + dplyr::filter(.data$include_mapped == TRUE) |> dplyr::pull("cohort_name"), collapse = "; ") cli::cli_abort( glue::glue("Mapped as TRUE not supported (found in {exc})")) @@ -155,7 +155,7 @@ codesFromCohort <- function(path, codelistTibble <- NULL unknown <- 1 for (k in seq_along(files)) { - codelistTibble <- codelistTibble %>% + codelistTibble <- codelistTibble |> dplyr::union_all(extractCodes(files[k], unknown)) } @@ -271,11 +271,11 @@ extractCodes <- function(file, unknown) { includeDescendants, ifelse(is.null(incD), FALSE, incD) ) } - codelistTibble <- codelistTibble %>% + codelistTibble <- codelistTibble |> dplyr::union_all(dplyr::tibble( codelist_name = name, concept_id = conceptId, include_descendants = includeDescendants, is_excluded = isExcluded - ) %>% + ) |> dplyr::mutate(filename = file)) } return(codelistTibble) @@ -283,32 +283,32 @@ extractCodes <- function(file, unknown) { appendDescendants <- function(cdm, codelistTable) { - cdm[[codelistTable]] %>% - dplyr::mutate(concept_id = as.integer(.data$concept_id)) %>% - dplyr::filter(.data$include_descendants == TRUE) %>% - dplyr::rename("ancestor_concept_id" = "concept_id") %>% + cdm[[codelistTable]] |> + dplyr::mutate(concept_id = as.integer(.data$concept_id)) |> + dplyr::filter(.data$include_descendants == TRUE) |> + dplyr::rename("ancestor_concept_id" = "concept_id") |> dplyr::inner_join( - cdm[["concept_ancestor"]] %>% - dplyr::select("ancestor_concept_id", "descendant_concept_id") %>% + cdm[["concept_ancestor"]] |> + dplyr::select("ancestor_concept_id", "descendant_concept_id") |> dplyr::mutate(ancestor_concept_id = as.integer(.data$ancestor_concept_id)), by = "ancestor_concept_id" - ) %>% - dplyr::select(-"ancestor_concept_id") %>% - dplyr::rename("concept_id" = "descendant_concept_id") %>% + ) |> + dplyr::select(-"ancestor_concept_id") |> + dplyr::rename("concept_id" = "descendant_concept_id") |> dplyr::union_all( - cdm[[codelistTable]] %>% + cdm[[codelistTable]] |> dplyr::filter(.data$include_descendants == "FALSE") - ) %>% + ) |> dplyr::select(-"include_descendants") } excludeCodes <- function(codelistTibble) { - codelistTibble %>% - dplyr::filter(.data$is_excluded == FALSE) %>% - dplyr::select(-"is_excluded") %>% + codelistTibble |> + dplyr::filter(.data$is_excluded == FALSE) |> + dplyr::select(-"is_excluded") |> dplyr::anti_join( - codelistTibble %>% + codelistTibble |> dplyr::filter(.data$is_excluded == TRUE), by = c("codelist_name", "concept_id") ) @@ -316,15 +316,15 @@ excludeCodes <- function(codelistTibble) { tibbleToList <- function(codelistTibble) { - codelistTibble <- codelistTibble %>% + codelistTibble <- codelistTibble |> dplyr::mutate(nam = paste0(.data$codelist_name, "; ", .data$filename)) nam <- unique(codelistTibble$nam) codelist <- lapply(nam, function(x) { - codelistTibble %>% - dplyr::filter(.data$nam == .env$x) %>% - dplyr::pull("concept_id") %>% + codelistTibble |> + dplyr::filter(.data$nam == .env$x) |> + dplyr::pull("concept_id") |> unique() }) names(codelist) <- nam @@ -376,27 +376,27 @@ addDetails <- function(conceptList, cdm){ overwrite = TRUE, temporary = FALSE) - conceptList <- cdm[[tableConceptList]] %>% - dplyr::left_join(cdm[["concept"]] %>% + conceptList <- cdm[[tableConceptList]] |> + dplyr::left_join(cdm[["concept"]] |> dplyr::select("concept_id", "concept_name", "domain_id", "vocabulary_id", "standard_concept"), - by = "concept_id") %>% + by = "concept_id") |> dplyr::mutate( standard_concept = ifelse(is.na(.data$standard_concept), "non-standard", .data$standard_concept ) - ) %>% + ) |> dplyr::mutate( standard_concept = ifelse(.data$standard_concept == "C", "classification", .data$standard_concept ) - ) %>% + ) |> dplyr::mutate( standard_concept = ifelse(.data$standard_concept == "S", "standard", .data$standard_concept ) - ) %>% + ) |> dplyr::collect() CDMConnector::dropTable(cdm = cdm, name = tableConceptList) @@ -404,13 +404,13 @@ addDetails <- function(conceptList, cdm){ if(isFALSE(inputIsTbl)){ conceptList <- split( - x = conceptList %>% dplyr::select(!"concept_set"), + x = conceptList |> dplyr::select(!"concept_set"), f = as.factor(conceptList$concept_set) ) } for(i in seq_along(conceptList)){ - conceptList[[i]] <- conceptList[[i]] %>% + conceptList[[i]] <- conceptList[[i]] |> dplyr::arrange(.data$concept_name) } @@ -427,46 +427,46 @@ addDetails <- function(conceptList, cdm){ #' @return list of concept_ids and respective cohort_definition_ids of interest #' @noRd formatConceptList <- function(cdm, conceptListTable) { - conceptList <- cdm[[conceptListTable]] %>% - dplyr::filter(.data$include_descendants == FALSE) %>% + conceptList <- cdm[[conceptListTable]] |> + dplyr::filter(.data$include_descendants == FALSE) |> dplyr::union_all( - cdm[["concept_ancestor"]] %>% + cdm[["concept_ancestor"]] |> dplyr::select( "concept_id" = "ancestor_concept_id", "descendant_concept_id" - ) %>% - dplyr::mutate(concept_id = as.integer(.data$concept_id)) %>% + ) |> + dplyr::mutate(concept_id = as.integer(.data$concept_id)) |> dplyr::right_join( - cdm[[conceptListTable]] %>% - dplyr::mutate(concept_id = as.integer(.data$concept_id)) %>% + cdm[[conceptListTable]] |> + dplyr::mutate(concept_id = as.integer(.data$concept_id)) |> dplyr::filter(.data$include_descendants == TRUE), by = "concept_id" - ) %>% + ) |> dplyr::mutate(descendant_concept_id = dplyr::if_else( # in case concept is not in ancestor table # (even though it should be) is.na(.data$descendant_concept_id), - .data$concept_id, .data$descendant_concept_id)) %>% - dplyr::select(-"concept_id") %>% + .data$concept_id, .data$descendant_concept_id)) |> + dplyr::select(-"concept_id") |> dplyr::rename("concept_id" = "descendant_concept_id") - ) %>% - dplyr::select(-"include_descendants") %>% + ) |> + dplyr::select(-"include_descendants") |> dplyr::collect() # eliminate the ones that is_excluded = TRUE - conceptList <- conceptList %>% - dplyr::filter(.data$is_excluded == FALSE) %>% - dplyr::select("cohort_name", "concept_id") %>% + conceptList <- conceptList |> + dplyr::filter(.data$is_excluded == FALSE) |> + dplyr::select("cohort_name", "concept_id") |> dplyr::anti_join( - conceptList %>% + conceptList |> dplyr::filter(.data$is_excluded == TRUE), by = c("cohort_name","concept_id") ) conceptFinalList <- list() - for(n in conceptList[["cohort_name"]] %>% unique()) { - conceptFinalList[[n]] <- conceptList %>% - dplyr::filter(.data$cohort_name == n) %>% - dplyr::select("concept_id") %>% + for(n in conceptList[["cohort_name"]] |> unique()) { + conceptFinalList[[n]] <- conceptList |> + dplyr::filter(.data$cohort_name == n) |> + dplyr::select("concept_id") |> dplyr::pull() } return(conceptFinalList) @@ -500,14 +500,14 @@ readConceptSet <- function(conceptSets) { x <- append(x, x[["concept"]]) x[["concept"]] <- NULL return(x) - }) %>% - dplyr::bind_rows() %>% + }) |> + dplyr::bind_rows() |> dplyr::mutate( cohort_name = conceptSetName ) # Add columns missing from the read file with default values conceptSet[setdiff(names, names(conceptSet))] <- as.character(NA) - conceptSet <- conceptSet %>% + conceptSet <- conceptSet |> dplyr::mutate( isExcluded = ifelse(is.na(.data$isExcluded), FALSE, .data$isExcluded), includeMapped = ifelse( @@ -524,7 +524,7 @@ readConceptSet <- function(conceptSets) { conceptList <- dplyr::bind_rows(conceptList, conceptSet) } } - conceptList <- conceptList %>% + conceptList <- conceptList |> dplyr::select( "cohort_name", "concept_id" = "CONCEPT_ID", diff --git a/R/codesInUse.R b/R/codesInUse.R index 1af38ec5..f4e6674c 100644 --- a/R/codesInUse.R +++ b/R/codesInUse.R @@ -182,10 +182,10 @@ unmappedSourceCodesInUse <- function(cdm, ) # keep unmapped codes - codes[[i]] <- as.integer(cdm[[workingTable]] %>% - dplyr::filter(!!rlang::sym(standardConcept) == 0) %>% - dplyr::select(dplyr::all_of(workingConcept)) %>% - dplyr::distinct() %>% + codes[[i]] <- as.integer(cdm[[workingTable]] |> + dplyr::filter(!!rlang::sym(standardConcept) == 0) |> + dplyr::select(dplyr::all_of(workingConcept)) |> + dplyr::distinct() |> dplyr::pull()) codes[[i]] <- stats::na.omit(codes[[i]]) } @@ -198,7 +198,7 @@ unmappedSourceCodesInUse <- function(cdm, fetchAchillesCodesInUse <- function(cdm, minimumCount = 0L, collect = TRUE){ minimumCount <- as.integer(minimumCount) - codes <- cdm[["achilles_results"]] %>% + codes <- cdm[["achilles_results"]] |> dplyr::filter(.data$analysis_id %in% c( 401L, # condition occurrence @@ -209,13 +209,13 @@ fetchAchillesCodesInUse <- function(cdm, minimumCount = 0L, collect = TRUE){ 601L, # procedure_occurrence 2101L # device_exposure ), - .data$count_value >= .env$minimumCount) %>% - dplyr::select("concept_id" = "stratum_1") %>% - dplyr::mutate(concept_id = as.integer(.data$concept_id)) %>% + .data$count_value >= .env$minimumCount) |> + dplyr::select("concept_id" = "stratum_1") |> + dplyr::mutate(concept_id = as.integer(.data$concept_id)) |> dplyr::distinct() if(isTRUE(collect)){ - codes <- codes %>% + codes <- codes |> dplyr::pull("concept_id") } @@ -227,7 +227,7 @@ fetchAchillesSourceCodesInUse <- function(cdm, minimumCount = 0L){ minimumCount <- as.integer(minimumCount) - cdm[["achilles_results"]] %>% + cdm[["achilles_results"]] |> dplyr::filter(.data$analysis_id %in% c( 425L, # condition occurrence @@ -237,10 +237,10 @@ fetchAchillesSourceCodesInUse <- function(cdm, minimumCount = 0L){ 225L, # visit_occurrence 625L, # procedure_occurrence 2125L # device_exposure - )) %>% - dplyr::filter(.data$count_value >= .env$minimumCount) %>% - dplyr::select("stratum_1") %>% - dplyr::distinct() %>% - dplyr::mutate(stratum_1 = as.integer(.data$stratum_1)) %>% + )) |> + dplyr::filter(.data$count_value >= .env$minimumCount) |> + dplyr::select("stratum_1") |> + dplyr::distinct() |> + dplyr::mutate(stratum_1 = as.integer(.data$stratum_1)) |> dplyr::pull("stratum_1") } diff --git a/R/compareCodelists.R b/R/compareCodelists.R index 3fb01694..d469c4a6 100644 --- a/R/compareCodelists.R +++ b/R/compareCodelists.R @@ -68,7 +68,7 @@ compareCodelists <- function(codelist1, checkmate::reportAssertions(collection = errorMessage) - all <- dplyr::bind_rows(codelist1, codelist2) %>% + all <- dplyr::bind_rows(codelist1, codelist2) |> dplyr::select("concept_id", "concept_name") duplicates <- all[duplicated(all), ] unique <- unique(all) diff --git a/R/drugCodes.R b/R/drugCodes.R index dbd0f34c..f85721af 100644 --- a/R/drugCodes.R +++ b/R/drugCodes.R @@ -78,14 +78,14 @@ getATCCodes <- function(cdm, checkmate::assertCharacter(type, len = 1) checkmate::reportAssertions(collection = errorMessage) - atc_groups <- cdm$concept %>% - dplyr::filter(.data$vocabulary_id == "ATC") %>% - dplyr::filter(.data$concept_class_id %in% .env$level) %>% - dplyr::select("concept_id", "concept_name", "concept_code") %>% + atc_groups <- cdm$concept |> + dplyr::filter(.data$vocabulary_id == "ATC") |> + dplyr::filter(.data$concept_class_id %in% .env$level) |> + dplyr::select("concept_id", "concept_name", "concept_code") |> dplyr::collect() if (!is.null(name)) { - atc_groups <- atc_groups %>% + atc_groups <- atc_groups |> dplyr::filter(tidyWords(.data$concept_name) %in% tidyWords(.env$name)) } @@ -108,10 +108,10 @@ getATCCodes <- function(cdm, } if (nrow(atc_descendants) > 0) { - atc_descendants <- atc_descendants %>% + atc_descendants <- atc_descendants |> dplyr::select("concept_id", "concept_name", "domain_id", "vocabulary_id", - "ancestor_concept_id") %>% + "ancestor_concept_id") |> # split different ancestors into multiple cols tidyr::separate_wider_delim( cols = "ancestor_concept_id", @@ -120,7 +120,7 @@ getATCCodes <- function(cdm, too_few = "align_start" ) - atc_descendants <- atc_descendants %>% + atc_descendants <- atc_descendants |> # one row per concept + ancestor tidyr::pivot_longer(cols = !c("concept_id", "concept_name", "domain_id", "vocabulary_id"), @@ -151,13 +151,13 @@ getATCCodes <- function(cdm, # for each item in the list - pull out concepts and name for (i in seq_along(atc_descendants)) { if(type == "codelist"){ - atc_descendants[[i]] <- atc_descendants[[i]] %>% - dplyr::select("concept_id") %>% - dplyr::distinct() %>% + atc_descendants[[i]] <- atc_descendants[[i]] |> + dplyr::select("concept_id") |> + dplyr::distinct() |> dplyr::pull() } else { - atc_descendants[[i]] <- atc_descendants[[i]] %>% + atc_descendants[[i]] <- atc_descendants[[i]] |> dplyr::select(!"ancestor_concept_id") } } @@ -245,14 +245,14 @@ getDrugIngredientCodes <- function(cdm, checkmate::assertCharacter(type, len = 1) checkmate::reportAssertions(collection = errorMessage) - ingredientConcepts <- cdm$concept %>% - dplyr::filter(.data$standard_concept == "S") %>% - dplyr::filter(.data$concept_class_id == "Ingredient") %>% - dplyr::select("concept_id", "concept_name", "concept_code") %>% + ingredientConcepts <- cdm$concept |> + dplyr::filter(.data$standard_concept == "S") |> + dplyr::filter(.data$concept_class_id == "Ingredient") |> + dplyr::select("concept_id", "concept_name", "concept_code") |> dplyr::collect() if (!is.null(name)) { - ingredientConcepts <- ingredientConcepts %>% + ingredientConcepts <- ingredientConcepts |> dplyr::filter(tidyWords(.data$concept_name) %in% tidyWords(.env$name)) } @@ -279,11 +279,11 @@ getDrugIngredientCodes <- function(cdm, cli::cli_warn("No descendant codes found") return(invisible(list())) } - ingredientCodes <- ingredientCodes %>% + ingredientCodes <- ingredientCodes |> dplyr::select("concept_id", "concept_name", "domain_id", "vocabulary_id", "standard_concept", - "ancestor_concept_id") %>% + "ancestor_concept_id") |> # split different ancestors into multiple cols tidyr::separate_wider_delim( cols = "ancestor_concept_id", @@ -292,7 +292,7 @@ getDrugIngredientCodes <- function(cdm, too_few = "align_start" ) - ingredientCodes <- ingredientCodes %>% + ingredientCodes <- ingredientCodes |> # one row per concept + ancestor tidyr::pivot_longer(cols = !c("concept_id", "concept_name", "domain_id", "vocabulary_id", @@ -322,13 +322,13 @@ getDrugIngredientCodes <- function(cdm, # for each item in the list - pull out concepts and name for (i in seq_along(ingredientCodes)) { if(type == "codelist"){ - ingredientCodes[[i]] <- ingredientCodes[[i]] %>% - dplyr::select("concept_id") %>% - dplyr::distinct() %>% + ingredientCodes[[i]] <- ingredientCodes[[i]] |> + dplyr::select("concept_id") |> + dplyr::distinct() |> dplyr::pull() } else { - ingredientCodes[[i]] <- ingredientCodes[[i]] %>% + ingredientCodes[[i]] <- ingredientCodes[[i]] |> dplyr::select(!"ancestor_concept_id") } } diff --git a/R/getICD10StandardCodes.R b/R/getICD10StandardCodes.R index 27420a33..c5b156dc 100644 --- a/R/getICD10StandardCodes.R +++ b/R/getICD10StandardCodes.R @@ -94,56 +94,56 @@ getICD10StandardCodes <- function(cdm, } ICD10NonStandardCodes <- dplyr::bind_rows(ICD10NonStandardCodes) # map to standard - ICD10NonStandardCodes <- ICD10NonStandardCodes %>% + ICD10NonStandardCodes <- ICD10NonStandardCodes |> dplyr::inner_join( - cdm[["concept_relationship"]] %>% + cdm[["concept_relationship"]] |> dplyr::filter(.data$relationship_id == "Maps to"), by = c("concept_id" = "concept_id_1"), copy = TRUE, relationship = "many-to-many" - ) %>% - dplyr::select("concept_id_2", "name") %>% + ) |> + dplyr::select("concept_id_2", "name") |> dplyr::rename("concept_id" = "concept_id_2") - ICD10MapsTo <- cdm$concept %>% - dplyr::select("concept_id") %>% + ICD10MapsTo <- cdm$concept |> + dplyr::select("concept_id") |> dplyr::inner_join(ICD10NonStandardCodes, by = "concept_id", copy = TRUE - ) %>% + ) |> dplyr::distinct() if(!is.null(attr(cdm, "dbcon"))){ - ICD10MapsTo <- ICD10MapsTo %>% - CDMConnector::compute_query() + ICD10MapsTo <- ICD10MapsTo |> + dplyr::compute() } # add descendants if (isTRUE(includeDescendants)) { cli::cli_inform("Getting descendant concepts") - ICD10MapsTo <- ICD10MapsTo %>% + ICD10MapsTo <- ICD10MapsTo |> dplyr::left_join(cdm$concept_ancestor, by = c("concept_id" = "ancestor_concept_id") - ) %>% - dplyr::select("name", "descendant_concept_id") %>% + ) |> + dplyr::select("name", "descendant_concept_id") |> dplyr::rename("concept_id" = "descendant_concept_id") if(!is.null(attr(cdm, "dbcon"))){ - ICD10MapsTo <- ICD10MapsTo %>% - CDMConnector::compute_query() + ICD10MapsTo <- ICD10MapsTo |> + dplyr::compute() } } if(type == "codelist_with_details") { - ICD10MapsTo <- ICD10MapsTo %>% - dplyr::left_join(cdm[["concept"]] %>% + ICD10MapsTo <- ICD10MapsTo |> + dplyr::left_join(cdm[["concept"]] |> dplyr::select("concept_id", "concept_name", "domain_id", "vocabulary_id"), by = "concept_id") # split into list - ICD10StandardCodes <- ICD10MapsTo %>% - dplyr::collect() %>% - dplyr::left_join(cdm[["concept"]] %>% dplyr::select("concept_id", "concept_code"), + ICD10StandardCodes <- ICD10MapsTo |> + dplyr::collect() |> + dplyr::left_join(cdm[["concept"]] |> dplyr::select("concept_id", "concept_code"), by = "concept_id", - copy = T) %>% + copy = T) |> dplyr::mutate(name = paste0(.data$concept_code,"_", .data$name)) ICD10StandardCodes <- split( @@ -153,10 +153,10 @@ getICD10StandardCodes <- function(cdm, ) } else { # split into list (only returning vector of concept ids) - ICD10StandardCodes <- ICD10MapsTo %>% - dplyr::left_join(cdm[["concept"]] %>% + ICD10StandardCodes <- ICD10MapsTo |> + dplyr::left_join(cdm[["concept"]] |> dplyr::select("concept_id"), - by = "concept_id") %>% + by = "concept_id") |> dplyr::collect() ICD10StandardCodes <- split( x = ICD10StandardCodes$concept_id, @@ -184,7 +184,7 @@ getICD10NonStandardCodes <- function(cdm, if(!is.null(name)){ - conceptDb <- cdm[["concept"]] %>% + conceptDb <- cdm[["concept"]] |> dplyr::filter(tolower(.data$concept_name) == tolower(.env$name)) } else { conceptDb <- cdm[["concept"]] @@ -192,25 +192,25 @@ getICD10NonStandardCodes <- function(cdm, if ("ICD10 SubChapter" %in% level) { # go down two levels to get specific codes - icd_sub <- conceptDb %>% - dplyr::filter(.data$vocabulary_id == "ICD10") %>% - dplyr::filter(.data$concept_class_id %in% "ICD10 SubChapter") %>% + icd_sub <- conceptDb |> + dplyr::filter(.data$vocabulary_id == "ICD10") |> + dplyr::filter(.data$concept_class_id %in% "ICD10 SubChapter") |> dplyr::select("concept_id", "concept_name", "concept_code") if(!is.null(attr(cdm, "dbcon"))){ - icd_sub <- icd_sub %>% + icd_sub <- icd_sub |> dplyr::compute() } icd_sub1 <- get_subsumed_concepts( cdm = cdm, - concepts = icd_sub %>% + concepts = icd_sub |> dplyr::rename( "concept_id_1" = "concept_id" ) ) if(!is.null(attr(cdm, "dbcon"))){ - icd_sub1 <- icd_sub1 %>% + icd_sub1 <- icd_sub1 |> dplyr::compute() } # one more level down @@ -220,14 +220,14 @@ getICD10NonStandardCodes <- function(cdm, ) if(!is.null(attr(cdm, "dbcon"))){ - icd_sub2 <- icd_sub2 %>% + icd_sub2 <- icd_sub2 |> dplyr::compute()} - icd_subchapter <- icd_sub2 %>% - dplyr::collect() %>% - dplyr::mutate(name = stringr::str_to_lower(.data$concept_name)) %>% - dplyr::mutate(name = stringr::str_replace_all(.data$name, " ", "_")) %>% - dplyr::select("concept_id_1", "name") %>% + icd_subchapter <- icd_sub2 |> + dplyr::collect() |> + dplyr::mutate(name = stringr::str_to_lower(.data$concept_name)) |> + dplyr::mutate(name = stringr::str_replace_all(.data$name, " ", "_")) |> + dplyr::select("concept_id_1", "name") |> dplyr::distinct() } else { icd_subchapter <- dplyr::tibble() @@ -235,25 +235,25 @@ getICD10NonStandardCodes <- function(cdm, if ("ICD10 Chapter" %in% level) { # go down three levels to get specific codes - icd_ch <- conceptDb %>% - dplyr::filter(.data$vocabulary_id == "ICD10") %>% - dplyr::filter(.data$concept_class_id %in% "ICD10 Chapter") %>% + icd_ch <- conceptDb |> + dplyr::filter(.data$vocabulary_id == "ICD10") |> + dplyr::filter(.data$concept_class_id %in% "ICD10 Chapter") |> dplyr::select("concept_id", "concept_name", "concept_code") if(!is.null(attr(cdm, "dbcon"))){ - icd_ch <-icd_ch %>% + icd_ch <-icd_ch |> dplyr::compute() } icd_ch1 <- get_subsumed_concepts( cdm = cdm, - concepts = icd_ch %>% + concepts = icd_ch |> dplyr::rename( "concept_id_1" = "concept_id" ) ) if(!is.null(attr(cdm, "dbcon"))){ - icd_ch1 <- icd_ch1 %>% + icd_ch1 <- icd_ch1 |> dplyr::compute() } # one more level down @@ -262,7 +262,7 @@ getICD10NonStandardCodes <- function(cdm, concepts = icd_ch1 ) if(!is.null(attr(cdm, "dbcon"))){ - icd_ch2 <- icd_ch2 %>% + icd_ch2 <- icd_ch2 |> dplyr::compute() } # and one more level down @@ -271,14 +271,14 @@ getICD10NonStandardCodes <- function(cdm, concepts = icd_ch2 ) if(!is.null(attr(cdm, "dbcon"))){ - icd_ch3 <-icd_ch3 %>% + icd_ch3 <-icd_ch3 |> dplyr::compute()} - icd_chapter <- icd_ch3 %>% - dplyr::collect() %>% - dplyr::mutate(name = stringr::str_to_lower(.data$concept_name)) %>% - dplyr::mutate(name = stringr::str_replace_all(.data$name, " ", "_")) %>% - dplyr::select("concept_id_1", "name") %>% + icd_chapter <- icd_ch3 |> + dplyr::collect() |> + dplyr::mutate(name = stringr::str_to_lower(.data$concept_name)) |> + dplyr::mutate(name = stringr::str_replace_all(.data$name, " ", "_")) |> + dplyr::select("concept_id_1", "name") |> dplyr::distinct() } else { icd_chapter <- dplyr::tibble() @@ -301,11 +301,11 @@ getICD10NonStandardCodes <- function(cdm, # run again to get next set of subsumed) get_subsumed_concepts <- function(cdm, concepts) { - concepts %>% + concepts |> dplyr::inner_join(cdm[["concept_relationship"]], by = "concept_id_1" - ) %>% - dplyr::filter(.data$relationship_id == "Subsumes") %>% - dplyr::select("concept_id_2", "concept_name", "concept_code") %>% + ) |> + dplyr::filter(.data$relationship_id == "Subsumes") |> + dplyr::select("concept_id_2", "concept_name", "concept_code") |> dplyr::rename("concept_id_1" = "concept_id_2") } diff --git a/R/getMappings.R b/R/getMappings.R index 4ace96e9..aff8d28a 100644 --- a/R/getMappings.R +++ b/R/getMappings.R @@ -74,15 +74,15 @@ getMappings <- function(candidateCodelist, # vocabs to upper case nonStandardVocabularies <- toupper(nonStandardVocabularies) - conceptDb <- conceptDb %>% + conceptDb <- conceptDb |> dplyr::mutate(vocabulary_id = toupper(.data$vocabulary_id)) # check nonStandardVocabularies exist errorMessage <- checkmate::makeAssertCollection() - nonStandardVocabulariesInDb <- conceptDb %>% - dplyr::select("vocabulary_id") %>% - dplyr::distinct() %>% - dplyr::collect() %>% + nonStandardVocabulariesInDb <- conceptDb |> + dplyr::select("vocabulary_id") |> + dplyr::distinct() |> + dplyr::collect() |> dplyr::pull() for (i in seq_along(nonStandardVocabularies)) { nonStandardVocabulariesCheck <- nonStandardVocabularies[i] %in% @@ -97,48 +97,48 @@ getMappings <- function(candidateCodelist, checkmate::reportAssertions(collection = errorMessage) - mappedCodes <- conceptDb %>% - dplyr::inner_join(conceptRelationshipDb %>% - dplyr::filter(.data$relationship_id == "Mapped from") %>% - dplyr::filter(.data$concept_id_1 %in% !!candidateCodelist$concept_id) %>% - dplyr::select("concept_id_1", "concept_id_2") %>% + mappedCodes <- conceptDb |> + dplyr::inner_join(conceptRelationshipDb |> + dplyr::filter(.data$relationship_id == "Mapped from") |> + dplyr::filter(.data$concept_id_1 %in% !!candidateCodelist$concept_id) |> + dplyr::select("concept_id_1", "concept_id_2") |> dplyr::rename("concept_id" = "concept_id_2"), by = c("concept_id") - ) %>% - dplyr::filter(.data$vocabulary_id %in% .env$nonStandardVocabularies) %>% - dplyr::distinct() %>% + ) |> + dplyr::filter(.data$vocabulary_id %in% .env$nonStandardVocabularies) |> + dplyr::distinct() |> dplyr::collect() - mappedCodes <- mappedCodes %>% + mappedCodes <- mappedCodes |> dplyr::select( "concept_id_1", "concept_id", "concept_name", "concept_code", "vocabulary_id" ) - mappedCodes <- mappedCodes %>% - dplyr::select("concept_id_1") %>% - dplyr::rename("concept_id" = "concept_id_1") %>% - dplyr::left_join(conceptDb %>% - dplyr::filter(.data$concept_id %in% !!mappedCodes$concept_id_1) %>% + mappedCodes <- mappedCodes |> + dplyr::select("concept_id_1") |> + dplyr::rename("concept_id" = "concept_id_1") |> + dplyr::left_join(conceptDb |> + dplyr::filter(.data$concept_id %in% !!mappedCodes$concept_id_1) |> dplyr::collect(), by = c("concept_id") - ) %>% - dplyr::select("concept_id", "concept_name", "vocabulary_id") %>% - dplyr::rename("standard_vocabulary_id" = "vocabulary_id") %>% - dplyr::rename("concept_id_1" = "concept_id") %>% - dplyr::rename("standard_concept_name" = "concept_name") %>% + ) |> + dplyr::select("concept_id", "concept_name", "vocabulary_id") |> + dplyr::rename("standard_vocabulary_id" = "vocabulary_id") |> + dplyr::rename("concept_id_1" = "concept_id") |> + dplyr::rename("standard_concept_name" = "concept_name") |> dplyr::full_join(mappedCodes, by = "concept_id_1" - ) %>% - dplyr::rename("standard_concept_id" = "concept_id_1") %>% - dplyr::rename("non_standard_concept_id" = "concept_id") %>% - dplyr::rename("non_standard_concept_code" = "concept_code") %>% - dplyr::rename("non_standard_concept_name" = "concept_name") %>% + ) |> + dplyr::rename("standard_concept_id" = "concept_id_1") |> + dplyr::rename("non_standard_concept_id" = "concept_id") |> + dplyr::rename("non_standard_concept_code" = "concept_code") |> + dplyr::rename("non_standard_concept_name" = "concept_name") |> dplyr::rename("non_standard_vocabulary_id" = "vocabulary_id") - mappedCodes <- mappedCodes %>% - dplyr::distinct() %>% + mappedCodes <- mappedCodes |> + dplyr::distinct() |> dplyr::arrange(.data$standard_concept_id) return(mappedCodes) diff --git a/R/mockVocabRef.R b/R/mockVocabRef.R index a14b6362..d4a8fc04 100644 --- a/R/mockVocabRef.R +++ b/R/mockVocabRef.R @@ -191,7 +191,7 @@ mockVocabRef <- function(backend = "data_frame") { concept_id = 3L, concept_synonym_name = "Osteoarthrosis" ) - )%>% + )|> dplyr::mutate(language_concept_id = NA) conceptRelationship <- dplyr::bind_rows( data.frame( @@ -239,7 +239,7 @@ mockVocabRef <- function(backend = "data_frame") { concept_id_2 = 3L, relationship_id = "Maps to" ) - ) %>% + ) |> dplyr::mutate(valid_start_date = NA, valid_end_date = NA, invalid_reason = NA) diff --git a/R/runSearch.R b/R/runSearch.R index 2ac2cda1..562f587f 100644 --- a/R/runSearch.R +++ b/R/runSearch.R @@ -44,7 +44,7 @@ runSearch <- function(keywords, standardConceptFlags <- standardConcept # formatting of conceptDb variables - conceptDb <- conceptDb %>% + conceptDb <- conceptDb |> dplyr::mutate( domain_id = tolower(.data$domain_id), standard_concept = dplyr::case_when( @@ -56,26 +56,26 @@ runSearch <- function(keywords, ) cli::cli_inform("Limiting to domains of interest") - concept <- conceptDb %>% + concept <- conceptDb |> dplyr::filter(.data$standard_concept %in% .env$standardConceptFlags, .data$domain_id %in% .env$domains) |> dplyr::compute() # will only collect conceptSynonym later if needed if (searchInSynonyms == TRUE) { - conceptSynonymDb <- conceptSynonymDb %>% + conceptSynonymDb <- conceptSynonymDb |> dplyr::left_join( - conceptDb %>% + conceptDb |> dplyr::select("concept_id", "domain_id", "standard_concept"), by = "concept_id" ) - conceptSynonymDb <- conceptSynonymDb %>% + conceptSynonymDb <- conceptSynonymDb |> dplyr::filter(.data$domain_id %in% .env$domains & - .data$standard_concept %in% .env$standardConceptFlags) %>% + .data$standard_concept %in% .env$standardConceptFlags) |> dplyr::select(-c("domain_id", "standard_concept")) - conceptSynonym <- conceptSynonymDb %>% + conceptSynonym <- conceptSynonymDb |> dplyr::rename_with(tolower) } else { conceptSynonym <- NULL @@ -83,32 +83,32 @@ runSearch <- function(keywords, # collect the drug_strength table if drug if ("drug" %in% domains) { - drugStrength <- drugStrengthDb %>% + drugStrength <- drugStrengthDb |> dplyr::left_join( - conceptDb %>% - dplyr::rename("drug_concept_id" = "concept_id") %>% + conceptDb |> + dplyr::rename("drug_concept_id" = "concept_id") |> dplyr::select("drug_concept_id", "domain_id", "standard_concept"), by = "drug_concept_id" - ) %>% + ) |> dplyr::filter(.data$domain_id %in% .env$domains & - .data$standard_concept %in% .env$standardConceptFlags) %>% + .data$standard_concept %in% .env$standardConceptFlags) |> dplyr::rename_with(tolower) } candidateCodesList <- list() - workingConcept <- concept %>% + workingConcept <- concept |> dplyr::filter(.data$domain_id %in% .env$domains) if (!is.null(conceptSynonym)) { - workingconceptSynonym <- conceptSynonym %>% + workingconceptSynonym <- conceptSynonym |> dplyr::left_join( - concept %>% + concept |> dplyr::select("concept_id", "domain_id"), by = "concept_id" - ) %>% - dplyr::filter(.data$domain_id %in% .env$domains) %>% + ) |> + dplyr::filter(.data$domain_id %in% .env$domains) |> dplyr::select(!"domain_id") } @@ -135,20 +135,20 @@ runSearch <- function(keywords, conceptDf = workingConcept ) - candidateCodes <- candidateCodes %>% + candidateCodes <- candidateCodes |> dplyr::mutate(found_from = "From initial search", - found_id = 1L) %>% + found_id = 1L) |> dplyr::compute() # run exclusion if (length(exclude) > 0) { - if (excludeCodes %>% - utils::head(10) %>% - dplyr::tally() %>% + if (excludeCodes |> + utils::head(10) |> + dplyr::tally() |> dplyr::pull("n") > 0) { - candidateCodes <- candidateCodes %>% + candidateCodes <- candidateCodes |> dplyr::anti_join( - excludeCodes %>% + excludeCodes |> dplyr::select("concept_id"), by = "concept_id" ) @@ -161,33 +161,33 @@ runSearch <- function(keywords, cli::cli_inform("Adding concepts using synonymns") candidateCodesInSynonyms <- getMatches( words = tidyWords(keywords), - conceptDf = workingconceptSynonym %>% + conceptDf = workingconceptSynonym |> dplyr::rename("concept_name" = "concept_synonym_name") - ) %>% - dplyr::select("concept_id") %>% - dplyr::distinct() %>% + ) |> + dplyr::select("concept_id") |> + dplyr::distinct() |> dplyr::left_join(workingConcept, by = "concept_id" ) candidateCodes <- dplyr::union_all( candidateCodes, - candidateCodesInSynonyms %>% + candidateCodesInSynonyms |> dplyr::mutate(found_from = "In synonyms", found_id = 2L) - ) %>% + ) |> dplyr::distinct() } # run exclusion if (length(exclude) > 0) { - if (excludeCodes %>% - utils::head(10) %>% - dplyr::tally() %>% + if (excludeCodes |> + utils::head(10) |> + dplyr::tally() |> dplyr::pull("n") > 0) { - candidateCodes <- candidateCodes %>% + candidateCodes <- candidateCodes |> dplyr::anti_join( - excludeCodes %>% + excludeCodes |> dplyr::select("concept_id"), by = "concept_id" ) |> @@ -200,9 +200,9 @@ runSearch <- function(keywords, # 5) add any codes lower in the hierarchy if (includeDescendants == TRUE) { - if (candidateCodes %>% - utils::head(10) %>% - dplyr::tally() %>% + if (candidateCodes |> + utils::head(10) |> + dplyr::tally() |> dplyr::pull("n") > 0) { cli::cli_inform("Adding descendants") candidateCodeDescendants <- addDescendants( @@ -213,22 +213,22 @@ runSearch <- function(keywords, candidateCodes <- dplyr::union_all( candidateCodes, - candidateCodeDescendants %>% + candidateCodeDescendants |> dplyr::mutate(found_from = "From descendants", - found_id = 3L) %>% - dplyr::anti_join(candidateCodes %>% + found_id = 3L) |> + dplyr::anti_join(candidateCodes |> dplyr::select("concept_id"), - by = "concept_id")) %>% + by = "concept_id")) |> dplyr::compute() # run exclusion if (length(exclude) > 0) { - if (excludeCodes %>% - utils::head(10) %>% - dplyr::tally() %>% + if (excludeCodes |> + utils::head(10) |> + dplyr::tally() |> dplyr::pull("n") > 0) { - candidateCodes <- candidateCodes %>% - dplyr::anti_join(excludeCodes %>% + candidateCodes <- candidateCodes |> + dplyr::anti_join(excludeCodes |> dplyr::select("concept_id"), by = "concept_id" )|> @@ -240,9 +240,9 @@ runSearch <- function(keywords, # 6) add any codes one level above in the hierarchy if (includeAncestor == TRUE) { - if (candidateCodes %>% - utils::head(10) %>% - dplyr::tally() %>% + if (candidateCodes |> + utils::head(10) |> + dplyr::tally() |> dplyr::pull("n") > 0) { cli::cli_inform("Adding ancestor") @@ -254,21 +254,21 @@ runSearch <- function(keywords, candidateCodes <- dplyr::union_all( candidateCodes, - candidateCodeAncestor %>% + candidateCodeAncestor |> dplyr::mutate(found_from = "From ancestor", found_id = 4L) - ) %>% - dplyr::distinct() %>% + ) |> + dplyr::distinct() |> dplyr::compute() # run exclusion if (length(exclude) > 0) { - if (excludeCodes %>% - utils::head(10) %>% - dplyr::tally() %>% + if (excludeCodes |> + utils::head(10) |> + dplyr::tally() |> dplyr::pull("n") > 0) { - candidateCodes <- candidateCodes %>% - dplyr::anti_join(excludeCodes %>% dplyr::select("concept_id"), + candidateCodes <- candidateCodes |> + dplyr::anti_join(excludeCodes |> dplyr::select("concept_id"), by = "concept_id" )|> dplyr::compute() @@ -283,13 +283,13 @@ runSearch <- function(keywords, # are multiple mappings if (searchNonStandard == TRUE) { cli::cli_inform("Adding codes from non-standard") - conceptNs <- conceptDb %>% - dplyr::filter(.data$standard_concept == "non-standard") %>% + conceptNs <- conceptDb |> + dplyr::filter(.data$standard_concept == "non-standard") |> dplyr::rename_with(tolower) - if (conceptNs %>% - utils::head(10) %>% - dplyr::tally() %>% + if (conceptNs |> + utils::head(10) |> + dplyr::tally() |> dplyr::pull("n") > 0) { candidateCodesNs <- getMatches( words = tidyWords(keywords), @@ -297,42 +297,42 @@ runSearch <- function(keywords, ) } - if (conceptNs %>% - utils::head(10) %>% - dplyr::tally() %>% + if (conceptNs |> + utils::head(10) |> + dplyr::tally() |> dplyr::pull("n") > 0) { - candidateCodesNs <- candidateCodesNs %>% - dplyr::select("concept_id") %>% + candidateCodesNs <- candidateCodesNs |> + dplyr::select("concept_id") |> dplyr::left_join( - conceptRelationshipDb %>% - dplyr::filter(.data$relationship_id == "Mapped from") %>% + conceptRelationshipDb |> + dplyr::filter(.data$relationship_id == "Mapped from") |> dplyr::rename_with(tolower), by = c("concept_id" = "concept_id_2") - ) %>% - dplyr::select("concept_id"= "concept_id_1") %>% - dplyr::distinct() %>% + ) |> + dplyr::select("concept_id"= "concept_id_1") |> + dplyr::distinct() |> dplyr::left_join(concept, by = "concept_id" - ) %>% + ) |> dplyr::compute() candidateCodes <- dplyr::union_all( candidateCodes, - candidateCodesNs %>% + candidateCodesNs |> dplyr::mutate(found_from = "From non-standard", found_id = 5L) - ) %>% + ) |> dplyr::compute() } # run exclusion if (length(exclude) > 0) { - if (excludeCodes %>% - utils::head(10) %>% - dplyr::tally() %>% + if (excludeCodes |> + utils::head(10) |> + dplyr::tally() |> dplyr::pull("n") > 0) { - candidateCodes <- candidateCodes %>% - dplyr::anti_join(excludeCodes %>% dplyr::select("concept_id"), + candidateCodes <- candidateCodes |> + dplyr::anti_join(excludeCodes |> dplyr::select("concept_id"), by = "concept_id" )|> dplyr::compute() @@ -340,14 +340,14 @@ runSearch <- function(keywords, } } - candidateCodes <- candidateCodes %>% - dplyr::select(c("concept_id", "found_from", "found_id")) %>% - dplyr::inner_join(cdm[["concept"]] %>% + candidateCodes <- candidateCodes |> + dplyr::select(c("concept_id", "found_from", "found_id")) |> + dplyr::inner_join(cdm[["concept"]] |> dplyr::select("concept_id", "concept_name", "domain_id", "vocabulary_id", "standard_concept"), - by = "concept_id") %>% - dplyr::distinct() %>% + by = "concept_id") |> + dplyr::distinct() |> dplyr::collect() if (nrow(candidateCodes) > 0) { @@ -358,10 +358,10 @@ runSearch <- function(keywords, # keep first time it was found # for drug, same concept_id with different ingredient_concept_id # will be removed as well (with only the first kept). - candidateCodes <- candidateCodes %>% - dplyr::arrange(.data$found_id) %>% - dplyr::group_by(.data$concept_id) %>% - dplyr::filter(dplyr::row_number(.data$concept_id) == 1) %>% + candidateCodes <- candidateCodes |> + dplyr::arrange(.data$found_id) |> + dplyr::group_by(.data$concept_id) |> + dplyr::filter(dplyr::row_number(.data$concept_id) == 1) |> dplyr::ungroup() |> dplyr::select(!"found_id") @@ -404,7 +404,7 @@ tidyWords <- function(words) { getMatches <- function(words, conceptDf) { - conceptDf <- conceptDf %>% # start with all + conceptDf <- conceptDf |> # start with all dplyr::mutate(concept_name = tolower(.data$concept_name)) # because there may be a lot of synonyms, get these from a loop @@ -425,17 +425,17 @@ getMatches <- function(words, if (nchar(workingExclude[j]) >= 1) { cToSearch <- paste0("%", workingExclude[j], "%") - workingConcepts <- workingConcepts %>% + workingConcepts <- workingConcepts |> dplyr::filter(stringr::str_like(.data$concept_name, .env$cToSearch)) } } - conceptsFound[[i]] <- workingConcepts %>% + conceptsFound[[i]] <- workingConcepts |> dplyr::compute() } if(length(conceptsFound)==1){ - conceptsFound <- conceptsFound[[1]] %>% dplyr::distinct() + conceptsFound <- conceptsFound[[1]] |> dplyr::distinct() } else { conceptsFoundList <- list() conceptsFoundList[[1]] <- conceptsFound[[1]] @@ -444,7 +444,7 @@ getMatches <- function(words, conceptsFound[[i+1]]) } - conceptsFound <- conceptsFoundList[[1]] %>% dplyr::distinct() + conceptsFound <- conceptsFoundList[[1]] |> dplyr::distinct() } return(conceptsFound) @@ -454,18 +454,18 @@ addDescendants <- function(workingCandidateCodes, conceptAncestorDf, conceptDf) { - candidateCodeDescendants <- workingCandidateCodes %>% - dplyr::select("concept_id") %>% - dplyr::rename("ancestor_concept_id" = "concept_id") %>% + candidateCodeDescendants <- workingCandidateCodes |> + dplyr::select("concept_id") |> + dplyr::rename("ancestor_concept_id" = "concept_id") |> dplyr::left_join( conceptAncestorDf, by = "ancestor_concept_id" - ) %>% - dplyr::select("concept_id" = "descendant_concept_id") %>% - dplyr::distinct() %>% + ) |> + dplyr::select("concept_id" = "descendant_concept_id") |> + dplyr::distinct() |> dplyr::compute() - candidateCodeDescendants <- candidateCodeDescendants %>% + candidateCodeDescendants <- candidateCodeDescendants |> dplyr::left_join(conceptDf, by = "concept_id") |> dplyr::compute() @@ -475,23 +475,23 @@ addDescendants <- function(workingCandidateCodes, addAncestor <- function(workingCandidateCodes, conceptAncestorDf, conceptDf) { - candidateCodeAncestor <- workingCandidateCodes %>% - dplyr::select("concept_id") %>% - dplyr::rename("descendant_concept_id" = "concept_id") %>% + candidateCodeAncestor <- workingCandidateCodes |> + dplyr::select("concept_id") |> + dplyr::rename("descendant_concept_id" = "concept_id") |> dplyr::left_join(conceptAncestorDf, by = "descendant_concept_id" - ) %>% - dplyr::filter(.data$min_levels_of_separation == "1") %>% - dplyr::select("ancestor_concept_id") %>% - dplyr::rename("concept_id" = "ancestor_concept_id") %>% + ) |> + dplyr::filter(.data$min_levels_of_separation == "1") |> + dplyr::select("ancestor_concept_id") |> + dplyr::rename("concept_id" = "ancestor_concept_id") |> dplyr::left_join(conceptDf, by = "concept_id" ) # keep if not already in candidateCodes - candidateCodeAncestor <- candidateCodeAncestor %>% + candidateCodeAncestor <- candidateCodeAncestor |> dplyr::anti_join( - workingCandidateCodes %>% + workingCandidateCodes |> dplyr::select("concept_id"), by = "concept_id" ) diff --git a/R/summariseAchillesCodeUse.R b/R/summariseAchillesCodeUse.R index bdeed1dd..03c4cf3f 100644 --- a/R/summariseAchillesCodeUse.R +++ b/R/summariseAchillesCodeUse.R @@ -50,7 +50,7 @@ summariseAchillesCodeUse <- function(x, allCodes <- purrr::list_c(x) codesWithDetails <- addDetails(x, cdm) - codesWithDetails <- purrr::list_rbind(codesWithDetails) %>% + codesWithDetails <- purrr::list_rbind(codesWithDetails) |> dplyr::distinct() codeUse <- list() @@ -58,19 +58,19 @@ summariseAchillesCodeUse <- function(x, if("record" %in% countBy){ allRecordCount <- getAchillesRecordCounts(cdm = cdm, conceptId = allCodes) if(nrow(allRecordCount)>=1){ - allRecordCount <- allRecordCount %>% - dplyr::mutate(concept_id = as.character(.data$concept_id)) %>% - dplyr::left_join(codesWithDetails %>% + allRecordCount <- allRecordCount |> + dplyr::mutate(concept_id = as.character(.data$concept_id)) |> + dplyr::left_join(codesWithDetails |> dplyr::mutate(concept_id = as.character(.data$concept_id)), by = "concept_id") for(i in seq_along(x)){ - codeUse[[paste0(i, "_record")]] <- allRecordCount %>% - dplyr::filter(.data$concept_id %in% x[[i]]) %>% + codeUse[[paste0(i, "_record")]] <- allRecordCount |> + dplyr::filter(.data$concept_id %in% x[[i]]) |> dplyr::rename( "variable_name" = "concept_name", # standard concept name "variable_level" = "concept_id" # standard concept id - ) %>% - dplyr::mutate(estimate_name = "record_count") %>% + ) |> + dplyr::mutate(estimate_name = "record_count") |> dplyr::mutate(group_level = names(x)[i]) } } @@ -79,19 +79,19 @@ summariseAchillesCodeUse <- function(x, if("person" %in% countBy){ allPersonCount <- getAchillesPersonCounts(cdm = cdm, conceptId = allCodes) if(nrow(allPersonCount)>=1){ - allPersonCount <- allPersonCount %>% - dplyr::mutate(concept_id = as.character(.data$concept_id)) %>% - dplyr::left_join(codesWithDetails %>% + allPersonCount <- allPersonCount |> + dplyr::mutate(concept_id = as.character(.data$concept_id)) |> + dplyr::left_join(codesWithDetails |> dplyr::mutate(concept_id = as.character(.data$concept_id)), by = "concept_id") for(i in seq_along(x)){ - codeUse[[paste0(i, "_person")]] <- allPersonCount %>% - dplyr::filter(.data$concept_id %in% x[[i]]) %>% + codeUse[[paste0(i, "_person")]] <- allPersonCount |> + dplyr::filter(.data$concept_id %in% x[[i]]) |> dplyr::rename( "variable_name" = "concept_name", # standard concept name "variable_level" = "concept_id" # standard concept id - ) %>% - dplyr::mutate(estimate_name = "person_count") %>% + ) |> + dplyr::mutate(estimate_name = "person_count") |> dplyr::mutate(group_level = names(x)[i]) } } @@ -104,7 +104,7 @@ summariseAchillesCodeUse <- function(x, )) return(omopgenerics::emptySummarisedResult()) } else { - codeUse <- dplyr::bind_rows(codeUse) %>% + codeUse <- dplyr::bind_rows(codeUse) |> dplyr::mutate( result_id = as.integer(1), cdm_name = CDMConnector::cdmName(cdm), @@ -112,9 +112,9 @@ summariseAchillesCodeUse <- function(x, domain_id = tolower(.data$domain_id), estimate_type = "integer", estimate_value = as.character(.data$n) - ) %>% - visOmopResults::uniteAdditional(cols = c("standard_concept", "vocabulary_id")) %>% - visOmopResults::uniteStrata(cols = c("domain_id")) %>% + ) |> + visOmopResults::uniteAdditional(cols = c("standard_concept", "vocabulary_id")) |> + visOmopResults::uniteStrata(cols = c("domain_id")) |> dplyr::select(dplyr::any_of(omopgenerics::resultColumns("summarised_result"))) codeUse <- codeUse |> @@ -138,13 +138,13 @@ achillesVersionDate <- function(cdm){ cli::cli_abort("No achilles tables found in cdm reference") } - cdm[["achilles_results"]] %>% - dplyr::filter(.data$analysis_id == 0) %>% - dplyr::collect() %>% + cdm[["achilles_results"]] |> + dplyr::filter(.data$analysis_id == 0) |> + dplyr::collect() |> dplyr::mutate(achilles_version = paste0("Using achilles results from version ", .data$stratum_2, " which was run on ", - .data$stratum_3)) %>% + .data$stratum_3)) |> dplyr::pull("achilles_version") } @@ -176,20 +176,20 @@ getAchillesRecordCounts <- function(cdm, conceptId = NULL){ } fetchAchillesCounts <- function(cdm, analysisId, conceptId = NULL){ - analyses <- cdm[["achilles_results"]] %>% - dplyr::filter(.data$analysis_id %in% .env$analysisId) %>% - dplyr::select("stratum_1", "count_value") %>% + analyses <- cdm[["achilles_results"]] |> + dplyr::filter(.data$analysis_id %in% .env$analysisId) |> + dplyr::select("stratum_1", "count_value") |> dplyr::rename("concept_id" = "stratum_1", - "n"="count_value") %>% + "n"="count_value") |> dplyr::collect() if(!is.null(conceptId)){ - analyses <- analyses %>% + analyses <- analyses |> dplyr::filter(.data$concept_id %in% .env$conceptId) } # the same code might appear in multiple tables so we will sum them - analyses %>% + analyses |> dplyr::group_by(.data$concept_id) |> dplyr::summarise(n = sum(.data$n, na.rm = TRUE)) |> dplyr::mutate(n = as.integer(.data$n)) diff --git a/R/summariseCodeUse.R b/R/summariseCodeUse.R index 6415e77b..08bfaa43 100644 --- a/R/summariseCodeUse.R +++ b/R/summariseCodeUse.R @@ -76,11 +76,11 @@ summariseCodeUse <- function(x, codeUse <- dplyr::bind_rows(codeUse) if(nrow(codeUse) > 0) { - codeUse <- codeUse %>% + codeUse <- codeUse |> dplyr::mutate( result_id = as.integer(1), cdm_name = omopgenerics::cdmName(cdm) - ) %>% + ) |> omopgenerics::newSummarisedResult( settings = dplyr::tibble( result_id = as.integer(1), @@ -162,11 +162,11 @@ summariseCohortCodeUse <- function(x, "cohort_end_date") %in% colnames(cdm[[cohortTable]]))) if(is.null(cohortId)){ - cohortId <- sort(CDMConnector::settings(cdm[[cohortTable]]) %>% + cohortId <- sort(CDMConnector::settings(cdm[[cohortTable]]) |> dplyr::pull("cohort_definition_id")) } - settings <- omopgenerics::settings(cdm[[cohortTable]]) %>% + settings <- omopgenerics::settings(cdm[[cohortTable]]) |> dplyr::filter(.data$cohort_definition_id %in% .env$cohortId) cohortCodeUse <- list() @@ -188,11 +188,11 @@ summariseCohortCodeUse <- function(x, cohortCodeUse <- dplyr::bind_rows(cohortCodeUse) if (nrow(cohortCodeUse) > 0) { - cohortCodeUse <- cohortCodeUse %>% + cohortCodeUse <- cohortCodeUse |> dplyr::mutate( result_id = as.integer(1), cdm_name = omopgenerics::cdmName(cdm) - ) %>% + ) |> omopgenerics::newSummarisedResult( settings = dplyr::tibble( result_id = as.integer(1), @@ -249,9 +249,9 @@ getCodeUse <- function(x, table = dplyr::tibble(concept_id = x[[1]]), overwrite = TRUE, temporary = FALSE) - cdm[[tableCodelist]] <- cdm[[tableCodelist]] %>% + cdm[[tableCodelist]] <- cdm[[tableCodelist]] |> dplyr::left_join( - cdm[["concept"]] %>% dplyr::select("concept_id", "domain_id"), + cdm[["concept"]] |> dplyr::select("concept_id", "domain_id"), by = "concept_id") @@ -263,14 +263,13 @@ getCodeUse <- function(x, overwrite = TRUE, temporary = FALSE) - cdm[[tableCodelist]] <- cdm[[tableCodelist]] %>% + cdm[[tableCodelist]] <- cdm[[tableCodelist]] |> dplyr::mutate(domain_id = tolower(.data$domain_id)) |> dplyr::left_join(cdm[[tableDomainsData]], by = "domain_id") |> dplyr::compute(name = tableCodelist, temporary = FALSE, overwrite = TRUE) - CDMConnector::dropTable(cdm = cdm, name = tableDomainsData) cdm[[tableDomainsData]] <- NULL @@ -284,9 +283,9 @@ getCodeUse <- function(x, intermediateTable = intermediateTable) if(!is.null(records) && - (records %>% utils::head(1) %>% dplyr::tally() %>% dplyr::pull("n") > 0)) { + (records |> utils::head(1) |> dplyr::tally() |> dplyr::pull("n") > 0)) { if(bySex == TRUE | !is.null(ageGroup)){ - records <- records %>% + records <- records |> PatientProfiles::addDemographicsQuery(age = !is.null(ageGroup), ageGroup = ageGroup, sex = bySex, @@ -310,23 +309,24 @@ getCodeUse <- function(x, if (is.null(cohortTable)) { cohortName <- NA } else { - cohortName <- omopgenerics::settings(cdm[[cohortTable]]) %>% - dplyr::filter(.data$cohort_definition_id == cohortId) %>% + cohortName <- omopgenerics::settings(cdm[[cohortTable]]) |> + dplyr::filter(.data$cohort_definition_id == cohortId) |> dplyr::pull("cohort_name") } - - codeCounts <- codeCounts %>% + codeCounts <- codeCounts |> dplyr::mutate( "codelist_name" := !!names(x), "cohort_name" = .env$cohortName, "estimate_type" = "integer", "variable_name" = dplyr::if_else(is.na(.data$standard_concept_name), "overall", .data$standard_concept_name), "variable_level" = as.character(.data$standard_concept_id) - ) %>% - visOmopResults::uniteGroup(cols = c("cohort_name", "codelist_name")) %>% + ) |> + visOmopResults::uniteGroup(cols = c("cohort_name", "codelist_name")) |> visOmopResults::uniteAdditional( - cols = c("source_concept_name", "source_concept_id", "domain_id") - ) %>% + cols = c("source_concept_name", "source_concept_id", + "source_concept_value", "domain_id"), + ignore = "overall" + ) |> dplyr::select( "group_name", "group_level", "strata_name", "strata_level", "variable_name", "variable_level", "estimate_name", "estimate_type", @@ -355,8 +355,8 @@ getCodeUse <- function(x, # addDomainInfo <- function(codes, # cdm) { # -# codes <- codes %>% -# dplyr::mutate(domain_id = tolower(.data$domain_id)) %>% +# codes <- codes |> +# dplyr::mutate(domain_id = tolower(.data$domain_id)) |> # dplyr::mutate(table_name = # dplyr::case_when( # stringr::str_detect(domain_id,"condition") ~ "condition_occurrence", @@ -367,7 +367,7 @@ getCodeUse <- function(x, # stringr::str_detect(domain_id,"procedure") ~ "procedure_occurrence", # stringr::str_detect(domain_id,"device") ~ "device_exposure" # ) -# ) %>% +# ) |> # dplyr::mutate(standard_concept_id_name = # dplyr::case_when( # stringr::str_detect(domain_id,"condition") ~ "condition_concept_id", @@ -378,7 +378,7 @@ getCodeUse <- function(x, # stringr::str_detect(domain_id,"procedure") ~ "procedure_concept_id", # stringr::str_detect(domain_id,"device") ~ "device_concept_id" # ) -# ) %>% +# ) |> # dplyr::mutate(source_concept_id_name = # dplyr::case_when( # stringr::str_detect(domain_id,"condition") ~ "condition_source_concept_id", @@ -389,7 +389,7 @@ getCodeUse <- function(x, # stringr::str_detect(domain_id,"procedure") ~ "procedure_source_concept_id", # stringr::str_detect(domain_id,"device") ~ "device_source_concept_id" # ) -# ) %>% +# ) |> # dplyr::mutate(date_name = # dplyr::case_when( # stringr::str_detect(domain_id,"condition") ~ "condition_start_date", @@ -402,9 +402,9 @@ getCodeUse <- function(x, # ) # ) # -# unsupported_domains <- codes %>% -# dplyr::filter(!is.na(.data$domain_id)) %>% -# dplyr::filter(is.na(.data$table_name)) %>% +# unsupported_domains <- codes |> +# dplyr::filter(!is.na(.data$domain_id)) |> +# dplyr::filter(is.na(.data$table_name)) |> # dplyr::pull("domain_id") # # if(length(unsupported_domains)>0){ @@ -429,19 +429,20 @@ getRelevantRecords <- function(cdm, tableName <- purrr::discard(unique(codes$table), is.na) standardConceptIdName <- purrr::discard(unique(codes$standard_concept), is.na) sourceConceptIdName <- purrr::discard(unique(codes$source_concept), is.na) + sourceConceptValueName <- purrr::discard(unique(codes$source_concept_value), is.na) dateName <- purrr::discard(unique(codes$date_name), is.na) if(!is.null(cohortTable)){ if(is.null(cohortId)){ - cohortSubjects <- cdm[[cohortTable]] %>% - dplyr::select("subject_id", "cohort_start_date") %>% - dplyr::rename("person_id" = "subject_id") %>% + cohortSubjects <- cdm[[cohortTable]] |> + dplyr::select("subject_id", "cohort_start_date") |> + dplyr::rename("person_id" = "subject_id") |> dplyr::distinct() } else { - cohortSubjects <- cdm[[cohortTable]] %>% - dplyr::filter(.data$cohort_definition_id %in% cohortId) %>% - dplyr::select("subject_id", "cohort_start_date") %>% - dplyr::rename("person_id" = "subject_id") %>% + cohortSubjects <- cdm[[cohortTable]] |> + dplyr::filter(.data$cohort_definition_id %in% cohortId) |> + dplyr::select("subject_id", "cohort_start_date") |> + dplyr::rename("person_id" = "subject_id") |> dplyr::distinct() } } @@ -450,11 +451,11 @@ getRelevantRecords <- function(cdm, codeRecords <- cdm[[tableName[[1]]]] if(!is.null(cohortTable)){ # keep only records of those in the cohorts of interest - codeRecords <- codeRecords %>% + codeRecords <- codeRecords |> dplyr::inner_join(cohortSubjects, by = "person_id") if(timing == "entry"){ - codeRecords <- codeRecords %>% + codeRecords <- codeRecords |> dplyr::filter(.data$cohort_start_date == !!dplyr::sym(dateName[[1]])) } } @@ -468,23 +469,24 @@ getRelevantRecords <- function(cdm, omopgenerics::uniqueId()) cdm <- omopgenerics::insertTable(cdm = cdm, name = tableCodes, - table = codes %>% - dplyr::filter(.data$table == !!tableName[[1]]) %>% + table = codes |> + dplyr::filter(.data$table == !!tableName[[1]]) |> dplyr::select("concept_id", "domain_id"), overwrite = TRUE, temporary = FALSE) - - codeRecords <- codeRecords %>% - dplyr::mutate(date = !!dplyr::sym(dateName[[1]])) %>% - dplyr::mutate(year = lubridate::year(date)) %>% + codeRecords <- codeRecords |> + dplyr::mutate(date = !!dplyr::sym(dateName[[1]])) |> + dplyr::mutate(year = lubridate::year(date)) |> dplyr::select(dplyr::all_of(c("person_id", standardConceptIdName[[1]], sourceConceptIdName[[1]], - "date", "year"))) %>% + sourceConceptValueName[[1]], + "date", "year"))) |> dplyr::rename("standard_concept_id" = .env$standardConceptIdName[[1]], - "source_concept_id" = .env$sourceConceptIdName[[1]]) %>% + "source_concept_id" = .env$sourceConceptIdName[[1]], + "source_concept_value" = .env$sourceConceptValueName[[1]]) |> dplyr::inner_join(cdm[[tableCodes]], - by = c("standard_concept_id"="concept_id")) %>% + by = c("standard_concept_id"="concept_id")) |> dplyr::compute( name = paste0(intermediateTable,"_grr"), temporary = FALSE, @@ -505,32 +507,32 @@ getRelevantRecords <- function(cdm, workingRecords <- cdm[[tableName[[i+1]]]] if(!is.null(cohortTable)){ # keep only records of those in the cohorts of interest - workingRecords <- workingRecords %>% + workingRecords <- workingRecords |> dplyr::inner_join(cohortSubjects, by = "person_id") if(timing == "entry"){ - workingRecords <- workingRecords %>% + workingRecords <- workingRecords |> dplyr::filter(.data$cohort_start_date == !!dplyr::sym(dateName[[i+1]])) } } - workingRecords <- workingRecords %>% - dplyr::mutate(date = !!dplyr::sym(dateName[[i+1]])) %>% - dplyr::mutate(year = lubridate::year(date)) %>% + workingRecords <- workingRecords |> + dplyr::mutate(date = !!dplyr::sym(dateName[[i+1]])) |> + dplyr::mutate(year = lubridate::year(date)) |> dplyr::select(dplyr::all_of(c("person_id", standardConceptIdName[[i+1]], sourceConceptIdName[[i+1]], - "date", "year"))) %>% + "date", "year"))) |> dplyr::rename("standard_concept_id" = .env$standardConceptIdName[[i+1]], - "source_concept_id" = .env$sourceConceptIdName[[i+1]]) %>% - dplyr::inner_join(codes %>% - dplyr::filter(.data$table == tableName[[i+1]]) %>% + "source_concept_id" = .env$sourceConceptIdName[[i+1]]) |> + dplyr::inner_join(codes |> + dplyr::filter(.data$table == tableName[[i+1]]) |> dplyr::select("concept_id", "domain_id"), by = c("standard_concept_id"="concept_id"), copy = TRUE) - if(workingRecords %>% utils::head(1) %>% dplyr::tally() %>% dplyr::pull("n") >0){ - codeRecords <- codeRecords %>% - dplyr::union_all(workingRecords) %>% + if(workingRecords |> utils::head(1) |> dplyr::tally() |> dplyr::pull("n") >0){ + codeRecords <- codeRecords |> + dplyr::union_all(workingRecords) |> dplyr::compute( name = paste0(intermediateTable,"_grr_i"), temporary = FALSE, @@ -541,18 +543,18 @@ getRelevantRecords <- function(cdm, } } - if(codeRecords %>% utils::head(1) %>% dplyr::tally() %>% dplyr::pull("n") >0){ - codeRecords <- codeRecords %>% - dplyr::left_join(cdm[["concept"]] %>% + if(codeRecords |> utils::head(1) |> dplyr::tally() |> dplyr::pull("n") >0){ + codeRecords <- codeRecords |> + dplyr::left_join(cdm[["concept"]] |> dplyr::select("concept_id", "concept_name"), - by = c("standard_concept_id"="concept_id")) %>% - dplyr::rename("standard_concept_name"="concept_name") %>% - dplyr::left_join(cdm[["concept"]] %>% + by = c("standard_concept_id"="concept_id")) |> + dplyr::rename("standard_concept_name"="concept_name") |> + dplyr::left_join(cdm[["concept"]] |> dplyr::select("concept_id", "concept_name"), - by = c("source_concept_id"="concept_id")) %>% - dplyr::rename("source_concept_name"="concept_name") %>% + by = c("source_concept_id"="concept_id")) |> + dplyr::rename("source_concept_name"="concept_name") |> dplyr::mutate(source_concept_name = dplyr::if_else(is.na(.data$source_concept_name), - "NA", .data$source_concept_name)) %>% + "NA", .data$source_concept_name)) |> dplyr::compute( name = paste0(intermediateTable,"_grr_cr"), temporary = FALSE, @@ -573,26 +575,26 @@ getSummaryCounts <- function(records, byYear, bySex, byAgeGroup) { - if ("record" %in% countBy) { - recordSummary <- records %>% - dplyr::tally(name = "estimate_value") %>% - dplyr::mutate(estimate_value = as.character(.data$estimate_value)) %>% + recordSummary <- records |> + dplyr::tally(name = "estimate_value") |> + dplyr::mutate(estimate_value = as.character(.data$estimate_value)) |> dplyr::collect() if(isTRUE(byConcept)) { recordSummary <- dplyr::bind_rows( recordSummary, - records %>% + records |> dplyr::group_by( .data$standard_concept_id, .data$standard_concept_name, - .data$source_concept_id, .data$source_concept_name, .data$domain_id - ) %>% - dplyr::tally(name = "estimate_value") %>% - dplyr::mutate(estimate_value = as.character(.data$estimate_value)) %>% + .data$source_concept_id, .data$source_concept_name, + .data$source_concept_value, .data$domain_id + ) |> + dplyr::tally(name = "estimate_value") |> + dplyr::mutate(estimate_value = as.character(.data$estimate_value)) |> dplyr::collect() ) } - recordSummary <- recordSummary %>% + recordSummary <- recordSummary |> dplyr::mutate( strata_name = "overall", strata_level = "overall", @@ -603,32 +605,34 @@ getSummaryCounts <- function(records, } if ("person" %in% countBy) { - personSummary <- records %>% - dplyr::select("person_id") %>% - dplyr::distinct() %>% - dplyr::tally(name = "estimate_value") %>% - dplyr::mutate(estimate_value = as.character(.data$estimate_value)) %>% + personSummary <- records |> + dplyr::select("person_id") |> + dplyr::distinct() |> + dplyr::tally(name = "estimate_value") |> + dplyr::mutate(estimate_value = as.character(.data$estimate_value)) |> dplyr::collect() if (isTRUE(byConcept)) { personSummary <- dplyr::bind_rows( personSummary, - records %>% + records |> dplyr::select( "person_id", "standard_concept_id", "standard_concept_name", - "source_concept_id", "source_concept_name", "domain_id" - ) %>% - dplyr::distinct() %>% + "source_concept_id", "source_concept_name", + "source_concept_value", "domain_id" + ) |> + dplyr::distinct() |> dplyr::group_by( .data$standard_concept_id, .data$standard_concept_name, - .data$source_concept_id, .data$source_concept_name, .data$domain_id - ) %>% - dplyr::tally(name = "estimate_value") %>% - dplyr::mutate(estimate_value = as.character(.data$estimate_value)) %>% + .data$source_concept_id, .data$source_concept_name, + .data$source_concept_value, .data$domain_id + ) |> + dplyr::tally(name = "estimate_value") |> + dplyr::mutate(estimate_value = as.character(.data$estimate_value)) |> dplyr::collect() ) } - personSummary <- personSummary %>% + personSummary <- personSummary |> dplyr::mutate( strata_name = "overall", strata_level = "overall", @@ -697,21 +701,21 @@ getGroupedRecordCount <- function(records, groupBy){ groupedCounts <- dplyr::bind_rows( - records %>% - dplyr::group_by(dplyr::pick(.env$groupBy)) %>% - dplyr::tally(name = "estimate_value") %>% - dplyr::mutate(estimate_value = as.character(.data$estimate_value)) %>% + records |> + dplyr::group_by(dplyr::pick(.env$groupBy)) |> + dplyr::tally(name = "estimate_value") |> + dplyr::mutate(estimate_value = as.character(.data$estimate_value)) |> dplyr::collect(), - records %>% + records |> dplyr::group_by(dplyr::pick(.env$groupBy, "standard_concept_id", "standard_concept_name", "source_concept_id", "source_concept_name", - "domain_id")) %>% - dplyr::tally(name = "estimate_value") %>% - dplyr::mutate(estimate_value = as.character(.data$estimate_value)) %>% + "source_concept_value", "domain_id")) |> + dplyr::tally(name = "estimate_value") |> + dplyr::mutate(estimate_value = as.character(.data$estimate_value)) |> dplyr::collect() - ) %>% - visOmopResults::uniteStrata(cols = groupBy) %>% + ) |> + visOmopResults::uniteStrata(cols = groupBy) |> dplyr::mutate(estimate_name = "record_count") return(groupedCounts) @@ -723,27 +727,29 @@ getGroupedPersonCount <- function(records, groupBy){ groupedCounts <- dplyr::bind_rows( - records %>% - dplyr::select(dplyr::all_of(c("person_id", .env$groupBy))) %>% - dplyr::distinct() %>% - dplyr::group_by(dplyr::pick(.env$groupBy)) %>% - dplyr::tally(name = "estimate_value") %>% - dplyr::mutate(estimate_value = as.character(.data$estimate_value)) %>% + records |> + dplyr::select(dplyr::all_of(c("person_id", .env$groupBy))) |> + dplyr::distinct() |> + dplyr::group_by(dplyr::pick(.env$groupBy)) |> + dplyr::tally(name = "estimate_value") |> + dplyr::mutate(estimate_value = as.character(.data$estimate_value)) |> dplyr::collect(), - records %>% + records |> dplyr::select(dplyr::all_of(c( "person_id", "standard_concept_id", "standard_concept_name", - "source_concept_id", "source_concept_name", "domain_id", .env$groupBy - ))) %>% - dplyr::distinct() %>% + "source_concept_id", "source_concept_name", + "source_concept_value", "domain_id", .env$groupBy + ))) |> + dplyr::distinct() |> dplyr::group_by(dplyr::pick( .env$groupBy, "standard_concept_id", "standard_concept_name", - "source_concept_id", "source_concept_name", "domain_id" - )) %>% - dplyr::tally(name = "estimate_value") %>% - dplyr::mutate(estimate_value = as.character(.data$estimate_value)) %>% - dplyr::collect()) %>% - visOmopResults::uniteStrata(cols = groupBy) %>% + "source_concept_id", "source_concept_name", + "source_concept_value", "domain_id" + )) |> + dplyr::tally(name = "estimate_value") |> + dplyr::mutate(estimate_value = as.character(.data$estimate_value)) |> + dplyr::collect()) |> + visOmopResults::uniteStrata(cols = groupBy) |> dplyr::mutate(estimate_name = "person_count") return(groupedCounts) @@ -790,14 +796,14 @@ checkCategory <- function(category, overlap = FALSE) { # 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 == "", paste0(.data$lower_bound, " to ", .data$upper_bound), .data$category_label - )) %>% + )) |> dplyr::arrange(.data$lower_bound) # check overlap diff --git a/R/sysdata.rda b/R/sysdata.rda index 6a45e415..01665779 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/tableAchillesCodeUse.R b/R/tableAchillesCodeUse.R index ceb4e48b..71c65483 100644 --- a/R/tableAchillesCodeUse.R +++ b/R/tableAchillesCodeUse.R @@ -10,7 +10,7 @@ #' "codelist_name", "domain_id", "standard_concept_name", "standard_concept_id", #' "estimate_name", "standard_concept", "vocabulary_id". #' Alternatively, it can include other names to use as overall header labels. -#' @param groupColumns Variables to use as group labels. Allowed columns are: +#' @param groupColumn Variables to use as group labels. Allowed columns are: #' "cdm_name", "codelist_name", "domain_id", "standard_concept_name", #' "standard_concept_id", "estimate_name", "standard_concept", "vocabulary_id". #' These cannot be used in header. @@ -39,7 +39,7 @@ tableAchillesCodeUse <- function(result, type = "gt", header = c("cdm_name", "estimate_name"), - groupColumns = character(), + groupColumn = character(), hide = character(), .options = list()) { @@ -62,7 +62,7 @@ tableAchillesCodeUse <- function(result, resultType = "achilles_code_use", type = type, header = header, - groupColumns = groupColumns, + groupColumn = groupColumn, hide = hide, .options = .options ) @@ -82,7 +82,7 @@ tableAchillesCodeUse <- function(result, #' "codelist_name", "domain_id", "standard_concept_name", "standard_concept_id", #' "estimate_name", "standard_concept", "vocabulary_id". #' Alternatively, it can include other names to use as overall header labels. -#' @param groupColumns Variables to use as group labels. Allowed columns are: +#' @param groupColumn Variables to use as group labels. Allowed columns are: #' "cdm_name", "codelist_name", "domain_id", "standard_concept_name", #' "standard_concept_id", "estimate_name", "standard_concept", "vocabulary_id". #' These cannot be used in header. @@ -118,7 +118,7 @@ tableAchillesCodeUse <- function(result, tableOrphanCodes <- function(result, type = "gt", header = c("cdm_name", "estimate_name"), - groupColumns = character(), + groupColumn = character(), hide = character(), .options = list()) { @@ -140,7 +140,7 @@ tableOrphanCodes <- function(result, resultType = "orphan_code_use", type = type, header = header, - groupColumns = groupColumns, + groupColumn = groupColumn, hide = hide, .options = .options ) @@ -152,13 +152,13 @@ internalTableAchillesResult <- function(result, type, resultType, header, - groupColumns, + groupColumn, hide, .options) { omopgenerics::assertCharacter(header, null = TRUE) omopgenerics::assertCharacter(hide, null = TRUE) - if (!is.list(groupColumns) & !is.null(groupColumns)) groupColumns <- list(groupColumns) - omopgenerics::assertCharacter(groupColumns[[1]], null = TRUE) + if (!is.list(groupColumn) & !is.null(groupColumn)) groupColumn <- list(groupColumn) + omopgenerics::assertCharacter(groupColumn[[1]], null = TRUE) # filter result + nice estimate name x <- result |> @@ -166,7 +166,7 @@ internalTableAchillesResult <- function(result, dplyr::mutate(estimate_name = stringr::str_to_sentence(gsub("_", " ", .data$estimate_name))) header <- reformulateTableAchilles(header) - groupColumns[[1]] <- reformulateTableAchilles(groupColumns[[1]]) + groupColumn[[1]] <- reformulateTableAchilles(groupColumn[[1]]) hide <- reformulateTableAchilles(hide) # visOmopTable @@ -174,7 +174,7 @@ internalTableAchillesResult <- function(result, result = x, estimateName = character(), header = header, - groupColumn = groupColumns, + groupColumn = groupColumn, type = type, rename = c( "Domain ID" = "domain_id", "Vocabulary ID" = "vocabulary_id", diff --git a/R/tableCodeUse.R b/R/tableCodeUse.R index 67f79709..6763909d 100644 --- a/R/tableCodeUse.R +++ b/R/tableCodeUse.R @@ -10,7 +10,7 @@ #' "estimate_name", "source_concept_name", "source_concept_id", "domain_id". If #' results are stratified, "year", "sex", "age_group" can also be used. #' Alternatively, it can include other names to use as overall header labels. -#' @param groupColumns Variables to use as group labels. Allowed columns are: +#' @param groupColumn Variables to use as group labels. Allowed columns are: #' "cdm_name", "codelist_name", "standard_concept_name", "standard_concept_id", #' "estimate_name", "source_concept_name", "source_concept_id", "domain_id". If #' results are stratified, "year", "sex", "age_group" can also be used. @@ -49,7 +49,7 @@ tableCodeUse <- function(result, type = "gt", header = c("cdm_name", "estimate_name"), - groupColumns = character(), + groupColumn = character(), hide = character(), .options = list()) { @@ -72,7 +72,7 @@ tableCodeUse <- function(result, resultType = "code_use", type = type, header = header, - groupColumns = groupColumns, + groupColumn = groupColumn, timing = FALSE, hide = hide, .options = .options @@ -93,7 +93,7 @@ tableCodeUse <- function(result, #' "estimate_name", "source_concept_name", "source_concept_id", "domain_id". If #' results are stratified, "year", "sex", "age_group" can also be used. #' Alternatively, it can include other names to use as overall header labels. -#' @param groupColumns Variables to use as group labels. Allowed columns are: +#' @param groupColumn Variables to use as group labels. Allowed columns are: #' "cdm_name", "codelist_name", "standard_concept_name", "standard_concept_id", #' "estimate_name", "source_concept_name", "source_concept_id", "domain_id". If #' results are stratified, "year", "sex", "age_group" can also be used. @@ -140,7 +140,7 @@ tableCodeUse <- function(result, tableCohortCodeUse <- function(result, type = "gt", header = c("cdm_name", "estimate_name"), - groupColumns = NULL, + groupColumn = NULL, timing = FALSE, hide = character(), .options = list()) { @@ -165,7 +165,7 @@ tableCohortCodeUse <- function(result, resultType = "cohort_code_use", type = type, header = header, - groupColumns = groupColumns, + groupColumn = groupColumn, timing = timing, hide = hide, .options = .options @@ -178,14 +178,14 @@ internalTableCodeUse <- function(result, resultType, type, header, - groupColumns, + groupColumn, timing, hide, .options) { omopgenerics::assertCharacter(header, null = TRUE) omopgenerics::assertCharacter(hide, null = TRUE) - if (!is.list(groupColumns) & !is.null(groupColumns)) groupColumns <- list(groupColumns) - omopgenerics::assertCharacter(groupColumns[[1]], null = TRUE) + if (!is.list(groupColumn) & !is.null(groupColumn)) groupColumn <- list(groupColumn) + omopgenerics::assertCharacter(groupColumn[[1]], null = TRUE) # .options .options <- optionsCodeUse(.options) @@ -201,7 +201,7 @@ internalTableCodeUse <- function(result, dplyr::mutate(estimate_name = stringr::str_to_sentence(gsub("_", " ", .data$estimate_name))) header <- reformulateTableAchilles(header) - groupColumns[[1]] <- reformulateTableAchilles(groupColumns[[1]]) + groupColumn[[1]] <- reformulateTableAchilles(groupColumn[[1]]) hide <- reformulateTableAchilles(hide) # visTable @@ -209,7 +209,7 @@ internalTableCodeUse <- function(result, result = x, estimateName = character(), header = header, - groupColumn = groupColumns, + groupColumn = groupColumn, type = type, settingsColumns = settingsColumns, rename = c( diff --git a/R/tableUnmappedCodes.R b/R/tableUnmappedCodes.R index 44193a5d..ef868811 100644 --- a/R/tableUnmappedCodes.R +++ b/R/tableUnmappedCodes.R @@ -10,7 +10,7 @@ #' "codelist_name", "domain_id", "standard_concept_name", "standard_concept_id", #' "estimate_name", "standard_concept", "vocabulary_id". #' Alternatively, it can include other names to use as overall header labels. -#' @param groupColumns Variables to use as group labels. Allowed columns are: +#' @param groupColumn Variables to use as group labels. Allowed columns are: #' "cdm_name", "codelist_name", "domain_id", "standard_concept_name", #' "standard_concept_id", "estimate_name", "standard_concept", "vocabulary_id". #' These cannot be used in header. @@ -31,7 +31,7 @@ tableUnmappedCodes <- function(result, type = "gt", header = c("cdm_name", "estimate_name"), - groupColumns = character(), + groupColumn = character(), hide = character(), .options = list()) { # checks @@ -53,7 +53,7 @@ tableUnmappedCodes <- function(result, resultType = "unmapped_codes", type = type, header = header, - groupColumns = groupColumns, + groupColumn = groupColumn, hide = hide, .options = .options ) @@ -66,13 +66,13 @@ internalTableUnmappedCodes <- function(result, type, resultType, header, - groupColumns, + groupColumn, hide, .options) { omopgenerics::assertCharacter(header, null = TRUE) omopgenerics::assertCharacter(hide, null = TRUE) - if (!is.list(groupColumns) & !is.null(groupColumns)) groupColumns <- list(groupColumns) - omopgenerics::assertCharacter(groupColumns[[1]], null = TRUE) + if (!is.list(groupColumn) & !is.null(groupColumn)) groupColumn <- list(groupColumn) + omopgenerics::assertCharacter(groupColumn[[1]], null = TRUE) # filter result + nice estimate name x <- result |> @@ -80,7 +80,7 @@ internalTableUnmappedCodes <- function(result, dplyr::mutate(estimate_name = stringr::str_to_sentence(gsub("_", " ", .data$estimate_name))) header <- reformulateTableUnmappedCodes(header) - groupColumns[[1]] <- reformulateTableUnmappedCodes(groupColumns[[1]]) + groupColumn[[1]] <- reformulateTableUnmappedCodes(groupColumn[[1]]) hide <- reformulateTableUnmappedCodes(hide) # visOmopTable @@ -88,7 +88,7 @@ internalTableUnmappedCodes <- function(result, result = x, estimateName = character(), header = header, - groupColumn = groupColumns, + groupColumn = groupColumn, type = type, rename = c( "Domain ID" = "domain_id", "Vocabulary ID" = "vocabulary_id", diff --git a/R/utils-pipe.R b/R/utils-pipe.R deleted file mode 100644 index fd0b1d13..00000000 --- a/R/utils-pipe.R +++ /dev/null @@ -1,14 +0,0 @@ -#' 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/R/vocabUtilities.R b/R/vocabUtilities.R index 479d2d32..6dd4ce5e 100644 --- a/R/vocabUtilities.R +++ b/R/vocabUtilities.R @@ -39,10 +39,10 @@ getVocabVersion <- function(cdm) { } checkmate::reportAssertions(collection = errorMessage) - version <- as.character(cdm$vocabulary %>% - dplyr::rename_with(tolower) %>% - dplyr::filter(.data$vocabulary_id == "None") %>% - dplyr::select("vocabulary_version") %>% + version <- as.character(cdm$vocabulary |> + dplyr::rename_with(tolower) |> + dplyr::filter(.data$vocabulary_id == "None") |> + dplyr::select("vocabulary_version") |> dplyr::collect()) return(version) } @@ -94,28 +94,28 @@ getDomains <- function(cdm, conceptDb <- cdm$concept standardConcept <- tolower(standardConcept) - conceptDb <- conceptDb %>% + conceptDb <- conceptDb |> dplyr::mutate( standard_concept = ifelse(is.na(.data$standard_concept), "non-standard", .data$standard_concept ) - ) %>% + ) |> dplyr::mutate( standard_concept = ifelse(.data$standard_concept == "C", "classification", .data$standard_concept ) - ) %>% + ) |> dplyr::mutate( standard_concept = ifelse(.data$standard_concept == "S", "standard", .data$standard_concept ) - ) %>% + ) |> dplyr::filter(.data$standard_concept %in% .env$standardConcept) - domains <- conceptDb %>% - dplyr::select("domain_id") %>% - dplyr::distinct() %>% - dplyr::collect() %>% + domains <- conceptDb |> + dplyr::select("domain_id") |> + dplyr::distinct() |> + dplyr::collect() |> dplyr::pull() return(domains) @@ -147,10 +147,10 @@ getVocabularies <- function(cdm) { } checkmate::reportAssertions(collection = errorMessage) - vocabs <- sort(cdm$concept %>% - dplyr::select("vocabulary_id") %>% - dplyr::distinct() %>% - dplyr::collect() %>% + vocabs <- sort(cdm$concept |> + dplyr::select("vocabulary_id") |> + dplyr::distinct() |> + dplyr::collect() |> dplyr::pull()) return(vocabs) @@ -207,34 +207,34 @@ getConceptClassId <- function(cdm, conceptDb <- cdm$concept if (!is.null(domain)) { - conceptDb <- conceptDb %>% + conceptDb <- conceptDb |> dplyr::filter(tolower(.data$domain_id) == tolower(.env$domain)) } standardConcept <- tolower(standardConcept) - conceptDb <- conceptDb %>% + conceptDb <- conceptDb |> dplyr::mutate( standard_concept = ifelse(is.na(.data$standard_concept), "non-standard", .data$standard_concept ) - ) %>% + ) |> dplyr::mutate( standard_concept = ifelse(.data$standard_concept == "C", "classification", .data$standard_concept ) - ) %>% + ) |> dplyr::mutate( standard_concept = ifelse(.data$standard_concept == "S", "standard", .data$standard_concept ) - ) %>% + ) |> dplyr::filter(.data$standard_concept %in% .env$standardConcept) # get overall version - conceptClassId <- conceptDb %>% - dplyr::select("concept_class_id") %>% - dplyr::distinct() %>% - dplyr::collect() %>% + conceptClassId <- conceptDb |> + dplyr::select("concept_class_id") |> + dplyr::distinct() |> + dplyr::collect() |> dplyr::pull() conceptClassId <- sort(conceptClassId) @@ -268,20 +268,20 @@ getDoseForm <- function(cdm) { } checkmate::reportAssertions(collection = errorMessage) - rxDoseForm <- cdm$concept_relationship %>% - dplyr::filter(.data$relationship_id == "RxNorm has dose form") %>% - dplyr::select("concept_id_2") %>% - dplyr::rename("concept_id" = "concept_id_2") %>% - dplyr::distinct() %>% + rxDoseForm <- cdm$concept_relationship |> + dplyr::filter(.data$relationship_id == "RxNorm has dose form") |> + dplyr::select("concept_id_2") |> + dplyr::rename("concept_id" = "concept_id_2") |> + dplyr::distinct() |> dplyr::left_join( - cdm$concept %>% + cdm$concept |> dplyr::select( "concept_id", "concept_name", "standard_concept" ), by = "concept_id" - ) %>% - dplyr::collect() %>% + ) |> + dplyr::collect() |> dplyr::pull("concept_name") rxDoseForm <- sort(rxDoseForm) @@ -354,19 +354,19 @@ if(isFALSE(withAncestor)){ } getDescendantsOnly <- function(cdm, conceptId, ingredientRange, doseForm) { - descendants <- cdm$concept_ancestor %>% - dplyr::filter(.data$ancestor_concept_id %in% .env$conceptId) %>% - dplyr::select("descendant_concept_id") %>% - dplyr::distinct() %>% - dplyr::rename("concept_id" = "descendant_concept_id") %>% + descendants <- cdm$concept_ancestor |> + dplyr::filter(.data$ancestor_concept_id %in% .env$conceptId) |> + dplyr::select("descendant_concept_id") |> + dplyr::distinct() |> + dplyr::rename("concept_id" = "descendant_concept_id") |> dplyr::left_join(cdm$concept, by = "concept_id") if(ingredientRange[1] != 0 && ingredientRange[2] != 9999999){ - descendants <- addIngredientCount(cdm = cdm, concepts = descendants) %>% + descendants <- addIngredientCount(cdm = cdm, concepts = descendants) |> dplyr::filter(.data$ingredient_count >= !!.env$ingredientRange[1], - .data$ingredient_count <= !!.env$ingredientRange[2]) %>% + .data$ingredient_count <= !!.env$ingredientRange[2]) |> dplyr::select(!c("ingredient_count")) } @@ -374,7 +374,7 @@ getDescendantsOnly <- function(cdm, conceptId, ingredientRange, doseForm) { descendantDoseForms <- getPresentDoseForms(cdm, concepts = descendants) } - descendants <- descendants %>% + descendants <- descendants |> dplyr::collect() if(!is.null(doseForm)){ @@ -394,33 +394,33 @@ getDescendantsAndAncestor <- function(cdm, conceptId, ingredientRange, doseForm) table = dplyr::tibble(ancestor_concept_id = as.integer(conceptId)), overwrite = TRUE) - descendants <- cdm$concept_ancestor %>% + descendants <- cdm$concept_ancestor |> dplyr::inner_join(cdm[[conceptIdDbTable]], - by = "ancestor_concept_id") %>% - dplyr::rename("concept_id" = "descendant_concept_id") %>% + by = "ancestor_concept_id") |> + dplyr::rename("concept_id" = "descendant_concept_id") |> dplyr::left_join(cdm$concept, - by = "concept_id") %>% + by = "concept_id") |> dplyr::compute() - descendants <- addIngredientCount(cdm = cdm, concepts = descendants) %>% + descendants <- addIngredientCount(cdm = cdm, concepts = descendants) |> dplyr::filter(.data$ingredient_count >= !!ingredientRange[1], - .data$ingredient_count <= !!ingredientRange[2]) %>% + .data$ingredient_count <= !!ingredientRange[2]) |> dplyr::select(!c("ingredient_count")) if(!is.null(doseForm) && - nrow(descendants %>% - utils::head(5) %>% - dplyr::tally() %>% + nrow(descendants |> + utils::head(5) |> + dplyr::tally() |> dplyr::collect()) > 0){ descendantDoseForms <- getPresentDoseForms(cdm, concepts = descendants) } - descendants <- descendants %>% - dplyr::collect() %>% + descendants <- descendants |> + dplyr::collect() |> dplyr::mutate(name = paste0("concept_", .data$ancestor_concept_id)) if(nrow(descendants)>0){ -descendants <- descendants %>% +descendants <- descendants |> tidyr::pivot_wider(names_from = "name", values_from = "ancestor_concept_id") @@ -431,7 +431,7 @@ descendants <- descendants %>% collapse = "|"), negate = TRUE) -descendants <- descendants %>% +descendants <- descendants |> tidyr::unite(col="ancestor_concept_id", dplyr::all_of(working_cols), sep=";") # quicker to replace NAs afterwards rather than inside unite @@ -444,9 +444,9 @@ descendants$ancestor_concept_id <- stringr::str_replace_all( } if(!is.null(doseForm) && - nrow(descendants %>% - utils::head(5) %>% - dplyr::tally() %>% + nrow(descendants |> + utils::head(5) |> + dplyr::tally() |> dplyr::collect()) > 0){ descendants <- filterOnDoseForm(concepts = descendants, conceptDoseForms = descendantDoseForms, @@ -462,30 +462,30 @@ descendants$ancestor_concept_id <- stringr::str_replace_all( getPresentDoseForms <- function(cdm, concepts){ - presentDoseForms <- concepts %>% + presentDoseForms <- concepts |> dplyr::left_join( - cdm$concept_relationship %>% - dplyr::filter(.data$relationship_id == "RxNorm has dose form") %>% - dplyr::select("concept_id_1", "concept_id_2") %>% - dplyr::rename("concept_id" = "concept_id_2") %>% - dplyr::distinct() %>% - dplyr::left_join(cdm$concept, by = "concept_id") %>% - dplyr::select("concept_id_1", "concept_name") %>% + cdm$concept_relationship |> + dplyr::filter(.data$relationship_id == "RxNorm has dose form") |> + dplyr::select("concept_id_1", "concept_id_2") |> + dplyr::rename("concept_id" = "concept_id_2") |> + dplyr::distinct() |> + dplyr::left_join(cdm$concept, by = "concept_id") |> + dplyr::select("concept_id_1", "concept_name") |> dplyr::rename("concept_id"="concept_id_1", "dose_form"="concept_name") , by ="concept_id" - ) %>% - dplyr::select("concept_id", "dose_form") %>% + ) |> + dplyr::select("concept_id", "dose_form") |> dplyr::collect() - presentDoseForms <- presentDoseForms %>% - dplyr::group_by(.data$concept_id) %>% - dplyr::mutate(seq = dplyr::row_number()) %>% + presentDoseForms <- presentDoseForms |> + dplyr::group_by(.data$concept_id) |> + dplyr::mutate(seq = dplyr::row_number()) |> tidyr::pivot_wider( names_from = "seq", values_from = "dose_form" ) - presentDoseForms <- presentDoseForms %>% + presentDoseForms <- presentDoseForms |> tidyr::unite( col = "dose_form", 2:ncol(presentDoseForms), sep = "; ", na.rm = TRUE @@ -495,15 +495,15 @@ getPresentDoseForms <- function(cdm, concepts){ } filterOnDoseForm <- function(concepts, conceptDoseForms, doseForm){ - concepts <- concepts %>% + concepts <- concepts |> dplyr::inner_join( - conceptDoseForms %>% + conceptDoseForms |> dplyr::filter(stringr::str_detect( string = tolower(.data$dose_form), pattern = paste(tolower(.env$doseForm), collapse = "|" ) - )) %>% + )) |> dplyr::select("concept_id"), by = "concept_id") @@ -512,28 +512,28 @@ filterOnDoseForm <- function(concepts, conceptDoseForms, doseForm){ } addIngredientCount <- function(cdm, concepts) { - ingredient_ancestor <- cdm$concept_ancestor %>% - dplyr::inner_join(cdm$concept %>% + ingredient_ancestor <- cdm$concept_ancestor |> + dplyr::inner_join(cdm$concept |> dplyr::filter(.data$concept_class_id == "Ingredient", - .data$standard_concept == "S") %>% + .data$standard_concept == "S") |> dplyr::select("concept_id"), by = c("ancestor_concept_id" = "concept_id")) - ingredient_count <- concepts %>% - dplyr::select("concept_id") %>% - dplyr::distinct() %>% + ingredient_count <- concepts |> + dplyr::select("concept_id") |> + dplyr::distinct() |> dplyr::left_join(ingredient_ancestor, - by = c("concept_id" = "descendant_concept_id")) %>% - dplyr::select("concept_id") %>% - dplyr::group_by(.data$concept_id) %>% - dplyr::tally(name = "ingredient_count") %>% + by = c("concept_id" = "descendant_concept_id")) |> + dplyr::select("concept_id") |> + dplyr::group_by(.data$concept_id) |> + dplyr::tally(name = "ingredient_count") |> dplyr::mutate(ingredient_count = as.integer(ingredient_count)) - concepts <- concepts %>% + concepts <- concepts |> dplyr::left_join(ingredient_count, by = "concept_id") if(!is.null(attr(cdm, "dbcon"))){ - concepts <- concepts %>% + concepts <- concepts |> dplyr::compute()} concepts @@ -598,7 +598,7 @@ getRelationshipId <- function(cdm, domains1 <- tolower(domains1) domains2 <- tolower(domains2) - cdm[["concept"]] <- cdm[["concept"]] %>% + cdm[["concept"]] <- cdm[["concept"]] |> dplyr::mutate( domain_id = tolower(.data$domain_id), standard_concept = dplyr::case_when( diff --git a/README.Rmd b/README.Rmd index bf626600..20991c68 100644 --- a/README.Rmd +++ b/README.Rmd @@ -21,8 +21,7 @@ knitr::opts_chunk$set( [![CRAN status](https://www.r-pkg.org/badges/version/CodelistGenerator)](https://CRAN.R-project.org/package=CodelistGenerator) [![codecov.io](https://codecov.io/github/darwin-eu/CodelistGenerator/coverage.svg?branch=main)](https://app.codecov.io/github/darwin-eu/CodelistGenerator?branch=main) [![R-CMD-check](https://github.com/darwin-eu/CodelistGenerator/workflows/R-CMD-check/badge.svg)](https://github.com/darwin-eu/CodelistGenerator/actions) -[![Lifecycle:Stable](https://img.shields.io/badge/Lifecycle-Stable-97ca00)](https://lifecycle.r-lib.org/articles/stages.html) -[![R-CMD-check](https://github.com/darwin-eu/CodelistGenerator/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/darwin-eu/CodelistGenerator/actions/workflows/R-CMD-check.yaml) +[![Lifecycle:stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) ## Installation @@ -65,17 +64,12 @@ getConceptClassId(cdm, ## Vocabulary based codelists using CodelistGenerator CodelistGenerator provides functions to extract code lists based on vocabulary hierarchies. One example is `getDrugIngredientCodes, which we can use, for example, to get all the concept IDs used to represent aspirin. ```{r} -getDrugIngredientCodes(cdm = cdm, name = "aspirin") -``` - -If we also want the details of these concept IDs we can get these like so. -```{r} -getDrugIngredientCodes(cdm = cdm, name = "aspirin", withConceptDetails = TRUE) +getDrugIngredientCodes(cdm = cdm, name = "aspirin", nameStyle = "{concept_name}") ``` And if we want codelists for all drug ingredients we can simply omit the name argument and all ingredients will be returned. ```{r} -ing <- getDrugIngredientCodes(cdm = cdm) +ing <- getDrugIngredientCodes(cdm = cdm, nameStyle = "{concept_name}") ing$aspirin ing$diclofenac ing$celecoxib @@ -91,7 +85,7 @@ asthma_codes1 <- getCandidateCodes( keywords = "asthma", domains = "Condition" ) -asthma_codes1 %>% +asthma_codes1 |> glimpse() ``` @@ -103,7 +97,7 @@ asthma_codes2 <- getCandidateCodes( exclude = "childhood", domains = "Condition" ) -asthma_codes2 %>% +asthma_codes2 |> glimpse() ``` @@ -119,7 +113,7 @@ Gastrointestinal_hemorrhage <- getCandidateCodes( keywords = "Gastrointestinal hemorrhage", domains = "Condition" ) -Gastrointestinal_hemorrhage %>% +Gastrointestinal_hemorrhage |> glimpse() ``` @@ -127,7 +121,7 @@ Gastrointestinal_hemorrhage %>% ```{r} summariseCodeUse(list("asthma" = asthma_codes1$concept_id), - cdm = cdm) %>% + cdm = cdm) |> glimpse() ``` diff --git a/README.md b/README.md index 64c53d4a..52ee546c 100644 --- a/README.md +++ b/README.md @@ -9,8 +9,7 @@ status](https://www.r-pkg.org/badges/version/CodelistGenerator)](https://CRAN.R-project.org/package=CodelistGenerator) [![codecov.io](https://codecov.io/github/darwin-eu/CodelistGenerator/coverage.svg?branch=main)](https://app.codecov.io/github/darwin-eu/CodelistGenerator?branch=main) [![R-CMD-check](https://github.com/darwin-eu/CodelistGenerator/workflows/R-CMD-check/badge.svg)](https://github.com/darwin-eu/CodelistGenerator/actions) -[![Lifecycle:Stable](https://img.shields.io/badge/Lifecycle-Stable-97ca00)](https://lifecycle.r-lib.org/articles/stages.html) -[![R-CMD-check](https://github.com/darwin-eu/CodelistGenerator/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/darwin-eu/CodelistGenerator/actions/workflows/R-CMD-check.yaml) +[![Lifecycle:stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) ## Installation @@ -62,9 +61,9 @@ classes of standard concepts used for drugs getConceptClassId(cdm, standardConcept = "Standard", domain = "Drug") -#> [1] "Ingredient" "Quant Clinical Drug" "Branded Drug" -#> [4] "Quant Branded Drug" "Clinical Drug Comp" "Branded Drug Comp" -#> [7] "CVX" "Clinical Drug" "Branded Pack" +#> [1] "Branded Drug" "Branded Drug Comp" "Branded Pack" +#> [4] "Clinical Drug" "Clinical Drug Comp" "CVX" +#> [7] "Ingredient" "Quant Branded Drug" "Quant Clinical Drug" ``` ## Vocabulary based codelists using CodelistGenerator @@ -75,29 +74,16 @@ we can use, for example, to get all the concept IDs used to represent aspirin. ``` r -getDrugIngredientCodes(cdm = cdm, name = "aspirin") +getDrugIngredientCodes(cdm = cdm, name = "aspirin", nameStyle = "{concept_name}") #> #> - aspirin (2 codes) ``` -If we also want the details of these concept IDs we can get these like -so. - -``` r -getDrugIngredientCodes(cdm = cdm, name = "aspirin", withConceptDetails = TRUE) -#> $aspirin -#> # A tibble: 2 × 4 -#> concept_id concept_name domain_id vocabulary_id -#> -#> 1 19059056 Aspirin 81 MG Oral Tablet Drug RxNorm -#> 2 1112807 Aspirin Drug RxNorm -``` - And if we want codelists for all drug ingredients we can simply omit the name argument and all ingredients will be returned. ``` r -ing <- getDrugIngredientCodes(cdm = cdm) +ing <- getDrugIngredientCodes(cdm = cdm, nameStyle = "{concept_name}") ing$aspirin #> [1] 19059056 1112807 ing$diclofenac @@ -123,7 +109,7 @@ asthma_codes1 <- getCandidateCodes( keywords = "asthma", domains = "Condition" ) -asthma_codes1 %>% +asthma_codes1 |> glimpse() #> Rows: 2 #> Columns: 6 @@ -145,7 +131,7 @@ asthma_codes2 <- getCandidateCodes( exclude = "childhood", domains = "Condition" ) -asthma_codes2 %>% +asthma_codes2 |> glimpse() #> Rows: 1 #> Columns: 6 @@ -179,7 +165,7 @@ Gastrointestinal_hemorrhage <- getCandidateCodes( keywords = "Gastrointestinal hemorrhage", domains = "Condition" ) -Gastrointestinal_hemorrhage %>% +Gastrointestinal_hemorrhage |> glimpse() #> Rows: 1 #> Columns: 6 @@ -195,7 +181,7 @@ Gastrointestinal_hemorrhage %>% ``` r summariseCodeUse(list("asthma" = asthma_codes1$concept_id), - cdm = cdm) %>% + cdm = cdm) |> glimpse() #> Rows: 6 #> Columns: 13 @@ -206,10 +192,10 @@ summariseCodeUse(list("asthma" = asthma_codes1$concept_id), #> $ strata_name "overall", "overall", "overall", "overall", "overall"… #> $ strata_level "overall", "overall", "overall", "overall", "overall"… #> $ variable_name "overall", "Childhood asthma", "Asthma", "overall", "… -#> $ variable_level NA, "4051466", "317009", NA, "4051466", "317009" +#> $ variable_level NA, "4051466", "317009", NA, "317009", "4051466" #> $ estimate_name "record_count", "record_count", "record_count", "pers… #> $ estimate_type "integer", "integer", "integer", "integer", "integer"… -#> $ estimate_value "101", "96", "5", "101", "96", "5" +#> $ estimate_value "101", "96", "5", "101", "5", "96" #> $ additional_name "overall", "source_concept_name &&& source_concept_id… #> $ additional_level "overall", "Childhood asthma &&& 4051466 &&& conditio… ``` diff --git a/cran-comments.md b/cran-comments.md index e7ab6ec5..00fb1048 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,3 +1,3 @@ ## R CMD check results -This is a new release. +This is a patch release for a breaking change in a dependency. diff --git a/data-raw/conceptDomainsData.R b/data-raw/conceptDomainsData.R index e1fdf1a6..02bc8a1d 100644 --- a/data-raw/conceptDomainsData.R +++ b/data-raw/conceptDomainsData.R @@ -2,7 +2,7 @@ conceptDomainsData <- dplyr::tibble(domain_id = c("drug","condition", "procedure", "observation", "measurement", "visit", - "device")) %>% + "device")) |> dplyr::mutate(table = dplyr::case_when( stringr::str_detect(domain_id,"condition") ~ "condition_occurrence", @@ -13,7 +13,7 @@ conceptDomainsData <- dplyr::tibble(domain_id = c("drug","condition", stringr::str_detect(domain_id,"procedure") ~ "procedure_occurrence", stringr::str_detect(domain_id,"device") ~ "device_exposure" ) - ) %>% + ) |> dplyr::mutate(standard_concept = dplyr::case_when( stringr::str_detect(domain_id,"condition") ~ "condition_concept_id", @@ -24,7 +24,7 @@ conceptDomainsData <- dplyr::tibble(domain_id = c("drug","condition", stringr::str_detect(domain_id,"procedure") ~ "procedure_concept_id", stringr::str_detect(domain_id,"device") ~ "device_concept_id" ) - ) %>% + ) |> dplyr::mutate(source_concept = dplyr::case_when( stringr::str_detect(domain_id,"condition") ~ "condition_source_concept_id", @@ -35,7 +35,18 @@ conceptDomainsData <- dplyr::tibble(domain_id = c("drug","condition", stringr::str_detect(domain_id,"procedure") ~ "procedure_source_concept_id", stringr::str_detect(domain_id,"device") ~ "device_source_concept_id" ) - ) %>% + ) |> + dplyr::mutate(source_concept_value = + dplyr::case_when( + stringr::str_detect(domain_id,"condition") ~ "condition_source_value", + stringr::str_detect(domain_id,"drug") ~ "drug_source_value", + stringr::str_detect(domain_id,"observation") ~ "observation_source_value", + stringr::str_detect(domain_id,"measurement") ~ "measurement_source_value", + stringr::str_detect(domain_id,"visit") ~ "visit_source_value", + stringr::str_detect(domain_id,"procedure") ~ "procedure_source_value", + stringr::str_detect(domain_id,"device") ~ "device_source_value" + ) + ) |> dplyr::mutate(date_name = dplyr::case_when( stringr::str_detect(domain_id,"condition") ~ "condition_start_date", diff --git a/extras/precomputeVignetteData.R b/extras/precomputeVignetteData.R index 72579f01..51bf3d51 100644 --- a/extras/precomputeVignetteData.R +++ b/extras/precomputeVignetteData.R @@ -30,14 +30,14 @@ cdm <- CDMConnector::cdm_from_con(con = db, # intro vignette ---- vocabVersion <- getVocabVersion(cdm = cdm) -codesFromDescendants <- cdm$concept_ancestor %>% - filter(.data$ancestor_concept_id == 4182210) %>% - select("descendant_concept_id") %>% - rename("concept_id" = "descendant_concept_id") %>% - select("concept_id") %>% +codesFromDescendants <- cdm$concept_ancestor |> + filter(.data$ancestor_concept_id == 4182210) |> + select("descendant_concept_id") |> + rename("concept_id" = "descendant_concept_id") |> + select("concept_id") |> left_join(cdm$concept, - by="concept_id") %>% - select("concept_id", "concept_name", "domain_id", "vocabulary_id") %>% + by="concept_id") |> + select("concept_id", "concept_name", "domain_id", "vocabulary_id") |> collect() diff --git a/man/pipe.Rd b/man/pipe.Rd deleted file mode 100644 index a648c296..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 \code{rhs(lhs)}. -} -\description{ -See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. -} -\keyword{internal} diff --git a/man/tableAchillesCodeUse.Rd b/man/tableAchillesCodeUse.Rd index 59080bdd..2cab1aa0 100644 --- a/man/tableAchillesCodeUse.Rd +++ b/man/tableAchillesCodeUse.Rd @@ -8,7 +8,7 @@ tableAchillesCodeUse( result, type = "gt", header = c("cdm_name", "estimate_name"), - groupColumns = character(), + groupColumn = character(), hide = character(), .options = list() ) @@ -27,7 +27,7 @@ The header vector can contain one of the following variables: "cdm_name", "estimate_name", "standard_concept", "vocabulary_id". Alternatively, it can include other names to use as overall header labels.} -\item{groupColumns}{Variables to use as group labels. Allowed columns are: +\item{groupColumn}{Variables to use as group labels. Allowed columns are: "cdm_name", "codelist_name", "domain_id", "standard_concept_name", "standard_concept_id", "estimate_name", "standard_concept", "vocabulary_id". These cannot be used in header.} diff --git a/man/tableCodeUse.Rd b/man/tableCodeUse.Rd index 439b9927..fa507140 100644 --- a/man/tableCodeUse.Rd +++ b/man/tableCodeUse.Rd @@ -8,7 +8,7 @@ tableCodeUse( result, type = "gt", header = c("cdm_name", "estimate_name"), - groupColumns = character(), + groupColumn = character(), hide = character(), .options = list() ) @@ -27,7 +27,7 @@ The header vector can contain one of the following variables: "cdm_name", results are stratified, "year", "sex", "age_group" can also be used. Alternatively, it can include other names to use as overall header labels.} -\item{groupColumns}{Variables to use as group labels. Allowed columns are: +\item{groupColumn}{Variables to use as group labels. Allowed columns are: "cdm_name", "codelist_name", "standard_concept_name", "standard_concept_id", "estimate_name", "source_concept_name", "source_concept_id", "domain_id". If results are stratified, "year", "sex", "age_group" can also be used. diff --git a/man/tableCohortCodeUse.Rd b/man/tableCohortCodeUse.Rd index 6db8df3f..86c4e09e 100644 --- a/man/tableCohortCodeUse.Rd +++ b/man/tableCohortCodeUse.Rd @@ -8,7 +8,7 @@ tableCohortCodeUse( result, type = "gt", header = c("cdm_name", "estimate_name"), - groupColumns = NULL, + groupColumn = NULL, timing = FALSE, hide = character(), .options = list() @@ -28,7 +28,7 @@ The header vector can contain one of the following variables: "cdm_name", results are stratified, "year", "sex", "age_group" can also be used. Alternatively, it can include other names to use as overall header labels.} -\item{groupColumns}{Variables to use as group labels. Allowed columns are: +\item{groupColumn}{Variables to use as group labels. Allowed columns are: "cdm_name", "codelist_name", "standard_concept_name", "standard_concept_id", "estimate_name", "source_concept_name", "source_concept_id", "domain_id". If results are stratified, "year", "sex", "age_group" can also be used. diff --git a/man/tableOrphanCodes.Rd b/man/tableOrphanCodes.Rd index b4121be0..47f997ca 100644 --- a/man/tableOrphanCodes.Rd +++ b/man/tableOrphanCodes.Rd @@ -8,7 +8,7 @@ tableOrphanCodes( result, type = "gt", header = c("cdm_name", "estimate_name"), - groupColumns = character(), + groupColumn = character(), hide = character(), .options = list() ) @@ -27,7 +27,7 @@ The header vector can contain one of the following variables: "cdm_name", "estimate_name", "standard_concept", "vocabulary_id". Alternatively, it can include other names to use as overall header labels.} -\item{groupColumns}{Variables to use as group labels. Allowed columns are: +\item{groupColumn}{Variables to use as group labels. Allowed columns are: "cdm_name", "codelist_name", "domain_id", "standard_concept_name", "standard_concept_id", "estimate_name", "standard_concept", "vocabulary_id". These cannot be used in header.} diff --git a/man/tableUnmappedCodes.Rd b/man/tableUnmappedCodes.Rd index ee3e9c8b..00962867 100644 --- a/man/tableUnmappedCodes.Rd +++ b/man/tableUnmappedCodes.Rd @@ -8,7 +8,7 @@ tableUnmappedCodes( result, type = "gt", header = c("cdm_name", "estimate_name"), - groupColumns = character(), + groupColumn = character(), hide = character(), .options = list() ) @@ -27,7 +27,7 @@ The header vector can contain one of the following variables: "cdm_name", "estimate_name", "standard_concept", "vocabulary_id". Alternatively, it can include other names to use as overall header labels.} -\item{groupColumns}{Variables to use as group labels. Allowed columns are: +\item{groupColumn}{Variables to use as group labels. Allowed columns are: "cdm_name", "codelist_name", "domain_id", "standard_concept_name", "standard_concept_id", "estimate_name", "standard_concept", "vocabulary_id". These cannot be used in header.} diff --git a/tests/testthat/test-codesInUse.R b/tests/testthat/test-codesInUse.R index e711d8ca..acb03bdf 100644 --- a/tests/testthat/test-codesInUse.R +++ b/tests/testthat/test-codesInUse.R @@ -62,11 +62,11 @@ test_that("sql server with achilles", { cdm = cdm) expect_equal(sort(asthma_codes_present[[1]]), - sort(cdm$condition_occurrence %>% + sort(cdm$condition_occurrence |> dplyr::filter(.data$condition_concept_id %in% - !!asthma_codes$concept_id) %>% - dplyr::select("condition_concept_id") %>% - dplyr::distinct() %>% + !!asthma_codes$concept_id) |> + dplyr::select("condition_concept_id") |> + dplyr::distinct() |> dplyr::pull())) diff --git a/tests/testthat/test-compareCodelists.R b/tests/testthat/test-compareCodelists.R index 329caf80..12181202 100644 --- a/tests/testthat/test-compareCodelists.R +++ b/tests/testthat/test-compareCodelists.R @@ -33,24 +33,24 @@ test_that("comparing two codelists", { ) %in% names(codesCompared))) - expect_true(codesCompared %>% - dplyr::filter(concept_id == 3) %>% - dplyr::select(codelist) %>% + expect_true(codesCompared |> + dplyr::filter(concept_id == 3) |> + dplyr::select(codelist) |> dplyr::pull() == "Only codelist 1") - expect_true(codesCompared %>% - dplyr::filter(concept_id == 5) %>% - dplyr::select(codelist) %>% + expect_true(codesCompared |> + dplyr::filter(concept_id == 5) |> + dplyr::select(codelist) |> dplyr::pull() == "Only codelist 1") - expect_true(codesCompared %>% - dplyr::filter(concept_id == 4) %>% - dplyr::select(codelist) %>% + expect_true(codesCompared |> + dplyr::filter(concept_id == 4) |> + dplyr::select(codelist) |> dplyr::pull() == "Both") - expect_true(codesCompared %>% - dplyr::filter(concept_id == 2) %>% - dplyr::select(codelist) %>% + expect_true(codesCompared |> + dplyr::filter(concept_id == 2) |> + dplyr::select(codelist) |> dplyr::pull() == "Only codelist 2") # expected errors @@ -100,24 +100,24 @@ test_that("comparing two codelists- same codes found different ways", { # tests expect_true(nrow(codesCompared) == 4) - expect_true(codesCompared %>% - dplyr::filter(concept_id == 3) %>% - dplyr::select(codelist) %>% + expect_true(codesCompared |> + dplyr::filter(concept_id == 3) |> + dplyr::select(codelist) |> dplyr::pull() == "Both") - expect_true(codesCompared %>% - dplyr::filter(concept_id == 4) %>% - dplyr::select(codelist) %>% + expect_true(codesCompared |> + dplyr::filter(concept_id == 4) |> + dplyr::select(codelist) |> dplyr::pull() == "Both") - expect_true(codesCompared %>% - dplyr::filter(concept_id == 5) %>% - dplyr::select(codelist) %>% + expect_true(codesCompared |> + dplyr::filter(concept_id == 5) |> + dplyr::select(codelist) |> dplyr::pull() == "Both") - expect_true(codesCompared %>% - dplyr::filter(concept_id == 2) %>% - dplyr::select(codelist) %>% + expect_true(codesCompared |> + dplyr::filter(concept_id == 2) |> + dplyr::select(codelist) |> dplyr::pull() == "Only codelist 2") if (backends[[i]] == "database") { diff --git a/tests/testthat/test-dbms.R b/tests/testthat/test-dbms.R index 871d00df..4b08fd90 100644 --- a/tests/testthat/test-dbms.R +++ b/tests/testthat/test-dbms.R @@ -67,13 +67,13 @@ test_that("redshift", { # achilles - cdm$achilles_results <- cdm$condition_occurrence %>% - dplyr::group_by(condition_concept_id) %>% - dplyr::tally(name = "count_value") %>% - dplyr::rename("stratum_1" = "condition_concept_id") %>% + cdm$achilles_results <- cdm$condition_occurrence |> + dplyr::group_by(condition_concept_id) |> + dplyr::tally(name = "count_value") |> + dplyr::rename("stratum_1" = "condition_concept_id") |> dplyr::mutate(stratum_2 = NA, stratum_3 = NA, - analysis_id = 401) %>% + analysis_id = 401) |> dplyr::compute() asthma <- list(asthma = c(317009, 257581)) @@ -81,35 +81,35 @@ test_that("redshift", { cdm = cdm) result_cdm <- summariseCodeUse(asthma, cdm = cdm) - expect_equal(result_achilles %>% + expect_equal(result_achilles |> dplyr::filter(stringr::str_detect(variable_level, "317009"), - estimate_name == "record_count") %>% + estimate_name == "record_count") |> dplyr::pull("estimate_value"), - result_cdm %>% + result_cdm |> dplyr::filter(variable_level == 317009, - estimate_name == "record_count") %>% + estimate_name == "record_count") |> dplyr::pull("estimate_value")) - expect_equal(result_achilles %>% + expect_equal(result_achilles |> dplyr::filter(stringr::str_detect(variable_level, "257581"), - estimate_name == "record_count") %>% + estimate_name == "record_count") |> dplyr::pull("estimate_value"), - result_cdm %>% + result_cdm |> dplyr::filter(variable_level == 257581, - estimate_name == "record_count") %>% + estimate_name == "record_count") |> dplyr::pull("estimate_value")) - cdm$achilles_results <- cdm$condition_occurrence %>% - dplyr::group_by(person_id, condition_concept_id) %>% - dplyr::tally() %>% - dplyr::ungroup() %>% - dplyr::group_by(condition_concept_id) %>% - dplyr::tally(name = "count_value") %>% - dplyr::rename("stratum_1" = "condition_concept_id") %>% + cdm$achilles_results <- cdm$condition_occurrence |> + dplyr::group_by(person_id, condition_concept_id) |> + dplyr::tally() |> + dplyr::ungroup() |> + dplyr::group_by(condition_concept_id) |> + dplyr::tally(name = "count_value") |> + dplyr::rename("stratum_1" = "condition_concept_id") |> dplyr::mutate(stratum_2 = NA, stratum_3 = NA, - analysis_id = 400) %>% + analysis_id = 400) |> dplyr::compute() asthma <- list(asthma = c(317009, 257581)) @@ -117,22 +117,22 @@ test_that("redshift", { cdm = cdm) result_cdm <- summariseCodeUse(asthma, cdm = cdm) - expect_equal(result_achilles %>% + expect_equal(result_achilles |> dplyr::filter(stringr::str_detect(variable_level, "317009"), - estimate_name == "person_count") %>% + estimate_name == "person_count") |> dplyr::pull("estimate_value"), - result_cdm %>% + result_cdm |> dplyr::filter(variable_level == 317009, - estimate_name == "person_count") %>% + estimate_name == "person_count") |> dplyr::pull("estimate_value")) - expect_equal(result_achilles %>% + expect_equal(result_achilles |> dplyr::filter(stringr::str_detect(variable_level, "257581"), - estimate_name == "person_count") %>% + estimate_name == "person_count") |> dplyr::pull("estimate_value"), - result_cdm %>% + result_cdm |> dplyr::filter(variable_level == 257581, - estimate_name == "person_count") %>% + estimate_name == "person_count") |> dplyr::pull("estimate_value")) @@ -207,13 +207,13 @@ test_that("snowflake", { expect_no_error(getDrugIngredientCodes(cdm, "metformin")) # achilles - cdm$achilles_results <- cdm$condition_occurrence %>% - dplyr::group_by(condition_concept_id) %>% - dplyr::tally(name = "count_value") %>% - dplyr::rename("stratum_1" = "condition_concept_id") %>% + cdm$achilles_results <- cdm$condition_occurrence |> + dplyr::group_by(condition_concept_id) |> + dplyr::tally(name = "count_value") |> + dplyr::rename("stratum_1" = "condition_concept_id") |> dplyr::mutate(stratum_2 = NA, stratum_3 = NA, - analysis_id = 401) %>% + analysis_id = 401) |> dplyr::compute() asthma <- list(asthma = c(317009, 257581)) @@ -221,34 +221,34 @@ test_that("snowflake", { cdm = cdm) result_cdm <- summariseCodeUse(asthma, cdm = cdm) - expect_equal(result_achilles %>% + expect_equal(result_achilles |> dplyr::filter(variable_level == "317009", - variable_name == "record_count") %>% + variable_name == "record_count") |> dplyr::pull("estimate_value"), - result_cdm %>% + result_cdm |> dplyr::filter(variable_level == "317009", - variable_name == "record_count ") %>% + variable_name == "record_count ") |> dplyr::pull("estimate_value")) - expect_equal(result_achilles %>% + expect_equal(result_achilles |> dplyr::filter(variable_level == "257581", - variable_name == "record_count") %>% + variable_name == "record_count") |> dplyr::pull("estimate_value"), - result_cdm %>% + result_cdm |> dplyr::filter(variable_level == "257581", - variable_name == "record_count ") %>% + variable_name == "record_count ") |> dplyr::pull("estimate_value")) - cdm$achilles_results <- cdm$condition_occurrence %>% - dplyr::group_by(person_id, condition_concept_id) %>% - dplyr::tally() %>% - dplyr::ungroup() %>% - dplyr::group_by(condition_concept_id) %>% - dplyr::tally(name = "count_value") %>% - dplyr::rename("stratum_1" = "condition_concept_id") %>% + cdm$achilles_results <- cdm$condition_occurrence |> + dplyr::group_by(person_id, condition_concept_id) |> + dplyr::tally() |> + dplyr::ungroup() |> + dplyr::group_by(condition_concept_id) |> + dplyr::tally(name = "count_value") |> + dplyr::rename("stratum_1" = "condition_concept_id") |> dplyr::mutate(stratum_2 = NA, stratum_3 = NA, - analysis_id = 400) %>% + analysis_id = 400) |> dplyr::compute() asthma <- list(asthma = c(317009, 257581)) @@ -256,32 +256,32 @@ test_that("snowflake", { cdm = cdm) result_cdm <- summariseCodeUse(asthma, cdm = cdm) - expect_equal(result_achilles %>% + expect_equal(result_achilles |> dplyr::filter(variable_level == "317009", - variable_name == "record_count") %>% + variable_name == "record_count") |> dplyr::pull("estimate_value"), - result_cdm %>% + result_cdm |> dplyr::filter(variable_level == "317009", - variable_name == "record_count ") %>% + variable_name == "record_count ") |> dplyr::pull("estimate_value")) - expect_equal(result_achilles %>% + expect_equal(result_achilles |> dplyr::filter(group_level == "317009", - variable_name == "person_count") %>% + variable_name == "person_count") |> dplyr::pull("estimate_value"), - result_cdm %>% + result_cdm |> dplyr::filter(group_level == "317009", - variable_name == "person_count") %>% + variable_name == "person_count") |> dplyr::pull("estimate_value")) - expect_equal(result_achilles %>% + expect_equal(result_achilles |> dplyr::filter(group_level == "257581", - variable_name == "person_count") %>% + variable_name == "person_count") |> dplyr::pull("estimate_value"), - result_cdm %>% + result_cdm |> dplyr::filter(group_level == "257581", - variable_name == "person_count") %>% + variable_name == "person_count") |> dplyr::pull("estimate_value")) # edge cases diff --git a/tests/testthat/test-drugCodes.R b/tests/testthat/test-drugCodes.R index 87ace0e3..d433521f 100644 --- a/tests/testthat/test-drugCodes.R +++ b/tests/testthat/test-drugCodes.R @@ -273,7 +273,7 @@ test_that("no duplicate names example 1",{ concept_id = 3L, concept_synonym_name = "Osteoarthrosis" ) - )%>% + )|> dplyr::mutate(language_concept_id = NA) vocabulary <- dplyr::bind_rows( @@ -370,7 +370,7 @@ test_that("no duplicate names example 1",{ concept_id_2 = 3L, relationship_id = "Maps to" ) - ) %>% + ) |> dplyr::mutate(valid_start_date = NA, valid_end_date = NA, invalid_reason = NA) @@ -413,7 +413,7 @@ test_that("no duplicate names example 1",{ 2 ) - expect_equal(names(ingredient_list) %>% + expect_equal(names(ingredient_list) |> unique()|> length() |> as.numeric(), @@ -593,7 +593,7 @@ test_that("no duplicate names example 2",{ concept_id = 3L, concept_synonym_name = "Osteoarthrosis" ) - )%>% + )|> dplyr::mutate(language_concept_id = NA) conceptRelationship <- dplyr::bind_rows( @@ -642,7 +642,7 @@ test_that("no duplicate names example 2",{ concept_id_2 = 3L, relationship_id = "Maps to" ) - ) %>% + ) |> dplyr::mutate(valid_start_date = NA, valid_end_date = NA, invalid_reason = NA) @@ -725,7 +725,7 @@ test_that("no duplicate names example 2",{ 2 ) - expect_equal(names(atc_list) %>% + expect_equal(names(atc_list) |> unique()|> length() |> as.numeric(), diff --git a/tests/testthat/test-findUnmappedCodes.R b/tests/testthat/test-findUnmappedCodes.R index e384c7d7..0a1fa2a5 100644 --- a/tests/testthat/test-findUnmappedCodes.R +++ b/tests/testthat/test-findUnmappedCodes.R @@ -34,8 +34,8 @@ test_that("achilles code use", { a<- candidateCodes - a<-cdm$condition_occurrence %>% - dplyr::filter(condition_concept_id == 0) %>% + a<-cdm$condition_occurrence |> + dplyr::filter(condition_concept_id == 0) |> dplyr::collect() diff --git a/tests/testthat/test-getCandidateCodes.R b/tests/testthat/test-getCandidateCodes.R index 3da5927c..3675d5d1 100644 --- a/tests/testthat/test-getCandidateCodes.R +++ b/tests/testthat/test-getCandidateCodes.R @@ -34,10 +34,10 @@ test_that("tests with mock db", { ) expect_true(nrow(codes) == 2) expect_true("Osteoarthritis of knee" %in% - (codes %>% + (codes |> dplyr::pull("concept_name"))) expect_true("Osteoarthritis of hip" %in% - (codes %>% + (codes |> dplyr::pull("concept_name"))) # test include descendants diff --git a/tests/testthat/test-getICD10StandardCodes.R b/tests/testthat/test-getICD10StandardCodes.R index 0c8e4a0d..f034d658 100644 --- a/tests/testthat/test-getICD10StandardCodes.R +++ b/tests/testthat/test-getICD10StandardCodes.R @@ -59,7 +59,7 @@ test_that("db without icd10 codes loaded", { backends <- c("database", "data_frame") for (i in seq_along(backends)) { cdm <- mockVocabRef(backend = backends[i]) - cdm$concept <- cdm$concept %>% + cdm$concept <- cdm$concept |> dplyr::filter(vocabulary_id != "ICD10") expect_message(codes <- getICD10StandardCodes(cdm = cdm)) expect_true(length(codes) == 0) diff --git a/tests/testthat/test-mockVocabRef.R b/tests/testthat/test-mockVocabRef.R index d8dea926..a07bb39c 100644 --- a/tests/testthat/test-mockVocabRef.R +++ b/tests/testthat/test-mockVocabRef.R @@ -2,8 +2,8 @@ test_that("mock vocab db", { cdmDb <- mockVocabRef("database") cdmDF <- mockVocabRef("data_frame") - conceptFromDb <- cdmDb$concept %>% dplyr::collect() - conceptFromDf <- cdmDF$concept %>% dplyr::collect() + conceptFromDb <- cdmDb$concept |> dplyr::collect() + conceptFromDf <- cdmDF$concept |> dplyr::collect() expect_equal(conceptFromDb, conceptFromDf, diff --git a/tests/testthat/test-summariseAchillesCodeUse.R b/tests/testthat/test-summariseAchillesCodeUse.R index 377377cd..63f0e786 100644 --- a/tests/testthat/test-summariseAchillesCodeUse.R +++ b/tests/testthat/test-summariseAchillesCodeUse.R @@ -8,15 +8,15 @@ test_that("achilles code use", { # two codes: "Osteoarthritis of knee" "Osteoarthritis of hip" result_achilles <- summariseAchillesCodeUse(list(oa = oa$concept_id), cdm = cdm) - expect_true(result_achilles %>% - dplyr::filter(stringr::str_detect(variable_level, "4")) %>% + expect_true(result_achilles |> + dplyr::filter(stringr::str_detect(variable_level, "4")) |> dplyr::pull("estimate_value") == "400") - expect_true(result_achilles %>% - dplyr::filter(stringr::str_detect(variable_level, "5")) %>% + expect_true(result_achilles |> + dplyr::filter(stringr::str_detect(variable_level, "5")) |> dplyr::pull("estimate_value") == "200") expect_true(nrow(result_achilles) == 2) expect_equal(c("oa", "oa"), - result_achilles %>% + result_achilles |> dplyr::pull("group_level")) # check is a summarised result @@ -25,9 +25,10 @@ test_that("achilles code use", { # applying min cell count where estimate should be obscured result_achilles <- summariseAchillesCodeUse(list(oa = oa$concept_id), cdm = cdm) - expect_true(all(is.na(result_achilles %>% - omopgenerics::suppress(minCellCount = 500) %>% - dplyr::pull("estimate_value")))) + expect_true(all(result_achilles |> + omopgenerics::suppress(minCellCount = 500) |> + dplyr::pull("estimate_value") == "-" + )) # edge cases @@ -59,21 +60,21 @@ test_that("achilles code use: multipe codelists", { hip_oa = 5), cdm = cdm) - expect_true(result_achilles %>% - dplyr::filter(group_level == "knee_oa") %>% + expect_true(result_achilles |> + dplyr::filter(group_level == "knee_oa") |> dplyr::pull("estimate_value") == "400") - expect_true(result_achilles %>% - dplyr::filter(group_level == "hip_oa") %>% + expect_true(result_achilles |> + dplyr::filter(group_level == "hip_oa") |> dplyr::pull("estimate_value") == "200") - expect_true(result_achilles %>% - dplyr::filter(stringr::str_detect(variable_level, "4")) %>% + expect_true(result_achilles |> + dplyr::filter(stringr::str_detect(variable_level, "4")) |> dplyr::pull("estimate_value") == "400") - expect_true(result_achilles %>% - dplyr::filter(stringr::str_detect(variable_level, "5")) %>% + expect_true(result_achilles |> + dplyr::filter(stringr::str_detect(variable_level, "5")) |> dplyr::pull("estimate_value") == "200") expect_true(nrow(result_achilles) == 2) expect_equal(c("knee_oa", "hip_oa"), - result_achilles %>% + result_achilles |> dplyr::pull("group_level")) CDMConnector::cdm_disconnect(cdm) diff --git a/tests/testthat/test-summariseCodeUse.R b/tests/testthat/test-summariseCodeUse.R index 3e456b41..5d430c42 100644 --- a/tests/testthat/test-summariseCodeUse.R +++ b/tests/testthat/test-summariseCodeUse.R @@ -30,16 +30,15 @@ skip_on_cran() # min cell counts: expect_true( - all(is.na( + all( omopgenerics::suppress(results) |> dplyr::filter( variable_name == "overall", strata_level == "1909", group_level == "acetiminophen" ) |> - dplyr::pull("estimate_value") - )) - ) + dplyr::pull("estimate_value") == "-" + )) # check is a summarised result expect_true("summarised_result" %in% class(results)) @@ -47,129 +46,129 @@ skip_on_cran() colnames(results)) # overall record count - expect_true(results %>% + expect_true(results |> dplyr::filter(group_name == "codelist_name" & strata_name == "overall" & strata_level == "overall" & group_level == "acetiminophen" & estimate_name == "record_count", - variable_name == "overall") %>% + variable_name == "overall") |> dplyr::pull("estimate_value") |> as.numeric() == - cdm$drug_exposure %>% - dplyr::filter(drug_concept_id %in% acetiminophen) %>% - dplyr::tally() %>% + cdm$drug_exposure |> + dplyr::filter(drug_concept_id %in% acetiminophen) |> + dplyr::tally() |> dplyr::pull("n")) # overall person count - expect_true(results %>% + expect_true(results |> dplyr::filter(group_name == "codelist_name" & strata_name == "overall" & strata_level == "overall" & group_level == "acetiminophen" & estimate_name == "person_count", - variable_name == "overall") %>% + variable_name == "overall") |> dplyr::pull("estimate_value") |> as.numeric() == - cdm$drug_exposure %>% - dplyr::filter(drug_concept_id %in% acetiminophen) %>% - dplyr::select("person_id") %>% - dplyr::distinct() %>% - dplyr::tally() %>% + cdm$drug_exposure |> + dplyr::filter(drug_concept_id %in% acetiminophen) |> + dplyr::select("person_id") |> + dplyr::distinct() |> + dplyr::tally() |> dplyr::pull("n")) # by year # overall record count - expect_true(results %>% + expect_true(results |> dplyr::filter(group_name == "codelist_name" & strata_name == "year" & strata_level == "2008" & group_level == "acetiminophen" & estimate_name == "record_count", - variable_name == "overall") %>% + variable_name == "overall") |> dplyr::pull("estimate_value") |> as.numeric() == - cdm$drug_exposure %>% - dplyr::filter(drug_concept_id %in% acetiminophen) %>% - dplyr::filter(year(drug_exposure_start_date) == 2008) %>% - dplyr::tally() %>% + cdm$drug_exposure |> + dplyr::filter(drug_concept_id %in% acetiminophen) |> + dplyr::filter(year(drug_exposure_start_date) == 2008) |> + dplyr::tally() |> dplyr::pull("n")) # overall person count - expect_true(results %>% + expect_true(results |> dplyr::filter(group_name == "codelist_name" & strata_name == "year" & strata_level == "2008" & group_level == "acetiminophen" & estimate_name == "person_count", - variable_name == "overall") %>% + variable_name == "overall") |> dplyr::pull("estimate_value") |> as.numeric() == - cdm$drug_exposure %>% - dplyr::filter(drug_concept_id %in% acetiminophen) %>% - dplyr::filter(year(drug_exposure_start_date) == 2008) %>% - dplyr::select("person_id") %>% - dplyr::distinct() %>% - dplyr::tally() %>% + cdm$drug_exposure |> + dplyr::filter(drug_concept_id %in% acetiminophen) |> + dplyr::filter(year(drug_exposure_start_date) == 2008) |> + dplyr::select("person_id") |> + dplyr::distinct() |> + dplyr::tally() |> dplyr::pull("n")) # by age group and sex # overall record count - expect_true(results %>% + expect_true(results |> dplyr::filter(group_name == "codelist_name" & strata_name == "sex" & strata_level == "Male" & group_level == "acetiminophen" & estimate_name == "record_count", - variable_name == "overall") %>% + variable_name == "overall") |> dplyr::pull("estimate_value") |> as.numeric() == - cdm$drug_exposure %>% - dplyr::filter(drug_concept_id %in% acetiminophen) %>% - PatientProfiles::addSex() %>% - dplyr::filter(sex == "Male") %>% - dplyr::tally() %>% + cdm$drug_exposure |> + dplyr::filter(drug_concept_id %in% acetiminophen) |> + PatientProfiles::addSex() |> + dplyr::filter(sex == "Male") |> + dplyr::tally() |> dplyr::pull("n")) - expect_true(results %>% + expect_true(results |> dplyr::filter(group_name == "codelist_name" & strata_name == "age_group &&& sex" & strata_level == "18 to 65 &&& Male" & group_level == "acetiminophen" & estimate_name == "record_count", - variable_name == "overall") %>% + variable_name == "overall") |> dplyr::pull("estimate_value") |> as.numeric() == - cdm$drug_exposure %>% - dplyr::filter(drug_concept_id %in% acetiminophen) %>% - PatientProfiles::addAge(indexDate = "drug_exposure_start_date") %>% - PatientProfiles::addSex() %>% + cdm$drug_exposure |> + dplyr::filter(drug_concept_id %in% acetiminophen) |> + PatientProfiles::addAge(indexDate = "drug_exposure_start_date") |> + PatientProfiles::addSex() |> dplyr::filter(sex == "Male" & age >= "18" & - age <= "65") %>% - dplyr::tally() %>% + age <= "65") |> + dplyr::tally() |> dplyr::pull("n")) # overall person count - expect_true(results %>% + expect_true(results |> dplyr::filter(group_name == "codelist_name" & strata_name == "age_group &&& sex" & strata_level == "18 to 65 &&& Male" & group_level == "acetiminophen" & estimate_name == "person_count", - variable_name == "overall") %>% + variable_name == "overall") |> dplyr::pull("estimate_value") |> as.numeric() == - cdm$drug_exposure %>% - dplyr::filter(drug_concept_id %in% acetiminophen) %>% - PatientProfiles::addAge(indexDate = "drug_exposure_start_date") %>% - PatientProfiles::addSex() %>% + cdm$drug_exposure |> + dplyr::filter(drug_concept_id %in% acetiminophen) |> + PatientProfiles::addAge(indexDate = "drug_exposure_start_date") |> + PatientProfiles::addSex() |> dplyr::filter(sex == "Male" & age >= "18" & - age <= "65") %>% - dplyr::select("person_id") %>% - dplyr::distinct() %>% - dplyr::tally() %>% + age <= "65") |> + dplyr::select("person_id") |> + dplyr::distinct() |> + dplyr::tally() |> dplyr::pull("n")) results <- summariseCodeUse(list("acetiminophen" = acetiminophen), @@ -177,9 +176,9 @@ skip_on_cran() byYear = FALSE, bySex = FALSE, ageGroup = NULL) - expect_true(nrow(results %>% + expect_true(nrow(results |> dplyr::filter(estimate_name == "person_count")) > 0) - expect_true(nrow(results %>% + expect_true(nrow(results |> dplyr::filter(estimate_name == "record_count")) == 0) results <- summariseCodeUse(list("acetiminophen" = acetiminophen), @@ -187,9 +186,9 @@ skip_on_cran() byYear = FALSE, bySex = FALSE, ageGroup = NULL) - expect_true(nrow(results %>% + expect_true(nrow(results |> dplyr::filter(estimate_name == "person_count")) == 0) - expect_true(nrow(results %>% + expect_true(nrow(results |> dplyr::filter(estimate_name == "record_count")) > 0) # domains covered @@ -322,21 +321,21 @@ test_that("summarise cohort code use - eunomia", { timing = "any") expect_true(inherits(results_cohort, "summarised_result")) - expect_true(all(colnames(omopgenerics::settings(results_cohort)) %in% - c("result_id", "result_type", "package_name", "package_version", "timing"))) + expect_true(all(c("result_id", "result_type", "package_name", "package_version", "timing") %in% + colnames(omopgenerics::settings(results_cohort)))) - expect_true(results_cohort %>% + expect_true(results_cohort |> dplyr::filter(variable_name == "overall" & strata_name == "overall" & strata_level == "overall" & - estimate_name == "person_count") %>% + estimate_name == "person_count") |> dplyr::pull("estimate_value") |> as.numeric() < - results_all %>% + results_all |> dplyr::filter(variable_name == "overall" & strata_name == "overall" & strata_level == "overall" & - estimate_name == "person_count") %>% + estimate_name == "person_count") |> dplyr::pull("estimate_value") |> as.numeric()) @@ -348,39 +347,39 @@ test_that("summarise cohort code use - eunomia", { cdm = cdm, cohortTable = "pharyngitis", timing = "entry") - results_cohort %>% + results_cohort |> dplyr::filter(variable_name == "overall" & strata_name == "overall" & strata_level == "overall" & - estimate_name == "person_count") %>% + estimate_name == "person_count") |> dplyr::pull("estimate_value") |> as.numeric() == - CDMConnector::cohortCount(cdm$pharyngitis) %>% + CDMConnector::cohortCount(cdm$pharyngitis) |> dplyr::pull("number_subjects") # 260139 # on index - index_260139 <- cdm$pharyngitis %>% + index_260139 <- cdm$pharyngitis |> dplyr::left_join(cdm$condition_occurrence, - by=c("subject_id"="person_id")) %>% - dplyr::filter(condition_start_date == cohort_start_date) %>% - dplyr::filter(condition_concept_id == 260139) %>% - dplyr::select("subject_id") %>% - dplyr::distinct() %>% - dplyr::count() %>% + by=c("subject_id"="person_id")) |> + dplyr::filter(condition_start_date == cohort_start_date) |> + dplyr::filter(condition_concept_id == 260139) |> + dplyr::select("subject_id") |> + dplyr::distinct() |> + dplyr::count() |> dplyr::pull() results_cohort_260139 <- summariseCohortCodeUse(list(cs = 260139), cdm = cdm, cohortTable = "pharyngitis", timing = "entry") - expect_equal(results_cohort_260139 %>% + expect_equal(results_cohort_260139 |> dplyr::filter(variable_name == "overall" & strata_name == "overall" & strata_level == "overall" & - estimate_name == "person_count") %>% + estimate_name == "person_count") |> dplyr::pull("estimate_value") |> as.numeric(), index_260139) @@ -388,39 +387,39 @@ test_that("summarise cohort code use - eunomia", { # 260139 or 19133873 or 1127433 # on index index_260139_19133873_1127433 <- dplyr::union_all( - cdm$pharyngitis %>% + cdm$pharyngitis |> dplyr::left_join(cdm$condition_occurrence, - by=c("subject_id"="person_id")) %>% - dplyr::filter(condition_start_date == cohort_start_date) %>% - dplyr::filter(condition_concept_id == 260139) %>% + by=c("subject_id"="person_id")) |> + dplyr::filter(condition_start_date == cohort_start_date) |> + dplyr::filter(condition_concept_id == 260139) |> dplyr::select("subject_id"), - cdm$pharyngitis %>% + cdm$pharyngitis |> dplyr::left_join(cdm$drug_exposure, - by=c("subject_id"="person_id")) %>% - dplyr::filter(drug_exposure_start_date == cohort_start_date) %>% - dplyr::filter(drug_concept_id %in% c(19133873,1127433)) %>% - dplyr::select("subject_id")) %>% - dplyr::count() %>% + by=c("subject_id"="person_id")) |> + dplyr::filter(drug_exposure_start_date == cohort_start_date) |> + dplyr::filter(drug_concept_id %in% c(19133873,1127433)) |> + dplyr::select("subject_id")) |> + dplyr::count() |> dplyr::pull() results_cohort_260139_19133873_1127433<- summariseCohortCodeUse(list(cs = c(260139,19133873,1127433)), cdm = cdm, cohortTable = "pharyngitis", timing = "entry") - expect_equal(results_cohort_260139_19133873_1127433 %>% + expect_equal(results_cohort_260139_19133873_1127433 |> dplyr::filter(variable_name == "overall" & strata_name == "overall" & strata_level == "overall" & - estimate_name == "record_count") %>% + estimate_name == "record_count") |> dplyr::pull("estimate_value") |> as.numeric(), index_260139_19133873_1127433) - expect_equal(results_cohort_260139_19133873_1127433 %>% - dplyr::filter(stringr::str_detect(variable_name, "Acute bronchitis")) %>% + expect_equal(results_cohort_260139_19133873_1127433 |> + dplyr::filter(stringr::str_detect(variable_name, "Acute bronchitis")) |> dplyr::filter(strata_name == "overall" & strata_level == "overall" & - estimate_name == "person_count") %>% + estimate_name == "person_count") |> dplyr::pull("estimate_value") |> as.numeric(), index_260139) @@ -438,23 +437,23 @@ test_that("summarise cohort code use - eunomia", { cdm = cdm, cohortTable = "cohorts", timing = "entry") - expect_true(nrow(results_cohort_mult %>% - dplyr::filter(stringr::str_detect(variable_name, "Acute bronchitis")) %>% + expect_true(nrow(results_cohort_mult |> + dplyr::filter(stringr::str_detect(variable_name, "Acute bronchitis")) |> dplyr::filter(strata_name == "overall" & strata_level == "overall" & estimate_name == "person_count")) == 2) - expect_equal(c("a", "b"), results_cohort_mult %>% - dplyr::filter(stringr::str_detect(variable_name, "Acute bronchitis")) %>% + expect_equal(c("a", "b"), results_cohort_mult |> + dplyr::filter(stringr::str_detect(variable_name, "Acute bronchitis")) |> dplyr::filter(strata_name == "overall" & strata_level == "overall" & - estimate_name == "person_count") %>% - visOmopResults::splitGroup() %>% + estimate_name == "person_count") |> + visOmopResults::splitGroup() |> dplyr::pull("cohort_name")) # empty cohort - no results - cdm$pharyngitis <- cdm$pharyngitis %>% + cdm$pharyngitis <- cdm$pharyngitis |> dplyr::filter(cohort_definition_id == 99) expect_true(nrow(summariseCohortCodeUse(list(cs = 4134304), cdm = cdm, @@ -515,115 +514,115 @@ test_that("summarise code use - redshift", { expect_true(inherits(results, "summarised_result")) # overall record count - expect_true(results %>% + expect_true(results |> dplyr::filter(variable_name == "overall" & strata_name == "overall" & strata_level == "overall", - estimate_name == "record_count") %>% - dplyr::pull("estimate_value") %>% + estimate_name == "record_count") |> + dplyr::pull("estimate_value") |> as.numeric() == - cdm$condition_occurrence %>% - dplyr::filter(condition_concept_id %in% !!asthma[[1]]) %>% - dplyr::tally() %>% + cdm$condition_occurrence |> + dplyr::filter(condition_concept_id %in% !!asthma[[1]]) |> + dplyr::tally() |> dplyr::pull("n")) # overall person count - expect_true(results %>% + expect_true(results |> dplyr::filter(variable_name == "overall" & strata_name == "overall" & strata_level == "overall" & - estimate_name == "person_count") %>% - dplyr::pull("estimate_value") %>% + estimate_name == "person_count") |> + dplyr::pull("estimate_value") |> as.numeric() == - cdm$condition_occurrence %>% - dplyr::filter(condition_concept_id %in% !!asthma[[1]]) %>% - dplyr::select("person_id") %>% - dplyr::distinct() %>% - dplyr::tally() %>% + cdm$condition_occurrence |> + dplyr::filter(condition_concept_id %in% !!asthma[[1]]) |> + dplyr::select("person_id") |> + dplyr::distinct() |> + dplyr::tally() |> dplyr::pull("n")) # by year # overall record count - expect_true(results %>% + expect_true(results |> dplyr::filter(variable_name == "overall" & strata_name == "year" & strata_level == "2008", - estimate_name == "record_count") %>% - dplyr::pull("estimate_value") %>% + estimate_name == "record_count") |> + dplyr::pull("estimate_value") |> as.numeric() == - cdm$condition_occurrence %>% - dplyr::filter(condition_concept_id %in% !!asthma[[1]]) %>% - dplyr::filter(year(condition_start_date) == 2008) %>% - dplyr::tally() %>% + cdm$condition_occurrence |> + dplyr::filter(condition_concept_id %in% !!asthma[[1]]) |> + dplyr::filter(year(condition_start_date) == 2008) |> + dplyr::tally() |> dplyr::pull("n")) # overall person count - expect_true(results %>% + expect_true(results |> dplyr::filter(variable_name == "overall" & strata_name == "year" & strata_level == "2008", - estimate_name == "person_count") %>% - dplyr::pull("estimate_value") %>% + estimate_name == "person_count") |> + dplyr::pull("estimate_value") |> as.numeric() == - cdm$condition_occurrence %>% - dplyr::filter(condition_concept_id %in% !!asthma[[1]]) %>% - dplyr::filter(year(condition_start_date) == 2008) %>% - dplyr::select("person_id") %>% - dplyr::distinct() %>% - dplyr::tally() %>% + cdm$condition_occurrence |> + dplyr::filter(condition_concept_id %in% !!asthma[[1]]) |> + dplyr::filter(year(condition_start_date) == 2008) |> + dplyr::select("person_id") |> + dplyr::distinct() |> + dplyr::tally() |> dplyr::pull("n")) # by age group and sex # overall record count - expect_true(results %>% + expect_true(results |> dplyr::filter(variable_name == "overall" & strata_name == "sex" & strata_level == "Male", - estimate_name == "record_count") %>% - dplyr::pull("estimate_value") %>% + estimate_name == "record_count") |> + dplyr::pull("estimate_value") |> as.numeric() == - cdm$condition_occurrence %>% - dplyr::filter(condition_concept_id %in% !!asthma[[1]]) %>% - PatientProfiles::addSex() %>% - dplyr::filter(sex == "Male") %>% - dplyr::tally() %>% + cdm$condition_occurrence |> + dplyr::filter(condition_concept_id %in% !!asthma[[1]]) |> + PatientProfiles::addSex() |> + dplyr::filter(sex == "Male") |> + dplyr::tally() |> dplyr::pull("n")) - expect_true(results %>% + expect_true(results |> dplyr::filter(variable_name == "overall" & strata_name == "age_group &&& sex" & strata_level == "18 to 65 &&& Male", - estimate_name == "record_count") %>% - dplyr::pull("estimate_value") %>% + estimate_name == "record_count") |> + dplyr::pull("estimate_value") |> as.numeric() == - cdm$condition_occurrence %>% - dplyr::filter(condition_concept_id %in% !!asthma[[1]]) %>% - PatientProfiles::addAge(indexDate = "condition_start_date") %>% - PatientProfiles::addSex() %>% + cdm$condition_occurrence |> + dplyr::filter(condition_concept_id %in% !!asthma[[1]]) |> + PatientProfiles::addAge(indexDate = "condition_start_date") |> + PatientProfiles::addSex() |> dplyr::filter(sex == "Male" & age >= "18" & - age <= "65") %>% - dplyr::tally() %>% + age <= "65") |> + dplyr::tally() |> dplyr::pull("n")) # overall person count - expect_true(results %>% + expect_true(results |> dplyr::filter(variable_name == "overall" & strata_name == "age_group &&& sex" & strata_level == "18 to 65 &&& Male", - estimate_name == "person_count") %>% - dplyr::pull("estimate_value") %>% + estimate_name == "person_count") |> + dplyr::pull("estimate_value") |> as.numeric() == - cdm$condition_occurrence %>% - dplyr::filter(condition_concept_id %in% !!asthma[[1]]) %>% - PatientProfiles::addAge(indexDate = "condition_start_date") %>% - PatientProfiles::addSex() %>% + cdm$condition_occurrence |> + dplyr::filter(condition_concept_id %in% !!asthma[[1]]) |> + PatientProfiles::addAge(indexDate = "condition_start_date") |> + PatientProfiles::addSex() |> dplyr::filter(sex == "Male" & age >= "18" & - age <= "65") %>% - dplyr::select("person_id") %>% - dplyr::distinct() %>% - dplyr::tally() %>% + age <= "65") |> + dplyr::select("person_id") |> + dplyr::distinct() |> + dplyr::tally() |> dplyr::pull("n")) @@ -634,9 +633,9 @@ test_that("summarise code use - redshift", { byYear = FALSE, bySex = FALSE, ageGroup = NULL) - expect_true(nrow(results %>% + expect_true(nrow(results |> dplyr::filter(estimate_name == "person_count")) > 0) - expect_true(nrow(results %>% + expect_true(nrow(results |> dplyr::filter(estimate_name == "record_count")) == 0) results <- summariseCodeUse(asthma, @@ -644,9 +643,9 @@ test_that("summarise code use - redshift", { byYear = FALSE, bySex = FALSE, ageGroup = NULL) - expect_true(nrow(results %>% + expect_true(nrow(results |> dplyr::filter(estimate_name == "person_count")) == 0) - expect_true(nrow(results %>% + expect_true(nrow(results |> dplyr::filter(estimate_name == "record_count")) > 0) @@ -741,6 +740,77 @@ expect_true(nrow(results) == 0) }) +test_that("summarise code use - eunomia source concept id NA", { + skip_on_cran() + if (Sys.getenv("EUNOMIA_DATA_FOLDER") == "") { + Sys.setenv("EUNOMIA_DATA_FOLDER" = tempdir()) + } + if (!dir.exists(Sys.getenv("EUNOMIA_DATA_FOLDER"))) { + dir.create(Sys.getenv("EUNOMIA_DATA_FOLDER")) + } + if (!CDMConnector::eunomia_is_available()) { + invisible(utils::capture.output(CDMConnector::downloadEunomiaData(pathToData = Sys.getenv("EUNOMIA_DATA_FOLDER")))) + } + con <- DBI::dbConnect(duckdb::duckdb(), dbdir = CDMConnector::eunomia_dir()) + cdm <- CDMConnector::cdm_from_con(con, cdm_schem = "main", write_schema = "main") + + acetiminophen <- c(1125315, 1127433, 40229134, + 40231925, 40162522, 19133768, 1127078) + + cdm$drug_exposure <- cdm$drug_exposure |> + dplyr::mutate(drug_source_concept_id = NA_character_) + cs <- list(acetiminophen = acetiminophen) + results <- summariseCodeUse(cs, + cdm = cdm) + + expect_true(all(omopgenerics::splitAdditional(results) |> + dplyr::filter(variable_name != "overall") |> + dplyr::pull("source_concept_name") == "NA")) + expect_true(all(omopgenerics::splitAdditional(results) |> + dplyr::filter(variable_name != "overall") |> + dplyr::pull("source_concept_id") == "NA")) + CDMConnector::cdmDisconnect(cdm) +}) +test_that("summarise cohort code use - eunomia source concept id NA", { + skip_on_cran() + if (Sys.getenv("EUNOMIA_DATA_FOLDER") == "") { + Sys.setenv("EUNOMIA_DATA_FOLDER" = tempdir()) + } + if (!dir.exists(Sys.getenv("EUNOMIA_DATA_FOLDER"))) { + dir.create(Sys.getenv("EUNOMIA_DATA_FOLDER")) + } + if (!CDMConnector::eunomia_is_available()) { + invisible(utils::capture.output(CDMConnector::downloadEunomiaData(pathToData = Sys.getenv("EUNOMIA_DATA_FOLDER")))) + } + con <- DBI::dbConnect(duckdb::duckdb(), dbdir = CDMConnector::eunomia_dir()) + cdm <- CDMConnector::cdm_from_con(con, cdm_schem = "main", write_schema = "main") + + pharyngitis <- c(4112343) + + cdm$condition_occurrence <- cdm$condition_occurrence |> + dplyr::mutate(condition_source_concept_id = NA_character_) + + cdm <- CDMConnector::generateConceptCohortSet(cdm = cdm, + conceptSet = list(pharyngitis = pharyngitis), + name = "pharyngitis", + end = "observation_period_end_date", + overwrite = TRUE) + + results_cohort <- summariseCohortCodeUse(list(cs = 4134304), + cdm = cdm, + cohortTable = "pharyngitis", + timing = "any") + + expect_true(all(omopgenerics::splitAdditional(results_cohort) |> + dplyr::filter(variable_name != "overall") |> + dplyr::pull("source_concept_name") == "NA")) + expect_true(all(omopgenerics::splitAdditional(results_cohort) |> + dplyr::filter(variable_name != "overall") |> + dplyr::pull("source_concept_id") == "NA")) + + CDMConnector::cdmDisconnect(cdm) + +}) diff --git a/tests/testthat/test-summariseOrphanCodes.R b/tests/testthat/test-summariseOrphanCodes.R index ba8fad2b..252ecbe9 100644 --- a/tests/testthat/test-summariseOrphanCodes.R +++ b/tests/testthat/test-summariseOrphanCodes.R @@ -13,9 +13,9 @@ test_that("tests with mock db", { cdm = cdm) # we should pick up knee osteoarthritis from our achilles tables - expect_true(all(stringr::str_detect(orphan_codes %>% + expect_true(all(stringr::str_detect(orphan_codes |> dplyr::pull("variable_level"), c("4", "5")))) - expect_equal(orphan_codes %>% + expect_equal(orphan_codes |> dplyr::pull("estimate_value"), c("400", "200")) settings <- omopgenerics::settings(orphan_codes) diff --git a/tests/testthat/test-tableAchillesCodeUse.R b/tests/testthat/test-tableAchillesCodeUse.R index e7a0db3d..d55a6ce1 100644 --- a/tests/testthat/test-tableAchillesCodeUse.R +++ b/tests/testthat/test-tableAchillesCodeUse.R @@ -21,14 +21,14 @@ test_that("table achilles code use expcted columns", { tableAchillesCodeUse(result = result, type = "flextable", header = c("cdm_name", "estimate_name"), - groupColumns = "codelist_name", + groupColumn = "codelist_name", hide = c("standard_concept", "standard_concept_id", "vocabulary_id"), .options = list()) tableAchillesCodeUse(result = result, type = "flextable", header = c("estimate_name"), - groupColumns = "codelist_name", + groupColumn = "codelist_name", hide = c("cdm_name"), .options = list(includeHeaderName = FALSE)) @@ -36,7 +36,7 @@ test_that("table achilles code use expcted columns", { expect_error(tableAchillesCodeUse(result, type = "gt", header = c("cdm_name", "estimate_name"), - groupColumns = "estimate_name", + groupColumn = "estimate_name", .options = list())) # empty result @@ -50,7 +50,8 @@ test_that("table achilles code use expcted columns", { "condition_start_date" = as.Date("2000-01-01"), "condition_type_concept_id" = 1L, "condition_concept_id" = 4, - "condition_source_concept_id" = 1) + "condition_source_concept_id" = 1, + "condition_source_value" = "a") cdm <- omopgenerics::insertTable(cdm, name = "condition_occurrence", table = cond) @@ -88,7 +89,8 @@ test_that("test table orphan codes work", { "condition_start_date" = as.Date("2000-01-01"), "condition_type_concept_id" = 1L, "condition_concept_id" = 4, - "condition_source_concept_id" = 1) + "condition_source_concept_id" = 1, + "condition_source_value" = "a") cdm <- omopgenerics::insertTable(cdm, name = "condition_occurrence", table = cond) diff --git a/vignettes/a01_Introduction_to_CodelistGenerator.Rmd b/vignettes/a01_Introduction_to_CodelistGenerator.Rmd index 7ccd5256..a7d531be 100644 --- a/vignettes/a01_Introduction_to_CodelistGenerator.Rmd +++ b/vignettes/a01_Introduction_to_CodelistGenerator.Rmd @@ -71,19 +71,19 @@ codesFromDescendants <- tbl( vocabularyDatabaseSchema, ".concept_ancestor" )) -) %>% - filter(ancestor_concept_id == "4182210") %>% - select("descendant_concept_id") %>% - rename("concept_id" = "descendant_concept_id") %>% +) |> + filter(ancestor_concept_id == "4182210") |> + select("descendant_concept_id") |> + rename("concept_id" = "descendant_concept_id") |> left_join(tbl(db, sql(paste0( "SELECT * FROM ", vocabularyDatabaseSchema, ".concept" - )))) %>% + )))) |> select( "concept_id", "concept_name", "domain_id", "vocabulary_id" - ) %>% + ) |> collect() ``` @@ -93,7 +93,7 @@ codesFromDescendants <- readRDS(system.file("introData01.RData", ``` ```{r, message=FALSE, warning=FALSE } -codesFromDescendants %>% +codesFromDescendants |> glimpse() ``` @@ -118,7 +118,7 @@ dementiaCodes1 <- readRDS(system.file("introData02.RData", ``` ```{r, message=FALSE, warning=FALSE } -dementiaCodes1%>% +dementiaCodes1|> glimpse() ``` @@ -138,15 +138,15 @@ codeComparison <- readRDS(system.file("introData03.RData", ``` ```{r, message=FALSE, warning=FALSE } -codeComparison %>% - group_by(codelist) %>% +codeComparison |> + group_by(codelist) |> tally() ``` What are these extra codes picked up by CodelistGenerator? ```{r, message=FALSE, warning=FALSE } -codeComparison %>% - filter(codelist == "Only codelist 2") %>% +codeComparison |> + filter(codelist == "Only codelist 2") |> glimpse() ``` @@ -167,7 +167,7 @@ icdMappings <- getMappings( ``` ```{r, message=FALSE, warning=FALSE } -icdMappings %>% +icdMappings |> glimpse() ``` @@ -186,6 +186,6 @@ readMappings <- getMappings( ``` ```{r, message=FALSE, warning=FALSE } -readMappings %>% +readMappings |> glimpse() ``` diff --git a/vignettes/a02_Candidate_codes_OA.Rmd b/vignettes/a02_Candidate_codes_OA.Rmd index 28a1db2c..a92c74c4 100644 --- a/vignettes/a02_Candidate_codes_OA.Rmd +++ b/vignettes/a02_Candidate_codes_OA.Rmd @@ -86,7 +86,7 @@ oaCodes1 <- getCandidateCodes( What is the candidate codelist? ```{r, message=FALSE, warning=FALSE } -oaCodes1 %>% +oaCodes1 |> glimpse() ``` @@ -116,11 +116,11 @@ oaCodes2 <- getCandidateCodes( What new codes do we pick up? ```{r, message=FALSE, warning=FALSE } -newCodes1To2 <- compareCodelists(oaCodes1, oaCodes2) %>% - filter(codelist == "Only codelist 2") %>% +newCodes1To2 <- compareCodelists(oaCodes1, oaCodes2) |> + filter(codelist == "Only codelist 2") |> select(-"codelist") -newCodes1To2 %>% +newCodes1To2 |> glimpse() ``` @@ -149,11 +149,11 @@ oaCodes3 <- getCandidateCodes( What new codes do we pick up? ```{r, message=FALSE, warning=FALSE } -newCodes1To3 <- compareCodelists(oaCodes1, oaCodes3) %>% - filter(codelist == "Only codelist 2") %>% +newCodes1To3 <- compareCodelists(oaCodes1, oaCodes3) |> + filter(codelist == "Only codelist 2") |> select(-"codelist") -newCodes1To3 %>% +newCodes1To3 |> glimpse() ``` @@ -182,11 +182,11 @@ oaCodes4 <- getCandidateCodes( What new codes do we pick up? ```{r, message=FALSE, warning=FALSE } -newCodes1To4 <- compareCodelists(oaCodes1, oaCodes4) %>% - filter(codelist == "Only codelist 2") %>% +newCodes1To4 <- compareCodelists(oaCodes1, oaCodes4) |> + filter(codelist == "Only codelist 2") |> select(-"codelist") -newCodes1To4 %>% +newCodes1To4 |> glimpse() ``` @@ -215,11 +215,11 @@ oaCodes5 <- getCandidateCodes( What new codes do we pick up? ```{r, message=FALSE, warning=FALSE } -newCodes1To5 <- compareCodelists(oaCodes1, oaCodes5) %>% - filter(codelist == "Only codelist 2") %>% +newCodes1To5 <- compareCodelists(oaCodes1, oaCodes5) |> + filter(codelist == "Only codelist 2") |> select(-"codelist") -newCodes1To5 %>% +newCodes1To5 |> glimpse() ``` @@ -248,10 +248,10 @@ oaCodes8 <- getCandidateCodes( What new codes do we pick up? ```{r, message=FALSE, warning=FALSE } -newCodes1To8 <- compareCodelists(oaCodes1, oaCodes8) %>% - filter(codelist == "Only codelist 2") %>% +newCodes1To8 <- compareCodelists(oaCodes1, oaCodes8) |> + filter(codelist == "Only codelist 2") |> select(-"codelist") -newCodes1To8 %>% +newCodes1To8 |> glimpse() ``` diff --git a/vignettes/a03_Options_for_CodelistGenerator.Rmd b/vignettes/a03_Options_for_CodelistGenerator.Rmd index 1d6c2ed1..d345a71d 100644 --- a/vignettes/a03_Options_for_CodelistGenerator.Rmd +++ b/vignettes/a03_Options_for_CodelistGenerator.Rmd @@ -48,7 +48,7 @@ codes <- getCandidateCodes( includeDescendants = FALSE, ) -codes %>% +codes |> glimpse() ``` @@ -61,7 +61,7 @@ codes <- getCandidateCodes( includeDescendants = FALSE ) -codes %>% +codes |> glimpse() ``` @@ -77,7 +77,7 @@ getCandidateCodes( keywords = "Musculoskeletal disorder", domains = "Condition", includeDescendants = TRUE -) %>% +) |> glimpse() ``` @@ -95,7 +95,7 @@ codes <- getCandidateCodes( includeDescendants = FALSE ) -codes %>% +codes |> glimpse() ``` @@ -114,7 +114,7 @@ codes <- getCandidateCodes( domains = "Condition" ) -codes %>% +codes |> glimpse() ``` @@ -133,7 +133,7 @@ codes <- getCandidateCodes( includeDescendants = TRUE ) -codes %>% +codes |> glimpse() ``` @@ -153,7 +153,7 @@ codes <- getCandidateCodes( domains = "Condition" ) -codes %>% +codes |> glimpse() ``` @@ -172,7 +172,7 @@ codes <- getCandidateCodes( searchInSynonyms = TRUE ) -codes %>% +codes |> glimpse() ``` @@ -187,7 +187,7 @@ codes <- getCandidateCodes( searchNonStandard = TRUE ) -codes %>% +codes |> glimpse() ``` @@ -212,6 +212,6 @@ codes <- getCandidateCodes( standardConcept = c("Standard", "Non-standard") ) -codes %>% +codes |> glimpse() ```