diff --git a/R/measurementCohort.R b/R/measurementCohort.R index 2039d64..ae7cbc7 100644 --- a/R/measurementCohort.R +++ b/R/measurementCohort.R @@ -19,12 +19,13 @@ #' @inheritParams nameDoc #' @param valueAsConcept A vector of cohort IDs used to filter measurements. #' Only measurements with these values in the `value_as_concept_id` column of -#' the measurement table will be included. If NULL all entries independently of +#' the measurement table will be included. If NULL all entries independent of #' their value as concept will be considered. #' @param valueAsNumber A named list indicating the range of values and the unit #' they correspond to, as follows: -#' list("unit_concept_id" = c(rangeValue1, rangeValue2)). If NULL, all entries -#' independently of their value as number will be included. +#' list("unit_concept_id" = c(rangeValue1, rangeValue2)). If no name is supplied +#' in the list, no requirement on unit concept id will be applied. If NULL, all +#' entries independent of their value as number will be included. #' #' @export #' @@ -149,7 +150,6 @@ measurementCohort <- function(cdm, cohort <- cohort |> dplyr::filter(!!!filterExpr) |> dplyr::compute(name = name, temporary = FALSE) - if (cohort |> dplyr::tally() |> dplyr::pull("n") == 0) { cli::cli_warn( "There are no subjects with the specified value_as_concept_id or value_as_number." @@ -235,11 +235,18 @@ getFilterExpression <- function(valueAsConcept, valueAsNumber) { expFilter <- character() if (!is.null(valueAsNumber)) { for (ii in seq_along(valueAsNumber)) { - expFilter[ii] <- glue::glue( - "(.data$unit_concept_id %in% {names(valueAsNumber)[ii]} & + if(!is.null(names(valueAsNumber)[ii])){ + expFilter[ii] <- glue::glue( + "(.data$unit_concept_id %in% {names(valueAsNumber)[ii]} & .data$value_as_number >= {valueAsNumber[[ii]][1]} & .data$value_as_number <= {valueAsNumber[[ii]][2]})" - ) + ) + } else { + expFilter[ii] <- glue::glue( + "(.data$value_as_number >= {valueAsNumber[[ii]][1]} & + .data$value_as_number <= {valueAsNumber[[ii]][2]})" + ) + } } } else { ii <- 0 diff --git a/R/validateFunctions.R b/R/validateFunctions.R index 7412d70..f603309 100644 --- a/R/validateFunctions.R +++ b/R/validateFunctions.R @@ -182,11 +182,21 @@ validateStrata <- function(strata, cohort) { } validateValueAsNumber <- function(valueAsNumber) { - omopgenerics::assertList(valueAsNumber, - named = TRUE, - class = c("integer", "numeric"), - null = TRUE + + omopgenerics::assertList(valueAsNumber, + class = c("integer", "numeric"), + null = TRUE ) + + # if any is named all must be + if(is.null(names(valueAsNumber)) || any(nchar(names(valueAsNumber)) == 0)){ + omopgenerics::assertList(valueAsNumber, + length = 1, + null = TRUE, + msg = "If any valueAsNumber has no unit specified, only one range should be specified" + ) + } + for (i in seq_along(valueAsNumber)) { if (length(valueAsNumber[[i]]) != 2) { cli::cli_abort("Each numeric vector in `valueAsNumber` list must be of length 2.") diff --git a/tests/testthat/test-measurementCohort.R b/tests/testthat/test-measurementCohort.R index fb75091..e96b01c 100644 --- a/tests/testthat/test-measurementCohort.R +++ b/tests/testthat/test-measurementCohort.R @@ -240,6 +240,91 @@ test_that("mearurementCohorts works", { PatientProfiles::mockDisconnect(cdm) }) +test_that("mearurementCohorts - valueAsNumber without unit concept", { + skip_on_cran() + +cdm <- mockCohortConstructor(con = NULL, seed = 1) + +cdm <- omopgenerics::insertTable(cdm, "person", + dplyr::tibble(person_id = c(1, 2, 3), + gender_concept_id = NA_integer_, + year_of_birth = 1990L, + race_concept_id = NA_integer_, + ethnicity_concept_id = NA_integer_ )) +cdm <- omopgenerics::insertTable(cdm, "observation_period", + dplyr::tibble(observation_period_id = c(1, 2, 3), + person_id = c(1, 2, 3), + observation_period_start_date = as.Date("2000-01-01"), + observation_period_end_date = as.Date("2020-01-01"), + period_type_concept_id = NA_integer_ )) + +cdm <- omopgenerics::insertTable(cdm, "concept", + dplyr::tibble( + concept_id = c(4326744, 8876), + concept_name = c("Blood pressure", "my_unit"), + domain_id = c("Measurement", "Unit"), + vocabulary_id = c("SNOMED", "UCUM"), + standard_concept = "S", + concept_class_id = c("Observable Entity"), + concept_code = NA, + valid_start_date = NA, + valid_end_date = NA, + invalid_reason = NA)) + +cdm <- omopgenerics::insertTable(cdm, "measurement", + dplyr::tibble( + measurement_id = 1:3L, + person_id = as.integer(c(1, 2, 3)), + measurement_concept_id = c(4326744), + measurement_date = as.Date(c("2000-07-01", "2000-12-11", "2002-09-08")), + measurement_type_concept_id = NA_integer_, + value_as_number = c(100, 105, 110), + value_as_concept_id = c(0, 0, 0) , + unit_concept_id = c(8876, 8876, 0) + )) + + +cohort_1 <- measurementCohort( + cdm = cdm, + name = "cohort", + conceptSet = list("normal_blood_pressure" = c(4326744)), + valueAsNumber = list("8876" = c(70L, 120L)) +) +expect_true(all(sort(cohort_1 |> + dplyr::pull("subject_id")) == c(1, 2))) + + +# removing unit_concept_id 8876 - should mean any value between 70 and 120 would be included +# and we should now get person 3 included +cohort_2 <- measurementCohort( + cdm = cdm, + name = "cohort", + conceptSet = list("normal_blood_pressure" = c(4326744L)), + valueAsNumber = list(c(70L, 120L)) +) +expect_true(all(sort(cohort_2 |> + dplyr::pull("subject_id")) == c(1, 2, 3))) + +# don't allow some with unit concept id and others without +expect_error(measurementCohort( + cdm = cdm, + name = "cohort", + conceptSet = list("normal_blood_pressure" = c(4326744L)), + valueAsNumber = list("8876" = c(70L, 120L), + c(70L, 120L)))) + +# don't allow some with unit concept id and others without +expect_error(measurementCohort( + cdm = cdm, + name = "cohort", + conceptSet = list("normal_blood_pressure" = c(4326744L)), + valueAsNumber = list(c(70L, 120L), + c(100L, 150L)))) + +PatientProfiles::mockDisconnect(cdm) + +}) + test_that("expected errors", { testthat::skip_on_cran() cdm <- mockCohortConstructor(con = NULL, seed = 1)