Merge pull request #290 from OHDSI/omopgenerics_validate

validate in generateSequenceCohort()
OHDSI · Nov 28, 2024 · b5c70ee · b5c70ee
2 parents d945176 + 8f3d9e2
commit b5c70ee
Show file tree

Hide file tree

Showing 10 changed files with 82 additions and 138 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -55,7 +55,6 @@ Imports:
     dplyr,
     PatientProfiles,
     rlang,
-    stringr,
     tibble,
     visOmopResults (>= 0.4.0),
     tidyr,

diff --git a/R/generateSequenceCohortSet.R b/R/generateSequenceCohortSet.R
@@ -42,42 +42,47 @@
 #'  CDMConnector::cdmDisconnect(cdm = cdm)
 #' }
 generateSequenceCohortSet <- function(cdm,
-                              indexTable,
-                              markerTable,
-                              name,
-                              indexId = NULL,
-                              markerId = NULL,
-                              cohortDateRange = as.Date(c(NA, NA)),
-                              daysPriorObservation = 0,
-                              washoutWindow = 0,
-                              indexMarkerGap = Inf,
-                              combinationWindow = c(0,365),
-                              movingAverageRestriction = 548){
-  ### checks
-  checkInputGenerateSequenceCohortSet(
-    cdm = cdm,
-    indexTable = indexTable,
-    markerTable = markerTable,
-    name = name,
-    indexId = indexId,
-    markerId = markerId,
-    cohortDateRange = cohortDateRange,
-    daysPriorObservation = daysPriorObservation,
-    washoutWindow = washoutWindow,
-    indexMarkerGap = indexMarkerGap,
-    combinationWindow = combinationWindow,
-    movingAverageRestriction = movingAverageRestriction
-  )
-
-  ### internal and exported parameters
+                                      indexTable,
+                                      markerTable,
+                                      name,
+                                      indexId = NULL,
+                                      markerId = NULL,
+                                      cohortDateRange = as.Date(c(NA, NA)),
+                                      daysPriorObservation = 0,
+                                      washoutWindow = 0,
+                                      indexMarkerGap = Inf,
+                                      combinationWindow = c(0,365),
+                                      movingAverageRestriction = 548){
+  # checks
+  cdm <- omopgenerics::validateCdmArgument(cdm = cdm)
+  omopgenerics::assertCharacter(indexTable, length = 1)
+  omopgenerics::assertCharacter(markerTable, length = 1)
+  cdm[[indexTable]] <- omopgenerics::validateCohortArgument(cohort  = cdm[[indexTable]])
+  cdm[[markerTable]] <- omopgenerics::validateCohortArgument(cohort = cdm[[markerTable]])
+  name <- omopgenerics::validateNameArgument(name = name, validation = "warning")
+  indexId <- omopgenerics::validateCohortIdArgument({{indexId}}, cdm[[indexTable]])
+  markerId <- omopgenerics::validateCohortIdArgument({{markerId}}, cdm[[markerTable]])
+  omopgenerics::assertNumeric(daysPriorObservation, min = 0, max = 999999)
+  omopgenerics::assertNumeric(washoutWindow, min = 0, max = 999999)
+  omopgenerics::assertNumeric(indexMarkerGap, min = 0)
+  omopgenerics::assertNumeric(combinationWindow, length = 2)
+  combinationWindow <- omopgenerics::validateWindowArgument(window = combinationWindow, snakeCase = TRUE)
+  if(length(combinationWindow)!= 1) {
+    cli::cli_abort("combinationWindow should contain only one window.")
+  }
+  omopgenerics::assertNumeric(movingAverageRestriction, min = 0)
+
+  # Change CohortDateRange
   if (any(is.na(cohortDateRange))) {
     cohortDateRange <- getcohortDateRange(
       cdm = cdm,
       cohortDateRange = cohortDateRange
     )
   }
 
-  ### nsr
+  omopgenerics::assertDate(cohortDateRange, length = 2, unique = TRUE)
+
+  # nsr
   nsr_name <- omopgenerics::uniqueId()
   nsr_summary_name <- paste0(nsr_name, "_summary")
 
@@ -194,7 +199,7 @@ generateSequenceCohortSet <- function(cdm,
 
   nsr_tbl <- Reduce(dplyr::union_all, nsr_calc)
 
-  ### Preprocess both cohorts
+  # Preprocess both cohorts
   indexPreprocessed <- preprocessCohort(cdm = cdm, cohortName = indexTable,
                                         cohortId = indexId, cohortDateRange = cohortDateRange) |>
     dplyr::rename("index_id" = "cohort_definition_id",
@@ -236,7 +241,7 @@ generateSequenceCohortSet <- function(cdm,
                   "marker_end_date", "gap_to_prior_marker",
                   "marker_name", "first_date", "second_date")
 
-  ### Post-join processing
+  # Post-join processing
   cdm[[name]] <- joinedData %>%
     dplyr::mutate(
       gap = as.numeric(!!CDMConnector::datediff("index_date", "marker_date",
@@ -296,8 +301,7 @@ generateSequenceCohortSet <- function(cdm,
                   days_prior_observation = !!format(daysPriorObservation, nsmall = 0),
                   washout_window = !!format(washoutWindow, nsmall = 0),
                   index_marker_gap = !!format(indexMarkerGap, nsmall = 0),
-                  combination_window = !!paste0("(",combinationWindow[[1]], ",",
-                                                combinationWindow[[2]], ")"),
+                  combination_window = !!paste0(unlist(combinationWindow), collapse = ", "),
                   moving_average_restriction = !!format(movingAverageRestriction, nsmall = 0)) |>
     dplyr::left_join(nsr_tbl,
                      by = c("index_id", "marker_id"),
@@ -321,16 +325,16 @@ generateSequenceCohortSet <- function(cdm,
       omopgenerics::newCohortTable(cohortSetRef = cohortSetRef,
                                    cohortAttritionRef = NULL)
 
-    ### exclusion criteria - where attrition starts
+    # exclusion criteria - where attrition starts
     # 1) within combination window
     cdm[[name]] <- cdm[[name]] %>%
-      {if (is.infinite(combinationWindow[2]))
+      {if (is.infinite(combinationWindow[[1]][2]))
         dplyr::filter(.,
-                      abs(.data$gap) > !!combinationWindow[1])
+                      abs(.data$gap) > !!combinationWindow[[1]][1])
         else
         dplyr::filter(.,
-                      abs(.data$gap) > !!combinationWindow[1] &
-                      abs(.data$gap) <= !!combinationWindow[2])
+                      abs(.data$gap) > !!combinationWindow[[1]][1] &
+                      abs(.data$gap) <= !!combinationWindow[[1]][2])
         } |>
       dplyr::compute(name = name, temporary = FALSE) |>
       omopgenerics::recordCohortAttrition(reason="Events excluded due to the prespecified combination window")

diff --git a/R/inputValidation.R b/R/inputValidation.R
@@ -1,66 +1,3 @@
-checkInputGenerateSequenceCohortSet <- function(cdm,
-                                        indexTable,
-                                        markerTable,
-                                        name,
-                                        cohortDateRange,
-                                        indexId,
-                                        markerId,
-                                        daysPriorObservation,
-                                        washoutWindow,
-                                        indexMarkerGap,
-                                        combinationWindow,
-                                        movingAverageRestriction
-                                        ) {
-
-  # Check cdm objects, writing schema and index/marker tables
-  checkCdm(cdm, tables = c(indexTable, markerTable))
-
-  # Check the format of name
-  if(stringr::str_detect(name, "^[a-z0-9_]+$", negate = TRUE)){
-    cli::cli_abort(c("name must be given in snake case",
-                     "i" = "for example 'my_cohort' is allowed but 'MyCohort' is not"))
-  }
-
-  # Check the rest of inputs
-  errorMessage <- checkmate::makeAssertCollection()
-
-  ## check name format
-  checkmate::assertCharacter(name, len = 1, any.missing = FALSE, add = errorMessage)
-
-  ## Check date
-  checkCohortDateRange(cohortDateRange, errorMessage)
-
-  ## Checks that Index and Marker ids exist in Index and Marker tables
-  checkCohortIds(cohort = cdm[[indexTable]],
-                 cohortId = indexId,
-                 errorMessage = errorMessage)
-  checkCohortIds(cohort = cdm[[markerTable]],
-                 cohortId = markerId,
-                 errorMessage = errorMessage)
-
-  ## Checks columns in Index and Marker tables
-  checkColumns(cdm, indexTable, errorMessage)
-  checkColumns(cdm, markerTable, errorMessage)
-
-  ## Check daysPriorObservation
-  checkDaysPriorObservation(daysPriorObservation, errorMessage)
-
-  ## Check combinationWindow
-  checkCombinationWindow(combinationWindow, errorMessage)
-
-  ## Check indexMarkerGap
-  checkIndexMarkerGap(indexMarkerGap, combinationWindow, errorMessage)
-
-  ## Check washoutWindow
-  checkWashoutWindow(washoutWindow, errorMessage)
-
-  ## Check movingAverageRestriction
-  checkMovingAverageRestriction(movingAverageRestriction, errorMessage)
-
-  # Report errors
-  checkmate::reportAssertions(collection = errorMessage)
-}
-
 checkInputSummariseSequenceRatios <- function(cohort,
                                               cohortId,
                                               confidenceInterval,

diff --git a/R/plotSequenceRatios.R b/R/plotSequenceRatios.R
@@ -40,6 +40,14 @@ plotSequenceRatios <- function(result,
 
   # validate checks
   result <- omopgenerics::validateResultArgument(result)
+  omopgenerics::assertCharacter(plotTitle, length = 1, null = T)
+  omopgenerics::assertCharacter(labs, length = 2)
+  omopgenerics::assertLogical(onlyASR, length = 1)
+  if(onlyASR) {
+    omopgenerics::assertCharacter(colours, length = 1)
+  } else {
+    omopgenerics::assertCharacter(colours, length = 2)
+  }
 
   # check settings
   result <- result |>
@@ -51,18 +59,6 @@ plotSequenceRatios <- function(result,
     cli::cli_warn("`result` object does not contain any `result_type == 'sequence_ratios'` information.")
   }
 
-  if (!is.logical(onlyASR)) {
-    cli::cli_abort("The parameter onlyASR has to be either True or False.")
-  }
-
-  if(onlyASR) {
-    checkmate::assert_character(colours,
-                                len = 1)
-  } else {
-    checkmate::assert_character(colours,
-                                len = 2)
-  }
-
   data <- result |>
     omopgenerics::tidy() |>
     dplyr::mutate(

diff --git a/R/plotTemporalSymmetry.R b/R/plotTemporalSymmetry.R
@@ -39,12 +39,13 @@ plotTemporalSymmetry <- function(result,
   rlang::check_installed("ggplot2")
 
   # checks
-  checkInputPlotTemporalSymmetry(result = result,
-                                 plotTitle = plotTitle,
-                                 labs = labs,
-                                 xlim = xlim,
-                                 colours = colours,
-                                 scales = scales)
+  result <- omopgenerics::validateResultArgument(result = result)
+  omopgenerics::assertCharacter(plotTitle, length = 1, null = T)
+  omopgenerics::assertCharacter(labs, length = 2)
+  omopgenerics::assertNumeric(xlim, length = 2, unique = T)
+  omopgenerics::assertCharacter(colours, length = 2)
+  scales <- omopgenerics::assertChoice(scales,
+                                       choices = c("free", "fixed"))
 
   plot_data <- result |>
     visOmopResults::splitGroup() |>

diff --git a/R/summariseSequenceRatios.R b/R/summariseSequenceRatios.R
@@ -32,10 +32,17 @@ summariseSequenceRatios <- function(cohort,
                                     minCellCount = 5) {
 
   # checks
-  checkInputSummariseSequenceRatios(cohort = cohort,
-                                    cohortId = cohortId,
-                                    confidenceInterval = confidenceInterval,
-                                    minCellCount = minCellCount)
+  cdm <- omopgenerics::cdmReference(cohort)
+  cdm <- omopgenerics::validateCdmArgument(cdm = cdm)
+  cohortId <- omopgenerics::validateCohortIdArgument({{cohortId}}, cohort)
+  omopgenerics::assertNumeric(confidenceInterval,
+                              min = 1,
+                              max = 99,
+                              length = 1)
+  omopgenerics::assertNumeric(minCellCount,
+                              min = 0,
+                              max = 99999999,
+                              length = 1)
 
   if (is.null(cohortId)){
     cohortId <- cohort |>

diff --git a/R/tableTemporalSymmetry.R b/R/tableTemporalSymmetry.R
@@ -29,10 +29,10 @@
 #' }
 #'
 tableTemporalSymmetry <- function(result,
-                                header = "variable_level",
-                                groupColumn = c("cdm_name", "index_name"),
-                                type = "gt",
-                                hide = "variable_name") {
+                                  header = "variable_level",
+                                  groupColumn = c("cdm_name", "index_name"),
+                                  type = "gt",
+                                  hide = "variable_name"){
 
   rlang::check_installed("flextable")
   rlang::check_installed("gt")

diff --git a/tests/testthat/test-generateSequenceCohortSet.R b/tests/testthat/test-generateSequenceCohortSet.R
@@ -2,7 +2,7 @@
 test_that("check output table name", {
   skip_on_cran()
   cdm <- mockCohortSymmetry()
-  cdm <- generateSequenceCohortSet(cdm,
+  cdm <- generateSequenceCohortSet(cdm = cdm,
                                    name = "output",
                                    indexTable ="cohort_1",
                                    markerTable = "cohort_2")
@@ -760,10 +760,10 @@ test_that("unsuccessful examples - Inf prior observation", {
   CDMConnector::cdmDisconnect(cdm)
 })
 
-test_that("unsuccessful examples - name not in the right form", {
+test_that("warning examples - name not in the right form", {
   skip_on_cran()
   cdm <- mockCohortSymmetry()
-  expect_error(generateSequenceCohortSet(cdm,
+  expect_warning(generateSequenceCohortSet(cdm,
                                          name = "joinCohorts",
                                          indexTable = "cohort_1",
                                          markerTable = "cohort_2",
@@ -902,8 +902,7 @@ test_that("generateSequenceCohortSet - inputValidation", {
       cohortDateRange = as.Date(c("2002-01-01", NA)),
       washoutWindow = 365,
       combinationWindow = c(0,Inf)
-    ),
-    "cdm must be a CDMConnector CDM reference object"
+    )
   )
   expect_error(
     generateSequenceCohortSet(

diff --git a/tests/testthat/test-plotTemporalSymmetry.R b/tests/testthat/test-plotTemporalSymmetry.R
@@ -68,7 +68,6 @@ test_that("expected errors", {
   expect_error(plotTemporalSymmetry(result = result, xlim = 2))
   expect_error(plotTemporalSymmetry(result = result, xlim = "4"))
   expect_error(plotTemporalSymmetry(result = result, xlim = 2))
-  expect_error(plotTemporalSymmetry(result = result, colours = c("no", "black")))
   expect_error(plotTemporalSymmetry(result = result, colours = "red"))
   expect_error(plotTemporalSymmetry(result = result, colours = c(3,4)))
   expect_error(plotTemporalSymmetry(result = result, plotTitle = 2))

diff --git a/tests/testthat/test-summariseSequenceRatios.R b/tests/testthat/test-summariseSequenceRatios.R
@@ -118,7 +118,7 @@ test_that("summariseSequenceRatios - testing ratios and CIs, Example 1", {
 
   expect_true(all(res$days_prior_observation==0))
   expect_true(all(res$washout_window==0))
-  expect_true(all(res$combination_window == "(0,365)"))
+  expect_true(all(res$combination_window == "0, 365"))
   expect_true(all(res$index_marker_gap=="Inf"))
   expect_true(all(res$confidence_interval==95))
   expect_true(all(as.integer(res$first_pharmac_index_percentage)<=100 & 0 <= as.integer(res$first_pharmac_index_percentage)))
@@ -179,11 +179,11 @@ test_that("summariseSequenceRatios - testing ratios and CIs, Example 2", {
     dplyr::select(-"estimate_type") |>
     tidyr::pivot_wider(names_from = c("variable_level", "variable_name", "estimate_name"),
                        values_from = "estimate_value") |>
-    dplyr::left_join(res |> omopgenerics::settings())
+    dplyr::left_join(res |> omopgenerics::settings(), by = c("result_id", "cdm_name"))
 
   expect_true(all(res$days_prior_observation==0))
   expect_true(all(res$washout_window==0))
-  expect_true(all(res$combination_window == "(0,365)"))
+  expect_true(all(res$combination_window == "0, 365"))
   expect_true(all(res$index_marker_gap=="Inf"))
   expect_true(all(res$confidence_interval==95))
   expect_true((res$index_cohort_name=="cohort_1"))
@@ -1000,7 +1000,9 @@ test_that("Inf CI", {
                                    indexTable = "cohort_1",
                                    markerTable = "cohort_2")
 
-  res <- summariseSequenceRatios(cohort = cdm$joined_cohorts)
+  expect_warning(
+    res <- summariseSequenceRatios(cohort = cdm$joined_cohorts)
+  )
 
   expect_true(
     all(res |>
-Original file line number
+Diff line change
@@ Expand Up / @@ -55,7 +55,6 @@ Imports: @@
         dplyr,
         PatientProfiles,
         rlang,
-        stringr,
         tibble,
         visOmopResults (>= 0.4.0),
         tidyr,
@@ Expand Down @@