From 9f6bd887e8bc1c8e6b210655454052a06b8d34a9 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 6 Nov 2023 13:02:37 +0100 Subject: [PATCH 01/28] clean --- NAMESPACE | 2 +- R/dbetabinom.R | 19 ++++++++++++------- R/postprob.R | 2 +- R/postprobDist.R | 4 ++-- man/getBetamixPost.Rd | 38 -------------------------------------- man/h_getBetamixPost.Rd | 25 +++++++++++++++++++++++++ 6 files changed, 41 insertions(+), 49 deletions(-) delete mode 100644 man/getBetamixPost.Rd create mode 100644 man/h_getBetamixPost.Rd diff --git a/NAMESPACE b/NAMESPACE index 591960ce..6a4ab654 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,7 @@ export(dbetaMix) export(dbetabinom) export(dbetabinomMix) export(dbetadiff) -export(getBetamixPost) +export(h_getBetamixPost) export(logit) export(myPlot) export(myPlotDiff) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 3c92f18e..e75cdb57 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -78,18 +78,23 @@ dbetabinomMix <- Vectorize(dbetabinomMix, vectorize.args = "x") #' #' Computes the posterior parameters of a beta-mixture-binomial distribution. #' -#' @param x number of successes -#' @param n number of patients -#' @param par the beta parameters matrix, with K rows and 2 columns, +#' @typed x : +#' number of successes +#' @typed n : +#' number of patients +#' @typed 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 +#' @typed weights : +#' the mixture weights +#' @return A list with the updated beta parameters and weights #' #' @importFrom stats dbeta dbinom #' -#' @example examples/getBetamixPost.R +#' @keywords internal +#' #' @export -getBetamixPost <- function(x, n, par, weights) { +h_getBetamixPost <- function(x, n, par, weights) { ## check the format stopifnot( is.matrix(par), diff --git a/R/postprob.R b/R/postprob.R index 4fbb71b9..7d3b6a1e 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -86,7 +86,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, diff --git a/R/postprobDist.R b/R/postprobDist.R index 728752e5..6eba7346 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -81,8 +81,8 @@ postprobDist <- function(x, n, } ## compute updated beta parameters - 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) ## use numerical integration to compute this probability, as given on p.338 ## in the article by Thall and Simon (1994): diff --git a/man/getBetamixPost.Rd b/man/getBetamixPost.Rd deleted file mode 100644 index 33eae2ae..00000000 --- a/man/getBetamixPost.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dbetabinom.R -\name{getBetamixPost} -\alias{getBetamixPost} -\title{Compute Beta-Mixture-Binomial Posterior Distribution} -\usage{ -getBetamixPost(x, n, par, weights) -} -\arguments{ -\item{x}{number of successes} - -\item{n}{number of patients} - -\item{par}{the beta parameters matrix, with K rows and 2 columns, -corresponding to the beta parameters of the K components} - -\item{weights}{the mixture weights} -} -\value{ -a list with the updated beta parameters and weights -} -\description{ -Computes the posterior parameters of a beta-mixture-binomial distribution. -} -\examples{ -## example from Lee and Liu: -getBetamixPost(x = 16, n = 23, par = t(c(0.6, 0.4)), weights = 1) - -getBetamixPost( - x = 16, n = 23, - par = - rbind( - c(0.6, 0.4), - c(1, 1) - ), - weights = c(0.6, 0.4) -) -} diff --git a/man/h_getBetamixPost.Rd b/man/h_getBetamixPost.Rd new file mode 100644 index 00000000..4263dc2e --- /dev/null +++ b/man/h_getBetamixPost.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dbetabinom.R +\name{h_getBetamixPost} +\alias{h_getBetamixPost} +\title{Compute Beta-Mixture-Binomial Posterior Distribution} +\usage{ +h_getBetamixPost(x, n, par, weights) +} +\arguments{ +\item{x}{(``):\cr number of successes} + +\item{n}{(``):\cr number of patients} + +\item{par}{(``):\cr the beta parameters matrix, with K rows and 2 columns, +corresponding to the beta parameters of the K components} + +\item{weights}{(``):\cr the mixture weights} +} +\value{ +A list with the updated beta parameters and weights +} +\description{ +Computes the posterior parameters of a beta-mixture-binomial distribution. +} +\keyword{internal} From dec5b0dae0752c06f054d99699db32735fdf2427 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 6 Nov 2023 17:44:04 +0100 Subject: [PATCH 02/28] getBetamix has test cases --- R/dbetabinom.R | 80 ++++++++++++-------------- man/dbetaMix.Rd | 24 +++++--- man/dbetabinomMix.Rd | 3 +- man/h_getBetamixPost.Rd | 15 +++-- tests/testthat/test-dbetabinom.R | 96 ++++++++++++++++++++++++++++++++ 5 files changed, 157 insertions(+), 61 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index e75cdb57..2680b230 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -37,22 +37,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 of the numeric is assigned to a pair of beta parameters. #' @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`. @@ -74,19 +71,13 @@ dbetabinomMix <- function(x, m, par, weights, log = FALSE) { dbetabinomMix <- Vectorize(dbetabinomMix, vectorize.args = "x") -#' Compute Beta-Mixture-Binomial Posterior Distribution +#' Compute Beta-Mixture-Binomial Posterior Distribution's parameters and weights. #' -#' 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 #' -#' @typed x : -#' number of successes -#' @typed n : -#' number of patients -#' @typed par : -#' the beta parameters matrix, with K rows and 2 columns, -#' corresponding to the beta parameters of the K components -#' @typed weights : -#' the mixture weights #' @return A list with the updated beta parameters and weights #' #' @importFrom stats dbeta dbinom @@ -95,59 +86,58 @@ dbetabinomMix <- Vectorize(dbetabinomMix, vectorize.args = "x") #' #' @export h_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 + assert_numeric(x, lower = 0, upper = n, finite = TRUE) + assert_numeric(n, lower = 0, finite = TRUE) + assert_matrix(par) + 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 `log` or non-log Beta-Mixture density values of support `x`. +#' +#' @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. #' -#' Note that `x` can be a vector. +#' @inheritParams dbetabinom +#' @inheritParams dbetabinomMix +#' @typed log : flag +#' Default is `FALSE`. If `TRUE`,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 #' +#' @note `x` can be a vector of `length > 1` +#' #' @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") diff --git a/man/dbetaMix.Rd b/man/dbetaMix.Rd index b570244a..7a233feb 100644 --- a/man/dbetaMix.Rd +++ b/man/dbetaMix.Rd @@ -2,23 +2,33 @@ % Please edit documentation in R/dbetabinom.R \name{dbetaMix} \alias{dbetaMix} -\title{Beta-mixture density function} +\title{Beta-Mixture density function} \usage{ dbetaMix(x, par, weights, log = FALSE) } \arguments{ -\item{x}{the abscissa} +\item{x}{(\code{numeric}):\cr number of successes.} -\item{par}{the beta parameters matrix, with K rows and 2 columns, -corresponding to the beta parameters of the K components} +\item{par}{(\code{matrix}):\cr the beta parameters matrix, with K rows and 2 columns, +corresponding to the beta parameters of the K components.} -\item{weights}{the mixture weights of the beta mixture prior} +\item{weights}{(\code{numeric}):\cr the mixture weights of the beta mixture prior of length K. +Each element of the numeric is assigned to a pair of beta parameters.} -\item{log}{return the log value? (not default)} +\item{log}{(\code{flag}):\cr Default is \code{FALSE}. If \code{TRUE},log values of the Beta-Mixture density function are returned} } \value{ the (log) density values } \description{ -Note that \code{x} can be a vector. +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +The Beta Mixture density can be calculated with the combination of K set of beta parameters and K +length of weights. +} +\details{ +Calculating \code{log} or non-log Beta-Mixture density values of support \code{x}. +} +\note{ +\code{x} can be a vector of \code{length > 1} } diff --git a/man/dbetabinomMix.Rd b/man/dbetabinomMix.Rd index 6ec5b36e..11916851 100644 --- a/man/dbetabinomMix.Rd +++ b/man/dbetabinomMix.Rd @@ -14,7 +14,8 @@ dbetabinomMix(x, m, par, weights, log = FALSE) \item{par}{(\code{matrix}):\cr the beta parameters matrix, with K rows and 2 columns, corresponding to the beta parameters of the K components.} -\item{weights}{(\code{numeric}):\cr the mixture weights of the beta mixture prior.} +\item{weights}{(\code{numeric}):\cr the mixture weights of the beta mixture prior of length K. +Each element of the numeric is assigned to a pair of beta parameters.} \item{log}{(\code{flag}):\cr whether to return the log density value (not default).} } diff --git a/man/h_getBetamixPost.Rd b/man/h_getBetamixPost.Rd index 4263dc2e..aecf0efc 100644 --- a/man/h_getBetamixPost.Rd +++ b/man/h_getBetamixPost.Rd @@ -2,24 +2,23 @@ % Please edit documentation in R/dbetabinom.R \name{h_getBetamixPost} \alias{h_getBetamixPost} -\title{Compute Beta-Mixture-Binomial Posterior Distribution} +\title{Compute Beta-Mixture-Binomial Posterior Distribution's parameters and weights.} \usage{ h_getBetamixPost(x, n, par, weights) } \arguments{ -\item{x}{(``):\cr number of successes} +\item{x}{(\code{numeric}):\cr number of successes.} -\item{n}{(``):\cr number of patients} +\item{par}{(\code{matrix}):\cr the beta parameters matrix, with K rows and 2 columns, +corresponding to the beta parameters of the K components.} -\item{par}{(``):\cr the beta parameters matrix, with K rows and 2 columns, -corresponding to the beta parameters of the K components} - -\item{weights}{(``):\cr the mixture weights} +\item{weights}{(\code{numeric}):\cr the mixture weights of the beta mixture prior of length K. +Each element of the numeric is assigned to a pair of beta parameters.} } \value{ A list with the updated beta parameters and weights } \description{ -Computes the posterior parameters of a beta-mixture-binomial distribution. +A helper function that computes the posterior parameters of a beta-mixture-binomial distribution. } \keyword{internal} diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R index 36901c65..647e1e30 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -128,3 +128,99 @@ test_that("qbetaMix gives a number result", { ) expect_numeric(result) }) + +# h_getBetamixPost -- + +# We expect the results to be in list # TODO why it doenst work +test_that("h_getBetamixPost gives the correct Mixture parameters", { + result <- h_getBetamixPost( + x = 16, + n = 23, + par = matrix(c(1, 2), ncol = 2), + # in postprob, a numeric vector is transposed to a matrix + ) + # TODO could we try expect_type and type is list ? + expect_list(result) +}) + +test_that("h_getBetamixPost gives the correct Mixture parameters", { + result <- h_getBetamixPost( + x = 16, + n = 23, + par = matrix(c(1, 2), ncol = 2), + # in postprob, a numeric vector is transposed to a matrix + ) + expect_equal(result$par, t(c(17, 9))) +}) + +test_that("h_getBetamixPost gives the Mixture weights", { + result <- h_getBetamixPost( + x = 16, + n = 23, + par = rbind(c(1, 2)), # or matrix...in postprob, a numeric vector is transposed to a matrix + weights = c(0.6) + ) + expect_equal(result$weights, c(1)) +}) + +# Checking updated weights,for the case where there are two sets of beta parameters +test_that("h_getBetamixPost gives correct the Mixture weights", { + result <- h_getBetamixPost( + x = 16, + n = 23, + par = rbind(c(1, 2), c(3, 4)), # in postprob, a numeric vector is transposed to a matrix + weights = c(0.6, 0.4) + ) + expect_equal(result$weights, c(0.5085758, 0.4914242)) +}) + +# Checking updated par, for the case where there are two sets of beta parameters +test_that("h_getBetamixPost gives correct the Mixture parameters", { + result <- h_getBetamixPost( + x = 16, + n = 23, + par = rbind(c(1, 2), c(3, 4)), # in postprob, a numeric vector is transposed to a matrix + weights = c(0.6, 0.4) + ) + expect_equal(result$par, rbind(c(17, 9), c(19, 11))) +}) + +# Checking updated weights, for the case where there are three sets of beta parameters +test_that("h_getBetamixPost gives the correct Mixture weights", { + result <- h_getBetamixPost( + x = 16, + n = 23, + par = rbind(c(1, 2), c(3, 4), c(10, 10)), # in postprob, a numeric vector is transposed to a matrix + weights = c(0.6, 0.4, 0.5) + ) + expect_equal(result$weights, c(.2776991, 0.2683337, 0.4539671)) +}) + +# Checking updated par, for the case where there are three sets of beta parameters +test_that("h_getBetamixPost gives the correct Mixture parameters", { + result <- h_getBetamixPost( + x = 16, + n = 23, + par = rbind(c(1, 2), c(3, 4), c(10, 10)), # in postprob, a numeric vector is transposed to a matrix + weights = c(0.6, 0.4, 0.5) + ) + expect_equal(result$par, rbind(c(17, 9), c(19, 11), c(26, 17))) +}) + + +# TODO +# For case when K rows of weights exceed length of par. # what kind of error is this +test_that("Gives warning when nrow(weights) not equal to length(par) in h_getBetamixPost", { + result <- + expect_warning(results) +}) +test_that("the sum of Eff, Fut, Gray zone probabiliy is 1", { + expect_warning( + results <- h_getBetamixPost( + x = 16, + n = 23, + par = rbind(c(1, 2)), # in postprob, a numeric vector is transposed to a matrix + weights = c(0.6, 0.4) + ), "Assertion on 'weights' failed: Must have length 1, but has length 2." + ) +}) From a615c5b265dd0de1a9fe96f2592af070f164f649 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 7 Nov 2023 08:39:10 +0100 Subject: [PATCH 03/28] clean --- tests/testthat/test-dbetabinom.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R index 647e1e30..b6a468e1 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -139,8 +139,7 @@ test_that("h_getBetamixPost gives the correct Mixture parameters", { par = matrix(c(1, 2), ncol = 2), # in postprob, a numeric vector is transposed to a matrix ) - # TODO could we try expect_type and type is list ? - expect_list(result) + expect_list(result) # TODO expect_type and type is list }) test_that("h_getBetamixPost gives the correct Mixture parameters", { From c9874ca74a251d2ff7fce888d71a8bf543a983a6 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 7 Nov 2023 10:46:23 +0100 Subject: [PATCH 04/28] clean --- tests/testthat/test-dbetabinom.R | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R index b6a468e1..fb758223 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -42,8 +42,8 @@ test_that("Sum of dbetabinomMix for all x is 1", { dbetabinomMix( x = 0:20, m = 20, - par = matrix(c(1, 2), ncol = 2, nrow = 1), - weights = c(0.2, 0.8) + par = matrix(c(1, 2), ncol = 2, nrow = 1), # TODO or rbind + weights = c(0.2, 0.8) # TODO avoid this kind of error ) ) expect_equal(result, 1) @@ -139,7 +139,7 @@ test_that("h_getBetamixPost gives the correct Mixture parameters", { par = matrix(c(1, 2), ncol = 2), # in postprob, a numeric vector is transposed to a matrix ) - expect_list(result) # TODO expect_type and type is list + expect_list(result, types = "numeric", null.ok = FALSE) # TODO expect_type and type is list }) test_that("h_getBetamixPost gives the correct Mixture parameters", { @@ -206,6 +206,15 @@ test_that("h_getBetamixPost gives the correct Mixture parameters", { expect_equal(result$par, rbind(c(17, 9), c(19, 11), c(26, 17))) }) +test_that("Names within getBetamixPost are `par` and `weights` ", { + results <- h_getBetamixPost( + x = 16, + n = 23, + par = rbind(c(1, 2)), # in postprob, a numeric vector is transposed to a matrix + weights = 1 + ) + expect_names(names(results), identical.to = c("par", "weights")) +}) # TODO # For case when K rows of weights exceed length of par. # what kind of error is this @@ -213,6 +222,7 @@ test_that("Gives warning when nrow(weights) not equal to length(par) in h_getBet result <- expect_warning(results) }) + test_that("the sum of Eff, Fut, Gray zone probabiliy is 1", { expect_warning( results <- h_getBetamixPost( From d27823c50eaef90f705b03e89f7b5d494108da21 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 14 Nov 2023 09:17:39 +0100 Subject: [PATCH 05/28] clean --- examples/postprob.R | 4 +--- man/postprob.Rd | 4 +--- 2 files changed, 2 insertions(+), 6 deletions(-) diff --git a/examples/postprob.R b/examples/postprob.R index 6f7dd109..9019c4ae 100644 --- a/examples/postprob.R +++ b/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 = diff --git a/man/postprob.Rd b/man/postprob.Rd index 124791c3..57465603 100644 --- a/man/postprob.Rd +++ b/man/postprob.Rd @@ -43,8 +43,7 @@ Posterior is again a mixture of beta priors, with updated mixture weights and beta parameters. } \examples{ -# 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 @@ -54,7 +53,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 = From 323501489b16ee93258214b890f9a60fc2c2132f Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 14 Nov 2023 17:45:03 +0100 Subject: [PATCH 06/28] clean --- NAMESPACE | 1 - R/dbetabinom.R | 10 +------- man/dbetaMix.Rd | 5 +--- man/dbetabinom.Rd | 5 +--- man/dbetabinomMix.Rd | 5 +--- man/h_getBetamixPost.Rd | 2 +- tests/testthat/test-dbetabinom.R | 43 ++++++++++++++------------------ 7 files changed, 24 insertions(+), 47 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 6a4ab654..3af942e9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,6 @@ export(dbetaMix) export(dbetabinom) export(dbetabinomMix) export(dbetadiff) -export(h_getBetamixPost) export(logit) export(myPlot) export(myPlotDiff) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 2680b230..cc90fa0f 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -8,7 +8,7 @@ #' `p(x) = (m! / (x!*(m-x)!)) * Beta(x+a,m-x+b) / Beta(a,b)` #' #' @typed x : numeric -#' number of successes. +#' number of successes. Can be a vector of `length(x) > 1`. #' @typed m : number #' number of trials. #' @typed a : numeric @@ -19,8 +19,6 @@ #' whether to return the log density value (not default). #' @return The density values of the beta-binomial distribution at `x`. #' -#' @note `x`, `a` and `b` can be vectors. -#' #' @example examples/dbetabinom.R #' @export dbetabinom <- function(x, m, a, b, log = FALSE) { @@ -54,8 +52,6 @@ dbetabinom <- function(x, m, a, b, log = FALSE) { #' whether to return the log density value (not default). #' @return The (log) density values of the mixture of beta-binomial distributions at `x`. #' -#' @note `x` can be a vector. -#' #' @example examples/dbetabinomMix.R #' @export dbetabinomMix <- function(x, m, par, weights, log = FALSE) { @@ -83,8 +79,6 @@ dbetabinomMix <- Vectorize(dbetabinomMix, vectorize.args = "x") #' @importFrom stats dbeta dbinom #' #' @keywords internal -#' -#' @export h_getBetamixPost <- function(x, n, par, weights) { assert_numeric(x, lower = 0, upper = n, finite = TRUE) assert_numeric(n, lower = 0, finite = TRUE) @@ -129,8 +123,6 @@ h_getBetamixPost <- function(x, n, par, weights) { #' #' @return the (log) density values #' -#' @note `x` can be a vector of `length > 1` -#' #' @export dbetaMix <- function(x, par, weights, log = FALSE) { ret <- sum(weights * dbeta(x, par[, 1], par[, 2])) diff --git a/man/dbetaMix.Rd b/man/dbetaMix.Rd index 7a233feb..f576bbc5 100644 --- a/man/dbetaMix.Rd +++ b/man/dbetaMix.Rd @@ -7,7 +7,7 @@ dbetaMix(x, par, weights, log = FALSE) } \arguments{ -\item{x}{(\code{numeric}):\cr number of successes.} +\item{x}{(\code{numeric}):\cr number of successes. Can be a vector of \code{length(x) > 1}.} \item{par}{(\code{matrix}):\cr the beta parameters matrix, with K rows and 2 columns, corresponding to the beta parameters of the K components.} @@ -29,6 +29,3 @@ length of weights. \details{ Calculating \code{log} or non-log Beta-Mixture density values of support \code{x}. } -\note{ -\code{x} can be a vector of \code{length > 1} -} diff --git a/man/dbetabinom.Rd b/man/dbetabinom.Rd index 1fb32cee..53856c23 100644 --- a/man/dbetabinom.Rd +++ b/man/dbetabinom.Rd @@ -7,7 +7,7 @@ dbetabinom(x, m, a, b, log = FALSE) } \arguments{ -\item{x}{(\code{numeric}):\cr number of successes.} +\item{x}{(\code{numeric}):\cr number of successes. Can be a vector of \code{length(x) > 1}.} \item{m}{(\code{number}):\cr number of trials.} @@ -28,9 +28,6 @@ Calculates the density function of the beta-binomial distribution. The beta-binomial density function has the following form: \verb{p(x) = (m! / (x!*(m-x)!)) * Beta(x+a,m-x+b) / Beta(a,b)} } -\note{ -\code{x}, \code{a} and \code{b} can be vectors. -} \examples{ dbetabinom(x = 2, m = 29, a = 0.2, b = 0.4, log = FALSE) diff --git a/man/dbetabinomMix.Rd b/man/dbetabinomMix.Rd index 11916851..d5ca6f19 100644 --- a/man/dbetabinomMix.Rd +++ b/man/dbetabinomMix.Rd @@ -7,7 +7,7 @@ dbetabinomMix(x, m, par, weights, log = FALSE) } \arguments{ -\item{x}{(\code{numeric}):\cr number of successes.} +\item{x}{(\code{numeric}):\cr number of successes. Can be a vector of \code{length(x) > 1}.} \item{m}{(\code{number}):\cr number of trials.} @@ -27,9 +27,6 @@ The (log) density values of the mixture of beta-binomial distributions at \code{ Calculates the density function for a mixture of beta-binomial distributions. } -\note{ -\code{x} can be a vector. -} \examples{ dbetabinomMix(x = 2, m = 29, par = rbind(c(0.2, 0.4)), weights = 1) diff --git a/man/h_getBetamixPost.Rd b/man/h_getBetamixPost.Rd index aecf0efc..4840231d 100644 --- a/man/h_getBetamixPost.Rd +++ b/man/h_getBetamixPost.Rd @@ -7,7 +7,7 @@ h_getBetamixPost(x, n, par, weights) } \arguments{ -\item{x}{(\code{numeric}):\cr number of successes.} +\item{x}{(\code{numeric}):\cr number of successes. Can be a vector of \code{length(x) > 1}.} \item{par}{(\code{matrix}):\cr the beta parameters matrix, with K rows and 2 columns, corresponding to the beta parameters of the K components.} diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R index fb758223..b0b80d1d 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -42,8 +42,8 @@ test_that("Sum of dbetabinomMix for all x is 1", { dbetabinomMix( x = 0:20, m = 20, - par = matrix(c(1, 2), ncol = 2, nrow = 1), # TODO or rbind - weights = c(0.2, 0.8) # TODO avoid this kind of error + par = matrix(c(1, 2), ncol = 2, nrow = 1), + weights = c(0.2, 0.8) ) ) expect_equal(result, 1) @@ -137,9 +137,13 @@ test_that("h_getBetamixPost gives the correct Mixture parameters", { x = 16, n = 23, par = matrix(c(1, 2), ncol = 2), - # in postprob, a numeric vector is transposed to a matrix + weight = 1 ) - expect_list(result, types = "numeric", null.ok = FALSE) # TODO expect_type and type is list + expected <- list( + par = matrix(c(17, 9), nrow = 1), + weights = 1 + ) + expect_identical(result, expected) }) test_that("h_getBetamixPost gives the correct Mixture parameters", { @@ -147,7 +151,6 @@ test_that("h_getBetamixPost gives the correct Mixture parameters", { x = 16, n = 23, par = matrix(c(1, 2), ncol = 2), - # in postprob, a numeric vector is transposed to a matrix ) expect_equal(result$par, t(c(17, 9))) }) @@ -156,8 +159,8 @@ test_that("h_getBetamixPost gives the Mixture weights", { result <- h_getBetamixPost( x = 16, n = 23, - par = rbind(c(1, 2)), # or matrix...in postprob, a numeric vector is transposed to a matrix - weights = c(0.6) + par = t(c(1, 2)), + weights = 0.6, ) expect_equal(result$weights, c(1)) }) @@ -167,7 +170,7 @@ test_that("h_getBetamixPost gives correct the Mixture weights", { result <- h_getBetamixPost( x = 16, n = 23, - par = rbind(c(1, 2), c(3, 4)), # in postprob, a numeric vector is transposed to a matrix + par = rbind(c(1, 2), c(3, 4)), weights = c(0.6, 0.4) ) expect_equal(result$weights, c(0.5085758, 0.4914242)) @@ -178,7 +181,7 @@ test_that("h_getBetamixPost gives correct the Mixture parameters", { result <- h_getBetamixPost( x = 16, n = 23, - par = rbind(c(1, 2), c(3, 4)), # in postprob, a numeric vector is transposed to a matrix + par = rbind(c(1, 2), c(3, 4)), weights = c(0.6, 0.4) ) expect_equal(result$par, rbind(c(17, 9), c(19, 11))) @@ -189,18 +192,17 @@ test_that("h_getBetamixPost gives the correct Mixture weights", { result <- h_getBetamixPost( x = 16, n = 23, - par = rbind(c(1, 2), c(3, 4), c(10, 10)), # in postprob, a numeric vector is transposed to a matrix + par = rbind(c(1, 2), c(3, 4), c(10, 10)), weights = c(0.6, 0.4, 0.5) ) expect_equal(result$weights, c(.2776991, 0.2683337, 0.4539671)) }) -# Checking updated par, for the case where there are three sets of beta parameters test_that("h_getBetamixPost gives the correct Mixture parameters", { result <- h_getBetamixPost( x = 16, n = 23, - par = rbind(c(1, 2), c(3, 4), c(10, 10)), # in postprob, a numeric vector is transposed to a matrix + par = rbind(c(1, 2), c(3, 4), c(10, 10)), weights = c(0.6, 0.4, 0.5) ) expect_equal(result$par, rbind(c(17, 9), c(19, 11), c(26, 17))) @@ -210,26 +212,19 @@ test_that("Names within getBetamixPost are `par` and `weights` ", { results <- h_getBetamixPost( x = 16, n = 23, - par = rbind(c(1, 2)), # in postprob, a numeric vector is transposed to a matrix + par = rbind(c(1, 2)), weights = 1 ) expect_names(names(results), identical.to = c("par", "weights")) }) -# TODO -# For case when K rows of weights exceed length of par. # what kind of error is this -test_that("Gives warning when nrow(weights) not equal to length(par) in h_getBetamixPost", { - result <- - expect_warning(results) -}) - -test_that("the sum of Eff, Fut, Gray zone probabiliy is 1", { - expect_warning( +test_that("Error occurs when K rows of weights exceed length of par", { + expect_error( results <- h_getBetamixPost( x = 16, n = 23, - par = rbind(c(1, 2)), # in postprob, a numeric vector is transposed to a matrix + par = rbind(c(1, 2)), weights = c(0.6, 0.4) - ), "Assertion on 'weights' failed: Must have length 1, but has length 2." + ), "Must have length 1, but has length 2." ) }) From 46c1de956fe9cad508326c39c8123f24c0dba695 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 14:20:27 +0100 Subject: [PATCH 07/28] clean --- tests/testthat/test-dbetabinom.R | 56 +++++++++++++++----------------- 1 file changed, 27 insertions(+), 29 deletions(-) diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R index b0b80d1d..3ca67413 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -131,13 +131,12 @@ test_that("qbetaMix gives a number result", { # h_getBetamixPost -- -# We expect the results to be in list # TODO why it doenst work test_that("h_getBetamixPost gives the correct Mixture parameters", { result <- h_getBetamixPost( x = 16, n = 23, par = matrix(c(1, 2), ncol = 2), - weight = 1 + weights = 1 ) expected <- list( par = matrix(c(17, 9), nrow = 1), @@ -146,37 +145,47 @@ test_that("h_getBetamixPost gives the correct Mixture parameters", { expect_identical(result, expected) }) -test_that("h_getBetamixPost gives the correct Mixture parameters", { - result <- h_getBetamixPost( +test_that("h_getBetamixPost gives an error", { + expect_error( + result <- h_getBetamixPost( + x = 16, + n = 23, + par = matrix(c(1, 2), ncol = 2), + weights = 1, + ), "unused argument" + ) +}) + +test_that("Names within getBetamixPost are `par` and `weights` ", { + results <- h_getBetamixPost( x = 16, n = 23, - par = matrix(c(1, 2), ncol = 2), + par = rbind(c(1, 2)), + weights = 1 ) - expect_equal(result$par, t(c(17, 9))) + expect_names(names(results), identical.to = c("par", "weights")) }) -test_that("h_getBetamixPost gives the Mixture weights", { - result <- h_getBetamixPost( +test_that("h_getBetamixPost gives weight of 1 for non-Mixture distribution", { + results <- h_getBetamixPost( x = 16, n = 23, - par = t(c(1, 2)), - weights = 0.6, + par = rbind(c(1, 2)), + weights = 0.1 ) - expect_equal(result$weights, c(1)) + expect_equal(result$weights, 1) }) -# Checking updated weights,for the case where there are two sets of beta parameters -test_that("h_getBetamixPost gives correct the Mixture weights", { +test_that("h_getBetamixPost gives correct the Mixture weights ", { result <- h_getBetamixPost( x = 16, n = 23, par = rbind(c(1, 2), c(3, 4)), weights = c(0.6, 0.4) ) - expect_equal(result$weights, c(0.5085758, 0.4914242)) + expect_equal(result$weights, c(0.5085758, 0.4914242), tolerance = 1e-4) }) -# Checking updated par, for the case where there are two sets of beta parameters test_that("h_getBetamixPost gives correct the Mixture parameters", { result <- h_getBetamixPost( x = 16, @@ -184,10 +193,9 @@ test_that("h_getBetamixPost gives correct the Mixture parameters", { par = rbind(c(1, 2), c(3, 4)), weights = c(0.6, 0.4) ) - expect_equal(result$par, rbind(c(17, 9), c(19, 11))) + expect_identical(result$par, rbind(c(17, 9), c(19, 11))) }) -# Checking updated weights, for the case where there are three sets of beta parameters test_that("h_getBetamixPost gives the correct Mixture weights", { result <- h_getBetamixPost( x = 16, @@ -195,7 +203,7 @@ test_that("h_getBetamixPost gives the correct Mixture weights", { par = rbind(c(1, 2), c(3, 4), c(10, 10)), weights = c(0.6, 0.4, 0.5) ) - expect_equal(result$weights, c(.2776991, 0.2683337, 0.4539671)) + expect_equal(result$weights, c(.2776991, 0.2683337, 0.4539671), tolerance = 1e-4) }) test_that("h_getBetamixPost gives the correct Mixture parameters", { @@ -205,17 +213,7 @@ test_that("h_getBetamixPost gives the correct Mixture parameters", { par = rbind(c(1, 2), c(3, 4), c(10, 10)), weights = c(0.6, 0.4, 0.5) ) - expect_equal(result$par, rbind(c(17, 9), c(19, 11), c(26, 17))) -}) - -test_that("Names within getBetamixPost are `par` and `weights` ", { - results <- h_getBetamixPost( - x = 16, - n = 23, - par = rbind(c(1, 2)), - weights = 1 - ) - expect_names(names(results), identical.to = c("par", "weights")) + expect_identical(result$par, rbind(c(17, 9), c(19, 11), c(26, 17))) }) test_that("Error occurs when K rows of weights exceed length of par", { From 669ca3eb531f38c73e4b8daaa3373f5f8c57d075 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 14:50:23 +0100 Subject: [PATCH 08/28] Update R/dbetabinom.R Co-authored-by: Daniel Sabanes Bove --- R/dbetabinom.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index cc90fa0f..c1808cd9 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -47,7 +47,7 @@ dbetabinom <- function(x, m, a, b, log = FALSE) { #' corresponding to the beta parameters of the K components. #' @typed weights : numeric #' the mixture weights of the beta mixture prior of length K. -#' Each element of the numeric is assigned to a pair of beta parameters. +#' 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`. From 11ea0d7b5e4d7cccb3840a57dc449678a4ec2fd0 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 14:50:44 +0100 Subject: [PATCH 09/28] Update R/dbetabinom.R Co-authored-by: Daniel Sabanes Bove --- R/dbetabinom.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index c1808cd9..05c3b02b 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -67,7 +67,7 @@ dbetabinomMix <- function(x, m, par, weights, log = FALSE) { dbetabinomMix <- Vectorize(dbetabinomMix, vectorize.args = "x") -#' Compute Beta-Mixture-Binomial Posterior Distribution's parameters and weights. +#' Compute Beta-Mixture-Binomial Posterior Distribution #' #' A helper function that computes the posterior parameters of a beta-mixture-binomial distribution. #' From 2a6daa38c83efb1ccb1d712e68829c2a5351aa8a Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 14:50:53 +0100 Subject: [PATCH 10/28] Update R/dbetabinom.R Co-authored-by: Daniel Sabanes Bove --- R/dbetabinom.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 05c3b02b..1de6d477 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -74,7 +74,7 @@ dbetabinomMix <- Vectorize(dbetabinomMix, vectorize.args = "x") #' @inheritParams dbetabinom #' @inheritParams dbetabinomMix #' -#' @return A list with the updated beta parameters and weights +#' @return A list with the updated beta parameters and weights. #' #' @importFrom stats dbeta dbinom #' From a960bfd62ae35c75aee789e21c8684ae81c00861 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 14:51:36 +0100 Subject: [PATCH 11/28] Update R/dbetabinom.R Co-authored-by: Daniel Sabanes Bove --- R/dbetabinom.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 1de6d477..e9066772 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -113,7 +113,7 @@ h_getBetamixPost <- function(x, n, par, weights) { #' #' @description `r lifecycle::badge("experimental")` #' -#' The Beta Mixture density can be calculated with the combination of K set of beta parameters and K +#' The beta-mixture density can be calculated with the combination of K set of beta parameters and K #' length of weights. #' #' @inheritParams dbetabinom From 790690bb30b4400cba201915347c468288fa45ca Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 14:51:53 +0100 Subject: [PATCH 12/28] Update R/dbetabinom.R Co-authored-by: Daniel Sabanes Bove --- R/dbetabinom.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index e9066772..9728a9cc 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -119,7 +119,7 @@ h_getBetamixPost <- function(x, n, par, weights) { #' @inheritParams dbetabinom #' @inheritParams dbetabinomMix #' @typed log : flag -#' Default is `FALSE`. If `TRUE`,log values of the Beta-Mixture density function are returned +#' whether log values of the beta-mixture density function are returned. #' #' @return the (log) density values #' From e8d99891da92882f5c377bf306dd090d509d6ea3 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 15:02:37 +0100 Subject: [PATCH 13/28] clean --- R/dbetabinom.R | 4 ++-- man/dbetaMix.Rd | 8 ++++---- man/dbetabinom.Rd | 2 +- man/dbetabinomMix.Rd | 4 ++-- man/h_getBetamixPost.Rd | 8 ++++---- 5 files changed, 13 insertions(+), 13 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 9728a9cc..0021d015 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -8,7 +8,7 @@ #' `p(x) = (m! / (x!*(m-x)!)) * Beta(x+a,m-x+b) / Beta(a,b)` #' #' @typed x : numeric -#' number of successes. Can be a vector of `length(x) > 1`. +#' number of successes. #' @typed m : number #' number of trials. #' @typed a : numeric @@ -82,7 +82,7 @@ dbetabinomMix <- Vectorize(dbetabinomMix, vectorize.args = "x") 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) + assert_matrix(par, min.rows = 1, max.cols = 2) assert_numeric(weights, min = 0, len = nrow(par), finite = TRUE) # We renormalize weights. weights <- weights / sum(weights) diff --git a/man/dbetaMix.Rd b/man/dbetaMix.Rd index f576bbc5..9deaba08 100644 --- a/man/dbetaMix.Rd +++ b/man/dbetaMix.Rd @@ -7,15 +7,15 @@ dbetaMix(x, par, weights, log = FALSE) } \arguments{ -\item{x}{(\code{numeric}):\cr number of successes. Can be a vector of \code{length(x) > 1}.} +\item{x}{(\code{numeric}):\cr number of successes.} \item{par}{(\code{matrix}):\cr the beta parameters matrix, with K rows and 2 columns, corresponding to the beta parameters of the K components.} \item{weights}{(\code{numeric}):\cr the mixture weights of the beta mixture prior of length K. -Each element of the numeric is assigned to a pair of beta parameters.} +Each element corresponds to the row of beta parameters in \code{par}.} -\item{log}{(\code{flag}):\cr Default is \code{FALSE}. If \code{TRUE},log values of the Beta-Mixture density function are returned} +\item{log}{(\code{flag}):\cr whether log values of the beta-mixture density function are returned.} } \value{ the (log) density values @@ -23,7 +23,7 @@ the (log) density values \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -The Beta Mixture density can be calculated with the combination of K set of beta parameters and K +The beta-mixture density can be calculated with the combination of K set of beta parameters and K length of weights. } \details{ diff --git a/man/dbetabinom.Rd b/man/dbetabinom.Rd index 53856c23..b59b273f 100644 --- a/man/dbetabinom.Rd +++ b/man/dbetabinom.Rd @@ -7,7 +7,7 @@ dbetabinom(x, m, a, b, log = FALSE) } \arguments{ -\item{x}{(\code{numeric}):\cr number of successes. Can be a vector of \code{length(x) > 1}.} +\item{x}{(\code{numeric}):\cr number of successes.} \item{m}{(\code{number}):\cr number of trials.} diff --git a/man/dbetabinomMix.Rd b/man/dbetabinomMix.Rd index d5ca6f19..a8dcbe60 100644 --- a/man/dbetabinomMix.Rd +++ b/man/dbetabinomMix.Rd @@ -7,7 +7,7 @@ dbetabinomMix(x, m, par, weights, log = FALSE) } \arguments{ -\item{x}{(\code{numeric}):\cr number of successes. Can be a vector of \code{length(x) > 1}.} +\item{x}{(\code{numeric}):\cr number of successes.} \item{m}{(\code{number}):\cr number of trials.} @@ -15,7 +15,7 @@ dbetabinomMix(x, m, par, weights, log = FALSE) corresponding to the beta parameters of the K components.} \item{weights}{(\code{numeric}):\cr the mixture weights of the beta mixture prior of length K. -Each element of the numeric is assigned to a pair of beta parameters.} +Each element corresponds to the row of beta parameters in \code{par}.} \item{log}{(\code{flag}):\cr whether to return the log density value (not default).} } diff --git a/man/h_getBetamixPost.Rd b/man/h_getBetamixPost.Rd index 4840231d..6ad41c02 100644 --- a/man/h_getBetamixPost.Rd +++ b/man/h_getBetamixPost.Rd @@ -2,21 +2,21 @@ % Please edit documentation in R/dbetabinom.R \name{h_getBetamixPost} \alias{h_getBetamixPost} -\title{Compute Beta-Mixture-Binomial Posterior Distribution's parameters and weights.} +\title{Compute Beta-Mixture-Binomial Posterior Distribution} \usage{ h_getBetamixPost(x, n, par, weights) } \arguments{ -\item{x}{(\code{numeric}):\cr number of successes. Can be a vector of \code{length(x) > 1}.} +\item{x}{(\code{numeric}):\cr number of successes.} \item{par}{(\code{matrix}):\cr the beta parameters matrix, with K rows and 2 columns, corresponding to the beta parameters of the K components.} \item{weights}{(\code{numeric}):\cr the mixture weights of the beta mixture prior of length K. -Each element of the numeric is assigned to a pair of beta parameters.} +Each element corresponds to the row of beta parameters in \code{par}.} } \value{ -A list with the updated beta parameters and weights +A list with the updated beta parameters and weights. } \description{ A helper function that computes the posterior parameters of a beta-mixture-binomial distribution. From ee882ea269393e0332347c5a8079d914637400e7 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 15:48:17 +0100 Subject: [PATCH 14/28] clean --- R/dbetabinom.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 0021d015..c16d77ab 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -82,7 +82,7 @@ dbetabinomMix <- Vectorize(dbetabinomMix, vectorize.args = "x") 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) + 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) From 6ad72effbcd23510d36bfcb60784714fe92ccf8a Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 15:56:25 +0100 Subject: [PATCH 15/28] clean --- examples/dbetabinom.R | 51 ++++++++++++++++++++++++++++++++++++++++++- man/dbetabinom.Rd | 45 +++++++++++++++++++++++++++++++++++++- 2 files changed, 94 insertions(+), 2 deletions(-) diff --git a/examples/dbetabinom.R b/examples/dbetabinom.R index a555e95d..d9b4fb90 100644 --- a/examples/dbetabinom.R +++ b/examples/dbetabinom.R @@ -1,5 +1,54 @@ +# 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) + +# dbetabinomMix -- +# returns the same result as first example +dbetabinomMix( + x = 2, + m = 29, + par = rbind(c(0.2, 0.4)), + weights = 1 +) + +dbetabinomMix( + x = 1:28, + m = 29, + par = rbind( + c(0.2, 1), + c(0.4, 1) + ), + weights = rbind( + c(1, 1), + c(0.4, 1) + ), + log = FALSE +) + +# pbetaMix -- +pbetaMix( + q = 0.3, + par = rbind(c(0.2, 0.4)), + weights = 1 +) + +pbetaMix( + q = 0.3, + par = rbind(c(0.2, 0.4), c(1, 1)), + weights = c(0.6, 0.4) +) + +# qbetaMix -- +qbetaMix( + p = 0.6, + par = rbind(c(0.2, 0.4)), + weights = 1 +) + +qbetaMix( + p = 0.6, + par = rbind(c(0.2, 0.4), c(1, 1)), + weights = c(0.6, 0.4) +) diff --git a/man/dbetabinom.Rd b/man/dbetabinom.Rd index b59b273f..f447b20c 100644 --- a/man/dbetabinom.Rd +++ b/man/dbetabinom.Rd @@ -29,9 +29,52 @@ The beta-binomial density function has the following form: \verb{p(x) = (m! / (x!*(m-x)!)) * Beta(x+a,m-x+b) / Beta(a,b)} } \examples{ +# 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) + +# dbetabinomMix -- +# returns the same result as first example +dbetabinomMix( + x = 2, + m = 29, + par = rbind(c(0.2, 0.4)), + weights = 1 +) + +dbetabinomMix(x = 1:28, + m = 29, + par = rbind(c(0.2, 1), + c(0.4, 1)), + weights = rbind(c(1, 1), + c(0.4, 1)), + log = FALSE) + +# pbetaMix -- +pbetaMix( + q = 0.3, + par = rbind(c(0.2, 0.4)), + weights = 1 +) + +pbetaMix( + q = 0.3, + par = rbind(c(0.2, 0.4), c(1, 1)), + weights = c(0.6, 0.4) +) + +# qbetaMix -- +qbetaMix( + p = 0.6, + par = rbind(c(0.2, 0.4)), + weights = 1 +) + +qbetaMix( + p = 0.6, + par = rbind(c(0.2, 0.4), c(1, 1)), + weights = c(0.6, 0.4) +) } From e4796dc3075b7f2f040827d6bc3308858099b52b Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 16:01:49 +0100 Subject: [PATCH 16/28] added examples --- examples/dbetabinom.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/examples/dbetabinom.R b/examples/dbetabinom.R index d9b4fb90..3275c48c 100644 --- a/examples/dbetabinom.R +++ b/examples/dbetabinom.R @@ -27,6 +27,13 @@ dbetabinomMix( log = FALSE ) +# dbetaMix -- +dbetaMix( + x = 1:20, + par = rbind(c(1, 2), c(2, 5)), + weights = c(1, 2) +) + # pbetaMix -- pbetaMix( q = 0.3, From 38f9baefd31dd7c58ee42f1d5a73c14ce9b8280d Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 10:08:15 +0100 Subject: [PATCH 17/28] clean --- R/dbetabinom.R | 3 +-- examples/dbetabinom.R | 56 ------------------------------------------- man/dbetaMix.Rd | 2 +- man/dbetabinom.Rd | 43 --------------------------------- 4 files changed, 2 insertions(+), 102 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index c16d77ab..fe45b0da 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -106,10 +106,9 @@ h_getBetamixPost <- function(x, n, par, weights) { ) } - #' Beta-Mixture density function #' -#' Calculating `log` or non-log Beta-Mixture density values of support `x`. +#' Calculating beta-mixture density values of support `x`. #' #' @description `r lifecycle::badge("experimental")` #' diff --git a/examples/dbetabinom.R b/examples/dbetabinom.R index 3275c48c..1a92ee7b 100644 --- a/examples/dbetabinom.R +++ b/examples/dbetabinom.R @@ -3,59 +3,3 @@ 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) - -# dbetabinomMix -- -# returns the same result as first example -dbetabinomMix( - x = 2, - m = 29, - par = rbind(c(0.2, 0.4)), - weights = 1 -) - -dbetabinomMix( - x = 1:28, - m = 29, - par = rbind( - c(0.2, 1), - c(0.4, 1) - ), - weights = rbind( - c(1, 1), - c(0.4, 1) - ), - log = FALSE -) - -# dbetaMix -- -dbetaMix( - x = 1:20, - par = rbind(c(1, 2), c(2, 5)), - weights = c(1, 2) -) - -# pbetaMix -- -pbetaMix( - q = 0.3, - par = rbind(c(0.2, 0.4)), - weights = 1 -) - -pbetaMix( - q = 0.3, - par = rbind(c(0.2, 0.4), c(1, 1)), - weights = c(0.6, 0.4) -) - -# qbetaMix -- -qbetaMix( - p = 0.6, - par = rbind(c(0.2, 0.4)), - weights = 1 -) - -qbetaMix( - p = 0.6, - par = rbind(c(0.2, 0.4), c(1, 1)), - weights = c(0.6, 0.4) -) diff --git a/man/dbetaMix.Rd b/man/dbetaMix.Rd index 9deaba08..a6ff0fea 100644 --- a/man/dbetaMix.Rd +++ b/man/dbetaMix.Rd @@ -27,5 +27,5 @@ The beta-mixture density can be calculated with the combination of K set of beta length of weights. } \details{ -Calculating \code{log} or non-log Beta-Mixture density values of support \code{x}. +Calculating beta-mixture density values of support \code{x}. } diff --git a/man/dbetabinom.Rd b/man/dbetabinom.Rd index f447b20c..8b02f08b 100644 --- a/man/dbetabinom.Rd +++ b/man/dbetabinom.Rd @@ -34,47 +34,4 @@ 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) - -# dbetabinomMix -- -# returns the same result as first example -dbetabinomMix( - x = 2, - m = 29, - par = rbind(c(0.2, 0.4)), - weights = 1 -) - -dbetabinomMix(x = 1:28, - m = 29, - par = rbind(c(0.2, 1), - c(0.4, 1)), - weights = rbind(c(1, 1), - c(0.4, 1)), - log = FALSE) - -# pbetaMix -- -pbetaMix( - q = 0.3, - par = rbind(c(0.2, 0.4)), - weights = 1 -) - -pbetaMix( - q = 0.3, - par = rbind(c(0.2, 0.4), c(1, 1)), - weights = c(0.6, 0.4) -) - -# qbetaMix -- -qbetaMix( - p = 0.6, - par = rbind(c(0.2, 0.4)), - weights = 1 -) - -qbetaMix( - p = 0.6, - par = rbind(c(0.2, 0.4), c(1, 1)), - weights = c(0.6, 0.4) -) } From 091491dcd569366d17c9081cce8c94db99c4d870 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 21 Nov 2023 15:49:54 +0100 Subject: [PATCH 18/28] clean --- R/oc2.R | 2 +- R/oc3.R | 2 +- R/postprob.R | 2 +- R/predprob.R | 4 +-- R/predprobDist.R | 6 ++-- examples/getBetamixPost.R | 4 +-- man/postprob.Rd | 2 +- tests/testthat/test-dbetabinom.R | 57 ++++++++++++------------------ tests/testthat/test-postprobDist.R | 16 ++++----- 9 files changed, 42 insertions(+), 53 deletions(-) diff --git a/R/oc2.R b/R/oc2.R index 1f419afd..b94c6a4b 100644 --- a/R/oc2.R +++ b/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: diff --git a/R/oc3.R b/R/oc3.R index 9fbe867e..9a4176cd 100644 --- a/R/oc3.R +++ b/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: diff --git a/R/postprob.R b/R/postprob.R index dad27c3a..d742b632 100644 --- a/R/postprob.R +++ b/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 diff --git a/R/predprob.R b/R/predprob.R index 7c5faa35..987ac514 100644 --- a/R/predprob.R +++ b/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, diff --git a/R/predprobDist.R b/R/predprobDist.R index 27c4031b..270807a6 100644 --- a/R/predprobDist.R +++ b/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 ) diff --git a/examples/getBetamixPost.R b/examples/getBetamixPost.R index df64a141..14e2dd3c 100644 --- a/examples/getBetamixPost.R +++ b/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( diff --git a/man/postprob.Rd b/man/postprob.Rd index 57465603..66f3aed7 100644 --- a/man/postprob.Rd +++ b/man/postprob.Rd @@ -20,7 +20,7 @@ Default is a uniform prior.} \item{weights}{(\code{vector}):\cr The mixture weights of the beta mixture prior. Default are uniform weights across mixture components.} -\item{betamixPost}{(\code{matrix}):\cr optional result of \verb{[getBetamixPost()]} in order +\item{betamixPost}{(\code{matrix}):\cr optional result of \verb{[h_getBetamixPost()]} in order to speed up the computations. If supplied, this is directly used, bypassing the other arguments (except \code{p} and \code{log.p} of course).} diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R index 3ca67413..96c675c2 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -1,23 +1,23 @@ # dbetabinom ---- -test_that("dbetabinom for every x support is between 0 and 1", { +test_that("dbetabinom for every x support is between 0 and 1.", { results <- dbetabinom(x = 10, m = 20, a = 0.7, b = 2) expect_number(results, lower = 0, upper = 1) }) -test_that("sum of the dbetabinom values over the whole support for x is 1", { +test_that("sum of the dbetabinom values over the whole support for x is 1.", { result <- sum(dbetabinom(x = 0:10, m = 10, a = 1, b = 1)) - expect_equal(result, 1) + expect_identical(result, 1) }) -test_that("dbetabinom gives correct numeric result", { +test_that("dbetabinom gives correct numeric result with uniform parameters.", { result <- dbetabinom(x = 2, m = 29, a = 0.2, b = 0.4) expect_equal(result, 0.04286893, tolerance = 1e-6) }) # dbetabinomMix ---- -test_that("dbetabinomMix gives a result between 0 and 1", { +test_that("dbetabinomMix gives a result between 0 and 1.", { result <- dbetabinomMix( x = 2, m = 29, @@ -27,7 +27,7 @@ test_that("dbetabinomMix gives a result between 0 and 1", { expect_numeric(result, lower = 0, upper = 1, finite = TRUE) }) -test_that("dbetabinomMix gives the correct numeric result", { +test_that("dbetabinomMix gives the correct numeric result with non-uniform parameters.", { result <- dbetabinomMix( x = 2, m = 29, @@ -37,7 +37,7 @@ test_that("dbetabinomMix gives the correct numeric result", { expect_equal(result, 0.04286893, tolerance = 1e-6) }) -test_that("Sum of dbetabinomMix for all x is 1", { +test_that("Sum of dbetabinomMix for all x is 1.", { result <- sum( dbetabinomMix( x = 0:20, @@ -49,7 +49,7 @@ test_that("Sum of dbetabinomMix for all x is 1", { expect_equal(result, 1) }) -test_that("dbetabinomMix gives the correct numeric result", { +test_that("dbetabinomMix gives the correct numeric result with beta-mixture.", { result <- dbetabinomMix( x = 2, m = 29, @@ -61,7 +61,7 @@ test_that("dbetabinomMix gives the correct numeric result", { # pbetaMix ---- -test_that("The pbetaMix has incrementally higher cdf with increase x support", { +test_that("The pbetaMix has incrementally higher cdf with larger x.", { is_lower <- pbetaMix( q = 0.3, par = rbind(c(0.2, 0.4)), @@ -75,7 +75,7 @@ test_that("The pbetaMix has incrementally higher cdf with increase x support", { expect_true(is_lower < is_higher) }) -test_that("pbetaMix gives the correct number result", { +test_that("pbetaMix gives the correct number result with beta-mixture.", { result <- pbetaMix( q = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), @@ -84,7 +84,7 @@ test_that("pbetaMix gives the correct number result", { expect_equal(result, 0.4768404, tolerance = 1e-5) }) -test_that("The complement of pbetaMix can be derived with a different lower.tail flag", { +test_that("The complement of pbetaMix can be derived with a different lower.tail flag.", { result <- pbetaMix( q = 0.3, par = rbind(c(0.2, 0.4)), @@ -102,7 +102,7 @@ test_that("The complement of pbetaMix can be derived with a different lower.tail # qbetaMix ---- -test_that("qbetaMix gives the correct number result", { +test_that("qbetaMix gives the correct number result with beta-mixture.", { result <- qbetaMix( p = 0.6, par = rbind(c(0.2, 0.4)), @@ -111,7 +111,7 @@ test_that("qbetaMix gives the correct number result", { expect_equal(result, 0.3112068, tolerance = 1e-6) }) -test_that("qbetaMix gives the correct number result", { +test_that("qbetaMix gives the correct number result with beta-mixture with increased parameters.", { result <- qbetaMix( p = 0.6, par = rbind(c(0.2, 0.4), c(1, 1)), @@ -120,7 +120,7 @@ test_that("qbetaMix gives the correct number result", { expect_equal(result, 0.488759, tolerance = 1e-6) }) -test_that("qbetaMix gives a number result", { +test_that("qbetaMix gives a number result with beta-mixture.", { result <- qbetaMix( p = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), @@ -131,7 +131,7 @@ test_that("qbetaMix gives a number result", { # h_getBetamixPost -- -test_that("h_getBetamixPost gives the correct Mixture parameters", { +test_that("h_getBetamixPost gives the correct beta-mixture parameters.", { result <- h_getBetamixPost( x = 16, n = 23, @@ -145,18 +145,7 @@ test_that("h_getBetamixPost gives the correct Mixture parameters", { expect_identical(result, expected) }) -test_that("h_getBetamixPost gives an error", { - expect_error( - result <- h_getBetamixPost( - x = 16, - n = 23, - par = matrix(c(1, 2), ncol = 2), - weights = 1, - ), "unused argument" - ) -}) - -test_that("Names within getBetamixPost are `par` and `weights` ", { +test_that("Names within h_getBetamixPost are `par` and `weights`.", { results <- h_getBetamixPost( x = 16, n = 23, @@ -166,17 +155,17 @@ test_that("Names within getBetamixPost are `par` and `weights` ", { expect_names(names(results), identical.to = c("par", "weights")) }) -test_that("h_getBetamixPost gives weight of 1 for non-Mixture distribution", { +test_that("h_getBetamixPost gives weight of 1 for non-Mixture distribution.", { results <- h_getBetamixPost( x = 16, n = 23, par = rbind(c(1, 2)), weights = 0.1 ) - expect_equal(result$weights, 1) + expect_identical(results$weights, 1) }) -test_that("h_getBetamixPost gives correct the Mixture weights ", { +test_that("h_getBetamixPost gives correct weights with beta-mixture.", { result <- h_getBetamixPost( x = 16, n = 23, @@ -186,7 +175,7 @@ test_that("h_getBetamixPost gives correct the Mixture weights ", { expect_equal(result$weights, c(0.5085758, 0.4914242), tolerance = 1e-4) }) -test_that("h_getBetamixPost gives correct the Mixture parameters", { +test_that("h_getBetamixPost gives correct parameters with beta-mixture.", { result <- h_getBetamixPost( x = 16, n = 23, @@ -196,7 +185,7 @@ test_that("h_getBetamixPost gives correct the Mixture parameters", { expect_identical(result$par, rbind(c(17, 9), c(19, 11))) }) -test_that("h_getBetamixPost gives the correct Mixture weights", { +test_that("h_getBetamixPost gives the correct weights when sum of weights is not 1.", { result <- h_getBetamixPost( x = 16, n = 23, @@ -206,7 +195,7 @@ test_that("h_getBetamixPost gives the correct Mixture weights", { expect_equal(result$weights, c(.2776991, 0.2683337, 0.4539671), tolerance = 1e-4) }) -test_that("h_getBetamixPost gives the correct Mixture parameters", { +test_that("h_getBetamixPost gives the correct parameters when sum of weights is not 1.", { result <- h_getBetamixPost( x = 16, n = 23, @@ -216,7 +205,7 @@ test_that("h_getBetamixPost gives the correct Mixture parameters", { expect_identical(result$par, rbind(c(17, 9), c(19, 11), c(26, 17))) }) -test_that("Error occurs when K rows of weights exceed length of par", { +test_that("h_getBetamixPost gives error when K rows of weights exceed length of par.", { expect_error( results <- h_getBetamixPost( x = 16, diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index 15cae106..1643cbfd 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -126,8 +126,8 @@ test_that("h_integrand_relDelta gives the correct numerical result for a beta-mi 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) + activeBetamixPost <- h_getBetamixPost(x = x, n = n, par = parE, weights = weights) + controlBetamixPost <- h_getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) results <- h_integrand_relDelta( p_s = p_s, delta = delta, @@ -149,8 +149,8 @@ test_that("h_integrand_relDelta gives the correct numerical result for a weighte 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) + activeBetamixPost <- h_getBetamixPost(x = x, n = n, par = parE, weights = weights) + controlBetamixPost <- h_getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) results <- h_integrand_relDelta( p_s = p_s, delta = delta, @@ -173,8 +173,8 @@ test_that("h_integrand gives the correct numerical result for a beta-mixture", { 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) + activeBetamixPost <- h_getBetamixPost(x = x, n = n, par = parE, weights = weights) + controlBetamixPost <- h_getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) results <- h_integrand( p_s = p_s, delta = delta, @@ -196,8 +196,8 @@ test_that("h_integrand works as expected for a weighted beta-mixture.", { 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) + activeBetamixPost <- h_getBetamixPost(x = x, n = n, par = parE, weights = weights) + controlBetamixPost <- h_getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) results <- h_integrand( p_s = p_s, delta = delta, From 2ef76031fcaf3aaf50834851b025b4074be24624 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 21 Nov 2023 16:57:05 +0100 Subject: [PATCH 19/28] Update R/dbetabinom.R Co-authored-by: Daniel Sabanes Bove --- R/dbetabinom.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index fe45b0da..5c8c9a02 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -108,7 +108,7 @@ h_getBetamixPost <- function(x, n, par, weights) { #' Beta-Mixture density function #' -#' Calculating beta-mixture density values of support `x`. +#' This function calculates beta-mixture density values. #' #' @description `r lifecycle::badge("experimental")` #' From cbbe12a9178f8eec2eb99b869ba6164934cc0704 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 21 Nov 2023 16:57:17 +0100 Subject: [PATCH 20/28] Update R/dbetabinom.R Co-authored-by: Daniel Sabanes Bove --- R/dbetabinom.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 5c8c9a02..3040ca4d 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -112,8 +112,7 @@ h_getBetamixPost <- function(x, n, par, weights) { #' #' @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. +#' The beta-mixture distribution is defined by K beta parameters and the corresponding weights. #' #' @inheritParams dbetabinom #' @inheritParams dbetabinomMix From 6cbe54389ccc4b55bf342f130f7a5a13ad8347db Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 21 Nov 2023 16:57:52 +0100 Subject: [PATCH 21/28] Update tests/testthat/test-dbetabinom.R Co-authored-by: Daniel Sabanes Bove --- tests/testthat/test-dbetabinom.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R index 96c675c2..2266b58d 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -155,7 +155,7 @@ test_that("Names within h_getBetamixPost are `par` and `weights`.", { expect_names(names(results), identical.to = c("par", "weights")) }) -test_that("h_getBetamixPost gives weight of 1 for non-Mixture distribution.", { +test_that("h_getBetamixPost gives weight of 1 for a single beta distribution", { results <- h_getBetamixPost( x = 16, n = 23, From 7f89715d860fd17c6d6c212f1f09adaae4d7d4fc Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 21 Nov 2023 16:59:49 +0100 Subject: [PATCH 22/28] no dots --- tests/testthat/test-dbetabinom.R | 40 ++++++++++++++++---------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R index 2266b58d..f75dffd3 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -1,23 +1,23 @@ # dbetabinom ---- -test_that("dbetabinom for every x support is between 0 and 1.", { +test_that("dbetabinom for every x support is between 0 and 1", { results <- dbetabinom(x = 10, m = 20, a = 0.7, b = 2) expect_number(results, lower = 0, upper = 1) }) -test_that("sum of the dbetabinom values over the whole support for x is 1.", { +test_that("sum of the dbetabinom values over the whole support for x is 1", { result <- sum(dbetabinom(x = 0:10, m = 10, a = 1, b = 1)) expect_identical(result, 1) }) -test_that("dbetabinom gives correct numeric result with uniform parameters.", { +test_that("dbetabinom gives correct numeric result with uniform parameters", { result <- dbetabinom(x = 2, m = 29, a = 0.2, b = 0.4) expect_equal(result, 0.04286893, tolerance = 1e-6) }) # dbetabinomMix ---- -test_that("dbetabinomMix gives a result between 0 and 1.", { +test_that("dbetabinomMix gives a result between 0 and 1", { result <- dbetabinomMix( x = 2, m = 29, @@ -27,7 +27,7 @@ test_that("dbetabinomMix gives a result between 0 and 1.", { expect_numeric(result, lower = 0, upper = 1, finite = TRUE) }) -test_that("dbetabinomMix gives the correct numeric result with non-uniform parameters.", { +test_that("dbetabinomMix gives the correct numeric result with non-uniform parameters", { result <- dbetabinomMix( x = 2, m = 29, @@ -37,7 +37,7 @@ test_that("dbetabinomMix gives the correct numeric result with non-uniform param expect_equal(result, 0.04286893, tolerance = 1e-6) }) -test_that("Sum of dbetabinomMix for all x is 1.", { +test_that("Sum of dbetabinomMix for all x is 1", { result <- sum( dbetabinomMix( x = 0:20, @@ -49,7 +49,7 @@ test_that("Sum of dbetabinomMix for all x is 1.", { expect_equal(result, 1) }) -test_that("dbetabinomMix gives the correct numeric result with beta-mixture.", { +test_that("dbetabinomMix gives the correct numeric result with beta-mixture", { result <- dbetabinomMix( x = 2, m = 29, @@ -61,7 +61,7 @@ test_that("dbetabinomMix gives the correct numeric result with beta-mixture.", { # pbetaMix ---- -test_that("The pbetaMix has incrementally higher cdf with larger x.", { +test_that("The pbetaMix has incrementally higher cdf with larger x", { is_lower <- pbetaMix( q = 0.3, par = rbind(c(0.2, 0.4)), @@ -75,7 +75,7 @@ test_that("The pbetaMix has incrementally higher cdf with larger x.", { expect_true(is_lower < is_higher) }) -test_that("pbetaMix gives the correct number result with beta-mixture.", { +test_that("pbetaMix gives the correct number result with beta-mixture", { result <- pbetaMix( q = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), @@ -84,7 +84,7 @@ test_that("pbetaMix gives the correct number result with beta-mixture.", { expect_equal(result, 0.4768404, tolerance = 1e-5) }) -test_that("The complement of pbetaMix can be derived with a different lower.tail flag.", { +test_that("The complement of pbetaMix can be derived with a different lower.tail flag", { result <- pbetaMix( q = 0.3, par = rbind(c(0.2, 0.4)), @@ -102,7 +102,7 @@ test_that("The complement of pbetaMix can be derived with a different lower.tail # qbetaMix ---- -test_that("qbetaMix gives the correct number result with beta-mixture.", { +test_that("qbetaMix gives the correct number result with beta-mixture", { result <- qbetaMix( p = 0.6, par = rbind(c(0.2, 0.4)), @@ -111,7 +111,7 @@ test_that("qbetaMix gives the correct number result with beta-mixture.", { expect_equal(result, 0.3112068, tolerance = 1e-6) }) -test_that("qbetaMix gives the correct number result with beta-mixture with increased parameters.", { +test_that("qbetaMix gives the correct number result with beta-mixture with increased parameters", { result <- qbetaMix( p = 0.6, par = rbind(c(0.2, 0.4), c(1, 1)), @@ -120,7 +120,7 @@ test_that("qbetaMix gives the correct number result with beta-mixture with incre expect_equal(result, 0.488759, tolerance = 1e-6) }) -test_that("qbetaMix gives a number result with beta-mixture.", { +test_that("qbetaMix gives a number result with beta-mixture", { result <- qbetaMix( p = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), @@ -131,7 +131,7 @@ test_that("qbetaMix gives a number result with beta-mixture.", { # h_getBetamixPost -- -test_that("h_getBetamixPost gives the correct beta-mixture parameters.", { +test_that("h_getBetamixPost gives the correct beta-mixture parameters", { result <- h_getBetamixPost( x = 16, n = 23, @@ -145,7 +145,7 @@ test_that("h_getBetamixPost gives the correct beta-mixture parameters.", { expect_identical(result, expected) }) -test_that("Names within h_getBetamixPost are `par` and `weights`.", { +test_that("Names within h_getBetamixPost are `par` and `weights`", { results <- h_getBetamixPost( x = 16, n = 23, @@ -165,7 +165,7 @@ test_that("h_getBetamixPost gives weight of 1 for a single beta distribution", { expect_identical(results$weights, 1) }) -test_that("h_getBetamixPost gives correct weights with beta-mixture.", { +test_that("h_getBetamixPost gives correct weights with beta-mixture", { result <- h_getBetamixPost( x = 16, n = 23, @@ -175,7 +175,7 @@ test_that("h_getBetamixPost gives correct weights with beta-mixture.", { expect_equal(result$weights, c(0.5085758, 0.4914242), tolerance = 1e-4) }) -test_that("h_getBetamixPost gives correct parameters with beta-mixture.", { +test_that("h_getBetamixPost gives correct parameters with beta-mixture", { result <- h_getBetamixPost( x = 16, n = 23, @@ -185,7 +185,7 @@ test_that("h_getBetamixPost gives correct parameters with beta-mixture.", { expect_identical(result$par, rbind(c(17, 9), c(19, 11))) }) -test_that("h_getBetamixPost gives the correct weights when sum of weights is not 1.", { +test_that("h_getBetamixPost gives the correct weights when sum of weights is not 1", { result <- h_getBetamixPost( x = 16, n = 23, @@ -195,7 +195,7 @@ test_that("h_getBetamixPost gives the correct weights when sum of weights is not expect_equal(result$weights, c(.2776991, 0.2683337, 0.4539671), tolerance = 1e-4) }) -test_that("h_getBetamixPost gives the correct parameters when sum of weights is not 1.", { +test_that("h_getBetamixPost gives the correct parameters when sum of weights is not 1", { result <- h_getBetamixPost( x = 16, n = 23, @@ -205,7 +205,7 @@ test_that("h_getBetamixPost gives the correct parameters when sum of weights is expect_identical(result$par, rbind(c(17, 9), c(19, 11), c(26, 17))) }) -test_that("h_getBetamixPost gives error when K rows of weights exceed length of par.", { +test_that("h_getBetamixPost gives error when K rows of weights exceed length of par", { expect_error( results <- h_getBetamixPost( x = 16, From 405f5ec336b16fbd77874f4444ec9c0c6eddce47 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 27 Nov 2023 13:25:54 +0100 Subject: [PATCH 23/28] clean --- R/dbetabinom.R | 1 + examples/dbetaMix.R | 43 +------------- .../{getBetamixPost.R => h_getBetamixPost.R} | 2 +- examples/pbetaMix.R | 4 +- examples/qbetaMix.R | 6 +- examples/qbetadiff.R | 2 +- man/dbetaMix.Rd | 5 +- man/pbetaMix.Rd | 4 +- man/qbetaMix.Rd | 6 +- man/qbetadiff.Rd | 2 +- tests/testthat/test-dbetabinom.R | 57 ++++++++++++++----- 11 files changed, 62 insertions(+), 70 deletions(-) rename examples/{getBetamixPost.R => h_getBetamixPost.R} (84%) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 3040ca4d..457b2d56 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -123,6 +123,7 @@ h_getBetamixPost <- function(x, n, par, weights) { #' #' @export dbetaMix <- function(x, par, weights, log = FALSE) { + assert_numeric(sum(weights), lower = 0, upper = 1, finite = TRUE, any.missing = TRUE) ret <- sum(weights * dbeta(x, par[, 1], par[, 2])) if (log) { log(ret) diff --git a/examples/dbetaMix.R b/examples/dbetaMix.R index 5c5b5d03..f1f35e53 100644 --- a/examples/dbetaMix.R +++ b/examples/dbetaMix.R @@ -1,50 +1,13 @@ -## Calculating the density of a mixture -## of beta densities at x ## Calculating the density of a mixture -## of beta densities at x, x = 0.3; a = 0.2; b = 0.4 -## -## -## Only 1 mixture component, i.e., weights = 1 -## Compare to dbeta(0.3,0.2,0.4) = 0.4745802 -## +# Calculating the density of a mixture. dbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) -## With 2 mixture components -## Weight 0.6 for component 1; a = 0.2, b = 0.4 -## Weight 0.4 for component 2; a = 1.0, b = 1.0 -## Compare to 0.6*dbeta(0.3,0.2,0.4) + 0.4*dbeta(0.3,1,1) = 0.6847481 -## +# With 2 mixture components dbetaMix( x = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) -## Can also specify x as a vector, x = seq(0,1,.01) -## -## -dbetaMix( - x = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), - weights = c(0.6, 0.4) -) - -## -## Only 1 mixture component, i.e., weights = 1 -## Compare to dbeta(0.3,0.2,0.4) = 0.4745802 -## -dbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) - -## With 2 mixture components -## Weight 0.6 for component 1; a = 0.2, b = 0.4 -## Weight 0.4 for component 2; a = 1.0, b = 1.0 -## Compare to 0.6*dbeta(0.3,0.2,0.4) + 0.4*dbeta(0.3,1,1) = 0.6847481 -## -dbetaMix( - x = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), - weights = c(0.6, 0.4) -) - -## Can also specify x as a vector, x = seq(0,1,.01) -## -## +# Can also specify x as a vector dbetaMix( x = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) diff --git a/examples/getBetamixPost.R b/examples/h_getBetamixPost.R similarity index 84% rename from examples/getBetamixPost.R rename to examples/h_getBetamixPost.R index 14e2dd3c..f43f4538 100644 --- a/examples/getBetamixPost.R +++ b/examples/h_getBetamixPost.R @@ -1,4 +1,4 @@ -## example from Lee and Liu: +# example from Lee and Liu (2008) : h_getBetamixPost(x = 16, n = 23, par = t(c(0.6, 0.4)), weights = 1) h_getBetamixPost( diff --git a/examples/pbetaMix.R b/examples/pbetaMix.R index 15e7f13c..211b3d98 100644 --- a/examples/pbetaMix.R +++ b/examples/pbetaMix.R @@ -3,13 +3,13 @@ pbetaMix(q = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) # Can get the one minus CDF values. pbetaMix(q = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = FALSE) -## With 2 mixture components +# With 2 mixture components pbetaMix( q = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) -## Can also specify x as a vector. +# Can also specify x as a vector. pbetaMix( q = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) diff --git a/examples/qbetaMix.R b/examples/qbetaMix.R index 359c7759..09162d1b 100644 --- a/examples/qbetaMix.R +++ b/examples/qbetaMix.R @@ -1,17 +1,17 @@ -## Only 1 mixture component, i.e., weights = 1 +# Only 1 mixture component, i.e., weights = 1 qbetaMix( p = 0.60, par = rbind(c(0.2, 0.4)), weights = 1 ) -## With 2 mixture components +# With 2 mixture components qbetaMix( p = 0.6, par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) -## Can also specify q as a vector +# Can also specify q as a vector qbetaMix( p = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), diff --git a/examples/qbetadiff.R b/examples/qbetadiff.R index 52d82032..d990f290 100644 --- a/examples/qbetadiff.R +++ b/examples/qbetadiff.R @@ -3,7 +3,7 @@ parX <- c(1, 52) parY <- c(5.5, 20.5) # Calculate quantile when at there is at least 20% of difference. -test <- qbetadiff( +qbetadiff( p = 0.2, parY = parY, parX = parX diff --git a/man/dbetaMix.Rd b/man/dbetaMix.Rd index a6ff0fea..f1c09b2c 100644 --- a/man/dbetaMix.Rd +++ b/man/dbetaMix.Rd @@ -23,9 +23,8 @@ the (log) density values \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -The beta-mixture density can be calculated with the combination of K set of beta parameters and K -length of weights. +The beta-mixture distribution is defined by K beta parameters and the corresponding weights. } \details{ -Calculating beta-mixture density values of support \code{x}. +This function calculates beta-mixture density values. } diff --git a/man/pbetaMix.Rd b/man/pbetaMix.Rd index 07708b0c..400c0913 100644 --- a/man/pbetaMix.Rd +++ b/man/pbetaMix.Rd @@ -34,13 +34,13 @@ pbetaMix(q = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) # Can get the one minus CDF values. pbetaMix(q = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = FALSE) -## With 2 mixture components +# With 2 mixture components pbetaMix( q = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) -## Can also specify x as a vector. +# Can also specify x as a vector. pbetaMix( q = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) diff --git a/man/qbetaMix.Rd b/man/qbetaMix.Rd index 54462adb..b63b41bf 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -25,20 +25,20 @@ The abscissa. Calculates the quantile of the Beta-Mixture distribution for a given probability. } \examples{ -## Only 1 mixture component, i.e., weights = 1 +# Only 1 mixture component, i.e., weights = 1 qbetaMix( p = 0.60, par = rbind(c(0.2, 0.4)), weights = 1 ) -## With 2 mixture components +# With 2 mixture components qbetaMix( p = 0.6, par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) -## Can also specify q as a vector +# Can also specify q as a vector qbetaMix( p = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), diff --git a/man/qbetadiff.Rd b/man/qbetadiff.Rd index eb33f980..88b251dd 100644 --- a/man/qbetadiff.Rd +++ b/man/qbetadiff.Rd @@ -29,7 +29,7 @@ parX <- c(1, 52) parY <- c(5.5, 20.5) # Calculate quantile when at there is at least 20\% of difference. -test <- qbetadiff( +qbetadiff( p = 0.2, parY = parY, parX = parX diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R index f75dffd3..dd7e26ea 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -129,7 +129,46 @@ test_that("qbetaMix gives a number result with beta-mixture", { expect_numeric(result) }) -# h_getBetamixPost -- +# dbetaMix ---- + +test_that("dbetaMix gives the correct result with a 1 mixture component", { + result <- dbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) + expect_equal(result, 0.4745802, tolerance = 1e-4) +}) + +test_that("dbetaMix gives the correct result with increased parameters", { + result <- dbetaMix(x = 0.3, par = rbind(c(0.2, 0.4), c(1, 2)), weights = c(1, 1)) + expect_equal(result, 1.87458, tolerance = 1e-4) +}) + +test_that("dbetaMix gives error when weights do not sum to 1", { + expect_error( + results <- dbetaMix( + x = 0.3, + par = rbind(c(0.2, 0.4), c(1, 1)), + weights = c(1, 1) + ), "failed" + ) +}) + +test_that("dbetaMix gives the correct result as dbeta", { + result <- dbetaMix( + x = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), + weights = c(0.6, 0.4) + ) + result2 <- 0.6 * dbeta( + x = 0.3, + shape1 = 0.2, + shape2 = 0.4 + ) + 0.4 * dbeta( + x = 0.3, + shape1 = 1, + shape2 = 1, + ) + expect_equal(result, result2, tolerance = 1e-4) +}) + +# h_getBetamixPost ---- test_that("h_getBetamixPost gives the correct beta-mixture parameters", { result <- h_getBetamixPost( @@ -142,17 +181,7 @@ test_that("h_getBetamixPost gives the correct beta-mixture parameters", { par = matrix(c(17, 9), nrow = 1), weights = 1 ) - expect_identical(result, expected) -}) - -test_that("Names within h_getBetamixPost are `par` and `weights`", { - results <- h_getBetamixPost( - x = 16, - n = 23, - par = rbind(c(1, 2)), - weights = 1 - ) - expect_names(names(results), identical.to = c("par", "weights")) + expect_identical(result[result$par], expected) }) test_that("h_getBetamixPost gives weight of 1 for a single beta distribution", { @@ -165,7 +194,7 @@ test_that("h_getBetamixPost gives weight of 1 for a single beta distribution", { expect_identical(results$weights, 1) }) -test_that("h_getBetamixPost gives correct weights with beta-mixture", { +test_that("h_getBetamixPost gives correct weights with 2 beta-mixture component", { result <- h_getBetamixPost( x = 16, n = 23, @@ -185,7 +214,7 @@ test_that("h_getBetamixPost gives correct parameters with beta-mixture", { expect_identical(result$par, rbind(c(17, 9), c(19, 11))) }) -test_that("h_getBetamixPost gives the correct weights when sum of weights is not 1", { +test_that("h_getBetamixPost gives the correct weights when sum of weights is not 1 in beta-mixture", { result <- h_getBetamixPost( x = 16, n = 23, From ba607fef375a779bb71393ff781eb4ca96540550 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 27 Nov 2023 13:40:37 +0100 Subject: [PATCH 24/28] test labels --- tests/testthat/test-dbetabinom.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R index dd7e26ea..d7727f7c 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -204,7 +204,7 @@ test_that("h_getBetamixPost gives correct weights with 2 beta-mixture component" expect_equal(result$weights, c(0.5085758, 0.4914242), tolerance = 1e-4) }) -test_that("h_getBetamixPost gives correct parameters with beta-mixture", { +test_that("h_getBetamixPost gives correct beta parameters with beta-mixture", { result <- h_getBetamixPost( x = 16, n = 23, @@ -224,7 +224,7 @@ test_that("h_getBetamixPost gives the correct weights when sum of weights is not expect_equal(result$weights, c(.2776991, 0.2683337, 0.4539671), tolerance = 1e-4) }) -test_that("h_getBetamixPost gives the correct parameters when sum of weights is not 1", { +test_that("h_getBetamixPost gives the correct beta parameters when sum of weights is not 1", { result <- h_getBetamixPost( x = 16, n = 23, From f7fc96a4493bd16c4b4b9855259ced13ef07f1d0 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 27 Nov 2023 15:12:11 +0100 Subject: [PATCH 25/28] clean --- examples/dbetaMix.R | 3 ++- tests/testthat/test-dbetabinom.R | 30 ++++++++---------------------- vignettes/introduction.Rmd | 2 +- 3 files changed, 11 insertions(+), 24 deletions(-) diff --git a/examples/dbetaMix.R b/examples/dbetaMix.R index f1f35e53..302aa3c9 100644 --- a/examples/dbetaMix.R +++ b/examples/dbetaMix.R @@ -9,6 +9,7 @@ dbetaMix( # Can also specify x as a vector dbetaMix( - x = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), + x = seq(0, 1, .01), + par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R index d7727f7c..dae311f5 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -137,8 +137,8 @@ test_that("dbetaMix gives the correct result with a 1 mixture component", { }) test_that("dbetaMix gives the correct result with increased parameters", { - result <- dbetaMix(x = 0.3, par = rbind(c(0.2, 0.4), c(1, 2)), weights = c(1, 1)) - expect_equal(result, 1.87458, tolerance = 1e-4) + result <- dbetaMix(x = 0.3, par = rbind(c(0.2, 0.4), c(1, 2)), weights = c(0.1, 0.9)) + expect_equal(result, 1.307458, tolerance = 1e-4) }) test_that("dbetaMix gives error when weights do not sum to 1", { @@ -181,7 +181,7 @@ test_that("h_getBetamixPost gives the correct beta-mixture parameters", { par = matrix(c(17, 9), nrow = 1), weights = 1 ) - expect_identical(result[result$par], expected) + expect_identical(result, expected) }) test_that("h_getBetamixPost gives weight of 1 for a single beta distribution", { @@ -191,7 +191,11 @@ test_that("h_getBetamixPost gives weight of 1 for a single beta distribution", { par = rbind(c(1, 2)), weights = 0.1 ) - expect_identical(results$weights, 1) + expected <- list( + par = rbind(c(17, 9)), + weights = 1 + ) + expect_identical(results, expected) }) test_that("h_getBetamixPost gives correct weights with 2 beta-mixture component", { @@ -202,15 +206,6 @@ test_that("h_getBetamixPost gives correct weights with 2 beta-mixture component" weights = c(0.6, 0.4) ) expect_equal(result$weights, c(0.5085758, 0.4914242), tolerance = 1e-4) -}) - -test_that("h_getBetamixPost gives correct beta parameters with beta-mixture", { - result <- h_getBetamixPost( - x = 16, - n = 23, - par = rbind(c(1, 2), c(3, 4)), - weights = c(0.6, 0.4) - ) expect_identical(result$par, rbind(c(17, 9), c(19, 11))) }) @@ -222,15 +217,6 @@ test_that("h_getBetamixPost gives the correct weights when sum of weights is not weights = c(0.6, 0.4, 0.5) ) expect_equal(result$weights, c(.2776991, 0.2683337, 0.4539671), tolerance = 1e-4) -}) - -test_that("h_getBetamixPost gives the correct beta parameters when sum of weights is not 1", { - result <- h_getBetamixPost( - x = 16, - n = 23, - par = rbind(c(1, 2), c(3, 4), c(10, 10)), - weights = c(0.6, 0.4, 0.5) - ) expect_identical(result$par, rbind(c(17, 9), c(19, 11), c(26, 17))) }) diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd index ddce92aa..0f57863d 100644 --- a/vignettes/introduction.Rmd +++ b/vignettes/introduction.Rmd @@ -1040,7 +1040,7 @@ legend(.1, .6, ## Advanced predictive probability design {#PredProb-advanced} As an extension of the [basic example](#PredProb), this example shows a way to -use predictive proabilities (*PP*) to conduct interim analyses allowing gray +use predictive probabilities (*PP*) to conduct interim analyses allowing gray zones at the final analyses, i.e. trial results where neither efficacy nor futility decisions are made are possible (refering to the advance *PP* design in the predictive probability section). Such a final analysis design was used in the From 07a26f2752456c7a398aa9df0d75eeada28e3315 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 27 Nov 2023 15:32:30 +0100 Subject: [PATCH 26/28] clean --- examples/dbetaMix.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/examples/dbetaMix.R b/examples/dbetaMix.R index 302aa3c9..e00e5d72 100644 --- a/examples/dbetaMix.R +++ b/examples/dbetaMix.R @@ -13,3 +13,9 @@ dbetaMix( par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) + +dbetaMix( + x = seq(0, 1, .01), + par = rbind(c(1, 1)), + weights = c(0.6, 0.4) +) From 823d609ac5a10fbc53b342274d04da2f53d6c428 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 27 Nov 2023 16:21:07 +0100 Subject: [PATCH 27/28] Update R/dbetabinom.R Co-authored-by: Daniel Sabanes Bove --- R/dbetabinom.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 457b2d56..6f8eea28 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -123,7 +123,9 @@ h_getBetamixPost <- function(x, n, par, weights) { #' #' @export dbetaMix <- function(x, par, weights, log = FALSE) { - assert_numeric(sum(weights), lower = 0, upper = 1, finite = TRUE, any.missing = TRUE) + assert_numeric(weights, lower = 0, upper = 1, finite = TRUE, any.missing = FALSE) + assert_equal(sum(weights), 1) + assert_identical(length(weights), nrow(par)) ret <- sum(weights * dbeta(x, par[, 1], par[, 2])) if (log) { log(ret) From 7471e1e7cd90acb7effc8dc4becc3c3933f844b1 Mon Sep 17 00:00:00 2001 From: Daniel Sabanes Bove Date: Mon, 27 Nov 2023 16:29:45 +0100 Subject: [PATCH 28/28] added example into Rd via @example, fixed assertions, fixed example --- R/dbetabinom.R | 5 +++-- examples/dbetaMix.R | 6 ------ man/dbetaMix.Rd | 17 +++++++++++++++++ 3 files changed, 20 insertions(+), 8 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 6f8eea28..819c99a2 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -121,11 +121,12 @@ h_getBetamixPost <- function(x, n, par, weights) { #' #' @return the (log) density values #' +#' @example examples/dbetaMix.R #' @export dbetaMix <- function(x, par, weights, log = FALSE) { assert_numeric(weights, lower = 0, upper = 1, finite = TRUE, any.missing = FALSE) - assert_equal(sum(weights), 1) - assert_identical(length(weights), nrow(par)) + assert_true(all.equal(sum(weights), 1)) + assert_true(identical(length(weights), nrow(par))) ret <- sum(weights * dbeta(x, par[, 1], par[, 2])) if (log) { log(ret) diff --git a/examples/dbetaMix.R b/examples/dbetaMix.R index e00e5d72..302aa3c9 100644 --- a/examples/dbetaMix.R +++ b/examples/dbetaMix.R @@ -13,9 +13,3 @@ dbetaMix( par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) - -dbetaMix( - x = seq(0, 1, .01), - par = rbind(c(1, 1)), - weights = c(0.6, 0.4) -) diff --git a/man/dbetaMix.Rd b/man/dbetaMix.Rd index f1c09b2c..6bbc68ec 100644 --- a/man/dbetaMix.Rd +++ b/man/dbetaMix.Rd @@ -28,3 +28,20 @@ The beta-mixture distribution is defined by K beta parameters and the correspond \details{ This function calculates beta-mixture density values. } +\examples{ +# Calculating the density of a mixture. +dbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) + +# With 2 mixture components +dbetaMix( + x = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), + weights = c(0.6, 0.4) +) + +# Can also specify x as a vector +dbetaMix( + x = seq(0, 1, .01), + par = rbind(c(0.2, 0.4), c(1, 1)), + weights = c(0.6, 0.4) +) +}