clean

R/postprobDist.R

@@ -110,16 +110,13 @@ h_get_bounds <- function(controlBetamixPost) {
 #'  and each row corresponds to each component of a beta-mixture distribution
 #'  for the `E` group. See details.
 #' @typed weights : numeric
-#'  the non-negative mixture weights of the beta mixture prior for group `E`.
-#'  equal weights across mixture components.
-#'  In the simple case of no mixture of priors given, the Beta parameters are weighted as `100 %`.
-#'  Weights can exceed 1, to which the algorithm will normalize the weights such that all weights sum to 1.
+#'  the non-negative mixture weights of the beta mixture prior for group `E`. See details.
 #' @typed parS : "`numeric` or `matrix`"
 #'  parameters for beta distribution. If it is a matrix, it needs to have 2 columns,
 #'  and each row corresponds to each component of a beta-mixture distribution
 #'  for the `S` group. See details.
 #' @typed weightsS : numeric
-#'  weights for the SOC group. See also `weights`.
+#'  the non-negative mixture weights of the beta mixture prior for group `S`. See details.
 #' @typed epsilon : number
 #'  the smallest non-negative floating number to represent the lower bound for
 #'  the interval of integration.
@@ -142,10 +139,13 @@ h_get_bounds <- function(controlBetamixPost) {
 #'
 #' @details
 #'
-#' The beta mixture prior for the E arm requires argument `parE` and `weights`.
-#' The beta mixture prior for the E arm requires argument `parS` and `weightsS`.
+#' The beta mixture prior for the `E` arm requires argument `parE` and `weights`.
+#' The beta mixture prior for the `S` arm requires argument `parS` and `weightsS`.
 #' See `[postprob()]` for details.
 #'
+#' If a beta-mixture is used, by default, the weights are uniform across the components.
+#' Weights can exceed 1, to which the algorithm will normalize the weights such that all weights sum to 1.
+#'
 #' @example examples/postprobDist.R
 #' @export
 postprobDist <- function(x,

tests/testthat/test-postprob.R

@@ -19,7 +19,7 @@ test_that("postprob gives the correct number result", {
 })
 
 test_that("postprob gives the correct number result", {
-  # 2 component beta mixture prior, i.e., P_E ~ 1*beta(0.6,0.4) + 1*beta(1,1) and Pr(P_E > p | data) = 0.823
+  # 2 component beta mixture prior, i.e., P_E ~ 0.5*beta(0.6,0.4) + 0.5*beta(1,1) and Pr(P_E > p | data) = 0.05559802
   result <- postprob(
     x = 10,
     n = 23,

tests/testthat/test-postprobDist.R

@@ -11,7 +11,7 @@ test_that("postprobDist gives incrementally higher values with larger x", {
   expect_true(is_lower < is_higher)
 })
 
-test_that("postprobDist gives incrementally higher values with increase x support", {
+test_that("postprobDist gives incrementally higher values with larger x", {
   expected_lower <- postprobDist(x = 16, n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4))
   expected_higher <- postprobDist(x = 20, n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4))
   result <- postprobDist(x = c(16, 20), n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4))
@@ -84,25 +84,6 @@ test_that("postprobDist gives the correct result with a weighted beta-mixture",
   expect_equal(result, 0.3248885, tolerance = 1e-4)
 })
 
-test_that("postprobDist gives the correct number result", {
-  result <- postprobDist(
-    x = 10,
-    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),
-  )
-  expect_equal(result, 0.3248885, tolerance = 1e-4)
-})
-
 test_that("postprobDist gives an error when n is not a number", {
   expect_error(
     results <- postprobDist(
@@ -112,11 +93,11 @@ test_that("postprobDist gives an error when n is not a number", {
       parS = c(0.6, 0.4),
       delta = 0.1,
       relativeDelta = FALSE
-    ), "must have length 1, but has length 2"
+    ), "number of items to replace is not a multiple of replacement length"
   )
 })
 
-test_that("postprobDist gives an error", {
+test_that("postprobDist gives an error when xS and nS are not numbers", {
   expect_error(
     results <- postprobDist(
       x = c(10, 16),
@@ -128,37 +109,7 @@ test_that("postprobDist gives an error", {
       parS = c(0.6, 0.4),
       weights = c(0.5),
       weightsS = c(0.3),
-    ), "Must have length 1"
-  )
-})
-
-test_that("postprobDist gives an error", {
-  expect_error(
-    results <- postprobDist(
-      x = 16,
-      n = 23,
-      xS = c(10, 12),
-      nS = c(20),
-      parE = c(0.6, 0.4),
-      parS = c(0.6, 0.4),
-      delta = 0.1,
-      relativeDelta = FALSE
-    ), "Must have length 1."
-  )
-})
-
-test_that("postprobDist gives an error", {
-  expect_error(
-    results <- postprobDist(
-      x = 16,
-      n = 23,
-      xS = c(10, 12),
-      nS = c(20, 21),
-      parE = c(0.6, 0.4),
-      parS = c(0.6, 0.4),
-      delta = 0.1,
-      relativeDelta = FALSE
-    ), "Must have length 1."
+    ), "number of items to replace is not a multiple of replacement length"
   )
 })
 
@@ -178,33 +129,35 @@ test_that("h_integrand_relDelta gives the correct numerical result", {
   activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights)
   controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS)
   results <- h_integrand_relDelta(
-    p_s = p_s, delta = delta,
+    p_s = p_s,
+    delta = delta,
     activeBetamixPost = activeBetamixPost,
     controlBetamixPost = controlBetamixPost
   )
   expect_equal(results, 0.0001352829, tolerance = 1e-4)
 })
 
-test_that("h_integrand_relDelta gives the correct numerical result", {
+test_that("h_integrand_relDelta gives the correct numerical result with a weighted beta-mixture.", {
   x <- 16
   n <- 23
   xS <- 10
   nS <- 20
-  parE <- t(c(1, 3))
-  parS <- t(c(1, 1))
-  weights <- c(0.5)
-  weightsS <- c(1)
+  parE <- rbind(c(1, 3), c(2, 3))
+  parS <- rbind(c(1, 1), c(3, 4))
+  weights <- c(5, 10)
+  weightsS <- c(3, 4)
   p_s <- 0.1
   delta <- 0.1
   relativeDelta <- TRUE
   activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights)
   controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS)
   results <- h_integrand_relDelta(
-    p_s = p_s, delta = delta,
+    p_s = p_s,
+    delta = delta,
     activeBetamixPost = activeBetamixPost,
     controlBetamixPost = controlBetamixPost
   )
-  expect_equal(results, 0.0001352829, tolerance = 1e-4)
+  expect_equal(results, 6.498862e-05, tolerance = 1e-4)
 })
 
 # h_integrand --
@@ -223,32 +176,33 @@ test_that("h_integrand gives the correct numerical result", {
   activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights)
   controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS)
   results <- h_integrand(
-    p_s = p_s, delta = delta,
+    p_s = p_s,
+    delta = delta,
     activeBetamixPost = activeBetamixPost,
     controlBetamixPost = controlBetamixPost
   )
   expect_equal(results, 0.0001352828, tolerance = 1e-4)
 })
 
-
-test_that("h_integrand gives the correct numerical result", {
+test_that("h_integrand gives the correct numerical result with a weighted beta-mixture.", {
   x <- 16
   n <- 23
   xS <- 10
   nS <- 20
-  parE <- t(c(1, 3))
-  parS <- t(c(1, 1))
-  weights <- 1
-  weightsS <- 1
+  parE <- rbind(c(1, 3), c(2, 3))
+  parS <- rbind(c(1, 1), c(3, 4))
+  weights <- c(5, 10)
+  weightsS <- c(3, 4)
   p_s <- 0.1
   delta <- 0.1
   relativeDelta <- FALSE
   activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights)
   controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS)
   results <- h_integrand(
-    p_s = p_s, delta = delta,
+    p_s = p_s,
+    delta = delta,
     activeBetamixPost = activeBetamixPost,
     controlBetamixPost = controlBetamixPost
   )
-  expect_equal(results, 0.0001352828, tolerance = 1e-4)
+  expect_equal(results, 6.498861e-05, tolerance = 1e-4)
 })