Skip to content

Commit

Permalink
Minor updates and test additions
Browse files Browse the repository at this point in the history
  • Loading branch information
mvankessel-EMC committed Oct 5, 2023
1 parent 976c50c commit ba25a6b
Show file tree
Hide file tree
Showing 2 changed files with 117 additions and 11 deletions.
3 changes: 3 additions & 0 deletions R/OutcomeModels.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
}
Expand Down
125 changes: 114 additions & 11 deletions tests/testthat/test-fitOutcomeModel.R
Original file line number Diff line number Diff line change
Expand Up @@ -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", {
Expand Down Expand Up @@ -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", {
Expand Down Expand Up @@ -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", {
Expand Down Expand Up @@ -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", {
Expand Down Expand Up @@ -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"
)
})

0 comments on commit ba25a6b

Please sign in to comment.