Merge pull request #388 from OHDSI/valueAsNumber_without_unit

allow valueAsNumber without unit concept
OHDSI · Nov 28, 2024 · b503b66 · b503b66
2 parents c565b60 + ccb6ab6
commit b503b66
Show file tree

Hide file tree

Showing 3 changed files with 113 additions and 11 deletions.
diff --git 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
@@ -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
@@ -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)