From f9f877d53dadce9c834c8ce4a20d2e2aa975ddb9 Mon Sep 17 00:00:00 2001
From: Sam <s.e.abbott12@gmail.com>
Date: Mon, 2 Sep 2024 22:37:06 +0100
Subject: [PATCH] add check tests

---
 R/check.R                   | 12 +++++++---
 man/check_dprimary.Rd       |  5 +++--
 tests/testthat/test-check.R | 44 +++++++++++++++++++++++++++++++++++++
 3 files changed, 56 insertions(+), 5 deletions(-)
 create mode 100644 tests/testthat/test-check.R

diff --git a/R/check.R b/R/check.R
index 254cf6f..116e3ad 100644
--- a/R/check.R
+++ b/R/check.R
@@ -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) ||
@@ -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
@@ -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))
   }
diff --git a/man/check_dprimary.Rd b/man/check_dprimary.Rd
index bf6b0f2..5078f69 100644
--- a/man/check_dprimary.Rd
+++ b/man/check_dprimary.Rd
@@ -2,7 +2,7 @@
 % Please edit documentation in R/check.R
 \name{check_dprimary}
 \alias{check_dprimary}
-\title{Check if a function is a valid probability density function (PDF)}
+\title{Check if a function is a valid bounded probability density function (PDF)}
 \usage{
 check_dprimary(dprimary, pwindow, dprimary_args = list(), tolerance = 0.001)
 }
@@ -30,7 +30,8 @@ dprimary is not a valid PDF.
 }
 \description{
 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.
 }
 \examples{
 check_dprimary(dunif, pwindow = 1)
diff --git a/tests/testthat/test-check.R b/tests/testthat/test-check.R
new file mode 100644
index 0000000..98f1704
--- /dev/null
+++ b/tests/testthat/test-check.R
@@ -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"
+  )
+})