17_getBetaMix_dbetaMix

NAMESPACE

@@ -6,7 +6,6 @@ export(dbetaMix)
 export(dbetabinom)
 export(dbetabinomMix)
 export(dbetadiff)
-export(getBetamixPost)
 export(logit)
 export(myPlot)
 export(myPlotDiff)

R/dbetabinom.R

@@ -35,22 +35,19 @@ dbetabinom <- function(x, m, a, b, log = FALSE) {
   }
 }
 
-
 #' Beta-Mixture-Binomial Density Function
 #'
 #' @description `r lifecycle::badge("experimental")`
 #'
 #' Calculates the density function for a mixture of beta-binomial distributions.
 #'
-#' @typed x : numeric
-#'  number of successes.
-#' @typed m : number
-#'  number of trials.
+#' @inheritParams dbetabinom
 #' @typed par : matrix
 #'  the beta parameters matrix, with K rows and 2 columns,
 #'  corresponding to the beta parameters of the K components.
 #' @typed weights : numeric
-#'  the mixture weights of the beta mixture prior.
+#'  the mixture weights of the beta mixture prior of length K.
+#'  Each element corresponds to the row of beta parameters in `par`.
 #' @typed log : flag
 #'  whether to return the log density value (not default).
 #' @return The (log) density values of the mixture of beta-binomial distributions at `x`.
@@ -72,75 +69,66 @@ dbetabinomMix <- Vectorize(dbetabinomMix, vectorize.args = "x")
 
 #' Compute Beta-Mixture-Binomial Posterior Distribution
 #'
-#' Computes the posterior parameters of a beta-mixture-binomial distribution.
+#' A helper function that computes the posterior parameters of a beta-mixture-binomial distribution.
+#'
+#' @inheritParams dbetabinom
+#' @inheritParams dbetabinomMix
 #'
-#' @param x number of successes
-#' @param n number of patients
-#' @param par the beta parameters matrix, with K rows and 2 columns,
-#' corresponding to the beta parameters of the K components
-#' @param weights the mixture weights
-#' @return a list with the updated beta parameters and weights
+#' @return A list with the updated beta parameters and weights.
 #'
 #' @importFrom stats dbeta dbinom
 #'
