From 16047001fd723347f38d8c3e9bd38f595639a13f Mon Sep 17 00:00:00 2001 From: Marta Alcalde-Herraiz Date: Wed, 19 Jun 2024 14:44:12 +0100 Subject: [PATCH 1/5] Change summariseTableCount name to summariseRecordCounts --- NAMESPACE | 2 +- R/summariseOmopTable.R | 2 +- ...eTableCounts.R => summariseRecordCounts.R} | 2 +- ...ableCounts.Rd => summariseRecordCounts.Rd} | 8 ++-- ...eCounts.R => test-summariseRecordCounts.R} | 40 +++++++++---------- 5 files changed, 27 insertions(+), 27 deletions(-) rename R/{summariseTableCounts.R => summariseRecordCounts.R} (98%) rename man/{summariseTableCounts.Rd => summariseRecordCounts.Rd} (71%) rename tests/testthat/{test-summariseTableCounts.R => test-summariseRecordCounts.R} (56%) diff --git a/NAMESPACE b/NAMESPACE index 4d75919..5f94361 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,7 @@ export(summariseEntryCharacteristics) export(summariseObservationPeriod) export(summariseOmopTable) export(summarisePersonDays) -export(summariseTableCounts) +export(summariseRecordCounts) export(suppress) export(tableOmopTable) importFrom(magrittr,"%>%") diff --git a/R/summariseOmopTable.R b/R/summariseOmopTable.R index fc4270a..986fb9c 100644 --- a/R/summariseOmopTable.R +++ b/R/summariseOmopTable.R @@ -299,7 +299,7 @@ addVariables <- function(x, variables) { x <- x |> dplyr::select(dplyr::all_of(variables)) |> - dplyr::mutate(across(everything(), ~as.character(.))) + dplyr::mutate(dplyr::across(dplyr::everything(), ~as.character(.))) return(x) } diff --git a/R/summariseTableCounts.R b/R/summariseRecordCounts.R similarity index 98% rename from R/summariseTableCounts.R rename to R/summariseRecordCounts.R index 7af5791..6bc69f6 100644 --- a/R/summariseTableCounts.R +++ b/R/summariseRecordCounts.R @@ -9,7 +9,7 @@ #' @importFrom rlang := #' @export #' -summariseTableCounts<- function(omopTable, unit = "year", unitInterval = 1) { +summariseRecordCounts <- function(omopTable, unit = "year", unitInterval = 1) { # Initial checks ---- omopTableChecks(omopTable) diff --git a/man/summariseTableCounts.Rd b/man/summariseRecordCounts.Rd similarity index 71% rename from man/summariseTableCounts.Rd rename to man/summariseRecordCounts.Rd index 096d9c4..0c872b5 100644 --- a/man/summariseTableCounts.Rd +++ b/man/summariseRecordCounts.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/summariseTableCounts.R -\name{summariseTableCounts} -\alias{summariseTableCounts} +% Please edit documentation in R/summariseRecordCounts.R +\name{summariseRecordCounts} +\alias{summariseRecordCounts} \title{Create a gt table from a summarised omop_table.} \usage{ -summariseTableCounts(omopTable, unit = "year", unitInterval = 1) +summariseRecordCounts(omopTable, unit = "year", unitInterval = 1) } \arguments{ \item{omopTable}{A summarised_result object with the output from summariseOmopTable().} diff --git a/tests/testthat/test-summariseTableCounts.R b/tests/testthat/test-summariseRecordCounts.R similarity index 56% rename from tests/testthat/test-summariseTableCounts.R rename to tests/testthat/test-summariseRecordCounts.R index bfdc4b6..63c2b96 100644 --- a/tests/testthat/test-summariseTableCounts.R +++ b/tests/testthat/test-summariseRecordCounts.R @@ -1,4 +1,4 @@ -test_that("summariseTableCounts() works", { +test_that("summariseRecordCounts() works", { # Load mock database ---- con <- DBI::dbConnect(duckdb::duckdb(), CDMConnector::eunomia_dir()) @@ -7,22 +7,22 @@ test_that("summariseTableCounts() works", { ) # Check inputs ---- - expect_true(inherits(summariseTableCounts(omopTable = cdm$observation_period, unit = "month"),"summarised_result")) - expect_true(inherits(summariseTableCounts(omopTable = cdm$observation_period, unitInterval = 5),"summarised_result")) + expect_true(inherits(summariseRecordCounts(omopTable = cdm$observation_period, unit = "month"),"summarised_result")) + expect_true(inherits(summariseRecordCounts(omopTable = cdm$observation_period, unitInterval = 5),"summarised_result")) - expect_no_error(summariseTableCounts(cdm$observation_period)) - expect_no_error(summariseTableCounts(cdm$visit_occurrence)) - expect_no_error(summariseTableCounts(cdm$condition_occurrence)) - expect_no_error(summariseTableCounts(cdm$drug_exposure)) - expect_no_error(summariseTableCounts(cdm$procedure_occurrence)) - expect_warning(summariseTableCounts(cdm$device_exposure)) - expect_no_error(summariseTableCounts(cdm$measurement)) - expect_no_error(summariseTableCounts(cdm$observation)) - expect_warning(summariseTableCounts(cdm$death)) + expect_no_error(summariseRecordCounts(cdm$observation_period)) + expect_no_error(summariseRecordCounts(cdm$visit_occurrence)) + expect_no_error(summariseRecordCounts(cdm$condition_occurrence)) + expect_no_error(summariseRecordCounts(cdm$drug_exposure)) + expect_no_error(summariseRecordCounts(cdm$procedure_occurrence)) + expect_warning(summariseRecordCounts(cdm$device_exposure)) + expect_no_error(summariseRecordCounts(cdm$measurement)) + expect_no_error(summariseRecordCounts(cdm$observation)) + expect_warning(summariseRecordCounts(cdm$death)) # Check inputs ---- expect_true( - (summariseTableCounts(cdm$observation_period) |> + (summariseRecordCounts(cdm$observation_period) |> dplyr::filter(strata_level == "1963-01-01 to 1963-12-31") |> dplyr::pull("estimate_value") |> as.numeric()) == @@ -35,7 +35,7 @@ test_that("summariseTableCounts() works", { ) expect_true( - summariseTableCounts(cdm$condition_occurrence, unit = "month") |> + summariseRecordCounts(cdm$condition_occurrence, unit = "month") |> dplyr::filter(strata_level == "1961-02-01 to 1961-02-28") |> dplyr::pull("estimate_value") |> as.numeric() == @@ -49,7 +49,7 @@ test_that("summariseTableCounts() works", { ) expect_true( - (summariseTableCounts(cdm$condition_occurrence, unit = "month", unitInterval = 3) |> + (summariseRecordCounts(cdm$condition_occurrence, unit = "month", unitInterval = 3) |> dplyr::filter(strata_level %in% c("1984-01-01 to 1984-03-31")) |> dplyr::pull("estimate_value") |> as.numeric()) == @@ -63,7 +63,7 @@ test_that("summariseTableCounts() works", { ) expect_true( - (summariseTableCounts(cdm$drug_exposure, unitInterval = 8) |> + (summariseRecordCounts(cdm$drug_exposure, unitInterval = 8) |> dplyr::filter(strata_level == "1981-01-01 to 1988-12-31") |> dplyr::pull("estimate_value") |> as.numeric()) == @@ -75,8 +75,8 @@ test_that("summariseTableCounts() works", { dplyr::pull("n")) ) - # summariseTableCounts plot ---- - expect_true(inherits(plotTableCounts(summariseTableCounts(cdm$drug_exposure, unitInterval = 8)),"ggplot")) - expect_warning(inherits(plotTableCounts(summariseTableCounts(cdm$death, unitInterval = 8)),"ggplot")) - expect_true(inherits(plotTableCounts(summariseTableCounts(cdm$death, unitInterval = 8)),"ggplot")) + # summariseRecordCounts plot ---- + expect_true(inherits(plotTableCounts(summariseRecordCounts(cdm$drug_exposure, unitInterval = 8)),"ggplot")) + expect_warning(inherits(plotTableCounts(summariseRecordCounts(cdm$death, unitInterval = 8)),"ggplot")) + expect_true(inherits(plotTableCounts(summariseRecordCounts(cdm$death, unitInterval = 8)),"ggplot")) }) From f1fc2863e3e9c9ab67dea10d9d41fcb4e6497ac2 Mon Sep 17 00:00:00 2001 From: Marta Alcalde-Herraiz Date: Wed, 19 Jun 2024 15:22:45 +0100 Subject: [PATCH 2/5] Create checks file --- R/checks.R | 121 +++++++++++++++++++++++++++++++++ R/summariseObservationPeriod.R | 6 +- R/summariseRecordCounts.R | 33 ++------- 3 files changed, 128 insertions(+), 32 deletions(-) create mode 100644 R/checks.R diff --git a/R/checks.R b/R/checks.R new file mode 100644 index 0000000..3aa49e4 --- /dev/null +++ b/R/checks.R @@ -0,0 +1,121 @@ +#' @noRd +checkAgeGroup <- function(ageGroup, overlap = FALSE) { + checkmate::assertList(ageGroup, min.len = 1, null.ok = TRUE) + if (!is.null(ageGroup)) { + if (is.numeric(ageGroup[[1]])) { + ageGroup <- list("age_group" = ageGroup) + } + for (k in seq_along(ageGroup)) { + invisible(checkCategory(ageGroup[[k]], overlap)) + if (any(ageGroup[[k]] |> unlist() |> unique() < 0)) { + cli::cli_abort("ageGroup can't contain negative values") + } + } + if (is.null(names(ageGroup))) { + names(ageGroup) <- paste0("age_group_", 1:length(ageGroup)) + } + if ("" %in% names(ageGroup)) { + id <- which(names(ageGroup) == "") + names(ageGroup)[id] <- paste0("age_group_", id) + } + } + return(invisible(ageGroup)) +} + +#' @noRd +checkOmopTable <- function(omopTable){ + assertClass(omopTable, "omop_table") + omopTable |> + omopgenerics::tableName() |> + assertChoice(choices = tables$table_name) +} + +#' @noRd +checkUnit <- function(unit){ + inherits(unit, "character") + assertLength(unit, 1) + if(!unit %in% c("year","month")){ + cli::cli_abort("units value is not valid. Valid options are year or month.") + } +} + +#' @noRd +checkUnitInterval <- function(unitInterval){ + inherits(unitInterval, c("numeric", "integer")) + assertLength(unitInterval, 1) + if(unitInterval < 1){ + cli::cli_abort("unitInterval input has to be equal or greater than 1.") + } + if(!(unitInterval%%1 == 0)){ + cli::cli_abort("unitInterval has to be an integer.") + } +} + + +#' @noRd +checkCategory <- function(category, overlap = FALSE, type = "numeric") { + checkmate::assertList( + category, + types = type, any.missing = FALSE, unique = TRUE, + min.len = 1 + ) + + if (is.null(names(category))) { + names(category) <- rep("", length(category)) + } + + # check length + category <- lapply(category, function(x) { + if (length(x) == 1) { + x <- c(x, x) + } else if (length(x) > 2) { + cli::cli_abort( + paste0( + "Categories should be formed by a lower bound and an upper bound, ", + "no more than two elements should be provided." + ), + call. = FALSE + ) + } + invisible(x) + }) + + # check lower bound is smaller than upper bound + checkLower <- unlist(lapply(category, function(x) { + x[1] <= x[2] + })) + if (!(all(checkLower))) { + cli::cli_abort("Lower bound should be equal or smaller than upper bound") + } + + # 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::mutate(category_label = dplyr::if_else( + .data$category_label == "", + dplyr::case_when( + is.infinite(.data$lower_bound) & is.infinite(.data$upper_bound) ~ "any", + is.infinite(.data$lower_bound) ~ paste(.data$upper_bound, "or below"), + is.infinite(.data$upper_bound) ~ paste(.data$lower_bound, "or above"), + TRUE ~ paste(.data$lower_bound, "to", .data$upper_bound) + ), + .data$category_label + )) |> + dplyr::arrange(.data$lower_bound) + + # check overlap + if (!overlap) { + if (nrow(result) > 1) { + lower <- result$lower_bound[2:nrow(result)] + upper <- result$upper_bound[1:(nrow(result) - 1)] + if (!all(lower > upper)) { + cli::cli_abort("There can not be overlap between categories") + } + } + } + + invisible(result) +} diff --git a/R/summariseObservationPeriod.R b/R/summariseObservationPeriod.R index 8d77c9a..5f0d420 100644 --- a/R/summariseObservationPeriod.R +++ b/R/summariseObservationPeriod.R @@ -32,8 +32,8 @@ summariseObservationPeriod <- function(observationPeriod, unit = "year", unitInt if(missing(unit)){unit <- "year"} if(missing(unitInterval)){unitInterval <- 1} - unitChecks(unit) - unitIntervalChecks(unitInterval) + checkUnit(unit) + checkUnitInterval(unitInterval) cdm <- omopgenerics::cdmReference(observationPeriod) @@ -70,7 +70,7 @@ summariseObservationPeriod <- function(observationPeriod, unit = "year", unitInt "cdm_name" = omopgenerics::cdmName(omopgenerics::cdmReference(observationPeriod)), "group_name" = "omop_table", "group_level" = name, - "variable_level" = gsub(" to.*","",strata_level), + "variable_level" = gsub(" to.*","",.data$strata_level), "estimate_name" = "count", "estimate_type" = "integer", "additional_name" = "overall", diff --git a/R/summariseRecordCounts.R b/R/summariseRecordCounts.R index 6bc69f6..7403aa4 100644 --- a/R/summariseRecordCounts.R +++ b/R/summariseRecordCounts.R @@ -12,13 +12,13 @@ summariseRecordCounts <- function(omopTable, unit = "year", unitInterval = 1) { # Initial checks ---- - omopTableChecks(omopTable) + checkOmopTable(omopTable) if(missing(unit)){unit <- "year"} if(missing(unitInterval)){unitInterval <- 1} - unitChecks(unit) - unitIntervalChecks(unitInterval) + checkUnit(unit) + checkUnitInterval(unitInterval) cdm <- omopgenerics::cdmReference(omopTable) omopTable <- omopTable |> dplyr::ungroup() @@ -72,7 +72,7 @@ summariseRecordCounts <- function(omopTable, unit = "year", unitInterval = 1) { "cdm_name" = omopgenerics::cdmName(omopgenerics::cdmReference(omopTable)), "group_name" = "omop_table", "group_level" = name, - "variable_level" = gsub(" to.*","",strata_level), + "variable_level" = gsub(" to.*","",.data$strata_level), "estimate_name" = "count", "estimate_type" = "integer", "additional_name" = "overall", @@ -92,31 +92,6 @@ summariseRecordCounts <- function(omopTable, unit = "year", unitInterval = 1) { return(result) } -omopTableChecks <- function(omopTable){ - assertClass(omopTable, "omop_table") - omopTable |> - omopgenerics::tableName() |> - assertChoice(choices = tables$table_name) -} - -unitChecks <- function(unit){ - inherits(unit, "character") - assertLength(unit, 1) - if(!unit %in% c("year","month")){ - cli::cli_abort("units value is not valid. Valid options are year or month.") - } -} - -unitIntervalChecks <- function(unitInterval){ - inherits(unitInterval, c("numeric", "integer")) - assertLength(unitInterval, 1) - if(unitInterval < 1){ - cli::cli_abort("unitInterval input has to be equal or greater than 1.") - } - if(!(unitInterval%%1 == 0)){ - cli::cli_abort("unitInterval has to be an integer.") - } -} filterInObservation <- function(x, indexDate) { cdm <- omopgenerics::cdmReference(x) From 716b27db01c567293c198334feaaf86a1f06977e Mon Sep 17 00:00:00 2001 From: Marta Alcalde-Herraiz Date: Wed, 19 Jun 2024 17:32:56 +0100 Subject: [PATCH 3/5] ageGroup option in summariseRecordCounts() --- R/summariseRecordCounts.R | 43 +++++++++++++---- man/summariseRecordCounts.Rd | 9 +++- tests/testthat/test-summariseOmopTable.R | 1 - tests/testthat/test-summariseRecordCounts.R | 52 +++++++++++++++++++-- 4 files changed, 89 insertions(+), 16 deletions(-) diff --git a/R/summariseRecordCounts.R b/R/summariseRecordCounts.R index 7403aa4..96b2674 100644 --- a/R/summariseRecordCounts.R +++ b/R/summariseRecordCounts.R @@ -3,13 +3,14 @@ #' @param omopTable A summarised_result object with the output from summariseOmopTable(). #' @param unit Whether to stratify by "year" or by "month" #' @param unitInterval Number of years or months to stratify with +#' @param ageGroup A list of age groups to stratify results by. #' #' @return A summarised_result object with the summarised data. #' #' @importFrom rlang := #' @export #' -summariseRecordCounts <- function(omopTable, unit = "year", unitInterval = 1) { +summariseRecordCounts <- function(omopTable, unit = "year", unitInterval = 1, ageGroup = NULL) { # Initial checks ---- checkOmopTable(omopTable) @@ -19,6 +20,7 @@ summariseRecordCounts <- function(omopTable, unit = "year", unitInterval = 1) { checkUnit(unit) checkUnitInterval(unitInterval) + checkAgeGroup(ageGroup) cdm <- omopgenerics::cdmReference(omopTable) omopTable <- omopTable |> dplyr::ungroup() @@ -32,9 +34,15 @@ summariseRecordCounts <- function(omopTable, unit = "year", unitInterval = 1) { return(result) } + # Create strata variable ---- + strata <- dplyr::if_else(is.null(ageGroup), NA, "age_group") + if(is.na(strata)){strata <- NULL} + # Incidence counts ---- omopTable <- omopTable |> - dplyr::select(dplyr::all_of(date), "person_id") + dplyr::select(dplyr::all_of(date), "person_id") |> + PatientProfiles::addAgeQuery(indexDate = date, ageGroup = ageGroup) |> + dplyr::select(-c("age")) if (name != "observation_period") { omopTable <- omopTable |> @@ -52,31 +60,46 @@ summariseRecordCounts <- function(omopTable, unit = "year", unitInterval = 1) { result <- cdm$interval |> dplyr::cross_join( omopTable |> - dplyr::rename("incidence_date" = dplyr::all_of(date))) |> + dplyr::rename("incidence_date" = dplyr::all_of(date)) + ) |> dplyr::filter(.data$incidence_date >= .data$interval_start_date & .data$incidence_date <= .data$interval_end_date) |> - dplyr::group_by(.data$interval_group) |> + dplyr::group_by(.data$interval_group, dplyr::across(dplyr::all_of(strata))) |> dplyr::summarise("estimate_value" = dplyr::n(), .groups = "drop") |> dplyr::collect() |> dplyr::ungroup() + if(!is.null(strata)){ + result <- result |> + rbind( + result |> + dplyr::group_by(.data$interval_group) |> + dplyr::summarise(estimate_value = sum(.data$estimate_value), .groups = "drop") |> + dplyr::mutate(age_group = "overall") + ) |> + dplyr::rename() |> + dplyr::mutate() + }else{ + result <- result |> + dplyr::mutate("age_group" = "overall") + } + result <- result |> dplyr::mutate( "estimate_value" = as.character(.data$estimate_value), "variable_name" = "incidence_records", ) |> - dplyr::rename("time_interval" = "interval_group") |> - visOmopResults::uniteStrata(cols = "time_interval") |> + dplyr::rename("variable_level" = "interval_group") |> + visOmopResults::uniteStrata(cols = "age_group") |> dplyr::mutate( "result_id" = as.integer(1), "cdm_name" = omopgenerics::cdmName(omopgenerics::cdmReference(omopTable)), "group_name" = "omop_table", "group_level" = name, - "variable_level" = gsub(" to.*","",.data$strata_level), "estimate_name" = "count", "estimate_type" = "integer", - "additional_name" = "overall", - "additional_level" = "overall" + "additional_name" = "time_interval", + "additional_level" = gsub(" to.*","",.data$variable_level) ) |> omopgenerics::newSummarisedResult(settings = dplyr::tibble( "result_id" = 1L, @@ -93,7 +116,7 @@ summariseRecordCounts <- function(omopTable, unit = "year", unitInterval = 1) { } -filterInObservation <- function(x, indexDate) { +filterInObservation <- function(x, indexDate){ cdm <- omopgenerics::cdmReference(x) id <- c("person_id", "subject_id") id <- id[id %in% colnames(x)] diff --git a/man/summariseRecordCounts.Rd b/man/summariseRecordCounts.Rd index 0c872b5..1ce5142 100644 --- a/man/summariseRecordCounts.Rd +++ b/man/summariseRecordCounts.Rd @@ -4,7 +4,12 @@ \alias{summariseRecordCounts} \title{Create a gt table from a summarised omop_table.} \usage{ -summariseRecordCounts(omopTable, unit = "year", unitInterval = 1) +summariseRecordCounts( + omopTable, + unit = "year", + unitInterval = 1, + ageGroup = NULL +) } \arguments{ \item{omopTable}{A summarised_result object with the output from summariseOmopTable().} @@ -12,6 +17,8 @@ summariseRecordCounts(omopTable, unit = "year", unitInterval = 1) \item{unit}{Whether to stratify by "year" or by "month"} \item{unitInterval}{Number of years or months to stratify with} + +\item{ageGroup}{} } \value{ A summarised_result object with the summarised data. diff --git a/tests/testthat/test-summariseOmopTable.R b/tests/testthat/test-summariseOmopTable.R index 3e7ce30..ab6911f 100644 --- a/tests/testthat/test-summariseOmopTable.R +++ b/tests/testthat/test-summariseOmopTable.R @@ -76,4 +76,3 @@ test_that("tableOmopTable() works", { }) - diff --git a/tests/testthat/test-summariseRecordCounts.R b/tests/testthat/test-summariseRecordCounts.R index 63c2b96..1053b4d 100644 --- a/tests/testthat/test-summariseRecordCounts.R +++ b/tests/testthat/test-summariseRecordCounts.R @@ -23,7 +23,7 @@ test_that("summariseRecordCounts() works", { # Check inputs ---- expect_true( (summariseRecordCounts(cdm$observation_period) |> - dplyr::filter(strata_level == "1963-01-01 to 1963-12-31") |> + dplyr::filter(variable_level == "1963-01-01 to 1963-12-31") |> dplyr::pull("estimate_value") |> as.numeric()) == (cdm$observation_period |> @@ -36,7 +36,7 @@ test_that("summariseRecordCounts() works", { expect_true( summariseRecordCounts(cdm$condition_occurrence, unit = "month") |> - dplyr::filter(strata_level == "1961-02-01 to 1961-02-28") |> + dplyr::filter(variable_level == "1961-02-01 to 1961-02-28") |> dplyr::pull("estimate_value") |> as.numeric() == (cdm$condition_occurrence |> @@ -50,7 +50,7 @@ test_that("summariseRecordCounts() works", { expect_true( (summariseRecordCounts(cdm$condition_occurrence, unit = "month", unitInterval = 3) |> - dplyr::filter(strata_level %in% c("1984-01-01 to 1984-03-31")) |> + dplyr::filter(variable_level %in% c("1984-01-01 to 1984-03-31")) |> dplyr::pull("estimate_value") |> as.numeric()) == (cdm$condition_occurrence |> @@ -64,7 +64,7 @@ test_that("summariseRecordCounts() works", { expect_true( (summariseRecordCounts(cdm$drug_exposure, unitInterval = 8) |> - dplyr::filter(strata_level == "1981-01-01 to 1988-12-31") |> + dplyr::filter(variable_level == "1981-01-01 to 1988-12-31") |> dplyr::pull("estimate_value") |> as.numeric()) == (cdm$drug_exposure |> @@ -80,3 +80,47 @@ test_that("summariseRecordCounts() works", { expect_warning(inherits(plotTableCounts(summariseRecordCounts(cdm$death, unitInterval = 8)),"ggplot")) expect_true(inherits(plotTableCounts(summariseRecordCounts(cdm$death, unitInterval = 8)),"ggplot")) }) + +test_that("summariseOmopTable() ageGroup argument works", { + # Load mock database ---- + con <- DBI::dbConnect(duckdb::duckdb(), CDMConnector::eunomia_dir()) + cdm <- CDMConnector::cdmFromCon( + con = con, cdmSchema = "main", writeSchema = "main" + ) + + # Check that works ---- + expect_no_error(t <- summariseRecordCounts(cdm$condition_occurrence, ageGroup = list(">=65" = c(65, Inf), "<65" = c(0,64)))) + x <- t |> + dplyr::select("strata_level", "variable_level", "estimate_value") |> + dplyr::filter(strata_level != "overall") |> + dplyr::group_by(variable_level) |> + dplyr::summarise(estimate_value = sum(as.numeric(estimate_value))) |> + dplyr::arrange(variable_level) |> + dplyr::pull("estimate_value") + y <- t |> + dplyr::select("strata_level", "variable_level", "estimate_value") |> + dplyr::filter(strata_level == "overall") |> + dplyr::arrange(variable_level) |> + dplyr::mutate(estimate_value = as.numeric(estimate_value)) |> + dplyr::pull("estimate_value") + expect_equal(x,y) + + + + expect_no_error(t <- summariseRecordCounts(cdm$condition_occurrence, ageGroup = list("<=20" = c(0,20), "21 to 40" = c(21,40), "41 to 60" = c(41,60), ">60" = c(61, Inf)))) + x <- t |> + dplyr::select("strata_level", "variable_level", "estimate_value") |> + dplyr::filter(strata_level != "overall") |> + dplyr::group_by(variable_level) |> + dplyr::summarise(estimate_value = sum(as.numeric(estimate_value))) |> + dplyr::arrange(variable_level) |> + dplyr::pull("estimate_value") + y <- t |> + dplyr::select("strata_level", "variable_level", "estimate_value") |> + dplyr::filter(strata_level == "overall") |> + dplyr::arrange(variable_level) |> + dplyr::mutate(estimate_value = as.numeric(estimate_value)) |> + dplyr::pull("estimate_value") + expect_equal(x,y) + +}) From 745c93b73a0f95548be804a70aac0c90db299028 Mon Sep 17 00:00:00 2001 From: Marta Alcalde-Herraiz Date: Wed, 19 Jun 2024 17:39:55 +0100 Subject: [PATCH 4/5] add theme_bw() to the plots --- R/plotObservationPeriod.R | 3 ++- R/plotTableCounts.R | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/plotObservationPeriod.R b/R/plotObservationPeriod.R index 7d8afd1..e1f3427 100644 --- a/R/plotObservationPeriod.R +++ b/R/plotObservationPeriod.R @@ -29,7 +29,8 @@ plotObservationPeriod <- function(summarisedObservationPeriod){ ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1)) + ggplot2::xlab("Time interval") + ggplot2::ylab("Individuals in observation") + - ggplot2::labs(color = "CDM table") + ggplot2::labs(color = "CDM table") + + ggplot2::theme_bw() } diff --git a/R/plotTableCounts.R b/R/plotTableCounts.R index 0adea83..cf02c6e 100644 --- a/R/plotTableCounts.R +++ b/R/plotTableCounts.R @@ -30,5 +30,6 @@ plotTableCounts <- function(summarisedTableCounts) { ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1)) + ggplot2::xlab("Time") + ggplot2::ylab("Counts") + - ggplot2::labs(color = "Omop table") + ggplot2::labs(color = "Omop table") + + ggplot2::theme_bw() } From d261a8a8e059b84531db32b0bae19f86a900d2e6 Mon Sep 17 00:00:00 2001 From: Marta Alcalde-Herraiz Date: Fri, 21 Jun 2024 10:06:21 +0100 Subject: [PATCH 5/5] Update summariseRecordCount() name --- NAMESPACE | 2 +- R/summariseRecordCounts.R | 2 +- ...ecordCounts.Rd => summariseRecordCount.Rd} | 8 ++-- tests/testthat/test-summariseRecordCounts.R | 44 +++++++++---------- 4 files changed, 28 insertions(+), 28 deletions(-) rename man/{summariseRecordCounts.Rd => summariseRecordCount.Rd} (80%) diff --git a/NAMESPACE b/NAMESPACE index 5f94361..cc632fe 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,7 @@ export(summariseEntryCharacteristics) export(summariseObservationPeriod) export(summariseOmopTable) export(summarisePersonDays) -export(summariseRecordCounts) +export(summariseRecordCount) export(suppress) export(tableOmopTable) importFrom(magrittr,"%>%") diff --git a/R/summariseRecordCounts.R b/R/summariseRecordCounts.R index 96b2674..73f64e5 100644 --- a/R/summariseRecordCounts.R +++ b/R/summariseRecordCounts.R @@ -10,7 +10,7 @@ #' @importFrom rlang := #' @export #' -summariseRecordCounts <- function(omopTable, unit = "year", unitInterval = 1, ageGroup = NULL) { +summariseRecordCount <- function(omopTable, unit = "year", unitInterval = 1, ageGroup = NULL) { # Initial checks ---- checkOmopTable(omopTable) diff --git a/man/summariseRecordCounts.Rd b/man/summariseRecordCount.Rd similarity index 80% rename from man/summariseRecordCounts.Rd rename to man/summariseRecordCount.Rd index 1ce5142..2fce094 100644 --- a/man/summariseRecordCounts.Rd +++ b/man/summariseRecordCount.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/summariseRecordCounts.R -\name{summariseRecordCounts} -\alias{summariseRecordCounts} +\name{summariseRecordCount} +\alias{summariseRecordCount} \title{Create a gt table from a summarised omop_table.} \usage{ -summariseRecordCounts( +summariseRecordCount( omopTable, unit = "year", unitInterval = 1, @@ -18,7 +18,7 @@ summariseRecordCounts( \item{unitInterval}{Number of years or months to stratify with} -\item{ageGroup}{} +\item{ageGroup}{A list of age groups to stratify results by.} } \value{ A summarised_result object with the summarised data. diff --git a/tests/testthat/test-summariseRecordCounts.R b/tests/testthat/test-summariseRecordCounts.R index 1053b4d..359480c 100644 --- a/tests/testthat/test-summariseRecordCounts.R +++ b/tests/testthat/test-summariseRecordCounts.R @@ -1,4 +1,4 @@ -test_that("summariseRecordCounts() works", { +test_that("summariseRecordCount() works", { # Load mock database ---- con <- DBI::dbConnect(duckdb::duckdb(), CDMConnector::eunomia_dir()) @@ -7,22 +7,22 @@ test_that("summariseRecordCounts() works", { ) # Check inputs ---- - expect_true(inherits(summariseRecordCounts(omopTable = cdm$observation_period, unit = "month"),"summarised_result")) - expect_true(inherits(summariseRecordCounts(omopTable = cdm$observation_period, unitInterval = 5),"summarised_result")) + expect_true(inherits(summariseRecordCount(omopTable = cdm$observation_period, unit = "month"),"summarised_result")) + expect_true(inherits(summariseRecordCount(omopTable = cdm$observation_period, unitInterval = 5),"summarised_result")) - expect_no_error(summariseRecordCounts(cdm$observation_period)) - expect_no_error(summariseRecordCounts(cdm$visit_occurrence)) - expect_no_error(summariseRecordCounts(cdm$condition_occurrence)) - expect_no_error(summariseRecordCounts(cdm$drug_exposure)) - expect_no_error(summariseRecordCounts(cdm$procedure_occurrence)) - expect_warning(summariseRecordCounts(cdm$device_exposure)) - expect_no_error(summariseRecordCounts(cdm$measurement)) - expect_no_error(summariseRecordCounts(cdm$observation)) - expect_warning(summariseRecordCounts(cdm$death)) + expect_no_error(summariseRecordCount(cdm$observation_period)) + expect_no_error(summariseRecordCount(cdm$visit_occurrence)) + expect_no_error(summariseRecordCount(cdm$condition_occurrence)) + expect_no_error(summariseRecordCount(cdm$drug_exposure)) + expect_no_error(summariseRecordCount(cdm$procedure_occurrence)) + expect_warning(summariseRecordCount(cdm$device_exposure)) + expect_no_error(summariseRecordCount(cdm$measurement)) + expect_no_error(summariseRecordCount(cdm$observation)) + expect_warning(summariseRecordCount(cdm$death)) # Check inputs ---- expect_true( - (summariseRecordCounts(cdm$observation_period) |> + (summariseRecordCount(cdm$observation_period) |> dplyr::filter(variable_level == "1963-01-01 to 1963-12-31") |> dplyr::pull("estimate_value") |> as.numeric()) == @@ -35,7 +35,7 @@ test_that("summariseRecordCounts() works", { ) expect_true( - summariseRecordCounts(cdm$condition_occurrence, unit = "month") |> + summariseRecordCount(cdm$condition_occurrence, unit = "month") |> dplyr::filter(variable_level == "1961-02-01 to 1961-02-28") |> dplyr::pull("estimate_value") |> as.numeric() == @@ -49,7 +49,7 @@ test_that("summariseRecordCounts() works", { ) expect_true( - (summariseRecordCounts(cdm$condition_occurrence, unit = "month", unitInterval = 3) |> + (summariseRecordCount(cdm$condition_occurrence, unit = "month", unitInterval = 3) |> dplyr::filter(variable_level %in% c("1984-01-01 to 1984-03-31")) |> dplyr::pull("estimate_value") |> as.numeric()) == @@ -63,7 +63,7 @@ test_that("summariseRecordCounts() works", { ) expect_true( - (summariseRecordCounts(cdm$drug_exposure, unitInterval = 8) |> + (summariseRecordCount(cdm$drug_exposure, unitInterval = 8) |> dplyr::filter(variable_level == "1981-01-01 to 1988-12-31") |> dplyr::pull("estimate_value") |> as.numeric()) == @@ -75,10 +75,10 @@ test_that("summariseRecordCounts() works", { dplyr::pull("n")) ) - # summariseRecordCounts plot ---- - expect_true(inherits(plotTableCounts(summariseRecordCounts(cdm$drug_exposure, unitInterval = 8)),"ggplot")) - expect_warning(inherits(plotTableCounts(summariseRecordCounts(cdm$death, unitInterval = 8)),"ggplot")) - expect_true(inherits(plotTableCounts(summariseRecordCounts(cdm$death, unitInterval = 8)),"ggplot")) + # summariseRecordCount plot ---- + expect_true(inherits(plotTableCounts(summariseRecordCount(cdm$drug_exposure, unitInterval = 8)),"ggplot")) + expect_warning(inherits(plotTableCounts(summariseRecordCount(cdm$death, unitInterval = 8)),"ggplot")) + expect_true(inherits(plotTableCounts(summariseRecordCount(cdm$death, unitInterval = 8)),"ggplot")) }) test_that("summariseOmopTable() ageGroup argument works", { @@ -89,7 +89,7 @@ test_that("summariseOmopTable() ageGroup argument works", { ) # Check that works ---- - expect_no_error(t <- summariseRecordCounts(cdm$condition_occurrence, ageGroup = list(">=65" = c(65, Inf), "<65" = c(0,64)))) + expect_no_error(t <- summariseRecordCount(cdm$condition_occurrence, ageGroup = list(">=65" = c(65, Inf), "<65" = c(0,64)))) x <- t |> dplyr::select("strata_level", "variable_level", "estimate_value") |> dplyr::filter(strata_level != "overall") |> @@ -107,7 +107,7 @@ test_that("summariseOmopTable() ageGroup argument works", { - expect_no_error(t <- summariseRecordCounts(cdm$condition_occurrence, ageGroup = list("<=20" = c(0,20), "21 to 40" = c(21,40), "41 to 60" = c(41,60), ">60" = c(61, Inf)))) + expect_no_error(t <- summariseRecordCount(cdm$condition_occurrence, ageGroup = list("<=20" = c(0,20), "21 to 40" = c(21,40), "41 to 60" = c(41,60), ">60" = c(61, Inf)))) x <- t |> dplyr::select("strata_level", "variable_level", "estimate_value") |> dplyr::filter(strata_level != "overall") |>