Minor updates and test additions

OHDSI · Oct 5, 2023 · ba25a6b · ba25a6b
1 parent 976c50c
commit ba25a6b
Show file tree

Hide file tree

Showing 2 changed files with 117 additions and 11 deletions.
diff --git a/R/OutcomeModels.R b/R/OutcomeModels.R
@@ -109,6 +109,9 @@ fitOutcomeModel <- function(population,
   if (any(excludeCovariateIds %in% interactionCovariateIds)) {
     stop("Can't exclude covariates that are to be used for interaction terms")
   }
+  if (any(includeCovariateIds %in% excludeCovariateIds)) {
+    stop("Can't exclude covariates that are to be included")
+  }
   if (inversePtWeighting && is.null(population$iptw)) {
     stop("Requested inverse probability weighting, but no IPTW are provided. Use createPs to generate them")
   }

diff --git a/tests/testthat/test-fitOutcomeModel.R b/tests/testthat/test-fitOutcomeModel.R
@@ -60,6 +60,17 @@ test_that("population", {
     ),
     "Names must include the elements"
   )
+
+  ## sum(outcomeCount) == 0 ----
+  pop <- studyPop %>%
+    mutate(outcomeCount = 0)
+
+  expect_output(
+    fitOutcomeModel(
+      population = pop
+    ),
+    "NO OUTCOMES FOUND FOR POPULATION"
+  )
 })
 
 test_that("cohortMethodData", {
@@ -260,6 +271,29 @@ test_that("stratified", {
     modTrue1$outcomeCounts,
     modTrue2$outcomeCounts
   ))
+
+  ## sum(treatment) == 0 ----
+  pop0 <- studyPopStratisfied %>%
+    mutate(treatment = 0)
+
+  pop1 <- studyPopStratisfied %>%
+    mutate(treatment = 1)
+
+  expect_output(
+    fitOutcomeModel(
+      population = pop0,
+      stratified = TRUE
+    ),
+    "NO STRATA WITH BOTH TARGET, COMPARATOR, .+ OUTCOME"
+  )
+
+  expect_output(
+    fitOutcomeModel(
+      population = pop1,
+      stratified = TRUE
+    ),
+    "NO STRATA WITH BOTH TARGET, COMPARATOR, .+ OUTCOME"
+  )
 })
 
 test_that("useCovariates", {
@@ -443,6 +477,16 @@ test_that("interactionCovariateIds", {
       interactionCovariateIds = NA
     )
   )
+
+  ## length(interactionCovariateIds) > 1 & useCovariates ----
+  mod <- suppressWarnings(fitOutcomeModel(
+    population = studyPopMatched,
+    cohortMethodData = sCohortMethodData,
+    useCovariates = TRUE,
+    interactionCovariateIds = c(femaleCovId)
+  ))
+
+  expect_s3_class(mod, "OutcomeModel")
 })
 
 test_that("excludeCovariateIds", {
@@ -650,17 +694,6 @@ test_that("profileGrid", {
   )
 
   expect_s3_class(mod, "OutcomeModel")
-
-  ## Gird and Bounds ----
-  expect_error(
-    fitOutcomeModel(
-      population = studyPop,
-      cohortMethodData = sCohortMethodData,
-      profileGrid = log(seq(10)),
-      profileBounds = c(log(0.1), log(10))
-    ),
-    "grid and bounds"
-  )
 })
 
 test_that("profileBounds", {
@@ -926,3 +959,73 @@ test_that("control", {
     ))
   )
 })
+
+test_that("Combinations", {
+  ## stratified && nrow(population) > 0 && is.null(population$stratumId)
+  expect_error(
+    suppressWarnings(fitOutcomeModel(
+      population = studyPop,
+      stratified = TRUE
+    )),
+    "matchOnPs or stratifyByPs"
+  )
+  ## is.null(cohortMethodData) && useCovariates
+  expect_error(
+    suppressWarnings(fitOutcomeModel(
+      population = studyPop,
+      useCovariates = TRUE
+    )),
+    "covariates .+ no cohortMethodData object specified"
+  )
+
+  ## is.null(cohortMethodData) && length(interactionCovariateIds) != 0
+  expect_error(
+    suppressWarnings(fitOutcomeModel(
+      population = studyPop,
+      interactionCovariateIds = c(8532001)
+    )),
+    "interaction terms .+ no cohortMethodData object specified"
+  )
+
+  ## any(excludeCovariateIds %in% interactionCovariateIds)
+  expect_error(
+    suppressWarnings(fitOutcomeModel(
+      population = studyPop,
+      cohortMethodData = sCohortMethodData,
+      interactionCovariateIds = c(8532001),
+      excludeCovariateIds = c(8532001)
+    )),
+    "exclude covariates .+ used for interaction"
+  )
+
+  # any(includeCovariateIds %in% excludeCovariateIds)
+  expect_error(
+    suppressWarnings(fitOutcomeModel(
+      population = studyPop,
+      cohortMethodData = sCohortMethodData,
+      includeCovariateIds = c(8532001),
+      excludeCovariateIds = c(8532001)
+    )),
+    "exclude covariates .+ included"
+  )
+
+  ## inversePtWeighting && is.null(population$iptw)
+  expect_error(
+    suppressWarnings(fitOutcomeModel(
+      population = studyPop,
+      inversePtWeighting = TRUE
+    )),
+    "no IPTW are provided"
+  )
+
+  ## !is.null(profileGrid) && !is.null(profileBounds)
+  expect_error(
+    fitOutcomeModel(
+      population = studyPop,
+      cohortMethodData = sCohortMethodData,
+      profileGrid = log(seq(10)),
+      profileBounds = c(log(0.1), log(10))
+    ),
+    "grid and bounds"
+  )
+})