-#' @example examples/getBetamixPost.R
-#' @export
-
-getBetamixPost <- function(x, n, par, weights) {
-  ## check the format
-  stopifnot(
-    is.matrix(par),
-    is.numeric(par),
-    identical(ncol(par), 2L),
-    all(par > 0),
-    identical(nrow(par), length(weights)),
-    all(weights > 0)
-  )
-
-  ## renormalize weights
+#' @keywords internal
+h_getBetamixPost <- function(x, n, par, weights) {
+  assert_numeric(x, lower = 0, upper = n, finite = TRUE)
+  assert_numeric(n, lower = 0, finite = TRUE)
+  assert_matrix(par, min.rows = 1, max.cols = 2, mode = "numeric")
+  assert_numeric(weights, min = 0, len = nrow(par), finite = TRUE)
+  # We renormalize weights.
   weights <- weights / sum(weights)
-
-  ## now compute updated parameters
+  # We now compute updated parameters.
   postPar <- par
   postPar[, 1] <- postPar[, 1] + x
   postPar[, 2] <- postPar[, 2] + n - x
   postParProb <- postPar[, 1] / (postPar[, 1] + postPar[, 2])
-
-  ## compute updated mixture probabilities
+  # We compute updated mixture probabilities.
   tmp <- exp(
     stats::dbinom(x, size = n, prob = postParProb, log = TRUE) +
       stats::dbeta(postParProb, par[, 1], par[, 2], log = TRUE) -
       stats::dbeta(postParProb, postPar[, 1], postPar[, 2], log = TRUE)
   )
-
+  # We compute the updated weights of the posterior
   postWeights <- weights * tmp / sum(weights * tmp)
-
-  return(list(
+  assert_numeric(postWeights)
+  list(
     par = postPar,
     weights = postWeights
-  ))
+  )
 }
 
-
-
-#' Beta-mixture density function
+#' Beta-Mixture density function
+#'
+#' Calculating beta-mixture density values of support `x`.
 #'
-#' Note that `x` can be a vector.
+#' @description `r lifecycle::badge("experimental")`
+#'
+#' The beta-mixture density can be calculated with the combination of K set of beta parameters and K
+#' length of weights.
+#'
+#' @inheritParams dbetabinom
+#' @inheritParams dbetabinomMix
+#' @typed log : flag
+#'  whether log values of the beta-mixture density function are returned.
 #'
-#' @param x the abscissa
-#' @param par the beta parameters matrix, with K rows and 2 columns,
-#' corresponding to the beta parameters of the K components
-#' @param weights the mixture weights of the beta mixture prior
-#' @param log return the log value? (not default)
 #' @return the (log) density values
 #'
 #' @export
 dbetaMix <- function(x, par, weights, log = FALSE) {
   ret <- sum(weights * dbeta(x, par[, 1], par[, 2]))
   if (log) {
-    return(log(ret))
+    log(ret)
   } else {
-    return(ret)
+    ret
   }
 }
 dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x")

R/oc2.R

@@ -118,7 +118,7 @@ oc2 <- function(method =
   ## if prior weights of the beta mixture are not supplied
   if (missing(weights)) {
     weights <- rep(1, nrow(parE))
-    ## (don't need to be normalized, this is done in getBetamixPost)
+    ## (don't need to be normalized, this is done in h_getBetamixPost)
   }
 
   ## allocation to active and control arms:

R/oc3.R

@@ -113,7 +113,7 @@ oc3 <- function(method =
   ## if prior weights of the beta mixture are not supplied
   if (missing(weights)) {
     weights <- rep(1, nrow(parE))
-    ## (don't need to be normalized, this is done in getBetamixPost)
+    ## (don't need to be normalized, this is done in h_getBetamixPost)
   }
 
   ## allocation to active and control arms:

R/postprob.R

@@ -63,7 +63,7 @@ postprobBeta <- function(x, n, p, a = 1, b = 1) {
 #'  The mixture weights of the beta mixture prior. Default are
 #'  uniform weights across mixture components.
 #' @typed betamixPost : matrix
-#'  optional result of `[getBetamixPost()]` in order
+#'  optional result of `[h_getBetamixPost()]` in order
 #'  to speed up the computations. If supplied, this is directly used, bypassing
 #'  the other arguments (except `p` and `log.p` of course).
 #' @typed log.p : number
@@ -85,7 +85,7 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS
     if (missing(weights)) {
       weights <- rep(1, nrow(parE))
     }
-    betamixPost <- getBetamixPost(
+    betamixPost <- h_getBetamixPost(
       x = x,
       n = n,
       par = parE,

R/postprobDist.R

@@ -178,8 +178,8 @@ postprobDist <- function(x,
   assert_numeric(weightsS, lower = 0, finite = TRUE)
   assert_numeric(parE, lower = 0, finite = TRUE)
   assert_numeric(parS, lower = 0, finite = TRUE)
-  activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights)
-  controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS)
+  activeBetamixPost <- 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) {

R/predprob.R

@@ -59,11 +59,11 @@ predprob <- function(x, n, Nmax, p, thetaT, parE = c(1, 1),
   ## if prior weights of the beta mixture are not supplied
   if (missing(weights)) {
     weights <- rep(1, nrow(parE))
-    ## (don't need to be normalized, this is done in getBetamixPost)
+    ## (don't need to be normalized, this is done in h_getBetamixPost)
   }
 
   ## now compute updated parameters
-  betamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights)
+  betamixPost <- h_getBetamixPost(x = x, n = n, par = parE, weights = weights)
 
   py <- with(
     betamixPost,

R/predprobDist.R

@@ -100,7 +100,7 @@ predprobDist <- function(x, n,
   ## if prior weights of the beta mixture are not supplied
   if (missing(weights)) {
     weights <- rep(1, nrow(parE))
-    ## (don't need to be normalized, this is done in getBetamixPost)
+    ## (don't need to be normalized, this is done in h_getBetamixPost)
   }
 
   ## if parS is a vector => situation where there is only one component
@@ -119,7 +119,7 @@ predprobDist <- function(x, n,
 
   ## now compute updated parameters for beta mixture distribution on the
   ## treatment proportion
-  activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights)
+  activeBetamixPost <- h_getBetamixPost(x = x, n = n, par = parE, weights = weights)
 
   ## now with the beta binomial mixture:
   py <- with(
@@ -160,7 +160,7 @@ predprobDist <- function(x, n,
     ## counts in future SOC patients:
     mS <- NmaxControl - nS
 
-    controlBetamixPost <- getBetamixPost(
+    controlBetamixPost <- h_getBetamixPost(
       x = xS, n = nS, par = parS,
       weights = weightsS
     )

examples/dbetabinom.R

@@ -1,5 +1,5 @@
+# dbetabinom --
 dbetabinom(x = 2, m = 29, a = 0.2, b = 0.4, log = FALSE)
 
 # Can also specify x as a vector.
-
 dbetabinom(x = 1:28, m = 29, a = 0.2, b = 0.4, log = FALSE)

examples/getBetamixPost.R

@@ -1,7 +1,7 @@
 ## example from Lee and Liu:
-getBetamixPost(x = 16, n = 23, par = t(c(0.6, 0.4)), weights = 1)
+h_getBetamixPost(x = 16, n = 23, par = t(c(0.6, 0.4)), weights = 1)
 
-getBetamixPost(
+h_getBetamixPost(
   x = 16, n = 23,
   par =
     rbind(

examples/postprob.R

@@ -1,5 +1,4 @@
-# Example taken from Lee and Liu (2006)
-#
+# Example taken from Lee and Liu (2008) :
 # We observed 16 successes out of 23 patients
 # We set a threshold of 0.60
 # Assume a beta(0.6,0.4) prior for P_E
@@ -9,7 +8,6 @@ postprob(x = 16, n = 23, p = 0.60, par = c(0.6, 0.4))
 
 # We could instead specify a mixture prior
 # 2 component beta mixture prior, i.e., P_E ~ 0.6*beta(0.6,0.4) + 0.4*beta(1,1) and Pr(P_E > p | data) = 0.823
-
 postprob(
   x = 16, n = 23, p = 0.60,
   par =