revision

OHDSI · Apr 11, 2024 · aeec38b · aeec38b
1 parent c9ae297
commit aeec38b
Show file tree

Hide file tree

Showing 5 changed files with 44 additions and 79 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -3,7 +3,7 @@
 export(attrition)
 export(cohortCodelist)
 export(cohortCount)
-export(conceptCohortSet)
+export(conceptCohort)
 export(generateIntersectCohortSet)
 export(generateMatchedCohortSet)
 export(getIdentifier)

diff --git a/R/conceptCohortSet.R → R/conceptCohort.R b/R/conceptCohortSet.R → R/conceptCohort.R
@@ -4,24 +4,19 @@
 #' @param conceptSet A conceptSet, can either be a list of concepts, a codelist
 #' or a conceptSetExpression (TO DO).
 #' @param name Name of the cohort in the cdm object.
-#' @param verbose Whether to print intermediate progress messages.
 #'
 #' @export
 #'
 #' @return A cohort_table object.
 #'
-conceptCohortSet <- function(cdm,
-                             conceptSet = NULL,
-                             name = "cohort",
-                             verbose = TRUE) {
+conceptCohort <- function(cdm,
+                          conceptSet,
+                          name) {
   # initial input validation
   cdm <- validateCdm(cdm)
   name <- validateName(name)
-  verbose <- validateVerbose(verbose)
   if (length(conceptSet) == 0) {
-    if (verbose) {
-      cli::cli_inform(c("i" = "Empty codelist provided, returning empty cohort"))
-    }
+    cli::cli_inform(c("i" = "Empty codelist provided, returning empty cohort"))
     cdm <- omopgenerics::emptyCohortTable(cdm = cdm, name = name)
     return(cdm[[name]])
   }
@@ -37,17 +32,15 @@ conceptCohortSet <- function(cdm,
     dplyr::mutate("type" = "index event") |>
     addDomains(cdm)
 
-  if (verbose) {
-    ud <- cohortCodelist |>
-      dplyr::group_by(.data$domain_id) |>
-      dplyr::tally() |>
-      dplyr::collect() |>
-      dplyr::filter(!.data$domain_id %in% domainsData$domain_id)
-    for (k in seq_len(nrow(ud))) {
-      cli::cli_inform(c(
-        "x" = "Domain {.strong {ud$domain_id[k]}} ({ud$n[k]} concept{?s}) excluded because it is not supported."
-      ))
-    }
+  ud <- cohortCodelist |>
+    dplyr::group_by(.data$domain_id) |>
+    dplyr::tally() |>
+    dplyr::collect() |>
+    dplyr::filter(!.data$domain_id %in% domainsData$domain_id)
+  for (k in seq_len(nrow(ud))) {
+    cli::cli_inform(c(
+      "x" = "Domain {.strong {ud$domain_id[k]}} ({ud$n[k]} concept{?s}) excluded because it is not supported."
+    ))
   }
 
   cohortCodelist <- cohortCodelist |>
@@ -66,18 +59,14 @@ conceptCohortSet <- function(cdm,
     concept <- domainsData$concept[domainsData$domain_id == domain]
     start <- domainsData$start[domainsData$domain_id == domain]
     end <- domainsData$end[domainsData$domain_id == domain]
-    if (verbose) {
-      n <- cohortCodelist |>
-        dplyr::filter(.data$domain_id %in% .env$domain) |>
-        dplyr::tally() |>
-        dplyr::pull()
-    }
+    n <- cohortCodelist |>
+      dplyr::filter(.data$domain_id %in% .env$domain) |>
+      dplyr::tally() |>
+      dplyr::pull()
     if (table %in% names(cdm)) {
-      if (verbose) {
-        cli::cli_inform(c(
-          "i" = "Subsetting table {.strong {table}} using {n} concept{?s} with domain: {.strong {domain}}."
-        ))
-      }
+      cli::cli_inform(c(
+        "i" = "Subsetting table {.strong {table}} using {n} concept{?s} with domain: {.strong {domain}}."
+      ))
       cohorts[[k]] <- cdm[[table]] |>
         dplyr::select(
           "subject_id" = "person_id",
@@ -91,17 +80,15 @@ conceptCohortSet <- function(cdm,
             dplyr::select("concept_id", "cohort_definition_id"),
           by = "concept_id"
         )
-    } else if (verbose) {
+    } else {
       cli::cli_inform(c(
         "x" = "Domain {.strong {domain}} ({n} concept{?s}) excluded because table {table} is not present in the cdm."
       ))
     }
   }
 
   if (length(cohorts) == 0) {
-    if (verbose) {
-      cli::cli_inform(c("i" = "No table could be subsetted, returning empty cohort."))
-    }
+    cli::cli_inform(c("i" = "No table could be subsetted, returning empty cohort."))
     cdm <- omopgenerics::emptyCohortTable(cdm = cdm, name = name)
     cdm[[name]] <- cdm[[name]] |>
       omopgenerics::newCohortTable(
@@ -112,9 +99,7 @@ conceptCohortSet <- function(cdm,
     return(cdm[[name]])
   }
 
-  if (verbose) {
-    cli::cli_inform(c("i" = "Subsetting tables."))
-  }
+  cli::cli_inform(c("i" = "Subsetting tables."))
   cohort <- cohorts[[1]]
   if (length(cohorts) > 1) {
     for (k in 2:length(cohorts)) {
@@ -124,18 +109,14 @@ conceptCohortSet <- function(cdm,
   cohort <- cohort |>
     dplyr::compute(name = name, temporary = FALSE)
 
-  if (verbose) {
-    cli::cli_inform(c("i" = "Collapsing records."))
-  }
+  cli::cli_inform(c("i" = "Collapsing records."))
   # assign to cdm so we keep class, to be removed when https://github.com/darwin-eu-dev/omopgenerics/issues/256
   cdm[[name]] <- cohort |>
     collapseGap(gap = 0)
   cohort <- cdm[[name]] |>
     dplyr::compute(name = name, temporary = FALSE)
 
-  if (verbose) {
-    cli::cli_inform(c("i" = "Creating cohort attributes."))
-  }
+  cli::cli_inform(c("i" = "Creating cohort attributes."))
   cdm[[name]] <- cohort |>
     omopgenerics::newCohortTable(
       cohortSetRef = cohortSet,
@@ -145,9 +126,7 @@ conceptCohortSet <- function(cdm,
         dplyr::collect()
     )
 
-  if (verbose) {
-    cli::cli_inform(c("v" = "Cohort {.strong {name}} created."))
-  }
+  cli::cli_inform(c("v" = "Cohort {.strong {name}} created."))
 
   return(cdm[[name]])
 }

diff --git a/R/validateFunctions.R b/R/validateFunctions.R
@@ -74,10 +74,3 @@ validateName <- function(name) {
 validateConceptSet <- function(conceptSet) {
   omopgenerics::newCodelist(conceptSet)
 }
-
-validateVerbose <- function(verbose) {
-  if (!is.logical(verbose) | length(verbose) != 1 | is.na(verbose)) {
-    cli::cli_abort("verbose must be TRUE or FALSE.")
-  }
-  return(invisible(verbose))
-}
diff --git a/man/conceptCohortSet.Rd → man/conceptCohort.Rd b/man/conceptCohortSet.Rd → man/conceptCohort.Rd
diff --git a/tests/testthat/test-conceptCohortSet.R → tests/testthat/test-conceptCohort.R b/tests/testthat/test-conceptCohortSet.R → tests/testthat/test-conceptCohort.R
@@ -17,26 +17,26 @@ test_that("expected errors and messages", {
   )
 
   # not a cdm reference
-  expect_error(conceptCohortSet(cdm = NULL))
+  expect_error(conceptCohort(cdm = NULL, name = "cohort", conceptSet = NULL))
 
   # wrong naming
-  expect_error(conceptCohortSet(cdm = cdm, name = NA))
-  expect_error(conceptCohortSet(cdm = cdm, name = 1))
-  expect_error(conceptCohortSet(cdm = cdm, name = c("ass", "asdf")))
-  expect_error(conceptCohortSet(cdm = cdm, name = "AAAA"))
-  expect_no_error(x <- conceptCohortSet(cdm = cdm, name = "my_cohort"))
+  expect_error(conceptCohort(cdm = cdm, name = NA, conceptSet = NULL))
+  expect_error(conceptCohort(cdm = cdm, name = 1, conceptSet = NULL))
+  expect_error(conceptCohort(cdm = cdm, name = c("ass", "asdf"), conceptSet = NULL))
+  expect_error(conceptCohort(cdm = cdm, name = "AAAA", conceptSet = NULL))
+  expect_no_error(x <- conceptCohort(cdm = cdm, name = "my_cohort", conceptSet = NULL))
   expect_true("my_cohort" == omopgenerics::tableName(x))
 
   # empty cohort
-  expect_no_error(x <- conceptCohortSet(cdm = cdm, conceptSet = NULL))
+  expect_no_error(x <- conceptCohort(cdm = cdm, conceptSet = NULL, name = "cohort"))
   expect_true(inherits(x, "cohort_table"))
   expect_true(x |> dplyr::collect() |> nrow() == 0)
 
   # not codelist
-  expect_error(x <- conceptCohortSet(cdm = cdm, conceptSet = 1))
-  expect_error(x <- conceptCohortSet(cdm = cdm, conceptSet = list(1)))
+  expect_error(x <- conceptCohort(cdm = cdm, conceptSet = 1, name = "cohort"))
+  expect_error(x <- conceptCohort(cdm = cdm, conceptSet = list(1), name = "cohort"))
   expect_message(expect_message(
-    x <- conceptCohortSet(cdm = cdm, conceptSet = list(a = 1))
+    x <- conceptCohort(cdm = cdm, conceptSet = list(a = 1), name = "cohort")
   ))
   expect_true(inherits(x, "cohort_table"))
   expect_true(x |> dplyr::collect() |> nrow() == 0)
@@ -52,14 +52,9 @@ test_that("expected errors and messages", {
     cohortCodelist(x, 1), omopgenerics::newCodelist(list())
   ))
   expect_message(expect_message(
-    x <- conceptCohortSet(cdm = cdm, conceptSet = list(a = 2))
+    x <- conceptCohort(cdm = cdm, conceptSet = list(a = 2), name = "cohort")
   ))
 
-  # verbose
-  expect_error(x <- conceptCohortSet(cdm = cdm, verbose = "my_cohort"))
-  expect_error(x <- conceptCohortSet(cdm = cdm, verbose = c(T, F)))
-  expect_error(x <- conceptCohortSet(cdm = cdm, verbose = as.logical(NA)))
-
 })
 
 test_that("simple example", {
@@ -97,7 +92,7 @@ test_that("simple example", {
       )
   )
 
-  expect_no_error(cohort <- conceptCohortSet(cdm = cdm, conceptSet = list(a = 1)))
+  expect_no_error(cohort <- conceptCohort(cdm = cdm, conceptSet = list(a = 1), name = "cohort"))
 
   expect_true(cohort |> dplyr::tally() |> dplyr::pull() == 4)
   expect_true(cohortCount(cohort)$number_records == 4)
@@ -164,7 +159,7 @@ test_that("simple example duckdb", {
 
   cdm <- CDMConnector::copyCdmTo(con = DBI::dbConnect(duckdb::duckdb()), cdm = cdm, schema = "main")
 
-  expect_no_error(cohort <- conceptCohortSet(cdm = cdm, conceptSet = list(a = 1)))
+  expect_no_error(cohort <- conceptCohort(cdm = cdm, conceptSet = list(a = 1), name = "cohort"))
 
   expect_true(cohort |> dplyr::tally() |> dplyr::pull() == 4)
   expect_true(cohortCount(cohort)$number_records == 4)