more test

Author: gravesti

.pre-commit-config.yaml

@@ -3,7 +3,7 @@
 # R specific hooks: https://github.com/lorenzwalthert/precommit
 repos:
   - repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.4.2
+    rev: v0.4.3
     hooks:
       - id: style-files
         args: [--style_pkg=styler, --style_fun=tidyverse_style]
@@ -91,6 +91,6 @@ repos:
         files: '\.Rhistory|\.RData|\.Rds|\.rds$'
         # `exclude: <regex>` to allow committing specific files.
   - repo: https://github.com/igorshubovych/markdownlint-cli
-    rev: v0.40.0
+    rev: v0.41.0
     hooks:
       - id: markdownlint

R/dbetabinom.R

@@ -229,7 +229,6 @@ qbetaMix <- function(p, par, weights, lower.tail = TRUE) {
 
     uniroot(
       f = function(q) pbetaMix(q, par, weights, lower.tail = lower.tail, skipchecks = TRUE) - p,
-      # interval = c(0, 1),
       interval = grid_interval,
       f.lower = -p,
       f.upper = 1 - p,

R/postprobDist.R

@@ -178,8 +178,6 @@ postprobDist <- function(x,
   activeBetamixPost <- lapply(x, function(x) h_getBetamixPost(x = x, n = n, par = parE, weights = weights))
 
   controlBetamixPost <- h_getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS)
-  # assert_names(names(activeBetamixPost), identical.to = c("par", "weights"))
-  # assert_names(names(controlBetamixPost), identical.to = c("par", "weights"))
   if (relativeDelta) {
     epsilon <- .Machine$double.xmin
     integrand <- h_integrand_relDelta

man/ocPredprob.Rd

@@ -84,6 +84,23 @@ test_that("pbetaMix gives the correct number result with beta-mixture", {
   expect_equal(result, 0.4768404, tolerance = 1e-5)
 })
 
+test_that("pbetaMix works for edge cases", {
+  result_ushape <- pbetaMix(
+    q = c(0, 1),
+    par = rbind(c(0.2, 0.4), c(3, .3)),
+    weights = c(0.6, 0.4)
+  )
+  expect_equal(result_ushape, c(0, 1))
+
+  result_vshape <- pbetaMix(
+    q = c(0, 1),
+    par = rbind(c(9, 4), c(1, 1)),
+    weights = c(0.6, 0.4)
+  )
+  expect_equal(result_vshape, c(0, 1))
+})
+
+
 test_that("The complement of pbetaMix can be derived with a different lower.tail flag", {
   result <- pbetaMix(
     q = 0.3,
@@ -184,6 +201,32 @@ test_that("dbetaMix gives the correct result as dbeta", {
   expect_equal(result, result2, tolerance = 1e-4)
 })
 
+test_that("dbetaMix handles edge cases", {
+  result_inf <- dbetaMix(
+    x = c(0, 1), par = rbind(c(0.2, 0.4), c(1, 1)),
+    weights = c(0.6, 0.4)
+  )
+  expect_equal(result_inf, c(Inf, Inf))
+
+  result_finite <- dbetaMix(
+    x = c(0, 1), par = rbind(c(2, 4), c(1, 1)),
+    weights = c(0.6, 0.4)
+  )
+  expect_equal(result_finite, c(0.4, 0.4))
+
+  result_right <- dbetaMix(
+    x = c(0, 1), par = rbind(c(0, 4), c(1, 1)),
+    weights = c(0.6, 0.4)
+  )
+  expect_equal(result_right, c(Inf, 0.4))
+
+  result_right <- dbetaMix(
+    x = c(NA, 1), par = rbind(c(0, 4), c(1, 1)),
+    weights = c(0.6, 0.4)
+  )
+  expect_equal(result_right, c(NA, 0.4))
+})
+
 # h_getBetamixPost ----
 
 test_that("h_getBetamixPost gives the correct beta-mixture parameters", {

tests/testthat/test-dbetabinom.R

@@ -53,3 +53,18 @@ test_that("postprob gives incrementally higher values with increased x", {
   )
   expect_true(is_lower < is_higher)
 })
+
+test_that("postprob works with vector x", {
+  result <- postprob(x = 0:23, n = 23, p = 0.60, par = c(0.6, 0.4))
+  expected <- c(
+    1.12066620085448e-10, 6.73786529927603e-09, 1.45879637562279e-07,
+    1.86374536434781e-06, 1.64656040420248e-05, 0.000108838231763851,
+    0.000564103325535708, 0.00236446983272442, 0.00819197194809839,
+    0.0238449136766029, 0.0590640325657381, 0.125847456119664,
+    0.232931221473374, 0.378259188739121, 0.54495891589689,
+    0.705949748288983, 0.835980805221058, 0.922929283049132,
+    0.970355725500809, 0.991009176245894, 0.997963909660055,
+    0.999685712592687, 0.999972679748126, 0.99999934483779
+  )
+  expect_equal(result, expected, tolerance = 1e-5)
+})

tests/testthat/test-postprob.R

@@ -84,6 +84,26 @@ test_that("postprobDist gives the correct result for a weighted beta-mixture", {
   expect_equal(result, 0.3248885, tolerance = 1e-4)
 })
 
+test_that("postprobDist works with vector x", {
+  result <- postprobDist(
+    x = c(0, 10, 22, 23),
+    n = 23,
+    delta = 0.1,
+    parE = rbind(
+      c(0.6, 0.4),
+      c(1, 1)
+    ),
+    parS = rbind(
+      c(0.6, 0.4),
+      c(1, 1)
+    ),
+    weights = c(0.5, 0.5),
+    weightsS = c(0.3, 0.7)
+  )
+  expected <- c(0.0022653966293937, 0.324888481243124, 0.771937234865335, 0.817017633697455)
+  expect_equal(result, expected, tolerance = 1e-4)
+})
+
 test_that("postprobDist gives an error when n is not a number.", {
   expect_error(
     results <- postprobDist(