Skip to content

Commit

Permalink
add check tests
Browse files Browse the repository at this point in the history
  • Loading branch information
seabbs committed Sep 2, 2024
1 parent fac5f65 commit f9f877d
Show file tree
Hide file tree
Showing 3 changed files with 56 additions and 5 deletions.
12 changes: 9 additions & 3 deletions R/check.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ check_pdist <- function(pdist, D, ...) {
if (is.infinite(D)) {
D <- 1000
}
test_values <- sort(sample(seq(0, D, by = 1), 4))
test_values <- sort(runif(4, 0, D))
test_results <- pdist(test_values, ...)

if (!all(diff(test_results) >= 0) ||
Expand All @@ -34,10 +34,11 @@ check_pdist <- function(pdist, D, ...) {
return(invisible(NULL))
}

#' Check if a function is a valid probability density function (PDF)
#' Check if a function is a valid bounded probability density function (PDF)
#'
#' This function tests whether a given function behaves like a valid PDF by
#' checking if it integrates to approximately 1 over the specified range.
#' checking if it integrates to approximately 1 over the specified range
#' and if it takes the arguments min and max.
#'
#' @inheritParams pprimarycensoreddist
#' @param tolerance The tolerance for the integral to be considered close to 1
Expand All @@ -52,6 +53,11 @@ check_pdist <- function(pdist, D, ...) {
#' check_dprimary(dunif, pwindow = 1)
check_dprimary <- function(dprimary, pwindow, dprimary_args = list(),
tolerance = 1e-3) {
# check if dprimary takes min and max as arguments
if (!all(c("min", "max") %in% names(formals(dprimary)))) {
stop("dprimary must take min and max as arguments")
}

integrand <- function(x) {
do.call(dprimary, c(list(x = x, min = 0, max = pwindow), dprimary_args))
}
Expand Down
5 changes: 3 additions & 2 deletions man/check_dprimary.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

44 changes: 44 additions & 0 deletions tests/testthat/test-check.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,44 @@
test_that("check_pdist works correctly for valid CDF", {
expect_silent(check_pdist(pnorm, D = 10))
expect_silent(check_pdist(punif, D = 1))
})

test_that("check_pdist throws error for invalid CDF", {
invalid_cdf <- function(x, ...) x^2 - 1 # Not bounded between 0 and 1
expect_error(
check_pdist(invalid_cdf, D = 10),
"pdist is not a valid cumulative distribution function"
)
})

test_that("check_pdist handles infinite D correctly", {
expect_silent(check_pdist(pnorm, D = Inf))
})

test_that("check_dprimary works correctly for valid PDF", {
expect_silent(check_dprimary(dunif, pwindow = 1))
})

test_that("check_dprimary throws error if PDF doesn't have min and max args", {
expect_error(
check_dprimary(dnorm, pwindow = 1),
"dprimary must take min and max as arguments"
)
})

test_that("check_dprimary throws error for invalid PDF", {
invalid_pdf <- function(x, min, max, ...) rep(0.5, length(x))
expect_error(
check_dprimary(invalid_pdf, pwindow = 1),
"dprimary is not a valid probability density function"
)
})

test_that("check_dprimary respects tolerance", {
almost_valid_pdf <- function(x, min, max, ...) dunif(x, min, max) * 1.01
expect_silent(check_dprimary(almost_valid_pdf, pwindow = 1, tolerance = 0.02))
expect_error(
check_dprimary(almost_valid_pdf, pwindow = 1, tolerance = 0.005),
"dprimary is not a valid probability density function"
)
})

0 comments on commit f9f877d

Please sign in to comment.