From 50ef5b122e82f0e67295af746781431bc501c026 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 14 Aug 2023 17:53:05 +0200 Subject: [PATCH 001/106] cleaning up dbetabinom --- R/dbetabinom.R | 32 +++++++++++++++++++++++--------- man/dbetabinom.Rd | 13 +++++++------ man/dbetabinomMix.Rd | 16 +++++++++------- tests/testthat/test-dbetabinom.R | 5 +++++ 4 files changed, 44 insertions(+), 22 deletions(-) create mode 100644 tests/testthat/test-dbetabinom.R diff --git a/R/dbetabinom.R b/R/dbetabinom.R index be152158..80cb4ef3 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -1,5 +1,7 @@ #' Beta-binomial density function #' +#' @description `r lifecycle::badge("experimental")` +#' #' Calculates the density function of the beta-binomial distribution #' #' Note that \code{x} can be a vector. @@ -7,15 +9,23 @@ #' The beta-binomial density function has the following form: #' \deqn{p(x) = (m! / (x!*(m-x)!)) * Beta(x+a,m-x+b) / Beta(a,b)} #' -#' @param x number of successes -#' @param m number of trials -#' @param a first parameter of the beta distribution -#' @param b second parameter of the beta distribution +#' @typed x : numeric +#' number of successes +#' @typed m : numeric +#' number of trials +#' @typed a : numeric +#' first parameter of the beta distribution +#' @typed b : numeric +#' second parameter of the beta distribution #' @return the density values of the beta-binomial distribution at \code{x} #' #' @example examples/dbetabinom.R #' @export dbetabinom <- function(x, m, a, b) { + assert_numeric(x, lower = 0, upper = m, finite = TRUE) + assert_numeric(m, lower = 0, finite = TRUE) + assert_numeric(a, lower = 0, finite = TRUE) + assert_numeric(b, lower = 0, finite = TRUE) logRet <- lchoose(m, x) + lbeta(x + a, m - x + b) - lbeta(a, b) exp(logRet) } @@ -27,12 +37,16 @@ dbetabinom <- function(x, m, a, b) { #' #' Note that \code{x} can be a vector. #' -#' @param x number of successes -#' @param m number of trials -#' @param par the beta parameters matrix, with K rows and 2 columns, +#' @typed x : numeric +#' number of successes +#' @param m : numeric +#' number of trials +#' @param par : numeric +#' 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) +#' weights the mixture weights of the beta mixture prior +#' @param log : numeric +#' return the log value? (not default) #' @return The (log) density values of the mixture of beta-binomial distributions at \code{x}. #' #' @export diff --git a/man/dbetabinom.Rd b/man/dbetabinom.Rd index 1d6a61b2..bdc2b681 100644 --- a/man/dbetabinom.Rd +++ b/man/dbetabinom.Rd @@ -7,21 +7,22 @@ dbetabinom(x, m, a, b) } \arguments{ -\item{x}{number of successes} +\item{x}{(\code{numeric}):\cr number of successes} -\item{m}{number of trials} +\item{m}{(\code{numeric}):\cr number of trials} -\item{a}{first parameter of the beta distribution} +\item{a}{(\code{numeric}):\cr first parameter of the beta distribution} -\item{b}{second parameter of the beta distribution} +\item{b}{(\code{numeric}):\cr second parameter of the beta distribution} } \value{ the density values of the beta-binomial distribution at \code{x} } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + Calculates the density function of the beta-binomial distribution -} -\details{ + Note that \code{x} can be a vector. The beta-binomial density function has the following form: diff --git a/man/dbetabinomMix.Rd b/man/dbetabinomMix.Rd index 813b091c..dc39b9de 100644 --- a/man/dbetabinomMix.Rd +++ b/man/dbetabinomMix.Rd @@ -7,16 +7,18 @@ dbetabinomMix(x, m, par, weights, log = FALSE) } \arguments{ -\item{x}{number of successes} +\item{x}{(\code{numeric}):\cr number of successes} -\item{m}{number of trials} +\item{m}{: numeric +number of trials} -\item{par}{the beta parameters matrix, with K rows and 2 columns, -corresponding to the beta parameters of the K components} +\item{par}{: numeric +the beta parameters matrix, with K rows and 2 columns, +corresponding to the beta parameters of the K components +weights the mixture weights of the beta mixture prior} -\item{weights}{the mixture weights of the beta mixture prior} - -\item{log}{return the log value? (not default)} +\item{log}{: numeric +return the log value? (not default)} } \value{ The (log) density values of the mixture of beta-binomial distributions at \code{x}. diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R new file mode 100644 index 00000000..29e7a4d6 --- /dev/null +++ b/tests/testthat/test-dbetabinom.R @@ -0,0 +1,5 @@ +test_that("the dbetabinom density for every x support is between 0 and 1", { + results <- round(dbetabinom(10, 20, 0.7, 2), digits = 2) + expected <- 0.04 + expect_number(results, lower = 0, upper = 1) +}) From 4342b5a66e19685957539bfe845b380137e77518 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 14 Aug 2023 17:56:34 +0200 Subject: [PATCH 002/106] removed rounding, not needed --- 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 29e7a4d6..0dc5113e 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -1,5 +1,4 @@ test_that("the dbetabinom density for every x support is between 0 and 1", { - results <- round(dbetabinom(10, 20, 0.7, 2), digits = 2) - expected <- 0.04 + results <- dbetabinom(10, 20, 0.7, 2) expect_number(results, lower = 0, upper = 1) }) From b095ae62e0f5770fbb083a34f4e27c842cc01905 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 22 Aug 2023 13:49:39 +0200 Subject: [PATCH 003/106] rmarkdown language and assert for dbetabinom --- R/dbetabinom.R | 34 +++++++++++++++++++------------- man/dbetabinom.Rd | 2 +- man/dbetabinomMix.Rd | 13 +++++------- man/qbetaMix.Rd | 2 +- tests/testthat/test-dbetabinom.R | 5 +++++ 5 files changed, 32 insertions(+), 24 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 80cb4ef3..23e4e776 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -4,10 +4,10 @@ #' #' Calculates the density function of the beta-binomial distribution #' -#' Note that \code{x} can be a vector. +#' Note that `x` can be a vector. #' #' The beta-binomial density function has the following form: -#' \deqn{p(x) = (m! / (x!*(m-x)!)) * Beta(x+a,m-x+b) / Beta(a,b)} +#' `p(x) = (m! / (x!*(m-x)!)) * Beta(x+a,m-x+b) / Beta(a,b)` #' #' @typed x : numeric #' number of successes @@ -17,7 +17,7 @@ #' first parameter of the beta distribution #' @typed b : numeric #' second parameter of the beta distribution -#' @return the density values of the beta-binomial distribution at \code{x} +#' @return the density values of the beta-binomial distribution at `x` #' #' @example examples/dbetabinom.R #' @export @@ -35,27 +35,29 @@ dbetabinom <- function(x, m, a, b) { #' #' Calculates the density function for a mixture of beta-binomial distributions. #' -#' Note that \code{x} can be a vector. +#' Note that can be a vector. ## TODO markdown syntax #' -#' @typed x : numeric +#' @typed x : number #' number of successes -#' @param m : numeric +#' @typed m : number #' number of trials -#' @param par : numeric +#' @typed par : numeric matrix #' the beta parameters matrix, with K rows and 2 columns, #' corresponding to the beta parameters of the K components #' weights the mixture weights of the beta mixture prior -#' @param log : numeric +#' @typed log : flag #' return the log value? (not default) -#' @return The (log) density values of the mixture of beta-binomial distributions at \code{x}. +#' @return The (log) density values of the mixture of beta-binomial distributions at `x`. #' #' @export dbetabinomMix <- function(x, m, par, weights, log = FALSE) { + # TODO par has to columns, assert this, weights have same dim as par1 and 2 + # TODO weight assert numeric ret <- sum(weights * dbetabinom(x, m, par[, 1], par[, 2])) if (log) { - return(log(ret)) + log(ret) } else { - return(ret) + ret } } dbetabinomMix <- Vectorize(dbetabinomMix, vectorize.args = "x") @@ -112,7 +114,7 @@ getBetamixPost <- function(x, n, par, weights) { #' Beta-mixture density function #' -#' Note that \code{x} can be a vector. +#' Note that `x` can be a vector. #' #' @param x the abscissa #' @param par the beta parameters matrix, with K rows and 2 columns, @@ -135,7 +137,7 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' Beta-mixture cdf #' -#' Note that \code{x} can be a vector. +#' Note that `x` can be a vector. #' #' @param x the abscissa #' @param par the beta parameters matrix, with K rows and 2 columns, @@ -147,6 +149,10 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' #' @export pbetaMix <- function(x, par, weights, lower.tail = TRUE) { + assert_numeric(x, lower = 0, finite = TRUE) + assert_numeric(weights, lower = 0, upper = 1, finite = TRUE) + assert_numeric(pbeta, lower = 0, upper = 1, finite = TRUE) + assert_vector(par) ret <- sum(weights * pbeta(x, par[, 1], par[, 2], lower.tail = lower.tail)) return(ret) } @@ -155,7 +161,7 @@ pbetaMix <- Vectorize(pbetaMix, vectorize.args = "x") #' Beta-mixture quantile function #' -#' Note that \code{q} can be a vector. +#' Note that `x` can be a vector. #' #' @param q the required quantile #' @param par the beta parameters matrix, with K rows and 2 columns, diff --git a/man/dbetabinom.Rd b/man/dbetabinom.Rd index bdc2b681..56cf9da4 100644 --- a/man/dbetabinom.Rd +++ b/man/dbetabinom.Rd @@ -26,7 +26,7 @@ Calculates the density function of the beta-binomial distribution Note that \code{x} can be a vector. The beta-binomial density function has the following form: -\deqn{p(x) = (m! / (x!*(m-x)!)) * Beta(x+a,m-x+b) / Beta(a,b)} +\verb{p(x) = (m! / (x!*(m-x)!)) * Beta(x+a,m-x+b) / Beta(a,b)} } \examples{ ## Calculating the beta binomial density, x = 2; m = 29; a = 0.2; b = 0.4 diff --git a/man/dbetabinomMix.Rd b/man/dbetabinomMix.Rd index dc39b9de..d9a24bac 100644 --- a/man/dbetabinomMix.Rd +++ b/man/dbetabinomMix.Rd @@ -7,18 +7,15 @@ dbetabinomMix(x, m, par, weights, log = FALSE) } \arguments{ -\item{x}{(\code{numeric}):\cr number of successes} +\item{x}{(\code{number}):\cr number of successes} -\item{m}{: numeric -number of trials} +\item{m}{(\code{number}):\cr number of trials} -\item{par}{: numeric -the beta parameters matrix, with K rows and 2 columns, +\item{par}{(\verb{numeric matrix}):\cr the beta parameters matrix, with K rows and 2 columns, corresponding to the beta parameters of the K components weights the mixture weights of the beta mixture prior} -\item{log}{: numeric -return the log value? (not default)} +\item{log}{(\code{flag}):\cr return the log value? (not default)} } \value{ The (log) density values of the mixture of beta-binomial distributions at \code{x}. @@ -27,5 +24,5 @@ The (log) density values of the mixture of beta-binomial distributions at \code{ Calculates the density function for a mixture of beta-binomial distributions. } \details{ -Note that \code{x} can be a vector. +Note that can be a vector. ## TODO markdown syntax } diff --git a/man/qbetaMix.Rd b/man/qbetaMix.Rd index 340e6232..ddb09db3 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -18,5 +18,5 @@ corresponding to the beta parameters of the K components} the abscissa } \description{ -Note that \code{q} can be a vector. +Note that \code{x} can be a vector. } diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R index 0dc5113e..233c5446 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -2,3 +2,8 @@ test_that("the dbetabinom density for every x support is between 0 and 1", { results <- dbetabinom(10, 20, 0.7, 2) expect_number(results, lower = 0, upper = 1) }) + +test_that("the sum of the dbetabinom density for all x is 1", { + result <- sum(dbetabinom(0:10, 10, 1, 1)) + expect_equal(result, 1) +}) From 889e97dbdc822e09525fbd68fcd37b91eb374bd6 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 22 Aug 2023 13:52:59 +0200 Subject: [PATCH 004/106] changed x and m to number instead of numeric --- R/dbetabinom.R | 4 ++-- man/dbetabinom.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 23e4e776..4be07538 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -9,9 +9,9 @@ #' The beta-binomial density function has the following form: #' `p(x) = (m! / (x!*(m-x)!)) * Beta(x+a,m-x+b) / Beta(a,b)` #' -#' @typed x : numeric +#' @typed x : number #' number of successes -#' @typed m : numeric +#' @typed m : number #' number of trials #' @typed a : numeric #' first parameter of the beta distribution diff --git a/man/dbetabinom.Rd b/man/dbetabinom.Rd index 56cf9da4..8b5bfb03 100644 --- a/man/dbetabinom.Rd +++ b/man/dbetabinom.Rd @@ -7,9 +7,9 @@ dbetabinom(x, m, a, b) } \arguments{ -\item{x}{(\code{numeric}):\cr number of successes} +\item{x}{(\code{number}):\cr number of successes} -\item{m}{(\code{numeric}):\cr number of trials} +\item{m}{(\code{number}):\cr number of trials} \item{a}{(\code{numeric}):\cr first parameter of the beta distribution} From 2eafdc54d12bdbaef7478a5aa1a4bab4b010c184 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 22 Aug 2023 14:05:12 +0200 Subject: [PATCH 005/106] test --- R/dbetabinom.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 4be07538..82826b0b 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -154,7 +154,7 @@ pbetaMix <- function(x, par, weights, lower.tail = TRUE) { assert_numeric(pbeta, lower = 0, upper = 1, finite = TRUE) assert_vector(par) ret <- sum(weights * pbeta(x, par[, 1], par[, 2], lower.tail = lower.tail)) - return(ret) + return(ret) # hdhddhh } pbetaMix <- Vectorize(pbetaMix, vectorize.args = "x") From 9dc428bf73974c13f5e623192757bfa5e5309332 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 23 Aug 2023 13:46:03 +0200 Subject: [PATCH 006/106] pbetaMix function and test --- R/dbetabinom.R | 24 ++++++++++++++---------- inst/WORDLIST | 1 + man/pbetaMix.Rd | 12 +++++++----- man/qbetaMix.Rd | 5 ++--- tests/testthat/test-dbetabinom.R | 6 ++++++ 5 files changed, 30 insertions(+), 18 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 82826b0b..faec6d9c 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -139,22 +139,25 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' #' Note that `x` can be a vector. #' -#' @param x the abscissa -#' @param par the beta parameters matrix, with K rows and 2 columns, +#' @typed x : number +#' the abscissa ## TODO what is this +#' @typed par : matrix or array +#' 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 lower.tail logical; if TRUE (default), probabilities are `P[X <= x]`, +#' @typed weights : matrix or array +#' the mixture weights of the beta mixture prior +#' @typed lower.tail : logical # TODO Why not flag +#' if TRUE (default), probabilities are `P[X <= x]`, #' and otherwise `P[X > x]` -#' @return the (one minus) cdf value -#' +#' @return the (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-" +#' ## TODO could it be ret : numeric, `P[X <= x]` #' @export pbetaMix <- function(x, par, weights, lower.tail = TRUE) { assert_numeric(x, lower = 0, finite = TRUE) assert_numeric(weights, lower = 0, upper = 1, finite = TRUE) - assert_numeric(pbeta, lower = 0, upper = 1, finite = TRUE) assert_vector(par) ret <- sum(weights * pbeta(x, par[, 1], par[, 2], lower.tail = lower.tail)) - return(ret) # hdhddhh + ret } pbetaMix <- Vectorize(pbetaMix, vectorize.args = "x") @@ -163,8 +166,9 @@ pbetaMix <- Vectorize(pbetaMix, vectorize.args = "x") #' #' Note that `x` can be a vector. #' -#' @param q the required quantile -#' @param par the beta parameters matrix, with K rows and 2 columns, +#' @typed q : numeric +#' the required quantile +#' @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 of the beta mixture prior #' @return the abscissa diff --git a/inst/WORDLIST b/inst/WORDLIST index ef88f286..23c1bd0c 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -3238,6 +3238,7 @@ resizable ResourceRef responder responders +ret rf rG RG diff --git a/man/pbetaMix.Rd b/man/pbetaMix.Rd index 2b875742..3838f0e4 100644 --- a/man/pbetaMix.Rd +++ b/man/pbetaMix.Rd @@ -7,18 +7,20 @@ pbetaMix(x, par, weights, lower.tail = TRUE) } \arguments{ -\item{x}{the abscissa} +\item{x}{(\code{number}):\cr the abscissa ## TODO what is this} -\item{par}{the beta parameters matrix, with K rows and 2 columns, +\item{par}{(\verb{matrix or array}):\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}{(\verb{matrix or array}):\cr the mixture weights of the beta mixture prior} -\item{lower.tail}{logical; if TRUE (default), probabilities are \code{P[X <= x]}, +\item{lower.tail}{(\code{logical # TODO Why not flag}):\cr if TRUE (default), probabilities are \code{P[X <= x]}, and otherwise \code{P[X > x]}} } \value{ -the (one minus) cdf value +the (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-" +\subsection{TODO could it be ret : numeric, \code{P[X <= x]}}{ +} } \description{ Note that \code{x} can be a vector. diff --git a/man/qbetaMix.Rd b/man/qbetaMix.Rd index ddb09db3..cc1d58c5 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -7,10 +7,9 @@ qbetaMix(q, par, weights) } \arguments{ -\item{q}{the required quantile} +\item{q}{(\code{numeric}):\cr the required quantile} -\item{par}{the beta parameters matrix, with K rows and 2 columns, -corresponding to the beta parameters of the K components} +\item{par}{(\verb{the beta parameters matrix, with K rows and 2 columns,}):\cr corresponding to the beta parameters of the K components} \item{weights}{the mixture weights of the beta mixture prior} } diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R index 233c5446..956fc30f 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -7,3 +7,9 @@ test_that("the sum of the dbetabinom density for all x is 1", { result <- sum(dbetabinom(0:10, 10, 1, 1)) expect_equal(result, 1) }) + +test_that("the pbetaMix has incrementally higher cdf with increase x support", { + is_lower <- pbetaMix(x = 2, ...) # TODO fill in the blanks + is_higher <- pbetaMix(x = 3, ...) # TODO fill in the blanks + expect_true(is_lower > is_higher) +}) From dd1d8c45bb6673876f5947908b2e9ac930f3e0ee Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 24 Aug 2023 15:02:40 +0200 Subject: [PATCH 007/106] added new tests and changed documentation --- R/dbetabinom.R | 42 +++++++++++++++++++------------- examples/pbetaMix.R | 16 +----------- man/pbetaMix.Rd | 14 +++++------ man/qbetaMix.Rd | 13 ++++++---- tests/testthat/test-dbetabinom.R | 20 ++++++++++++--- 5 files changed, 58 insertions(+), 47 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index faec6d9c..8cbdc180 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -137,20 +137,22 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' Beta-mixture cdf #' +#' @description `r lifecycle::badge("experimental")` +#' #' Note that `x` can be a vector. #' #' @typed x : number -#' the abscissa ## TODO what is this +#' the abscissa. #' @typed par : matrix or array -#' the beta parameters matrix, with K rows and 2 columns, -#' corresponding to the beta parameters of the K components -#' @typed weights : matrix or array -#' the mixture weights of the beta mixture prior +#' the beta parameters matrix, with K rows and 2 columns, +#' corresponding to the beta parameters of the K components. +#' @typed weights : matrix +#' the mixture weights of the beta mixture prior. #' @typed lower.tail : logical # TODO Why not flag -#' if TRUE (default), probabilities are `P[X <= x]`, -#' and otherwise `P[X > x]` -#' @return the (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-" -#' ## TODO could it be ret : numeric, `P[X <= x]` +#' if TRUE (default), probabilities are `P[X <= x]`, +#' and otherwise `P[X > x]`. +#' @return the (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". +#' #' @export pbetaMix <- function(x, par, weights, lower.tail = TRUE) { assert_numeric(x, lower = 0, finite = TRUE) @@ -164,25 +166,31 @@ pbetaMix <- Vectorize(pbetaMix, vectorize.args = "x") #' Beta-mixture quantile function #' +#' @description `r lifecycle::badge("experimental")` +#' #' Note that `x` can be a vector. #' #' @typed q : numeric -#' the required quantile -#' @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 of the beta mixture prior -#' @return the abscissa +#' the required quantile. +#' @typed par : number +#' the beta parameters matrix, with K rows and 2 columns, +#' corresponding to the beta parameters of the K components. +#' @typed weights : matrix +#' the mixture weights of the beta mixture prior. +#' @return the abscissa. #' #' @export -qbetaMix <- function(q, par, weights) { +qbetaMix <- function(q, par, weights, lower.tail) { f <- function(pi) { pbetaMix(x = pi, par = par, weights = weights) - q } + assert_number(f, lower = 0, upper = 1, finite = TRUE) unirootResult <- uniroot(f, lower = 0, upper = 1) + assert_number(unirootResult, lower = 0, upper = 1, finite = TRUE) if (unirootResult$iter < 0) { - return(NA) + NA } else { - return(unirootResult$root) + unirootResult$root } } qbetaMix <- Vectorize(qbetaMix, vectorize.args = "q") diff --git a/examples/pbetaMix.R b/examples/pbetaMix.R index 32b34342..422b1cf6 100644 --- a/examples/pbetaMix.R +++ b/examples/pbetaMix.R @@ -1,31 +1,17 @@ -## Calculating the CDF 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 pbeta(0.3,0.2,0.4) = 0.5947341 -## pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) ## Can get the one minus CDF values -## Need to specify lower.tail = FALSE, 1 - 0.5947341 = 0.4052659 -## -## pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = FALSE) ## 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*pbeta(0.3,0.2,0.4) + 0.4*pbeta(0.3,1,1) = 0.4768404 -## pbetaMix( 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. pbetaMix( x = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) diff --git a/man/pbetaMix.Rd b/man/pbetaMix.Rd index 3838f0e4..ffd8ec96 100644 --- a/man/pbetaMix.Rd +++ b/man/pbetaMix.Rd @@ -7,21 +7,21 @@ pbetaMix(x, par, weights, lower.tail = TRUE) } \arguments{ -\item{x}{(\code{number}):\cr the abscissa ## TODO what is this} +\item{x}{(\code{number}):\cr the abscissa.} \item{par}{(\verb{matrix or array}):\cr the beta parameters matrix, with K rows and 2 columns, -corresponding to the beta parameters of the K components} +corresponding to the beta parameters of the K components.} -\item{weights}{(\verb{matrix or array}):\cr the mixture weights of the beta mixture prior} +\item{weights}{(\code{matrix}):\cr the mixture weights of the beta mixture prior.} \item{lower.tail}{(\code{logical # TODO Why not flag}):\cr if TRUE (default), probabilities are \code{P[X <= x]}, -and otherwise \code{P[X > x]}} +and otherwise \code{P[X > x]}.} } \value{ -the (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-" -\subsection{TODO could it be ret : numeric, \code{P[X <= x]}}{ -} +the (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + Note that \code{x} can be a vector. } diff --git a/man/qbetaMix.Rd b/man/qbetaMix.Rd index cc1d58c5..c27ee6d9 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -4,18 +4,21 @@ \alias{qbetaMix} \title{Beta-mixture quantile function} \usage{ -qbetaMix(q, par, weights) +qbetaMix(q, par, weights, lower.tail) } \arguments{ -\item{q}{(\code{numeric}):\cr the required quantile} +\item{q}{(\code{numeric}):\cr the required quantile.} -\item{par}{(\verb{the beta parameters matrix, with K rows and 2 columns,}):\cr corresponding to the beta parameters of the K components} +\item{par}{(\code{number}):\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{matrix}):\cr the mixture weights of the beta mixture prior.} } \value{ -the abscissa +the abscissa. } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + Note that \code{x} can be a vector. } diff --git a/tests/testthat/test-dbetabinom.R b/tests/testthat/test-dbetabinom.R index 956fc30f..22c0e888 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -9,7 +9,21 @@ test_that("the sum of the dbetabinom density for all x is 1", { }) test_that("the pbetaMix has incrementally higher cdf with increase x support", { - is_lower <- pbetaMix(x = 2, ...) # TODO fill in the blanks - is_higher <- pbetaMix(x = 3, ...) # TODO fill in the blanks - expect_true(is_lower > is_higher) + is_lower <- pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) + is_higher <- pbetaMix(x = 0.5, par = rbind(c(0.2, 0.4)), weights = 1) + expect_true(is_lower < is_higher) +}) + +test_that("the pbetaMix has the correct numeric result", { + result <- pbetaMix( + x = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), + weights = c(0.6, 0.4) + ) + expect_equal(result, 0.4768404, tolerance = 1e9) +}) + +test_that("the complement of pbetaMix can be derived with a different lower.tail flag", { + result <- pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = FALSE) + result_inversed <- pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = TRUE) + expect_equal(result, 1 - result_inversed, tolerance = 1e9) }) From 6d7f47880177f4f51a4cd4b81aabc94bb24e8a55 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 24 Aug 2023 15:15:59 +0200 Subject: [PATCH 008/106] upper case for test_that comments and more tests for qbeta --- examples/qbetaMix.R | 13 +------------ tests/testthat/test-dbetabinom.R | 28 +++++++++++++++++++++++++--- 2 files changed, 26 insertions(+), 15 deletions(-) diff --git a/examples/qbetaMix.R b/examples/qbetaMix.R index 92584a8a..81e1a2e7 100644 --- a/examples/qbetaMix.R +++ b/examples/qbetaMix.R @@ -1,24 +1,13 @@ -## Calculating the quantile (inverse CDF) of a mixture -## of beta densities at x where q = 0.6; a = 0.2; b = 0.4 -## -## ## Only 1 mixture component, i.e., weights = 1 -## Compare to qbeta(0.6,0.2,0.4) = 0.3112065 -## qbetaMix(q = 0.60, 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 -## qbetaMix( q = 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 : q = seq(0,1,.01) -## -## +## Can also specify q as a vector qbetaMix( q = 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 22c0e888..074f0ca7 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -8,13 +8,15 @@ test_that("the sum of the dbetabinom density for all x is 1", { expect_equal(result, 1) }) -test_that("the pbetaMix has incrementally higher cdf with increase x support", { +## pbetaMix ---- + +test_that("The pbetaMix has incrementally higher cdf with increase x support", { is_lower <- pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) is_higher <- pbetaMix(x = 0.5, par = rbind(c(0.2, 0.4)), weights = 1) expect_true(is_lower < is_higher) }) -test_that("the pbetaMix has the correct numeric result", { +test_that("The pbetaMix has the correct numeric result", { result <- pbetaMix( x = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) @@ -22,8 +24,28 @@ test_that("the pbetaMix has the correct numeric result", { expect_equal(result, 0.4768404, tolerance = 1e9) }) -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(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = FALSE) result_inversed <- pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = TRUE) expect_equal(result, 1 - result_inversed, tolerance = 1e9) }) + +## qbetaMix ---- + +test_that("The qbetaMix has the correct numeric result", { # TODO ask if "number" more accurate + result <- qbetaMix(q = 0.60, par = rbind(c(0.2, 0.4)), weights = 1) + expect_equal(result, 0.3112065, tolerance = 1e9) +}) + +test_that("The qbetaMix has the correct numeric result", { # TODO ask if "number" more accurate + result <- qbetaMix( + q = 0.6, par = rbind(c(0.2, 0.4), c(1, 1)), + weights = c(0.6, 0.4) + ) + expect_equal(result, 0.488759, tolerance = 1e9) +}) + +test_that("The qbetaMix has the correct numeric result", { + result <- qbetaMix(q = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4)) + expect_numeric(result) +}) From 0b361e34384c77befa70a1cc2cfe0320585b1c70 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Sun, 27 Aug 2023 15:49:02 +0200 Subject: [PATCH 009/106] test_thats for pbetaMix and qbetaMix --- R/dbetabinom.R | 19 ++++++---- examples/pbetaMix.R | 2 -- examples/qbetaMix.R | 9 +++-- man/pbetaMix.Rd | 25 +++++++++++-- man/qbetaMix.Rd | 28 +++++++++++++-- tests/testthat/test-dbetabinom.R | 60 +++++++++++++++++++++++--------- 6 files changed, 113 insertions(+), 30 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 5cb72228..d89e9461 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -149,11 +149,11 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' #' @description `r lifecycle::badge("experimental")` #' -#' Note that `x` can be a vector. +#' Calculates the cdf of the beta-mixture #' #' @typed x : number #' the abscissa. -#' @typed par : matrix or array +#' @typed par : matrix #' the beta parameters matrix, with K rows and 2 columns, #' corresponding to the beta parameters of the K components. #' @typed weights : matrix @@ -163,11 +163,15 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' and otherwise `P[X > x]`. #' @return the (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". #' +#' @note `x` can be a vector. +#' +#' @example examples/pbetaMix.R #' @export pbetaMix <- function(x, par, weights, lower.tail = TRUE) { assert_numeric(x, lower = 0, finite = TRUE) assert_numeric(weights, lower = 0, upper = 1, finite = TRUE) assert_vector(par) + assert_flag(lower.tail) ret <- sum(weights * pbeta(x, par[, 1], par[, 2], lower.tail = lower.tail)) ret } @@ -176,9 +180,9 @@ pbetaMix <- Vectorize(pbetaMix, vectorize.args = "x") #' Beta-mixture quantile function #' -#' @description `r lifecycle::badge("experimental")` +#' @description `r lifecycle::badge("experimental")` #' -#' Note that `x` can be a vector. +#' Calculates the quantile where x support is at the intersection of cdf and quantile function at chosen quantile/s #' #' @typed q : numeric #' the required quantile. @@ -187,16 +191,19 @@ pbetaMix <- Vectorize(pbetaMix, vectorize.args = "x") #' corresponding to the beta parameters of the K components. #' @typed weights : matrix #' the mixture weights of the beta mixture prior. +#' @typed lower.tail : flag +#' whether cdf at x taken at lower or upper tail #' @return the abscissa. #' +#' @example examples/qbetaMix.R #' @export qbetaMix <- function(q, par, weights, lower.tail) { f <- function(pi) { + assert_numeric(pi, lower = 0, finite = TRUE) pbetaMix(x = pi, par = par, weights = weights) - q } - assert_number(f, lower = 0, upper = 1, finite = TRUE) unirootResult <- uniroot(f, lower = 0, upper = 1) - assert_number(unirootResult, lower = 0, upper = 1, finite = TRUE) + assert_number(unirootResult$f.root) if (unirootResult$iter < 0) { NA } else { diff --git a/examples/pbetaMix.R b/examples/pbetaMix.R index 422b1cf6..c02ea51b 100644 --- a/examples/pbetaMix.R +++ b/examples/pbetaMix.R @@ -4,8 +4,6 @@ pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = FALSE) ## 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 pbetaMix( x = 0.3, 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 81e1a2e7..c1c21cca 100644 --- a/examples/qbetaMix.R +++ b/examples/qbetaMix.R @@ -1,5 +1,9 @@ ## Only 1 mixture component, i.e., weights = 1 -qbetaMix(q = 0.60, par = rbind(c(0.2, 0.4)), weights = 1) +qbetaMix( + q = 0.60, + par = rbind(c(0.2, 0.4)), + weights = 1 +) ## With 2 mixture components qbetaMix( @@ -9,6 +13,7 @@ qbetaMix( ## Can also specify q as a vector qbetaMix( - q = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), + 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/pbetaMix.Rd b/man/pbetaMix.Rd index ffd8ec96..a37a69c0 100644 --- a/man/pbetaMix.Rd +++ b/man/pbetaMix.Rd @@ -9,7 +9,7 @@ pbetaMix(x, par, weights, lower.tail = TRUE) \arguments{ \item{x}{(\code{number}):\cr the abscissa.} -\item{par}{(\verb{matrix or array}):\cr the beta parameters matrix, with K rows and 2 columns, +\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{matrix}):\cr the mixture weights of the beta mixture prior.} @@ -23,5 +23,26 @@ the (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Note that \code{x} can be a vector. +Calculates the cdf of the beta-mixture +} +\note{ +\code{x} can be a vector. +} +\examples{ +pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) + +## Can get the one minus CDF values +pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = FALSE) + +## With 2 mixture components +pbetaMix( + 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. +pbetaMix( + x = 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 c27ee6d9..0bd15540 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -13,12 +13,36 @@ qbetaMix(q, par, weights, lower.tail) corresponding to the beta parameters of the K components.} \item{weights}{(\code{matrix}):\cr the mixture weights of the beta mixture prior.} + +\item{lower.tail}{(\code{flag}):\cr whether cdf at x taken at lower or upper tail} } \value{ the abscissa. } \description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +@description \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +} +\details{ +Calculates the quantile where x support is at the intersection of cdf and quantile function at chosen quantile/s +} +\examples{ +## Only 1 mixture component, i.e., weights = 1 +qbetaMix( + q = 0.60, + par = rbind(c(0.2, 0.4)), + weights = 1 +) + +## With 2 mixture components +qbetaMix( + q = 0.6, par = rbind(c(0.2, 0.4), c(1, 1)), + weights = c(0.6, 0.4) +) -Note that \code{x} can be a vector. +## Can also specify q as a vector +qbetaMix( + q = 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 82f1c3f7..a02b7086 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -62,41 +62,69 @@ test_that("Beta mixture density has the correct numeric result", { ## pbetaMix ---- test_that("The pbetaMix has incrementally higher cdf with increase x support", { - is_lower <- pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) - is_higher <- pbetaMix(x = 0.5, par = rbind(c(0.2, 0.4)), weights = 1) + is_lower <- pbetaMix( + x = 0.3, + par = rbind(c(0.2, 0.4)), + weights = 1 + ) + is_higher <- pbetaMix( + x = 0.5, + par = rbind(c(0.2, 0.4)), + weights = 1 + ) expect_true(is_lower < is_higher) }) -test_that("The pbetaMix has the correct numeric result", { +test_that("The pbetaMix has the correct number result", { result <- pbetaMix( - x = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), + x = 0.3, + par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) - expect_equal(result, 0.4768404, tolerance = 1e9) + expect_equal(result, 0.4768404, tolerance = 1e-5) }) test_that("The complement of pbetaMix can be derived with a different lower.tail flag", { - result <- pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = FALSE) - result_inversed <- pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = TRUE) - expect_equal(result, 1 - result_inversed, tolerance = 1e9) + result <- pbetaMix( + x = 0.3, + par = rbind(c(0.2, 0.4)), + weights = 1, + lower.tail = FALSE + ) + result_inversed <- pbetaMix( + x = 0.3, + par = rbind(c(0.2, 0.4)), + weights = 1, + lower.tail = TRUE + ) + expect_equal(result, 1 - result_inversed, tolerance = 1e-5) }) ## qbetaMix ---- -test_that("The qbetaMix has the correct numeric result", { # TODO ask if "number" more accurate - result <- qbetaMix(q = 0.60, par = rbind(c(0.2, 0.4)), weights = 1) - expect_equal(result, 0.3112065, tolerance = 1e9) +test_that("The qbetaMix has the correct number result", { + result <- qbetaMix( + q = 0.6, + par = rbind(c(0.2, 0.4)), + weights = 1 + ) + expect_equal(result, 0.3112068, tolerance = 1e-6) }) -test_that("The qbetaMix has the correct numeric result", { # TODO ask if "number" more accurate +test_that("The qbetaMix has the correct number result", { result <- qbetaMix( - q = 0.6, par = rbind(c(0.2, 0.4), c(1, 1)), + q = 0.6, + par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) - expect_equal(result, 0.488759, tolerance = 1e9) + expect_equal(result, 0.488759, tolerance = 1e-6) }) -test_that("The qbetaMix has the correct numeric result", { - result <- qbetaMix(q = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4)) +test_that("The qbetaMix has a number result", { + result <- qbetaMix( + q = seq(0, 1, .01), + par = rbind(c(0.2, 0.4), c(1, 1)), + weights = c(0.6, 0.4) + ) expect_numeric(result) }) From 8b20f728559ed15c70feff72b928512b15fbde10 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 28 Aug 2023 09:07:34 +0200 Subject: [PATCH 010/106] tidy syntax and last checks --- R/dbetabinom.R | 4 ++-- man/qbetaMix.Rd | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index d89e9461..34e30f03 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -170,7 +170,7 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") pbetaMix <- function(x, par, weights, lower.tail = TRUE) { assert_numeric(x, lower = 0, finite = TRUE) assert_numeric(weights, lower = 0, upper = 1, finite = TRUE) - assert_vector(par) + assert_matrix(par) assert_flag(lower.tail) ret <- sum(weights * pbeta(x, par[, 1], par[, 2], lower.tail = lower.tail)) ret @@ -182,7 +182,7 @@ pbetaMix <- Vectorize(pbetaMix, vectorize.args = "x") #' #' @description `r lifecycle::badge("experimental")` #' -#' Calculates the quantile where x support is at the intersection of cdf and quantile function at chosen quantile/s +#' Calculates the quantile where x support is at the intersection of cdf and quantile function #' #' @typed q : numeric #' the required quantile. diff --git a/man/qbetaMix.Rd b/man/qbetaMix.Rd index 0bd15540..33f1c819 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -23,7 +23,7 @@ the abscissa. @description \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} } \details{ -Calculates the quantile where x support is at the intersection of cdf and quantile function at chosen quantile/s +Calculates the quantile where x support is at the intersection of cdf and quantile function } \examples{ ## Only 1 mixture component, i.e., weights = 1 From b0c22187e74b6b15c288664398c74532688ba7dd Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 28 Aug 2023 09:07:34 +0200 Subject: [PATCH 011/106] tidy syntax and last checks --- R/dbetabinom.R | 4 ++-- man/qbetaMix.Rd | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index d89e9461..34e30f03 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -170,7 +170,7 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") pbetaMix <- function(x, par, weights, lower.tail = TRUE) { assert_numeric(x, lower = 0, finite = TRUE) assert_numeric(weights, lower = 0, upper = 1, finite = TRUE) - assert_vector(par) + assert_matrix(par) assert_flag(lower.tail) ret <- sum(weights * pbeta(x, par[, 1], par[, 2], lower.tail = lower.tail)) ret @@ -182,7 +182,7 @@ pbetaMix <- Vectorize(pbetaMix, vectorize.args = "x") #' #' @description `r lifecycle::badge("experimental")` #' -#' Calculates the quantile where x support is at the intersection of cdf and quantile function at chosen quantile/s +#' Calculates the quantile where x support is at the intersection of cdf and quantile function #' #' @typed q : numeric #' the required quantile. diff --git a/man/qbetaMix.Rd b/man/qbetaMix.Rd index 0bd15540..33f1c819 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -23,7 +23,7 @@ the abscissa. @description \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} } \details{ -Calculates the quantile where x support is at the intersection of cdf and quantile function at chosen quantile/s +Calculates the quantile where x support is at the intersection of cdf and quantile function } \examples{ ## Only 1 mixture component, i.e., weights = 1 From 5384c3d3d9245251a79410b5a2c66258c1b43a7f Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 28 Aug 2023 14:26:04 +0200 Subject: [PATCH 012/106] 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 34e30f03..7aa49165 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -145,7 +145,7 @@ dbetaMix <- function(x, par, weights, log = FALSE) { dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") -#' Beta-mixture cdf +#' Beta-Mixture CDF #' #' @description `r lifecycle::badge("experimental")` #' From f5403fa28c44602bccaccc8f0565bfb31094eaf0 Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Mon, 28 Aug 2023 12:29:02 +0000 Subject: [PATCH 013/106] [skip actions] Roxygen Man Pages Auto Update --- man/pbetaMix.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/pbetaMix.Rd b/man/pbetaMix.Rd index a37a69c0..2d6d0d68 100644 --- a/man/pbetaMix.Rd +++ b/man/pbetaMix.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/dbetabinom.R \name{pbetaMix} \alias{pbetaMix} -\title{Beta-mixture cdf} +\title{Beta-Mixture CDF} \usage{ pbetaMix(x, par, weights, lower.tail = TRUE) } From 0dd2bab848bed856b3f1cc73e83eaf4138a91606 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 28 Aug 2023 14:29:25 +0200 Subject: [PATCH 014/106] 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 7aa49165..e4bd16e7 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -149,7 +149,7 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' #' @description `r lifecycle::badge("experimental")` #' -#' Calculates the cdf of the beta-mixture +#' Calculates the cdf of the beta-mixture distribution. #' #' @typed x : number #' the abscissa. From ca0236f6ffbf391dc604792e534a3093dbf0d8c5 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 28 Aug 2023 14:29:32 +0200 Subject: [PATCH 015/106] 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 e4bd16e7..06e7c895 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -157,7 +157,7 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' the beta parameters matrix, with K rows and 2 columns, #' corresponding to the beta parameters of the K components. #' @typed weights : matrix -#' the mixture weights of the beta mixture prior. +#' the mixture weights of the beta mixture prior which add up to 1. #' @typed lower.tail : logical # TODO Why not flag #' if TRUE (default), probabilities are `P[X <= x]`, #' and otherwise `P[X > x]`. From 9cf54d0a3e952492e3e7cf8fc9003c493b55256c Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 28 Aug 2023 14:29:37 +0200 Subject: [PATCH 016/106] 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 06e7c895..1a180fb1 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -156,7 +156,7 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' @typed par : matrix #' the beta parameters matrix, with K rows and 2 columns, #' corresponding to the beta parameters of the K components. -#' @typed weights : matrix +#' @typed weights : numeric #' the mixture weights of the beta mixture prior which add up to 1. #' @typed lower.tail : logical # TODO Why not flag #' if TRUE (default), probabilities are `P[X <= x]`, From 2eb3bd215a02faa4c2ccb13e96b1e5209013f04d Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 28 Aug 2023 14:29:46 +0200 Subject: [PATCH 017/106] 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 1a180fb1..0b52ff1e 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -158,7 +158,7 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' corresponding to the beta parameters of the K components. #' @typed weights : numeric #' the mixture weights of the beta mixture prior which add up to 1. -#' @typed lower.tail : logical # TODO Why not flag +#' @typed lower.tail : flag #' if TRUE (default), probabilities are `P[X <= x]`, #' and otherwise `P[X > x]`. #' @return the (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". From c08435fdda15fc50684d8afe573a226d97c7944c Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 28 Aug 2023 14:30:32 +0200 Subject: [PATCH 018/106] Update R/dbetabinom.R Co-authored-by: Daniel Sabanes Bove --- R/dbetabinom.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 0b52ff1e..d0ec16ed 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -203,7 +203,6 @@ qbetaMix <- function(q, par, weights, lower.tail) { pbetaMix(x = pi, par = par, weights = weights) - q } unirootResult <- uniroot(f, lower = 0, upper = 1) - assert_number(unirootResult$f.root) if (unirootResult$iter < 0) { NA } else { From e36facd305865a5f8dcca505db864c880fe2675f Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 28 Aug 2023 14:30:41 +0200 Subject: [PATCH 019/106] Update R/dbetabinom.R Co-authored-by: Daniel Sabanes Bove --- R/dbetabinom.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index d0ec16ed..e03f6cd3 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -206,6 +206,7 @@ qbetaMix <- function(q, par, weights, lower.tail) { if (unirootResult$iter < 0) { NA } else { + assert_number(unirootResult$root) unirootResult$root } } From f45d2f04dae9cdd8425019cf450f180949ede8c2 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 28 Aug 2023 14:30:46 +0200 Subject: [PATCH 020/106] 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 e03f6cd3..92bb60c9 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -210,4 +210,4 @@ qbetaMix <- function(q, par, weights, lower.tail) { unirootResult$root } } -qbetaMix <- Vectorize(qbetaMix, vectorize.args = "q") +qbetaMix <- Vectorize(qbetaMix, vectorize.args = "p") From 0505982a6aed333a0a7ac6ec23c34fde6f211dc4 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 28 Aug 2023 14:30:54 +0200 Subject: [PATCH 021/106] Update examples/pbetaMix.R Co-authored-by: Daniel Sabanes Bove --- examples/pbetaMix.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/pbetaMix.R b/examples/pbetaMix.R index c02ea51b..5d75722d 100644 --- a/examples/pbetaMix.R +++ b/examples/pbetaMix.R @@ -1,6 +1,6 @@ pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) -## Can get the one minus CDF values +# Can get the one minus CDF values. pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = FALSE) ## With 2 mixture components From 469ed6ef81f6c9e06c22ae8f9fe3035b60e38268 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 29 Aug 2023 11:29:08 +0200 Subject: [PATCH 022/106] p and q inputs --- R/dbetabinom.R | 15 +++++++-------- examples/pbetaMix.R | 8 ++++---- examples/qbetaMix.R | 6 +++--- man/pbetaMix.Rd | 22 +++++++++++----------- man/qbetaMix.Rd | 12 ++++++------ tests/testthat/test-dbetabinom.R | 16 ++++++++-------- 6 files changed, 39 insertions(+), 40 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 92bb60c9..aec0758b 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -167,15 +167,15 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' #' @example examples/pbetaMix.R #' @export -pbetaMix <- function(x, par, weights, lower.tail = TRUE) { - assert_numeric(x, lower = 0, finite = TRUE) +pbetaMix <- function(q, par, weights, lower.tail = TRUE) { + assert_numeric(q, lower = 0, finite = TRUE) assert_numeric(weights, lower = 0, upper = 1, finite = TRUE) assert_matrix(par) assert_flag(lower.tail) - ret <- sum(weights * pbeta(x, par[, 1], par[, 2], lower.tail = lower.tail)) + ret <- sum(weights * pbeta(q, par[, 1], par[, 2], lower.tail = lower.tail)) ret } -pbetaMix <- Vectorize(pbetaMix, vectorize.args = "x") +pbetaMix <- Vectorize(pbetaMix, vectorize.args = "q") #' Beta-mixture quantile function @@ -197,10 +197,9 @@ pbetaMix <- Vectorize(pbetaMix, vectorize.args = "x") #' #' @example examples/qbetaMix.R #' @export -qbetaMix <- function(q, par, weights, lower.tail) { +qbetaMix <- function(qt, par, weights, lower.tail = TRUE) { f <- function(pi) { - assert_numeric(pi, lower = 0, finite = TRUE) - pbetaMix(x = pi, par = par, weights = weights) - q + pbetaMix(q = pi, par = par, weights = weights, lower.tail = lower.tail) - qt } unirootResult <- uniroot(f, lower = 0, upper = 1) if (unirootResult$iter < 0) { @@ -210,4 +209,4 @@ qbetaMix <- function(q, par, weights, lower.tail) { unirootResult$root } } -qbetaMix <- Vectorize(qbetaMix, vectorize.args = "p") +qbetaMix <- Vectorize(qbetaMix, vectorize.args = "qt") diff --git a/examples/pbetaMix.R b/examples/pbetaMix.R index 5d75722d..15e7f13c 100644 --- a/examples/pbetaMix.R +++ b/examples/pbetaMix.R @@ -1,16 +1,16 @@ -pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) +pbetaMix(q = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) # Can get the one minus CDF values. -pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = FALSE) +pbetaMix(q = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = FALSE) ## With 2 mixture components pbetaMix( - x = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), + 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. pbetaMix( - x = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), + 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 c1c21cca..aea0eb83 100644 --- a/examples/qbetaMix.R +++ b/examples/qbetaMix.R @@ -1,19 +1,19 @@ ## Only 1 mixture component, i.e., weights = 1 qbetaMix( - q = 0.60, + qt = 0.60, par = rbind(c(0.2, 0.4)), weights = 1 ) ## With 2 mixture components qbetaMix( - q = 0.6, par = rbind(c(0.2, 0.4), c(1, 1)), + qt = 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 qbetaMix( - q = seq(0, 1, .01), + qt = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) diff --git a/man/pbetaMix.Rd b/man/pbetaMix.Rd index 2d6d0d68..ab2d4661 100644 --- a/man/pbetaMix.Rd +++ b/man/pbetaMix.Rd @@ -4,18 +4,18 @@ \alias{pbetaMix} \title{Beta-Mixture CDF} \usage{ -pbetaMix(x, par, weights, lower.tail = TRUE) +pbetaMix(q, par, weights, lower.tail = TRUE) } \arguments{ -\item{x}{(\code{number}):\cr the abscissa.} - \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{matrix}):\cr the mixture weights of the beta mixture prior.} +\item{weights}{(\code{numeric}):\cr the mixture weights of the beta mixture prior which add up to 1.} -\item{lower.tail}{(\code{logical # TODO Why not flag}):\cr if TRUE (default), probabilities are \code{P[X <= x]}, +\item{lower.tail}{(\code{flag}):\cr if TRUE (default), probabilities are \code{P[X <= x]}, and otherwise \code{P[X > x]}.} + +\item{x}{(\code{number}):\cr the abscissa.} } \value{ the (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". @@ -23,26 +23,26 @@ the (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Calculates the cdf of the beta-mixture +Calculates the cdf of the beta-mixture distribution. } \note{ \code{x} can be a vector. } \examples{ -pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) +pbetaMix(q = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) -## Can get the one minus CDF values -pbetaMix(x = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = FALSE) +# 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 pbetaMix( - x = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), + 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. pbetaMix( - x = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), + 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 33f1c819..9393cbaf 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -4,17 +4,17 @@ \alias{qbetaMix} \title{Beta-mixture quantile function} \usage{ -qbetaMix(q, par, weights, lower.tail) +qbetaMix(qt, par, weights, lower.tail = TRUE) } \arguments{ -\item{q}{(\code{numeric}):\cr the required quantile.} - \item{par}{(\code{number}):\cr the beta parameters matrix, with K rows and 2 columns, corresponding to the beta parameters of the K components.} \item{weights}{(\code{matrix}):\cr the mixture weights of the beta mixture prior.} \item{lower.tail}{(\code{flag}):\cr whether cdf at x taken at lower or upper tail} + +\item{q}{(\code{numeric}):\cr the required quantile.} } \value{ the abscissa. @@ -28,20 +28,20 @@ Calculates the quantile where x support is at the intersection of cdf and quanti \examples{ ## Only 1 mixture component, i.e., weights = 1 qbetaMix( - q = 0.60, + qt = 0.60, par = rbind(c(0.2, 0.4)), weights = 1 ) ## With 2 mixture components qbetaMix( - q = 0.6, par = rbind(c(0.2, 0.4), c(1, 1)), + qt = 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 qbetaMix( - q = seq(0, 1, .01), + qt = 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 a02b7086..eb4720ff 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -63,12 +63,12 @@ test_that("Beta mixture density has the correct numeric result", { test_that("The pbetaMix has incrementally higher cdf with increase x support", { is_lower <- pbetaMix( - x = 0.3, + q = 0.3, par = rbind(c(0.2, 0.4)), weights = 1 ) is_higher <- pbetaMix( - x = 0.5, + q = 0.5, par = rbind(c(0.2, 0.4)), weights = 1 ) @@ -77,7 +77,7 @@ test_that("The pbetaMix has incrementally higher cdf with increase x support", { test_that("The pbetaMix has the correct number result", { result <- pbetaMix( - x = 0.3, + q = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) @@ -86,13 +86,13 @@ test_that("The pbetaMix has the correct number result", { test_that("The complement of pbetaMix can be derived with a different lower.tail flag", { result <- pbetaMix( - x = 0.3, + q = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = FALSE ) result_inversed <- pbetaMix( - x = 0.3, + q = 0.3, par = rbind(c(0.2, 0.4)), weights = 1, lower.tail = TRUE @@ -104,7 +104,7 @@ test_that("The complement of pbetaMix can be derived with a different lower.tail test_that("The qbetaMix has the correct number result", { result <- qbetaMix( - q = 0.6, + qt = 0.6, par = rbind(c(0.2, 0.4)), weights = 1 ) @@ -113,7 +113,7 @@ test_that("The qbetaMix has the correct number result", { test_that("The qbetaMix has the correct number result", { result <- qbetaMix( - q = 0.6, + qt = 0.6, par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) @@ -122,7 +122,7 @@ test_that("The qbetaMix has the correct number result", { test_that("The qbetaMix has a number result", { result <- qbetaMix( - q = seq(0, 1, .01), + qt = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) From 1abea5060e1ac37736212fa32b41fec71e048268 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 29 Aug 2023 11:36:45 +0200 Subject: [PATCH 023/106] q,p changes --- R/dbetabinom.R | 17 ++++++++--------- man/pbetaMix.Rd | 4 ++-- man/qbetaMix.Rd | 8 ++++---- 3 files changed, 14 insertions(+), 15 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index aec0758b..c2b7ea1c 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -159,33 +159,32 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' @typed weights : numeric #' the mixture weights of the beta mixture prior which add up to 1. #' @typed lower.tail : flag -#' if TRUE (default), probabilities are `P[X <= x]`, +#' if `TRUE` (default), probabilities are `P[X <= x]`, #' and otherwise `P[X > x]`. -#' @return the (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". +#' @return The (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". #' #' @note `x` can be a vector. #' #' @example examples/pbetaMix.R #' @export pbetaMix <- function(q, par, weights, lower.tail = TRUE) { - assert_numeric(q, lower = 0, finite = TRUE) + assert_number(q, lower = 0, finite = TRUE) assert_numeric(weights, lower = 0, upper = 1, finite = TRUE) assert_matrix(par) assert_flag(lower.tail) - ret <- sum(weights * pbeta(q, par[, 1], par[, 2], lower.tail = lower.tail)) - ret + sum(weights * pbeta(q, par[, 1], par[, 2], lower.tail = lower.tail)) } pbetaMix <- Vectorize(pbetaMix, vectorize.args = "q") -#' Beta-mixture quantile function +#' Beta-Mixture Quantile function #' #' @description `r lifecycle::badge("experimental")` #' -#' Calculates the quantile where x support is at the intersection of cdf and quantile function +#' Calculates the quantile of the Beta-Mixture distribution for a given probability. #' -#' @typed q : numeric -#' the required quantile. +#' @typed qt : numeric +#' the required probability #' @typed par : number #' the beta parameters matrix, with K rows and 2 columns, #' corresponding to the beta parameters of the K components. diff --git a/man/pbetaMix.Rd b/man/pbetaMix.Rd index ab2d4661..1938692d 100644 --- a/man/pbetaMix.Rd +++ b/man/pbetaMix.Rd @@ -12,13 +12,13 @@ corresponding to the beta parameters of the K components.} \item{weights}{(\code{numeric}):\cr the mixture weights of the beta mixture prior which add up to 1.} -\item{lower.tail}{(\code{flag}):\cr if TRUE (default), probabilities are \code{P[X <= x]}, +\item{lower.tail}{(\code{flag}):\cr if \code{TRUE} (default), probabilities are \code{P[X <= x]}, and otherwise \code{P[X > x]}.} \item{x}{(\code{number}):\cr the abscissa.} } \value{ -the (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". +The (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} diff --git a/man/qbetaMix.Rd b/man/qbetaMix.Rd index 9393cbaf..5bda8ba7 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -2,19 +2,19 @@ % Please edit documentation in R/dbetabinom.R \name{qbetaMix} \alias{qbetaMix} -\title{Beta-mixture quantile function} +\title{Beta-Mixture Quantile function} \usage{ qbetaMix(qt, par, weights, lower.tail = TRUE) } \arguments{ +\item{qt}{(\code{numeric}):\cr the required probability} + \item{par}{(\code{number}):\cr the beta parameters matrix, with K rows and 2 columns, corresponding to the beta parameters of the K components.} \item{weights}{(\code{matrix}):\cr the mixture weights of the beta mixture prior.} \item{lower.tail}{(\code{flag}):\cr whether cdf at x taken at lower or upper tail} - -\item{q}{(\code{numeric}):\cr the required quantile.} } \value{ the abscissa. @@ -23,7 +23,7 @@ the abscissa. @description \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} } \details{ -Calculates the quantile where x support is at the intersection of cdf and quantile function +Calculates the quantile of the Beta-Mixture distribution for a given probability. } \examples{ ## Only 1 mixture component, i.e., weights = 1 From b7b523c10be18f2d3ebf57fc9bebf83e512bdc41 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 29 Aug 2023 11:39:00 +0200 Subject: [PATCH 024/106] 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 c2b7ea1c..efd2334a 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -179,7 +179,7 @@ pbetaMix <- Vectorize(pbetaMix, vectorize.args = "q") #' Beta-Mixture Quantile function #' -#' @description `r lifecycle::badge("experimental")` +#' @description `r lifecycle::badge("experimental")` #' #' Calculates the quantile of the Beta-Mixture distribution for a given probability. #' From 34a663bdabd7bce594b7e01551c2a99327f57c36 Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Tue, 29 Aug 2023 09:41:50 +0000 Subject: [PATCH 025/106] [skip actions] Roxygen Man Pages Auto Update --- man/qbetaMix.Rd | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/man/qbetaMix.Rd b/man/qbetaMix.Rd index 5bda8ba7..7f2cf18d 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -20,9 +20,8 @@ corresponding to the beta parameters of the K components.} the abscissa. } \description{ -@description \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -} -\details{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + Calculates the quantile of the Beta-Mixture distribution for a given probability. } \examples{ From f384100c0b2c1b274684c4d02aaebfa2e9e4f100 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 29 Aug 2023 11:49:28 +0200 Subject: [PATCH 026/106] documentation to reflect p and q changes --- R/dbetabinom.R | 12 ++++++------ man/pbetaMix.Rd | 8 ++++---- man/qbetaMix.Rd | 9 ++++----- 3 files changed, 14 insertions(+), 15 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index efd2334a..68a9ec41 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -149,9 +149,9 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' #' @description `r lifecycle::badge("experimental")` #' -#' Calculates the cdf of the beta-mixture distribution. +#' Calculates the CDF of the Beta-Mixture distribution. #' -#' @typed x : number +#' @typed q : number #' the abscissa. #' @typed par : matrix #' the beta parameters matrix, with K rows and 2 columns, @@ -163,7 +163,7 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' and otherwise `P[X > x]`. #' @return The (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". #' -#' @note `x` can be a vector. +#' @note `q` can be a vector. #' #' @example examples/pbetaMix.R #' @export @@ -181,7 +181,7 @@ pbetaMix <- Vectorize(pbetaMix, vectorize.args = "q") #' #' @description `r lifecycle::badge("experimental")` #' -#' Calculates the quantile of the Beta-Mixture distribution for a given probability. +#' Calculates the quantile of the Beta-Mixture distribution for a given probability. #' #' @typed qt : numeric #' the required probability @@ -191,8 +191,8 @@ pbetaMix <- Vectorize(pbetaMix, vectorize.args = "q") #' @typed weights : matrix #' the mixture weights of the beta mixture prior. #' @typed lower.tail : flag -#' whether cdf at x taken at lower or upper tail -#' @return the abscissa. +#' whether CDF at x taken at lower or upper tail +#' @return The abscissa. #' #' @example examples/qbetaMix.R #' @export diff --git a/man/pbetaMix.Rd b/man/pbetaMix.Rd index 1938692d..40bbe85f 100644 --- a/man/pbetaMix.Rd +++ b/man/pbetaMix.Rd @@ -7,6 +7,8 @@ pbetaMix(q, par, weights, lower.tail = TRUE) } \arguments{ +\item{q}{(\code{number}):\cr the abscissa.} + \item{par}{(\code{matrix}):\cr the beta parameters matrix, with K rows and 2 columns, corresponding to the beta parameters of the K components.} @@ -14,8 +16,6 @@ corresponding to the beta parameters of the K components.} \item{lower.tail}{(\code{flag}):\cr if \code{TRUE} (default), probabilities are \code{P[X <= x]}, and otherwise \code{P[X > x]}.} - -\item{x}{(\code{number}):\cr the abscissa.} } \value{ The (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". @@ -23,10 +23,10 @@ The (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Calculates the cdf of the beta-mixture distribution. +Calculates the CDF of the Beta-Mixture distribution. } \note{ -\code{x} can be a vector. +\code{q} can be a vector. } \examples{ pbetaMix(q = 0.3, par = rbind(c(0.2, 0.4)), weights = 1) diff --git a/man/qbetaMix.Rd b/man/qbetaMix.Rd index 5bda8ba7..11b56c4c 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -14,15 +14,14 @@ corresponding to the beta parameters of the K components.} \item{weights}{(\code{matrix}):\cr the mixture weights of the beta mixture prior.} -\item{lower.tail}{(\code{flag}):\cr whether cdf at x taken at lower or upper tail} +\item{lower.tail}{(\code{flag}):\cr whether CDF at x taken at lower or upper tail} } \value{ -the abscissa. +The abscissa. } \description{ -@description \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -} -\details{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + Calculates the quantile of the Beta-Mixture distribution for a given probability. } \examples{ From b9e50b258d5a89bb849e3786584b85e369b07adc Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 29 Aug 2023 14:47:49 +0200 Subject: [PATCH 027/106] amending qt --- R/dbetabinom.R | 8 ++++---- examples/qbetaMix.R | 6 +++--- man/pbetaMix.Rd | 2 +- man/qbetaMix.Rd | 12 ++++++------ tests/testthat/test-dbetabinom.R | 6 +++--- 5 files changed, 17 insertions(+), 17 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 68a9ec41..21dc983a 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -161,7 +161,7 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' @typed lower.tail : flag #' if `TRUE` (default), probabilities are `P[X <= x]`, #' and otherwise `P[X > x]`. -#' @return The (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". +#' @return The (one minus) cdf value #' #' @note `q` can be a vector. #' @@ -196,9 +196,9 @@ pbetaMix <- Vectorize(pbetaMix, vectorize.args = "q") #' #' @example examples/qbetaMix.R #' @export -qbetaMix <- function(qt, par, weights, lower.tail = TRUE) { +qbetaMix <- function(p, par, weights, lower.tail = TRUE) { f <- function(pi) { - pbetaMix(q = pi, par = par, weights = weights, lower.tail = lower.tail) - qt + pbetaMix(q = pi, par = par, weights = weights, lower.tail = lower.tail) - p } unirootResult <- uniroot(f, lower = 0, upper = 1) if (unirootResult$iter < 0) { @@ -208,4 +208,4 @@ qbetaMix <- function(qt, par, weights, lower.tail = TRUE) { unirootResult$root } } -qbetaMix <- Vectorize(qbetaMix, vectorize.args = "qt") +qbetaMix <- Vectorize(qbetaMix, vectorize.args = "p") diff --git a/examples/qbetaMix.R b/examples/qbetaMix.R index aea0eb83..359c7759 100644 --- a/examples/qbetaMix.R +++ b/examples/qbetaMix.R @@ -1,19 +1,19 @@ ## Only 1 mixture component, i.e., weights = 1 qbetaMix( - qt = 0.60, + p = 0.60, par = rbind(c(0.2, 0.4)), weights = 1 ) ## With 2 mixture components qbetaMix( - qt = 0.6, par = rbind(c(0.2, 0.4), c(1, 1)), + 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 qbetaMix( - qt = seq(0, 1, .01), + p = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) diff --git a/man/pbetaMix.Rd b/man/pbetaMix.Rd index 40bbe85f..07708b0c 100644 --- a/man/pbetaMix.Rd +++ b/man/pbetaMix.Rd @@ -18,7 +18,7 @@ corresponding to the beta parameters of the K components.} and otherwise \code{P[X > x]}.} } \value{ -The (one minus) cdf value # TODO DO WE NEED THIS return and where is the "1-". +The (one minus) cdf value } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} diff --git a/man/qbetaMix.Rd b/man/qbetaMix.Rd index 11b56c4c..7dbbdaf1 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -4,17 +4,17 @@ \alias{qbetaMix} \title{Beta-Mixture Quantile function} \usage{ -qbetaMix(qt, par, weights, lower.tail = TRUE) +qbetaMix(p, par, weights, lower.tail = TRUE) } \arguments{ -\item{qt}{(\code{numeric}):\cr the required probability} - \item{par}{(\code{number}):\cr the beta parameters matrix, with K rows and 2 columns, corresponding to the beta parameters of the K components.} \item{weights}{(\code{matrix}):\cr the mixture weights of the beta mixture prior.} \item{lower.tail}{(\code{flag}):\cr whether CDF at x taken at lower or upper tail} + +\item{qt}{(\code{numeric}):\cr the required probability} } \value{ The abscissa. @@ -27,20 +27,20 @@ Calculates the quantile of the Beta-Mixture distribution for a given probability \examples{ ## Only 1 mixture component, i.e., weights = 1 qbetaMix( - qt = 0.60, + p = 0.60, par = rbind(c(0.2, 0.4)), weights = 1 ) ## With 2 mixture components qbetaMix( - qt = 0.6, par = rbind(c(0.2, 0.4), c(1, 1)), + 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 qbetaMix( - qt = seq(0, 1, .01), + p = 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 eb4720ff..c57e2fd4 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -104,7 +104,7 @@ test_that("The complement of pbetaMix can be derived with a different lower.tail test_that("The qbetaMix has the correct number result", { result <- qbetaMix( - qt = 0.6, + p = 0.6, par = rbind(c(0.2, 0.4)), weights = 1 ) @@ -113,7 +113,7 @@ test_that("The qbetaMix has the correct number result", { test_that("The qbetaMix has the correct number result", { result <- qbetaMix( - qt = 0.6, + p = 0.6, par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) @@ -122,7 +122,7 @@ test_that("The qbetaMix has the correct number result", { test_that("The qbetaMix has a number result", { result <- qbetaMix( - qt = seq(0, 1, .01), + p = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), weights = c(0.6, 0.4) ) From 0ab047dba04757c8d54264ec9307b93440b35798 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 29 Aug 2023 15:54:58 +0200 Subject: [PATCH 028/106] intro x-> q --- vignettes/introduction.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd index 103d09f5..fbacf809 100644 --- a/vignettes/introduction.Rmd +++ b/vignettes/introduction.Rmd @@ -649,7 +649,7 @@ user could calculate the probability that the PET-CR rate is greater than 60%, i $\Pr(P_E > 0.6 \given x)$, by issuing the following command: ```{r Example_1_Postprob, echo=TRUE} -postprob(x = 55, n = 80, p = 0.6, parE = c(5.75, 4.25)) +postprob(q = 55, n = 80, p = 0.6, parE = c(5.75, 4.25)) ``` Here the result indicates that there is a roughly 93% chance that the PET-CR From 4164b4649db14297f429aebb875af37fe76c3e00 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 29 Aug 2023 16:07:44 +0200 Subject: [PATCH 029/106] amented postprob file --- R/postprob.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/postprob.R b/R/postprob.R index 57b4426f..5824b99d 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -73,7 +73,8 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS ## now compute updated parameters betamixPost <- getBetamixPost( - x = x, n = n, + x = x, + n = n, par = parE, weights = weights ) @@ -82,7 +83,7 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS ## now compute the survival function at p, i.e. 1 - cdf at p: ret <- with( betamixPost, - pbetaMix(x = p, par = par, weights = weights, lower.tail = FALSE) + pbetaMix(q = p, par = par, weights = weights, lower.tail = FALSE) ) if (log.p) { From 5d98627f4445e747e8901ae938b14fe1a9d50c5d Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 29 Aug 2023 16:07:44 +0200 Subject: [PATCH 030/106] amended postprob file --- R/postprob.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/postprob.R b/R/postprob.R index 57b4426f..5824b99d 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -73,7 +73,8 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS ## now compute updated parameters betamixPost <- getBetamixPost( - x = x, n = n, + x = x, + n = n, par = parE, weights = weights ) @@ -82,7 +83,7 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS ## now compute the survival function at p, i.e. 1 - cdf at p: ret <- with( betamixPost, - pbetaMix(x = p, par = par, weights = weights, lower.tail = FALSE) + pbetaMix(q = p, par = par, weights = weights, lower.tail = FALSE) ) if (log.p) { From 205e5740adf84f77eb5b212f57a42276e3854a42 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 29 Aug 2023 16:13:33 +0200 Subject: [PATCH 031/106] fixed mistake on x --- vignettes/introduction.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd index fbacf809..103d09f5 100644 --- a/vignettes/introduction.Rmd +++ b/vignettes/introduction.Rmd @@ -649,7 +649,7 @@ user could calculate the probability that the PET-CR rate is greater than 60%, i $\Pr(P_E > 0.6 \given x)$, by issuing the following command: ```{r Example_1_Postprob, echo=TRUE} -postprob(q = 55, n = 80, p = 0.6, parE = c(5.75, 4.25)) +postprob(x = 55, n = 80, p = 0.6, parE = c(5.75, 4.25)) ``` Here the result indicates that there is a roughly 93% chance that the PET-CR From 2d093bad776fcec68ce4efc7546bfe8db117bac9 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 29 Aug 2023 16:20:45 +0200 Subject: [PATCH 032/106] qbetaMix was in postprobDist --- R/postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index 1edddc90..ce339667 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -126,7 +126,7 @@ postprobDist <- function(x, n, bounds <- with( controlBetamixPost, qbetaMix( - q = c(epsilon, 1 - epsilon), + p = c(epsilon, 1 - epsilon), par = par, weights = weights ) From c7dbbf9b70e84804b7088250ff355c7aa70a9f48 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 30 Aug 2023 08:42:14 +0200 Subject: [PATCH 033/106] trying to find R CMD check error --- examples/ocPostprobDist.R | 35 +++++++++++++++++++++++++++++------ 1 file changed, 29 insertions(+), 6 deletions(-) diff --git a/examples/ocPostprobDist.R b/examples/ocPostprobDist.R index c9662deb..93b9c75f 100644 --- a/examples/ocPostprobDist.R +++ b/examples/ocPostprobDist.R @@ -11,8 +11,15 @@ res1 <- ocPostprobDist( - nn = c(10, 20, 30), p = 0.4, deltaE = 0.1, deltaF = -0.1, tL = 0.6, tU = 0.6, - parE = c(1, 1), parS = c(5, 25), ns = 100 + nn = c(10, 20, 30), + p = 0.4, + deltaE = 0.1, + deltaF = -0.1, + tL = 0.6, + tU = 0.6, + parE = c(1, 1), + parS = c(5, 25), + ns = 100 ) res1$oc @@ -22,16 +29,32 @@ res1$oc # this call will generate d (distance for random looks around the look locations) # based on "floor(min(nn - c(0,nn[-length(nn)]))/2)" as d is missing: res2 <- ocPostprobDist( - nn = c(10, 20, 30), p = 0.4, deltaE = 0.1, deltaF = -0.1, tL = 0.6, tU = 0.6, - parE = c(1, 1), parS = c(5, 25), ns = 100, nr = TRUE + nn = c(10, 20, 30), + p = 0.4, + deltaE = 0.1, + deltaF = -0.1, + tL = 0.6, + tU = 0.6, + parE = c(1, 1), + parS = c(5, 25), + ns = 100, nr = TRUE ) res2$oc # specify the distance for random looks around the look locations in nn (d=5 for illustration) res3 <- ocPostprobDist( - nn = c(10, 20, 30), p = 0.4, deltaE = 0.1, deltaF = -0.1, tL = 0.6, tU = 0.6, - parE = c(1, 1), parS = c(5, 25), ns = 100, nr = TRUE, d = 5 + nn = c(10, 20, 30), + p = 0.4, + deltaE = 0.1, + deltaF = -0.1, + tL = 0.6, + tU = 0.6, + parE = c(1, 1), + parS = c(5, 25), + ns = 100, + nr = TRUE, + d = 5 ) res3$oc From 640f9f31cf9c282fadac95c3e8889e41d512c214 Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Wed, 30 Aug 2023 06:46:02 +0000 Subject: [PATCH 034/106] [skip actions] Roxygen Man Pages Auto Update --- man/ocPostprobDist.Rd | 35 +++++++++++++++++++++++++++++------ 1 file changed, 29 insertions(+), 6 deletions(-) diff --git a/man/ocPostprobDist.Rd b/man/ocPostprobDist.Rd index 045a7bc5..11019a83 100644 --- a/man/ocPostprobDist.Rd +++ b/man/ocPostprobDist.Rd @@ -97,8 +97,15 @@ PrGrayZone: probability of no decision at the end ("gray zone") res1 <- ocPostprobDist( - nn = c(10, 20, 30), p = 0.4, deltaE = 0.1, deltaF = -0.1, tL = 0.6, tU = 0.6, - parE = c(1, 1), parS = c(5, 25), ns = 100 + nn = c(10, 20, 30), + p = 0.4, + deltaE = 0.1, + deltaF = -0.1, + tL = 0.6, + tU = 0.6, + parE = c(1, 1), + parS = c(5, 25), + ns = 100 ) res1$oc @@ -108,16 +115,32 @@ res1$oc # this call will generate d (distance for random looks around the look locations) # based on "floor(min(nn - c(0,nn[-length(nn)]))/2)" as d is missing: res2 <- ocPostprobDist( - nn = c(10, 20, 30), p = 0.4, deltaE = 0.1, deltaF = -0.1, tL = 0.6, tU = 0.6, - parE = c(1, 1), parS = c(5, 25), ns = 100, nr = TRUE + nn = c(10, 20, 30), + p = 0.4, + deltaE = 0.1, + deltaF = -0.1, + tL = 0.6, + tU = 0.6, + parE = c(1, 1), + parS = c(5, 25), + ns = 100, nr = TRUE ) res2$oc # specify the distance for random looks around the look locations in nn (d=5 for illustration) res3 <- ocPostprobDist( - nn = c(10, 20, 30), p = 0.4, deltaE = 0.1, deltaF = -0.1, tL = 0.6, tU = 0.6, - parE = c(1, 1), parS = c(5, 25), ns = 100, nr = TRUE, d = 5 + nn = c(10, 20, 30), + p = 0.4, + deltaE = 0.1, + deltaF = -0.1, + tL = 0.6, + tU = 0.6, + parE = c(1, 1), + parS = c(5, 25), + ns = 100, + nr = TRUE, + d = 5 ) res3$oc From 3f01c97a77bdfef9a8e3e5f50a7575bf95ae62e3 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 30 Aug 2023 08:50:23 +0200 Subject: [PATCH 035/106] manual of ocPostprobDist --- man/ocPostprobDist.Rd | 35 +++++++++++++++++++++++++++++------ 1 file changed, 29 insertions(+), 6 deletions(-) diff --git a/man/ocPostprobDist.Rd b/man/ocPostprobDist.Rd index 045a7bc5..11019a83 100644 --- a/man/ocPostprobDist.Rd +++ b/man/ocPostprobDist.Rd @@ -97,8 +97,15 @@ PrGrayZone: probability of no decision at the end ("gray zone") res1 <- ocPostprobDist( - nn = c(10, 20, 30), p = 0.4, deltaE = 0.1, deltaF = -0.1, tL = 0.6, tU = 0.6, - parE = c(1, 1), parS = c(5, 25), ns = 100 + nn = c(10, 20, 30), + p = 0.4, + deltaE = 0.1, + deltaF = -0.1, + tL = 0.6, + tU = 0.6, + parE = c(1, 1), + parS = c(5, 25), + ns = 100 ) res1$oc @@ -108,16 +115,32 @@ res1$oc # this call will generate d (distance for random looks around the look locations) # based on "floor(min(nn - c(0,nn[-length(nn)]))/2)" as d is missing: res2 <- ocPostprobDist( - nn = c(10, 20, 30), p = 0.4, deltaE = 0.1, deltaF = -0.1, tL = 0.6, tU = 0.6, - parE = c(1, 1), parS = c(5, 25), ns = 100, nr = TRUE + nn = c(10, 20, 30), + p = 0.4, + deltaE = 0.1, + deltaF = -0.1, + tL = 0.6, + tU = 0.6, + parE = c(1, 1), + parS = c(5, 25), + ns = 100, nr = TRUE ) res2$oc # specify the distance for random looks around the look locations in nn (d=5 for illustration) res3 <- ocPostprobDist( - nn = c(10, 20, 30), p = 0.4, deltaE = 0.1, deltaF = -0.1, tL = 0.6, tU = 0.6, - parE = c(1, 1), parS = c(5, 25), ns = 100, nr = TRUE, d = 5 + nn = c(10, 20, 30), + p = 0.4, + deltaE = 0.1, + deltaF = -0.1, + tL = 0.6, + tU = 0.6, + parE = c(1, 1), + parS = c(5, 25), + ns = 100, + nr = TRUE, + d = 5 ) res3$oc From cc069c3201083e1413d4b602bcd932a9885b675d Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 30 Aug 2023 09:04:13 +0200 Subject: [PATCH 036/106] fixing roxygen type to p --- R/dbetabinom.R | 2 +- man/qbetaMix.Rd | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 21dc983a..0b64e5fe 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -183,7 +183,7 @@ pbetaMix <- Vectorize(pbetaMix, vectorize.args = "q") #' #' Calculates the quantile of the Beta-Mixture distribution for a given probability. #' -#' @typed qt : numeric +#' @typed p : numeric #' the required probability #' @typed par : number #' the beta parameters matrix, with K rows and 2 columns, diff --git a/man/qbetaMix.Rd b/man/qbetaMix.Rd index 7dbbdaf1..be89fc47 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -7,14 +7,14 @@ qbetaMix(p, par, weights, lower.tail = TRUE) } \arguments{ +\item{p}{(\code{numeric}):\cr the required probability} + \item{par}{(\code{number}):\cr the beta parameters matrix, with K rows and 2 columns, corresponding to the beta parameters of the K components.} \item{weights}{(\code{matrix}):\cr the mixture weights of the beta mixture prior.} \item{lower.tail}{(\code{flag}):\cr whether CDF at x taken at lower or upper tail} - -\item{qt}{(\code{numeric}):\cr the required probability} } \value{ The abscissa. From 626345c09fc79e3269746a4fc9cf843928cef69f Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 30 Aug 2023 09:17:18 +0200 Subject: [PATCH 037/106] see if this fixes the CMD check --- R/dbetabinom.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 0b64e5fe..6a7c95f0 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -168,7 +168,7 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' @example examples/pbetaMix.R #' @export pbetaMix <- function(q, par, weights, lower.tail = TRUE) { - assert_number(q, lower = 0, finite = TRUE) + assert_numeric(q, lower = 0, finite = TRUE) assert_numeric(weights, lower = 0, upper = 1, finite = TRUE) assert_matrix(par) assert_flag(lower.tail) From 3882982216b6ea32471c3241862747d60f208c1d Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 30 Aug 2023 09:46:09 +0200 Subject: [PATCH 038/106] see if fixes CMD check error --- R/postprob.R | 4 ++-- examples/postprob.R | 2 +- man/postprob.Rd | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/postprob.R b/R/postprob.R index 5824b99d..02b895c9 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -73,7 +73,7 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS ## now compute updated parameters betamixPost <- getBetamixPost( - x = x, + x = xi, n = n, par = parE, weights = weights @@ -83,7 +83,7 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS ## now compute the survival function at p, i.e. 1 - cdf at p: ret <- with( betamixPost, - pbetaMix(q = p, par = par, weights = weights, lower.tail = FALSE) + pbetaMix(q = xi, par = par, weights = weights, lower.tail = FALSE) ) if (log.p) { diff --git a/examples/postprob.R b/examples/postprob.R index bad6317b..b31ab387 100644 --- a/examples/postprob.R +++ b/examples/postprob.R @@ -22,5 +22,5 @@ postprob( c(0.6, 0.4), c(1, 1) ), - weights = c(0.6, 0.4) + weights = c(0.5, 0.4) ) diff --git a/man/postprob.Rd b/man/postprob.Rd index 84418334..c3b5a8e7 100644 --- a/man/postprob.Rd +++ b/man/postprob.Rd @@ -66,6 +66,6 @@ postprob( c(0.6, 0.4), c(1, 1) ), - weights = c(0.6, 0.4) + weights = c(0.5, 0.4) ) } From f6c7df2a00a2119e6da8ba476fddb1c19e963a7b Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 30 Aug 2023 13:04:38 +0200 Subject: [PATCH 039/106] xi removed --- R/postprob.R | 4 ++-- examples/postprob.R | 2 +- man/postprob.Rd | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/postprob.R b/R/postprob.R index 02b895c9..484fad9b 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -73,7 +73,7 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS ## now compute updated parameters betamixPost <- getBetamixPost( - x = xi, + x = x, n = n, par = parE, weights = weights @@ -83,7 +83,7 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS ## now compute the survival function at p, i.e. 1 - cdf at p: ret <- with( betamixPost, - pbetaMix(q = xi, par = par, weights = weights, lower.tail = FALSE) + pbetaMix(q = x, par = par, weights = weights, lower.tail = FALSE) ) if (log.p) { diff --git a/examples/postprob.R b/examples/postprob.R index b31ab387..bad6317b 100644 --- a/examples/postprob.R +++ b/examples/postprob.R @@ -22,5 +22,5 @@ postprob( c(0.6, 0.4), c(1, 1) ), - weights = c(0.5, 0.4) + weights = c(0.6, 0.4) ) diff --git a/man/postprob.Rd b/man/postprob.Rd index c3b5a8e7..84418334 100644 --- a/man/postprob.Rd +++ b/man/postprob.Rd @@ -66,6 +66,6 @@ postprob( c(0.6, 0.4), c(1, 1) ), - weights = c(0.5, 0.4) + weights = c(0.6, 0.4) ) } From 80eee89e6442f3dc747bbff527d4f76e8ecd99b6 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 30 Aug 2023 13:04:38 +0200 Subject: [PATCH 040/106] example post prob works --- R/postprob.R | 4 ++-- examples/postprob.R | 2 +- man/postprob.Rd | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/postprob.R b/R/postprob.R index 02b895c9..484fad9b 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -73,7 +73,7 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS ## now compute updated parameters betamixPost <- getBetamixPost( - x = xi, + x = x, n = n, par = parE, weights = weights @@ -83,7 +83,7 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS ## now compute the survival function at p, i.e. 1 - cdf at p: ret <- with( betamixPost, - pbetaMix(q = xi, par = par, weights = weights, lower.tail = FALSE) + pbetaMix(q = x, par = par, weights = weights, lower.tail = FALSE) ) if (log.p) { diff --git a/examples/postprob.R b/examples/postprob.R index b31ab387..bad6317b 100644 --- a/examples/postprob.R +++ b/examples/postprob.R @@ -22,5 +22,5 @@ postprob( c(0.6, 0.4), c(1, 1) ), - weights = c(0.5, 0.4) + weights = c(0.6, 0.4) ) diff --git a/man/postprob.Rd b/man/postprob.Rd index c3b5a8e7..84418334 100644 --- a/man/postprob.Rd +++ b/man/postprob.Rd @@ -66,6 +66,6 @@ postprob( c(0.6, 0.4), c(1, 1) ), - weights = c(0.5, 0.4) + weights = c(0.6, 0.4) ) } From 1d115b429c6928cf25cd73817cbd346b3463fe53 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 30 Aug 2023 13:30:47 +0200 Subject: [PATCH 041/106] clean --- R/postprob.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/postprob.R b/R/postprob.R index 484fad9b..5824b99d 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -83,7 +83,7 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS ## now compute the survival function at p, i.e. 1 - cdf at p: ret <- with( betamixPost, - pbetaMix(q = x, par = par, weights = weights, lower.tail = FALSE) + pbetaMix(q = p, par = par, weights = weights, lower.tail = FALSE) ) if (log.p) { From 5bb074e11e9c6a67cb7e0e746298ec5769c5bc33 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 30 Aug 2023 14:24:15 +0200 Subject: [PATCH 042/106] assert_number --- R/dbetabinom.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 6a7c95f0..0b64e5fe 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -168,7 +168,7 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' @example examples/pbetaMix.R #' @export pbetaMix <- function(q, par, weights, lower.tail = TRUE) { - assert_numeric(q, lower = 0, finite = TRUE) + assert_number(q, lower = 0, finite = TRUE) assert_numeric(weights, lower = 0, upper = 1, finite = TRUE) assert_matrix(par) assert_flag(lower.tail) From 9d4b62c893dd9316427f9ff4cd575ac22ec8e5e9 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 30 Aug 2023 14:24:15 +0200 Subject: [PATCH 043/106] in postprobDist, I changed p-> q --- R/dbetabinom.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 6a7c95f0..0b64e5fe 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -168,7 +168,7 @@ dbetaMix <- Vectorize(dbetaMix, vectorize.args = "x") #' @example examples/pbetaMix.R #' @export pbetaMix <- function(q, par, weights, lower.tail = TRUE) { - assert_numeric(q, lower = 0, finite = TRUE) + assert_number(q, lower = 0, finite = TRUE) assert_numeric(weights, lower = 0, upper = 1, finite = TRUE) assert_matrix(par) assert_flag(lower.tail) From db8fb65df6f5399aeeed754d6abdd0a64f281814 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 30 Aug 2023 15:04:54 +0200 Subject: [PATCH 044/106] change p to q --- R/postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index ce339667..1edddc90 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -126,7 +126,7 @@ postprobDist <- function(x, n, bounds <- with( controlBetamixPost, qbetaMix( - p = c(epsilon, 1 - epsilon), + q = c(epsilon, 1 - epsilon), par = par, weights = weights ) From 847061649bf0190327e62e45f8ca398a4e1fe19d Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 30 Aug 2023 15:45:18 +0200 Subject: [PATCH 045/106] postprobold --- R/postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index 1edddc90..ce339667 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -126,7 +126,7 @@ postprobDist <- function(x, n, bounds <- with( controlBetamixPost, qbetaMix( - q = c(epsilon, 1 - epsilon), + p = c(epsilon, 1 - epsilon), par = par, weights = weights ) From 3c86a99d2d408d084fa805dffc6a2d7a519999c6 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 31 Aug 2023 14:05:26 +0200 Subject: [PATCH 046/106] postprobOld --- DESCRIPTION | 2 +- NAMESPACE | 1 - R/postprob.R | 30 +++++++++++++++++------- examples/postprobOld.R | 16 ++++++------- man/postprobOld.Rd | 43 ---------------------------------- tests/testthat/test-postprob.R | 12 ++++++++++ 6 files changed, 42 insertions(+), 62 deletions(-) delete mode 100644 man/postprobOld.Rd create mode 100644 tests/testthat/test-postprob.R diff --git a/DESCRIPTION b/DESCRIPTION index 839ca9dd..60b108fb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -48,9 +48,9 @@ Config/roxytypes: list(format = "({type}):\\cr {description}") Collate: 'Phase1b-package.R' 'betadiff.R' - 'dbetabinom.R' 'postprob.R' 'boundsPostprob.R' + 'dbetabinom.R' 'predprob.R' 'boundsPredprob.R' 'data.R' diff --git a/NAMESPACE b/NAMESPACE index 42f1866e..8e2d8992 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -53,7 +53,6 @@ importFrom(stats,dbeta) importFrom(stats,dbinom) importFrom(stats,integrate) importFrom(stats,optimize) -importFrom(stats,pbeta) importFrom(stats,quantile) importFrom(stats,rbeta) importFrom(stats,rbinom) diff --git a/R/postprob.R b/R/postprob.R index 5824b99d..b1ff429c 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -1,27 +1,39 @@ -#' @include dbetabinom.R +#' @include dbetabinom.R NULL +#' @description `r lifecycle::badge("experimental")` +#' #' Compute the posterior probability to be above threshold assuming a beta prior #' on the response rate #' -#' Computes the posterior probability Pr(P_E > p | data). Prior is P_E ~ beta(a, b), +#' Computes the posterior probability `Pr(P_E > p | data)`. Prior is `P_E ~ beta(a, b)`, #' with default set to be a uniform or beta(1,1). #' #' We observed x successes in n trials and so the posterior is -#' P_E | data ~ beta(a + x, b + n - x). +#' `P_E | data ~ beta(a + x, b + n - x)`. #' -#' @param x number of successes -#' @param n number of patients -#' @param p threshold -#' @param a first parameter of the beta prior (successes) -#' @param b second parameter of the beta prior (failures) +#' @typed x : number +#' number of successes. +#' @typed n : number +#' number of patients. +#' @typed p : number +#' threshold set to compute posterior probability. +#' @typed a : matrix +#' first parameter `alpha` of the beta prior (successes). +#' @typed b : matrix +#' second parameter `beta` of the beta prior (failures). #' @return The posterior probability that the response rate P_E is above a threshold p. #' -#' @importFrom stats pbeta +#' @note that `x`, can be a vector #' #' @example examples/postprobOld.R #' @export postprobOld <- function(x, n, p, a = 1, b = 1) { + assert_numeric(x, lower = 0, upper = n, finite = TRUE) + assert_number(a, finite = TRUE) + assert_number(b, finite = TRUE) + assert_number(n, lower = 0, finite = TRUE) + assert_number(p, lower = 0, upper = 1, finite = TRUE) stats::pbeta(p, a + x, b + n - x, lower.tail = FALSE) } diff --git a/examples/postprobOld.R b/examples/postprobOld.R index e0fa659f..06396527 100644 --- a/examples/postprobOld.R +++ b/examples/postprobOld.R @@ -1,10 +1,10 @@ -## Example taken from Lee and Liu (????) -## -## 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 -## Posterior will be a beta(16.6,22.8), Pr(P_E > p | data) = 0.8358808 -## -## +# Example taken from Lee & Liu (2006) +# We observed 16 successes out of 23 patients # should we write this in the documentation +# We set a threshold of 0.60 +# Assume a beta(0.6,0.4) prior for P_E +# Posterior will be a beta(16.6,22.8), Pr(P_E > p | data) = 0.8358808 + +# Example taken from Lee and Liu (2006) postprobOld(x = 16, n = 23, p = 0.60, a = 0.6, b = 0.4) +# Interpretation : The probability 16 of 23 successes is greater than 60 % threshold is approximately 84 % diff --git a/man/postprobOld.Rd b/man/postprobOld.Rd deleted file mode 100644 index fa6c09ac..00000000 --- a/man/postprobOld.Rd +++ /dev/null @@ -1,43 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/postprob.R -\name{postprobOld} -\alias{postprobOld} -\title{Compute the posterior probability to be above threshold assuming a beta prior -on the response rate} -\usage{ -postprobOld(x, n, p, a = 1, b = 1) -} -\arguments{ -\item{x}{number of successes} - -\item{n}{number of patients} - -\item{p}{threshold} - -\item{a}{first parameter of the beta prior (successes)} - -\item{b}{second parameter of the beta prior (failures)} -} -\value{ -The posterior probability that the response rate P_E is above a threshold p. -} -\description{ -Computes the posterior probability Pr(P_E > p | data). Prior is P_E ~ beta(a, b), -with default set to be a uniform or beta(1,1). -} -\details{ -We observed x successes in n trials and so the posterior is -P_E | data ~ beta(a + x, b + n - x). -} -\examples{ -## Example taken from Lee and Liu (????) -## -## 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 -## Posterior will be a beta(16.6,22.8), Pr(P_E > p | data) = 0.8358808 -## -## - -postprobOld(x = 16, n = 23, p = 0.60, a = 0.6, b = 0.4) -} diff --git a/tests/testthat/test-postprob.R b/tests/testthat/test-postprob.R new file mode 100644 index 00000000..f81f85e1 --- /dev/null +++ b/tests/testthat/test-postprob.R @@ -0,0 +1,12 @@ +# -- postprobOld +test_that("The postprob has the correct number result", { + # Example from Lee & Liu (2006) A predictive probability design for phase II cancer clinical trials + result <- postprob(x = 16, n = 23, p = 0.60, par = c(0.6, 0.4)) + expect_equal(result, 0.8359808, tolerance = 1e-5) +}) + +test_that("The postprob has incrementally higher cdf with increase x support", { + is_lower <- postprob(x = 10, n = 23, p = 0.60, par = c(0.6, 0.4)) + is_higher <- postprob(x = 16, n = 23, p = 0.60, par = c(0.6, 0.4)) + expect_true(is_lower < is_higher) +}) From 2f9b83158746c8e5116c5866dda052d3ccf4c1b0 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 7 Sep 2023 16:21:09 +0200 Subject: [PATCH 047/106] clean post prob --- R/dbetabinom.R | 3 +- R/postprob.R | 68 +++++++++++++++++--------------- examples/postprob.R | 2 +- man/postprob.Rd | 39 +++++++++--------- man/qbetaMix.Rd | 2 +- tests/testthat/test-dbetabinom.R | 24 +++++------ tests/testthat/test-postprob.R | 52 ++++++++++++++++++++++-- 7 files changed, 121 insertions(+), 69 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index ea3a2bdf..d0a39112 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -56,6 +56,7 @@ dbetabinom <- function(x, m, a, b, log = FALSE) { #' @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`. +#' #' @note `x` can be a vector. #' #' @example examples/dbetabinomMix.R @@ -184,7 +185,7 @@ pbetaMix <- Vectorize(pbetaMix, vectorize.args = "q") #' Calculates the quantile of the Beta-Mixture distribution for a given probability. #' #' @typed p : numeric -#' the required probability +#' the required probability. #' @typed par : number #' the beta parameters matrix, with K rows and 2 columns, #' corresponding to the beta parameters of the K components. diff --git a/R/postprob.R b/R/postprob.R index b1ff429c..848ebb5f 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -4,12 +4,10 @@ NULL #' @description `r lifecycle::badge("experimental")` #' #' Compute the posterior probability to be above threshold assuming a beta prior -#' on the response rate -#' -#' Computes the posterior probability `Pr(P_E > p | data)`. Prior is `P_E ~ beta(a, b)`, +#' on the response rate such that `Pr(P_E > p | data)`. Prior is `P_E ~ beta(a, b)`, #' with default set to be a uniform or beta(1,1). #' -#' We observed x successes in n trials and so the posterior is +#' We observed `x` successes in n trials and so the posterior is #' `P_E | data ~ beta(a + x, b + n - x)`. #' #' @typed x : number @@ -24,7 +22,7 @@ NULL #' second parameter `beta` of the beta prior (failures). #' @return The posterior probability that the response rate P_E is above a threshold p. #' -#' @note that `x`, can be a vector +#' @note that `x`, can be a vector. #' #' @example examples/postprobOld.R #' @export @@ -38,6 +36,8 @@ postprobOld <- function(x, n, p, a = 1, b = 1) { } +#' @description `r lifecycle::badge("experimental")` +#' #' Compute the posterior probability to be above threshold, #' with a beta mixture prior on the response rate. #' @@ -45,44 +45,49 @@ postprobOld <- function(x, n, p, a = 1, b = 1) { #' `P_E ~ sum(weights * beta(parE[, 1], parE[, 2]))`, i.e., a mixture of beta priors. #' Default is one component only with uniform or `beta(1,1)`. #' -#' We observed x successes in n trials. Note that \code{x} can be a vector. +#' We observed `x` successes in n trials. #' #' Posterior is again a mixture of beta priors, with updated mixture weights #' and beta parameters. #' -#' @param x number of successes -#' @param n number of patients -#' @param p threshold -#' @param parE the beta parameters matrix, with K rows and 2 columns, -#' corresponding to the beta parameters of the K components. Default is a -#' uniform prior. -#' @param weights the mixture weights of the beta mixture prior. Default are -#' uniform weights across mixture components. -#' @param betamixPost optional result of \code{\link{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) -#' @param log.p Return the log of the probability? (default: FALSE) -#' @return The posterior probability that the response rate P_E is above p. +#' @typed x : numeric +#' number of successes. +#' @types n : number +#' number of patients. +#' @types p : number +#' threshold that P_E is measured. +#' @typed parE : matrix +#' the beta parameters matrix, with K rows and 2 columns, +#' corresponding to the beta parameters of the K components. +#' Default is a uniform prior. +#' @typed weights : vector +#' The mixture weights of the beta mixture prior. Default are +#' uniform weights across mixture components. +#' @typed betamixPost : matrix +#' optional result of `[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 +#' Return the log of the probability? (default: `FALSE`). +#' @return The posterior probability that the response rate `P_E` is above `p`. +#' +#' @note that `x` can be a vector. #' #' @example examples/postprob.R #' @export postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALSE) { if (missing(betamixPost)) { - ## if parE is a vector => situation where there is only one component if (is.vector(parE)) { - ## check that it has exactly two entries - stopifnot(identical(length(parE), 2L)) - - ## and transpose to matrix with one row + # Here there is only one component. + assert_true(identical(length(parE), 2L)) + # To get matrix with one row. parE <- t(parE) } - - ## if prior weights of the beta mixture are not supplied + assert_matrix(parE) + # 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) } - ## now compute updated parameters betamixPost <- getBetamixPost( x = x, @@ -91,7 +96,8 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS weights = weights ) } - + assert_list(betamixPost) + assert_names(names(betamixPost), identical.to = c("par", "weights")) ## now compute the survival function at p, i.e. 1 - cdf at p: ret <- with( betamixPost, @@ -99,9 +105,9 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS ) if (log.p) { - return(log(ret)) + log(ret) } else { - return(ret) + ret } } postprob <- Vectorize(postprob, vectorize.args = "x") diff --git a/examples/postprob.R b/examples/postprob.R index bad6317b..c4a18f45 100644 --- a/examples/postprob.R +++ b/examples/postprob.R @@ -1,4 +1,4 @@ -## Example taken from Lee and Liu +## Example taken from Lee and Liu (2006) ## ## We observed 16 successes out of 23 patients ## We set a threshold of 0.60 diff --git a/man/postprob.Rd b/man/postprob.Rd index 84418334..d4273422 100644 --- a/man/postprob.Rd +++ b/man/postprob.Rd @@ -2,47 +2,48 @@ % Please edit documentation in R/postprob.R \name{postprob} \alias{postprob} -\title{Compute the posterior probability to be above threshold, -with a beta mixture prior on the response rate.} +\title{@description \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}} \usage{ postprob(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALSE) } \arguments{ -\item{x}{number of successes} +\item{x}{(\code{numeric}):\cr number of successes.} -\item{n}{number of patients} +\item{parE}{(\code{matrix}):\cr the beta parameters matrix, with K rows and 2 columns, +corresponding to the beta parameters of the K components. +Default is a uniform prior.} -\item{p}{threshold} - -\item{parE}{the beta parameters matrix, with K rows and 2 columns, -corresponding to the beta parameters of the K components. Default is a -uniform prior.} - -\item{weights}{the mixture weights of the beta mixture prior. Default are +\item{weights}{(\code{vector}):\cr The mixture weights of the beta mixture prior. Default are uniform weights across mixture components.} -\item{betamixPost}{optional result of \code{\link{getBetamixPost}} in order +\item{betamixPost}{(\code{matrix}):\cr optional result of \verb{[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)} +the other arguments (except \code{p} and \code{log.p} of course).} -\item{log.p}{Return the log of the probability? (default: FALSE)} +\item{log.p}{(\code{number}):\cr Return the log of the probability? (default: \code{FALSE}).} } \value{ -The posterior probability that the response rate P_E is above p. +The posterior probability that the response rate \code{P_E} is above \code{p}. } \description{ +Compute the posterior probability to be above threshold, +with a beta mixture prior on the response rate. +} +\details{ Computes the posterior probability \code{Pr(P_E > p | data)}. Prior is \code{P_E ~ sum(weights * beta(parE[, 1], parE[, 2]))}, i.e., a mixture of beta priors. Default is one component only with uniform or \code{beta(1,1)}. -} -\details{ -We observed x successes in n trials. Note that \code{x} can be a vector. + +We observed \code{x} successes in n trials. Posterior is again a mixture of beta priors, with updated mixture weights and beta parameters. } +\note{ +that \code{x} can be a vector. +} \examples{ -## Example taken from Lee and Liu +## Example taken from Lee and Liu (2006) ## ## We observed 16 successes out of 23 patients ## We set a threshold of 0.60 diff --git a/man/qbetaMix.Rd b/man/qbetaMix.Rd index be89fc47..31fb090e 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -7,7 +7,7 @@ qbetaMix(p, par, weights, lower.tail = TRUE) } \arguments{ -\item{p}{(\code{numeric}):\cr the required probability} +\item{p}{(\code{numeric}):\cr the required probability.} \item{par}{(\code{number}):\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 c57e2fd4..d8d49c73 100644 --- a/tests/testthat/test-dbetabinom.R +++ b/tests/testthat/test-dbetabinom.R @@ -1,23 +1,23 @@ # dbetabinom ---- -test_that("the dbetabinom density 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("the sum of the dbetabinom density for all x is 1", { +test_that("Sum of the dbetabinom for all x is 1", { result <- sum(dbetabinom(x = 0:10, m = 10, a = 1, b = 1)) expect_equal(result, 1) }) -test_that("Beta binomial density has correct numeric result for specific inputs", { +test_that("dbetabinom gives correct numeric result", { result <- dbetabinom(x = 2, m = 29, a = 0.2, b = 0.4) expect_equal(result, 0.04286893, tolerance = 1e-6) }) # dbetabinomMix ---- -test_that("the beta mixture has 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("the beta mixture has a result between 0 and 1", { expect_numeric(result, lower = 0, upper = 1, finite = TRUE) }) -test_that("the beta mixture density has the correct numeric result", { +test_that("dbetabinomMix gives the correct numeric result", { result <- dbetabinomMix( x = 2, m = 29, @@ -37,7 +37,7 @@ test_that("the beta mixture density has the correct numeric result", { expect_equal(result, 0.04286893, tolerance = 1e-6) }) -test_that("the sum of the beta mixture density 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("the sum of the beta mixture density for all x is 1", { expect_equal(result, 1) }) -test_that("Beta mixture density has the correct numeric result", { +test_that("dbetabinomMix gives the correct numeric result", { result <- dbetabinomMix( x = 2, m = 29, @@ -61,7 +61,7 @@ test_that("Beta mixture density has the correct numeric result", { ## pbetaMix ---- -test_that("The pbetaMix has incrementally higher cdf with increase x support", { +test_that("pbetaMix cdf gives incrementally higher cdf with increase x support", { 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("The pbetaMix has the correct number result", { +test_that("pbetaMix gives the correct number result", { result <- pbetaMix( q = 0.3, par = rbind(c(0.2, 0.4), c(1, 1)), @@ -102,7 +102,7 @@ test_that("The complement of pbetaMix can be derived with a different lower.tail ## qbetaMix ---- -test_that("The qbetaMix has the correct number result", { +test_that("qbetaMix gives the correct number result", { result <- qbetaMix( p = 0.6, par = rbind(c(0.2, 0.4)), @@ -111,7 +111,7 @@ test_that("The qbetaMix has the correct number result", { expect_equal(result, 0.3112068, tolerance = 1e-6) }) -test_that("The qbetaMix has the correct number result", { +test_that("qbetaMix gives the correct number result", { result <- qbetaMix( p = 0.6, par = rbind(c(0.2, 0.4), c(1, 1)), @@ -120,7 +120,7 @@ test_that("The qbetaMix has the correct number result", { expect_equal(result, 0.488759, tolerance = 1e-6) }) -test_that("The qbetaMix has a number result", { +test_that("qbetaMix gives a number result", { result <- qbetaMix( p = seq(0, 1, .01), par = rbind(c(0.2, 0.4), c(1, 1)), diff --git a/tests/testthat/test-postprob.R b/tests/testthat/test-postprob.R index f81f85e1..2434bc81 100644 --- a/tests/testthat/test-postprob.R +++ b/tests/testthat/test-postprob.R @@ -1,12 +1,56 @@ # -- postprobOld -test_that("The postprob has the correct number result", { +test_that("postprobOld gives the correct number result", { + # Example from Lee & Liu (2006) A predictive probability design for phase II cancer clinical trials + result <- postprobOld(x = 16, n = 23, p = 0.60, a = 0.6, b = 0.4) + expect_equal(result, 0.8359808, tolerance = 1e-5) +}) + +test_that("postprobOld gives incrementally higher cdf with increase x support", { + is_lower <- postprobOld(x = 10, n = 23, p = 0.60, a = 0.6, b = 0.4) + is_higher <- postprobOld(x = 16, n = 23, p = 0.60, a = 0.6, b = 0.4) + expect_true(is_lower < is_higher) +}) + + +# -- postprob +test_that("postprob gives the correct number result", { # Example from Lee & Liu (2006) A predictive probability design for phase II cancer clinical trials result <- postprob(x = 16, n = 23, p = 0.60, par = c(0.6, 0.4)) expect_equal(result, 0.8359808, tolerance = 1e-5) }) -test_that("The postprob has incrementally higher cdf with increase x support", { - is_lower <- postprob(x = 10, n = 23, p = 0.60, par = c(0.6, 0.4)) - is_higher <- postprob(x = 16, n = 23, p = 0.60, par = c(0.6, 0.4)) +test_that("postprob gives the correct number result", { + # 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 + result <- postprob( + x = 10, + n = 23, + p = 0.60, + par = rbind( + c(0.6, 0.4), + c(1, 1) + ) + ) + expect_equal(result, 0.05559802, tolerance = 1e-5) +}) + +test_that("postprob gives incrementally higher cdf with increase x support", { + is_lower <- postprob( + x = 10, + n = 23, + p = 0.60, + par = rbind( + c(0.6, 0.4), + c(1, 1) + ) + ) + is_higher <- postprob( + x = 16, + n = 23, + p = 0.60, + par = rbind( + c(0.6, 0.4), + c(1, 1) + ) + ) expect_true(is_lower < is_higher) }) From 5d553ee5f31585e2110e4b0be0de96d51b790423 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 7 Sep 2023 16:40:07 +0200 Subject: [PATCH 048/106] nice titles --- DESCRIPTION | 2 +- R/dbetabinom.R | 8 +++++--- R/postprob.R | 10 ++++++--- man/dbetabinom.Rd | 2 +- man/dbetabinomMix.Rd | 2 +- man/getBetamixPost.Rd | 2 +- man/postprob.Rd | 12 ++++++++--- man/postprobOld.Rd | 47 +++++++++++++++++++++++++++++++++++++++++++ man/qbetaMix.Rd | 2 +- 9 files changed, 73 insertions(+), 14 deletions(-) create mode 100644 man/postprobOld.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 60b108fb..839ca9dd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -48,9 +48,9 @@ Config/roxytypes: list(format = "({type}):\\cr {description}") Collate: 'Phase1b-package.R' 'betadiff.R' + 'dbetabinom.R' 'postprob.R' 'boundsPostprob.R' - 'dbetabinom.R' 'predprob.R' 'boundsPredprob.R' 'data.R' diff --git a/R/dbetabinom.R b/R/dbetabinom.R index d0a39112..1e9cf1e1 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -1,4 +1,4 @@ -#' Beta-binomial density function +#' Beta-Binomial Density Function #' #' @description `r lifecycle::badge("experimental")` #' @@ -38,7 +38,7 @@ dbetabinom <- function(x, m, a, b, log = FALSE) { } -#' Beta-mixture-binomial density function +#' Beta-Mixture-Binomial Density Function #' #' @description `r lifecycle::badge("experimental")` #' @@ -74,6 +74,8 @@ dbetabinomMix <- function(x, m, par, weights, log = FALSE) { dbetabinomMix <- Vectorize(dbetabinomMix, vectorize.args = "x") +#' Argument list for Beta-Mixture Posterior distribution +#' #' Computes the posterior parameters of a beta mixture #' #' @param x number of successes @@ -178,7 +180,7 @@ pbetaMix <- function(q, par, weights, lower.tail = TRUE) { pbetaMix <- Vectorize(pbetaMix, vectorize.args = "q") -#' Beta-Mixture Quantile function +#' Beta-Mixture Quantile Function #' #' @description `r lifecycle::badge("experimental")` #' diff --git a/R/postprob.R b/R/postprob.R index 848ebb5f..cc01e5bb 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -1,6 +1,8 @@ -#' @include dbetabinom.R +#' @include dbetabinom.R NULL +#' Posterior Probability with uniform Beta Prior distribution +#' #' @description `r lifecycle::badge("experimental")` #' #' Compute the posterior probability to be above threshold assuming a beta prior @@ -36,6 +38,8 @@ postprobOld <- function(x, n, p, a = 1, b = 1) { } +#' Posterior Probability in Beta-Mixture distribution +#' #' @description `r lifecycle::badge("experimental")` #' #' Compute the posterior probability to be above threshold, @@ -52,9 +56,9 @@ postprobOld <- function(x, n, p, a = 1, b = 1) { #' #' @typed x : numeric #' number of successes. -#' @types n : number +#' @typed n : number #' number of patients. -#' @types p : number +#' @typed p : number #' threshold that P_E is measured. #' @typed parE : matrix #' the beta parameters matrix, with K rows and 2 columns, diff --git a/man/dbetabinom.Rd b/man/dbetabinom.Rd index 8cc8f5e0..1fb32cee 100644 --- a/man/dbetabinom.Rd +++ b/man/dbetabinom.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/dbetabinom.R \name{dbetabinom} \alias{dbetabinom} -\title{Beta-binomial density function} +\title{Beta-Binomial Density Function} \usage{ dbetabinom(x, m, a, b, log = FALSE) } diff --git a/man/dbetabinomMix.Rd b/man/dbetabinomMix.Rd index fe6905e6..6ec5b36e 100644 --- a/man/dbetabinomMix.Rd +++ b/man/dbetabinomMix.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/dbetabinom.R \name{dbetabinomMix} \alias{dbetabinomMix} -\title{Beta-mixture-binomial density function} +\title{Beta-Mixture-Binomial Density Function} \usage{ dbetabinomMix(x, m, par, weights, log = FALSE) } diff --git a/man/getBetamixPost.Rd b/man/getBetamixPost.Rd index 7758bbd5..30016fd7 100644 --- a/man/getBetamixPost.Rd +++ b/man/getBetamixPost.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/dbetabinom.R \name{getBetamixPost} \alias{getBetamixPost} -\title{Computes the posterior parameters of a beta mixture} +\title{Argument list for Beta-Mixture Posterior distribution} \usage{ getBetamixPost(x, n, par, weights) } diff --git a/man/postprob.Rd b/man/postprob.Rd index d4273422..b9f118ab 100644 --- a/man/postprob.Rd +++ b/man/postprob.Rd @@ -2,13 +2,17 @@ % Please edit documentation in R/postprob.R \name{postprob} \alias{postprob} -\title{@description \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}} +\title{Posterior Probability in Beta-Mixture distribution} \usage{ postprob(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALSE) } \arguments{ \item{x}{(\code{numeric}):\cr number of successes.} +\item{n}{(\code{number}):\cr number of patients.} + +\item{p}{(\code{number}):\cr threshold that P_E is measured.} + \item{parE}{(\code{matrix}):\cr the beta parameters matrix, with K rows and 2 columns, corresponding to the beta parameters of the K components. Default is a uniform prior.} @@ -26,10 +30,12 @@ the other arguments (except \code{p} and \code{log.p} of course).} The posterior probability that the response rate \code{P_E} is above \code{p}. } \description{ -Compute the posterior probability to be above threshold, -with a beta mixture prior on the response rate. +@description \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} } \details{ +Compute the posterior probability to be above threshold, +with a beta mixture prior on the response rate. + Computes the posterior probability \code{Pr(P_E > p | data)}. Prior is \code{P_E ~ sum(weights * beta(parE[, 1], parE[, 2]))}, i.e., a mixture of beta priors. Default is one component only with uniform or \code{beta(1,1)}. diff --git a/man/postprobOld.Rd b/man/postprobOld.Rd new file mode 100644 index 00000000..2b9b421d --- /dev/null +++ b/man/postprobOld.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/postprob.R +\name{postprobOld} +\alias{postprobOld} +\title{Posterior Probability with uniform Beta Prior distribution} +\usage{ +postprobOld(x, n, p, a = 1, b = 1) +} +\arguments{ +\item{x}{(\code{number}):\cr number of successes.} + +\item{n}{(\code{number}):\cr number of patients.} + +\item{p}{(\code{number}):\cr threshold set to compute posterior probability.} + +\item{a}{(\code{matrix}):\cr first parameter \code{alpha} of the beta prior (successes).} + +\item{b}{(\code{matrix}):\cr second parameter \code{beta} of the beta prior (failures).} +} +\value{ +The posterior probability that the response rate P_E is above a threshold p. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +Compute the posterior probability to be above threshold assuming a beta prior +on the response rate such that \code{Pr(P_E > p | data)}. Prior is \code{P_E ~ beta(a, b)}, +with default set to be a uniform or beta(1,1). + +We observed \code{x} successes in n trials and so the posterior is +\code{P_E | data ~ beta(a + x, b + n - x)}. +} +\note{ +that \code{x}, can be a vector. +} +\examples{ +# Example taken from Lee & Liu (2006) +# We observed 16 successes out of 23 patients # should we write this in the documentation +# We set a threshold of 0.60 +# Assume a beta(0.6,0.4) prior for P_E +# Posterior will be a beta(16.6,22.8), Pr(P_E > p | data) = 0.8358808 + + +# Example taken from Lee and Liu (2006) +postprobOld(x = 16, n = 23, p = 0.60, a = 0.6, b = 0.4) +# Interpretation : The probability 16 of 23 successes is greater than 60 \% threshold is approximately 84 \% +} diff --git a/man/qbetaMix.Rd b/man/qbetaMix.Rd index 31fb090e..54462adb 100644 --- a/man/qbetaMix.Rd +++ b/man/qbetaMix.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/dbetabinom.R \name{qbetaMix} \alias{qbetaMix} -\title{Beta-Mixture Quantile function} +\title{Beta-Mixture Quantile Function} \usage{ qbetaMix(p, par, weights, lower.tail = TRUE) } From c475186d9a48247aeff1630f7e494a620ecd1783 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 8 Sep 2023 15:29:46 +0200 Subject: [PATCH 049/106] documentations --- R/ocPostprob.R | 83 ++++++++++++++++++++++++++++--------------- examples/ocPostprob.R | 2 +- inst/WORDLIST | 1 + man/ocPostprob.Rd | 74 ++++++++++++++++++++++---------------- 4 files changed, 99 insertions(+), 61 deletions(-) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index a1f6baf7..fc50104b 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -1,45 +1,70 @@ #' @include postprob.R NULL -#' Calculate operating characteristics for posterior probability method +#' Operating Characteristics for Posterior Probability method +#' +#' @description `r lifecycle::badge("experimental")` +#' +#' Calculate operating characteristics for posterior probability method. #' #' The trial is stopped for efficacy if the posterior probability to be #' above p1 is larger than tU, and stopped for futility if the posterior -#' probability to be below p0 is larger than tL. +#' probability to be below p0 is larger than tL: +#' +#' Stop criteria for Efficacy : `P_E(p > p1) > tU` +#' +#' Stop criteria for Futility `P_E(p < p0) < tL` +#' #' -#' Returned operating characteristics in a matrix include: -#' ExpectedN: expected number of patients in the trials -#' PrStopEarly: probability to stop the trial early (before reaching the +#' Resulting Operating Characteristics include the following: +#' +#' - `ExpectedN`: expected number of patients in the trials +#' - `PrStopEarly`: probability to stop the trial early (before reaching the #' maximum sample size) -#' PrEarlyEff: probability to decide for efficacy early -#' PrEarlyFut: probability to decide for futility early -#' PrEfficacy: probability to decide for efficacy -#' PrFutility: probability to decide for futility -#' PrGrayZone: probability of no decision at the end ("gray zone") +#' - `PrEarlyEff`: probability of Early Go decision +#' - `PrEarlyFut`: probability to decide for futility early +#' - `PrEfficacy`: probability of Go decision +#' - `PrFutility`: Probability of stop decision +#' - `PrGrayZone`: probability between Go and Stop ,"Evaluate" or grey decision zone +#' +#' @typed nn : numeric +#' sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, +#' specify in `nnF`. +#' +#' @typed p : number +#' assumed true rate of response. +#' true rate (scenario) +#' @typed p0 : +#' lower efficacy threshold. +#' @typed p1 : +#' upper efficacy threshold. +#' @typed tL : +#' probability threshold for being below `p0`. +#' @typed tU : +#' probability threshold for being above `p1`. +#' @typed parE : numeric +#' beta parameters for the prior on the treatment proportion. +#' @typed ns : number +#' number of simulations. +#' @typed nr : number +#' generate random look locations (not default) +#' @typed d : numeric +#' distance for random looks around the look locations in `nn`. +#' @typed nnF : +#' sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, +#' specify in `nnF`. #' -#' @param nn vector of look locations for efficacy -#' (if futility looks should be different, please specify also \code{nnF}) -#' @param p true rate (scenario) -#' @param p0 lower efficacy threshold -#' @param p1 upper efficacy threshold -#' @param tL probability threshold for being below p0 -#' @param tU probability threshold for being above p1 -#' @param parE beta parameters for the prior on the treatment proportion -#' @param ns number of simulations -#' @param nr generate random look locations? (not default) -#' @param d distance for random looks around the look locations in \code{nn} -#' @param nnF vector of look locations for futility -#' (default: same as efficacy) #' @return A list with the following elements: -#' oc: matrix with operating characteristics (see Details section) +#' +#' - oc: matrix with operating characteristics (see Details section) #' Decision: vector of the decisions made in the simulated trials -#' (\code{TRUE} for success, \code{FALSE} for failure, \code{NA} for no +#' (`TRUE` for success, `FALSE` for failure, `NA` for no #' decision) #' SampleSize: vector of the sample sizes in the simulated trials -#' nn: vector of look locations that was supplied -#' nnE: vector of efficacy look locations -#' nnF: vector of futility look locations -#' params: multiple parameters +#' - `nn`: vector of look locations that was supplied +#' - `nnE`: vector of efficacy look locations +#' - `nnF`: vector of futility look locations +#' - `params`: multiple parameters #' #' @example examples/ocPostprob.R #' @export diff --git a/examples/ocPostprob.R b/examples/ocPostprob.R index 22580644..607e1f58 100644 --- a/examples/ocPostprob.R +++ b/examples/ocPostprob.R @@ -1,7 +1,7 @@ # operating characteristics for posterior probability method # design details (example) -# multiple looks @ 10, 20, 30 patietns +# multiple looks @ 10, 20, 30 patients # True response rate of the treatment group=40% # stop for futility: P(response rate < 20% )> 60% # s top for efficacy: P(response rate > 30% )> 80% diff --git a/inst/WORDLIST b/inst/WORDLIST index 93b9b0a5..1c50d807 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -2068,6 +2068,7 @@ GradientType Grande grayscale grayzone +grey gripsmall gS gsk diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index a60b2d55..612ab26e 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/ocPostprob.R \name{ocPostprob} \alias{ocPostprob} -\title{Calculate operating characteristics for posterior probability method} +\title{Operating Characteristics for Posterior Probability method} \usage{ ocPostprob( nn, @@ -19,63 +19,75 @@ ocPostprob( ) } \arguments{ -\item{nn}{vector of look locations for efficacy -(if futility looks should be different, please specify also \code{nnF})} +\item{nn}{(\code{numeric}):\cr sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, +specify in \code{nnF}.} -\item{p}{true rate (scenario)} +\item{p}{(\code{number}):\cr assumed true rate of response. +true rate (scenario)} -\item{p0}{lower efficacy threshold} +\item{p0}{(``):\cr lower efficacy threshold.} -\item{p1}{upper efficacy threshold} +\item{p1}{(``):\cr upper efficacy threshold.} -\item{tL}{probability threshold for being below p0} +\item{tL}{(``):\cr probability threshold for being below \code{p0}.} -\item{tU}{probability threshold for being above p1} +\item{tU}{(``):\cr probability threshold for being above \code{p1}.} -\item{parE}{beta parameters for the prior on the treatment proportion} +\item{parE}{(\code{numeric}):\cr beta parameters for the prior on the treatment proportion.} -\item{ns}{number of simulations} +\item{ns}{(\code{number}):\cr number of simulations.} -\item{nr}{generate random look locations? (not default)} +\item{nr}{(\code{number}):\cr generate random look locations (not default)} -\item{d}{distance for random looks around the look locations in \code{nn}} +\item{d}{(\code{numeric}):\cr distance for random looks around the look locations in \code{nn}.} -\item{nnF}{vector of look locations for futility -(default: same as efficacy)} +\item{nnF}{(``):\cr sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, +specify in \code{nnF}.} } \value{ A list with the following elements: -oc: matrix with operating characteristics (see Details section) +\itemize{ +\item oc: matrix with operating characteristics (see Details section) Decision: vector of the decisions made in the simulated trials (\code{TRUE} for success, \code{FALSE} for failure, \code{NA} for no decision) SampleSize: vector of the sample sizes in the simulated trials -nn: vector of look locations that was supplied -nnE: vector of efficacy look locations -nnF: vector of futility look locations -params: multiple parameters +\item \code{nn}: vector of look locations that was supplied +\item \code{nnE}: vector of efficacy look locations +\item \code{nnF}: vector of futility look locations +\item \code{params}: multiple parameters +} } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +Calculate operating characteristics for posterior probability method. + The trial is stopped for efficacy if the posterior probability to be above p1 is larger than tU, and stopped for futility if the posterior -probability to be below p0 is larger than tL. -} -\details{ -Returned operating characteristics in a matrix include: -ExpectedN: expected number of patients in the trials -PrStopEarly: probability to stop the trial early (before reaching the +probability to be below p0 is larger than tL: + +Stop criteria for Efficacy : \code{P_E(p > p1) > tU} + +Stop criteria for Futility \code{P_E(p < p0) < tL} + +Resulting Operating Characteristics include the following: +\itemize{ +\item \code{ExpectedN}: expected number of patients in the trials +\item \code{PrStopEarly}: probability to stop the trial early (before reaching the maximum sample size) -PrEarlyEff: probability to decide for efficacy early -PrEarlyFut: probability to decide for futility early -PrEfficacy: probability to decide for efficacy -PrFutility: probability to decide for futility -PrGrayZone: probability of no decision at the end ("gray zone") +\item \code{PrEarlyEff}: probability of Early Go decision +\item \code{PrEarlyFut}: probability to decide for futility early +\item \code{PrEfficacy}: probability of Go decision +\item \code{PrFutility}: Probability of stop decision +\item \code{PrGrayZone}: probability between Go and Stop ,"Evaluate" or grey decision zone +} } \examples{ # operating characteristics for posterior probability method # design details (example) -# multiple looks @ 10, 20, 30 patietns +# multiple looks @ 10, 20, 30 patients # True response rate of the treatment group=40\% # stop for futility: P(response rate < 20\% )> 60\% # s top for efficacy: P(response rate > 30\% )> 80\% From 0dd9c8a364adddfa42c34bf56479ad30a5b3cf08 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 8 Sep 2023 17:00:18 +0200 Subject: [PATCH 050/106] clean --- R/ocPostprob.R | 24 ++++++++++++------------ man/ocPostprob.Rd | 20 ++++++++++---------- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index fc50104b..71202aaf 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -8,12 +8,12 @@ NULL #' Calculate operating characteristics for posterior probability method. #' #' The trial is stopped for efficacy if the posterior probability to be -#' above p1 is larger than tU, and stopped for futility if the posterior -#' probability to be below p0 is larger than tL: +#' above `p1` is larger than `tU`, and stopped for futility if the posterior +#' probability to be below `p0` is larger than `tL`: #' #' Stop criteria for Efficacy : `P_E(p > p1) > tU` #' -#' Stop criteria for Futility `P_E(p < p0) < tL` +#' Stop criteria for Futility : n`P_E(p < p0) < tL` #' #' #' Resulting Operating Characteristics include the following: @@ -24,23 +24,22 @@ NULL #' - `PrEarlyEff`: probability of Early Go decision #' - `PrEarlyFut`: probability to decide for futility early #' - `PrEfficacy`: probability of Go decision -#' - `PrFutility`: Probability of stop decision +#' - `PrFutility`: Probability of Stop decision #' - `PrGrayZone`: probability between Go and Stop ,"Evaluate" or grey decision zone #' #' @typed nn : numeric #' sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, #' specify in `nnF`. -#' #' @typed p : number #' assumed true rate of response. #' true rate (scenario) -#' @typed p0 : +#' @typed p0 : number #' lower efficacy threshold. -#' @typed p1 : +#' @typed p1 : number #' upper efficacy threshold. -#' @typed tL : +#' @typed tL : number #' probability threshold for being below `p0`. -#' @typed tU : +#' @typed tU : number #' probability threshold for being above `p1`. #' @typed parE : numeric #' beta parameters for the prior on the treatment proportion. @@ -50,13 +49,13 @@ NULL #' generate random look locations (not default) #' @typed d : numeric #' distance for random looks around the look locations in `nn`. -#' @typed nnF : +#' @typed nnF : numeric #' sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, #' specify in `nnF`. #' #' @return A list with the following elements: #' -#' - oc: matrix with operating characteristics (see Details section) +#' - `oc`: matrix with operating characteristics (see Details section) #' Decision: vector of the decisions made in the simulated trials #' (`TRUE` for success, `FALSE` for failure, `NA` for no #' decision) @@ -71,7 +70,8 @@ NULL ocPostprob <- function(nn, p, p0, p1, tL, tU, parE = c(1, 1), ns = 10000, nr = FALSE, d = NULL, nnF = nn) { # Calculate operating characteristics via simulation - # nn: vector of look locations + # nn: sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, + # it is specifed in `nnF` # s: decision reject H0 (TRUE) or fail to reject (FALSE) # during trial if continuing (NA) diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index 612ab26e..3b695b08 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -25,13 +25,13 @@ specify in \code{nnF}.} \item{p}{(\code{number}):\cr assumed true rate of response. true rate (scenario)} -\item{p0}{(``):\cr lower efficacy threshold.} +\item{p0}{(\code{number}):\cr lower efficacy threshold.} -\item{p1}{(``):\cr upper efficacy threshold.} +\item{p1}{(\code{number}):\cr upper efficacy threshold.} -\item{tL}{(``):\cr probability threshold for being below \code{p0}.} +\item{tL}{(\code{number}):\cr probability threshold for being below \code{p0}.} -\item{tU}{(``):\cr probability threshold for being above \code{p1}.} +\item{tU}{(\code{number}):\cr probability threshold for being above \code{p1}.} \item{parE}{(\code{numeric}):\cr beta parameters for the prior on the treatment proportion.} @@ -41,13 +41,13 @@ true rate (scenario)} \item{d}{(\code{numeric}):\cr distance for random looks around the look locations in \code{nn}.} -\item{nnF}{(``):\cr sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, +\item{nnF}{(\code{numeric}):\cr sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, specify in \code{nnF}.} } \value{ A list with the following elements: \itemize{ -\item oc: matrix with operating characteristics (see Details section) +\item \code{oc}: matrix with operating characteristics (see Details section) Decision: vector of the decisions made in the simulated trials (\code{TRUE} for success, \code{FALSE} for failure, \code{NA} for no decision) @@ -64,12 +64,12 @@ SampleSize: vector of the sample sizes in the simulated trials Calculate operating characteristics for posterior probability method. The trial is stopped for efficacy if the posterior probability to be -above p1 is larger than tU, and stopped for futility if the posterior -probability to be below p0 is larger than tL: +above \code{p1} is larger than \code{tU}, and stopped for futility if the posterior +probability to be below \code{p0} is larger than \code{tL}: Stop criteria for Efficacy : \code{P_E(p > p1) > tU} -Stop criteria for Futility \code{P_E(p < p0) < tL} +Stop criteria for Futility : n\code{P_E(p < p0) < tL} Resulting Operating Characteristics include the following: \itemize{ @@ -79,7 +79,7 @@ maximum sample size) \item \code{PrEarlyEff}: probability of Early Go decision \item \code{PrEarlyFut}: probability to decide for futility early \item \code{PrEfficacy}: probability of Go decision -\item \code{PrFutility}: Probability of stop decision +\item \code{PrFutility}: Probability of Stop decision \item \code{PrGrayZone}: probability between Go and Stop ,"Evaluate" or grey decision zone } } From 9ddd5df3abece613c4bb19b8ea3e82245b42f79f Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 21 Sep 2023 17:27:32 +0200 Subject: [PATCH 051/106] clean --- NAMESPACE | 2 +- R/ocPostprob.R | 226 ++++++++++++++++--------- inst/WORDLIST | 2 + man/{ocPostprob.Rd => get_distance.Rd} | 73 ++++---- tests/testthat/test-ocPostprob.R | 158 +++++++++++++++++ 5 files changed, 354 insertions(+), 107 deletions(-) rename man/{ocPostprob.Rd => get_distance.Rd} (58%) create mode 100644 tests/testthat/test-ocPostprob.R diff --git a/NAMESPACE b/NAMESPACE index 8e2d8992..3bc0b5f6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,12 +7,12 @@ export(dbetabinom) export(dbetabinomMix) export(dbetadiff) export(getBetamixPost) +export(get_distance) export(logit) export(myPlot) export(myPlotDiff) export(oc2) export(oc3) -export(ocPostprob) export(ocPostprobDist) export(ocPredprob) export(ocPredprobDist) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index 71202aaf..97344231 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -7,13 +7,14 @@ NULL #' #' Calculate operating characteristics for posterior probability method. #' +#' It is assumed that the true response rate is `truep`. #' The trial is stopped for efficacy if the posterior probability to be #' above `p1` is larger than `tU`, and stopped for futility if the posterior #' probability to be below `p0` is larger than `tL`: #' #' Stop criteria for Efficacy : `P_E(p > p1) > tU` #' -#' Stop criteria for Futility : n`P_E(p < p0) < tL` +#' Stop criteria for Futility : `P_E(p < p0) > tL` #' #' #' Resulting Operating Characteristics include the following: @@ -22,36 +23,43 @@ NULL #' - `PrStopEarly`: probability to stop the trial early (before reaching the #' maximum sample size) #' - `PrEarlyEff`: probability of Early Go decision -#' - `PrEarlyFut`: probability to decide for futility early +#' - `PrEarlyFut`: probability to decide for Futility early #' - `PrEfficacy`: probability of Go decision #' - `PrFutility`: Probability of Stop decision -#' - `PrGrayZone`: probability between Go and Stop ,"Evaluate" or grey decision zone +#' - `PrGrayZone`: probability between Go and Stop ,"Evaluate" or Gray decision zone #' -#' @typed nn : numeric +#' @typed nnE : numeric #' sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, #' specify in `nnF`. -#' @typed p : number -#' assumed true rate of response. -#' true rate (scenario) +#' @typed truep : number +#' assumed true response rate nor true rate (scenario). #' @typed p0 : number -#' lower efficacy threshold. +#' lower efficacy threshold of response rate. #' @typed p1 : number -#' upper efficacy threshold. +#' upper efficacy threshold of response rate. #' @typed tL : number -#' probability threshold for being below `p0`. +#' posterior probability threshold for being below `p0`. #' @typed tU : number -#' probability threshold for being above `p1`. +#' posterior probability threshold for being above `p1`. #' @typed parE : numeric #' beta parameters for the prior on the treatment proportion. -#' @typed ns : number +#' @typed sim : number #' number of simulations. -#' @typed nr : number +#' @typed wiggle : logical #' generate random look locations (not default) -#' @typed d : numeric +#' if `TRUE`, specify `dist` (see @details) +#' @typed dist : "`numeric` or `NULL`" #TODO ( was dl)... check Roxytypes #' distance for random looks around the look locations in `nn`. +#' If `NULL`, only one location look will be set at nnE or nnF or n #' @typed nnF : numeric -#' sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, +#' sample size or sizes where study can be stopped for futility decision. If different for futility decision, #' specify in `nnF`. +#' ## From helper functions +#' @typed nnrE : numeric +#' same as `nnE` but if wiggle room and distance applied. +#' @typed nnrF : numeric +#' same as `nnF` but if wiggle room and distance applied. +# #' #' @return A list with the following elements: #' @@ -64,76 +72,142 @@ NULL #' - `nnE`: vector of efficacy look locations #' - `nnF`: vector of futility look locations #' - `params`: multiple parameters +#' - `Decision` : resulting decision, one of `TRUE` for GO, `FALSE`for STOP, `NA` for Gray zone +#' +#' @details +#' ## About arguments +#' +#' `ExpectedN` is an average of the simulated sample sizes. +#' If `wiggle = TRUE`, one can specify `dist`, though the algorithm will generate it if `dist = NULL` +#' If `nnF = NULL`, no Futility or decision to Stop will be analysed. Note that `nnF = c(0)` is equivalent. +#' As default, `nnF` is set to the identical looks of `nnE`, and if `wiggle = TRUE`, all looks are the same, e.g. +#' `nnE = nnF` when wiggle and distance is applied. +#' +#' ## About helper function +#' +#' `get_distance` inputs `dist` into `get_looks` and thereafter contributes to arguments in `get_decision`. +#' Finally, `get_oc` generates a list of parameters such as `decisions`, `all_sizes` and operating characteristics (oc). +#' #' #' @example examples/ocPostprob.R #' @export -ocPostprob <- function(nn, p, p0, p1, tL, tU, parE = c(1, 1), - ns = 10000, nr = FALSE, d = NULL, nnF = nn) { - # Calculate operating characteristics via simulation - # nn: sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, - # it is specifed in `nnF` - # s: decision reject H0 (TRUE) or fail to reject (FALSE) - # during trial if continuing (NA) +#' - ## copy nn to nnE: - nnE <- sort(nn) - nnF <- sort(nnF) - s <- rep(NA, ns) - n <- s - nn <- sort(unique(c(nnF, nnE))) - nL <- length(nn) - Nstart <- nn[1] - Nmax <- nn[nL] - if (nr && is.null(d)) { - # set parameter d for randomly generating look locations - d <- floor(min(nn - c(0, nn[-nL])) / 2) - } - nnr <- nn - nnrE <- nnE - nnrF <- nnF - for (k in 1:ns) { - # simulate a clinical trial ns times - if (nr && (d > 0)) { - # randomly generate look locations - dd <- sample(-d:d, - size = nL - 1, replace = TRUE, - prob = 2^(c(-d:0, rev(-d:(-1))) / 2) - ) - nnr <- nn + c(dd, 0) +#-- helper functions for OcPostProb +#-- get_distance +get_distance <- function(nn) { + assert_numeric(nn, unique = TRUE, sorted = TRUE) + dist0 <- floor(min(nn - c(0, nn[-length(nn)])) / 2) + assert_numeric(dist0, sorted = TRUE) + dist <- sample(-dist0:dist0, + size = length(nn) - 1, + replace = TRUE, + prob = 2^(c(-dist0:0, rev(-dist0:(-1))) / 2) + ) + dist +} - nnrE <- nnr[nn %in% nnE] - nnrF <- nnr[nn %in% nnF] +#-- get_looks helper function +get_looks <- function(dist, nnE, nnF) { + assert_numeric(nnE) + assert_numeric(nnF) + nn <- unique(c(nnE, nnF)) + assert_numeric(nn) + assert_numeric(dist) + nnr <- nn + c(dist, 0) + list( + nnrE = nnr[nn %in% nnE], + nnrF = nnr[nn %in% nnF] + ) +} + +#-- get_decision helper function +get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, tL, tU) { + index_look <- 1 + assert_numeric(nnr) + size_look <- nnr[index_look] + all_sizes <- decision <- NA + response <- stats::rbinom(max(nnr), 1, truep) + assert_numeric(response, lower = 0, upper = 1) + while (is.na(decision) && index_look <= length(nnr)) { + if (size_look %in% nnF) { + qL <- 1 - postprob(x = sum(response[1:size_look]), n = size_look, p = p0, parE = parE) # for each + assert_number(qL, lower = 0, upper = 1) + decision <- ifelse(qL >= tL, FALSE, NA) + } + if (size_look %in% nnE) { + qU <- postprob(x = sum(response[1:size_look]), n = size_look, p = p1, parE = parE) + assert_number(qU, lower = 0, upper = 1) + decision <- ifelse(qU < tU, decision, TRUE) } - x <- stats::rbinom(Nmax, 1, p) - j <- 1 - i <- nnr[j] - while (is.na(s[k]) && (j <= length(nnr))) { - if (i %in% nnrF) { - qL <- 1 - postprob(x = sum(x[1:i]), n = i, p = p0, parE = parE) - s[k] <- ifelse(qL >= tL, FALSE, NA) - } + all_sizes <- size_look + index_look <- index_look + 1 + size_look <- nnr[index_look] + # } + } + list( + decision = decision, + all_sizes = all_sizes + ) +} - if (i %in% nnrE) { - qU <- postprob(x = sum(x[1:i]), n = i, p = p1, parE = parE) - s[k] <- ifelse(qU < tU, s[k], TRUE) - } +#-- get_oc helper function +get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { + sim <- length(all_sizes) + assert_logical(decision, len = sim) + assert_numeric(all_sizes) + assert_numeric(nnrE, lower = 0, upper = max(nnrE)) + assert_numeric(nnrF, lower = 0, upper = max(nnrF)) + data.frame( + ExpectedN = mean(all_sizes, na.rm = TRUE), + PrStopEarly = mean(all_sizes < max(nnrF), na.rm = TRUE), + PrEarlyEff = sum(decision * (all_sizes < max(nnrE)), na.rm = TRUE) / sim, + PrEarlyFut = sum((1 - decision) * (all_sizes < max(nnrF)), na.rm = TRUE) / sim, + PrEfficacy = sum(decision, na.rm = TRUE) / sim, + PrFutility = sum(1 - decision, na.rm = TRUE) / sim, + PrGrayZone = sum(is.na(decision)) / sim + ) +} - n[k] <- i - j <- j + 1 - i <- nnr[j] +#-- ocPostprob +ocPostprob <- function(nnE, truep, p0, p1, tL, tU, parE = c(1, 1), + sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = nnE) { + nn <- sort(unique(c(nnF, nnE))) + decision <- vector(length = sim) + all_sizes <- vector(length = sim) + assert_logical(decision) + assert_logical(all_sizes) + for (k in 1:sim) { + if (length(nn) != 1 && wiggle && is.null(randomdist)) { + dist <- get_distance(nn = nn) + nnr <- get_looks(dist = dist, nnE = nnE, nnF = nnF) + nnrE <- nnr$nnrE + nnrF <- nnr$nnrF + } else { + nnrE <- nnE + nnrF <- nnF } + nnr <- unique(c(nnrE, nnrF)) + tmp <- get_decision( + nnr = nnr, response = response, + truep = truep, p0 = p0, p1 = p1, + parE = c(1, 1), nnE = nnrE, + nnF = nnrF, tL = tL, tU = tU + ) + decision[k] <- tmp$decision + all_sizes[k] <- tmp$all_sizes } - oc <- cbind( - ExpectedN = mean(n), PrStopEarly = mean(n < Nmax), - PrEarlyEff = sum(s * (n < Nmax), na.rm = TRUE) / ns, - PrEarlyFut = sum((1 - s) * (n < Nmax), na.rm = TRUE) / ns, - PrEfficacy = sum(s, na.rm = TRUE) / ns, - PrFutility = sum(1 - s, na.rm = TRUE) / ns, - PrGrayZone = sum(is.na(s) / ns) - ) - return(list( - oc = oc, Decision = s, SampleSize = n, - nn = nn, nnE = nnE, nnF = nnF, + oc <- get_oc(all_sizes = all_sizes, nnr = nnr, decision = decision, nnrE = nnrE, nnrF = nnrF) + list( + oc = oc, + Decision = decision, + SampleSize = all_sizes, + union_nn = nnr, + input_nnE = nnE, + input_nnF = nnF, + wiggled_Eff_n = nnrE, # new + wiggled_Fut_n = nnrF, # new + wiggle_dist = dist, params = as.list(match.call(expand.dots = FALSE)) - )) + ) } diff --git a/inst/WORDLIST b/inst/WORDLIST index 1c50d807..d0d86b44 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1290,6 +1290,7 @@ aL alignRight aM aN +analysed antialiased aO Ao @@ -3271,6 +3272,7 @@ rO Ro RO roK +Roxytypes Rp RpO rPT diff --git a/man/ocPostprob.Rd b/man/get_distance.Rd similarity index 58% rename from man/ocPostprob.Rd rename to man/get_distance.Rd index 3b695b08..127b3800 100644 --- a/man/ocPostprob.Rd +++ b/man/get_distance.Rd @@ -1,48 +1,43 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ocPostprob.R -\name{ocPostprob} -\alias{ocPostprob} +\name{get_distance} +\alias{get_distance} \title{Operating Characteristics for Posterior Probability method} \usage{ -ocPostprob( - nn, - p, - p0, - p1, - tL, - tU, - parE = c(1, 1), - ns = 10000, - nr = FALSE, - d = NULL, - nnF = nn -) +get_distance(nn) } \arguments{ -\item{nn}{(\code{numeric}):\cr sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, +\item{nnE}{(\code{numeric}):\cr sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, specify in \code{nnF}.} -\item{p}{(\code{number}):\cr assumed true rate of response. -true rate (scenario)} +\item{truep}{(\code{number}):\cr assumed true response rate nor true rate (scenario).} -\item{p0}{(\code{number}):\cr lower efficacy threshold.} +\item{p0}{(\code{number}):\cr lower efficacy threshold of response rate.} -\item{p1}{(\code{number}):\cr upper efficacy threshold.} +\item{p1}{(\code{number}):\cr upper efficacy threshold of response rate.} -\item{tL}{(\code{number}):\cr probability threshold for being below \code{p0}.} +\item{tL}{(\code{number}):\cr posterior probability threshold for being below \code{p0}.} -\item{tU}{(\code{number}):\cr probability threshold for being above \code{p1}.} +\item{tU}{(\code{number}):\cr posterior probability threshold for being above \code{p1}.} \item{parE}{(\code{numeric}):\cr beta parameters for the prior on the treatment proportion.} -\item{ns}{(\code{number}):\cr number of simulations.} +\item{sim}{(\code{number}):\cr number of simulations.} -\item{nr}{(\code{number}):\cr generate random look locations (not default)} +\item{wiggle}{(\code{logical}):\cr generate random look locations (not default) +if \code{TRUE}, specify \code{dist} (see @details)} -\item{d}{(\code{numeric}):\cr distance for random looks around the look locations in \code{nn}.} +\item{dist}{(\code{numeric} or \code{NULL}#TODO ( was dl)... check Roxytypes):\cr distance for random looks around the look locations in \code{nn}. +If \code{NULL}, only one location look will be set at nnE or nnF or n} -\item{nnF}{(\code{numeric}):\cr sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, -specify in \code{nnF}.} +\item{nnF}{(\code{numeric}):\cr sample size or sizes where study can be stopped for futility decision. If different for futility decision, +specify in \code{nnF}. +\subsection{From helper functions}{ +}} + +\item{nnrE}{(\code{numeric}):\cr same as \code{nnE} but if wiggle room and distance applied.} + +\item{nnrF}{(\code{numeric}):\cr same as \code{nnF} but if wiggle room and distance applied.} } \value{ A list with the following elements: @@ -56,6 +51,7 @@ SampleSize: vector of the sample sizes in the simulated trials \item \code{nnE}: vector of efficacy look locations \item \code{nnF}: vector of futility look locations \item \code{params}: multiple parameters +\item \code{Decision} : resulting decision, one of \code{TRUE} for GO, \code{FALSE}for STOP, \code{NA} for Gray zone } } \description{ @@ -63,13 +59,14 @@ SampleSize: vector of the sample sizes in the simulated trials Calculate operating characteristics for posterior probability method. +It is assumed that the true response rate is \code{truep}. The trial is stopped for efficacy if the posterior probability to be above \code{p1} is larger than \code{tU}, and stopped for futility if the posterior probability to be below \code{p0} is larger than \code{tL}: Stop criteria for Efficacy : \code{P_E(p > p1) > tU} -Stop criteria for Futility : n\code{P_E(p < p0) < tL} +Stop criteria for Futility : \code{P_E(p < p0) > tL} Resulting Operating Characteristics include the following: \itemize{ @@ -77,10 +74,26 @@ Resulting Operating Characteristics include the following: \item \code{PrStopEarly}: probability to stop the trial early (before reaching the maximum sample size) \item \code{PrEarlyEff}: probability of Early Go decision -\item \code{PrEarlyFut}: probability to decide for futility early +\item \code{PrEarlyFut}: probability to decide for Futility early \item \code{PrEfficacy}: probability of Go decision \item \code{PrFutility}: Probability of Stop decision -\item \code{PrGrayZone}: probability between Go and Stop ,"Evaluate" or grey decision zone +\item \code{PrGrayZone}: probability between Go and Stop ,"Evaluate" or Gray decision zone +} +} +\details{ +\subsection{About arguments}{ + +\code{ExpectedN} is an average of the simulated sample sizes. +If \code{wiggle = TRUE}, one can specify \code{dist}, though the algorithm will generate it if \code{dist = NULL} +If \code{nnF = NULL}, no Futility or decision to Stop will be analysed. Note that \code{nnF = c(0)} is equivalent. +As default, \code{nnF} is set to the identical looks of \code{nnE}, and if \code{wiggle = TRUE}, all looks are the same, e.g. +\code{nnE = nnF} when wiggle and distance is applied. +} + +\subsection{About helper function}{ + +\code{get_distance} inputs \code{dist} into \code{get_looks} and thereafter contributes to arguments in \code{get_decision}. +Finally, \code{get_oc} generates a list of parameters such as \code{decisions}, \code{all_sizes} and operating characteristics (oc). } } \examples{ diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R new file mode 100644 index 00000000..fa6686da --- /dev/null +++ b/tests/testthat/test-ocPostprob.R @@ -0,0 +1,158 @@ +#-- get_distance (helper function) +test_that("get_distance gives an error with one element numeric", { + expect_error(get_distance(10), "error!") +}) + +test_that("get_distance gives results within range", { + results <- get_distance(c(10, 20, 30)) + expect_number(results, lower = 10, upper = 30) +}) + +test_that("get_distance gives results within range", { + set.seed(1989) + results <- get_distance(c(10, 20, 30)) + results_inv <- get_distance(c(10, 20, 30)) + expect_true(results && results_inv, lower = 10, upper = 30) +}) + +#-- get_looks (helper function) +test_that("get_looks gives correct results if input is identical", { + dist <- c(0, 5) + results <- get_looks(dist = dist, nnE = c(10, 20, 30), nnF = nnE) + expect_equal(results$nnrE, results$nnrF) +}) + +test_that("get_looks gives correct results if input is identical", { + dist <- c(0, 5) + results <- get_looks(dist = dist, nnE = c(10, 20, 30), nnF = nnE) + expect_equal(results$nnrE, results$nnrF) +}) + +#-- get_decision (helper function) +test_that("get_decision has list outputs of length of sim each", { + p <- 0.3 + p0 <- 0.2 + p1 <- 0.3 + tL <- 0.5 + tU <- 0.8 + wiggle <- TRUE + randomdist <- NULL + decision <- all_sizes <- NA + sim <- 10000 + for (k in 1:sim) { + if (length(nn) != 1 && wiggle && is.null(randomdist)) { + dist <- get_distance(nn) + nnr <- get_looks(dist, nnE, nnF) + nnrE <- nnr$nnrE + nnrF <- nnr$nnrF + } else { + nnrE <- nnE + nnrF <- nnF + } + nnr <- unique(c(nnrE, nnrF)) + tmp <- get_decision( + nnr = nnr, response = response, + truep = truep, p0 = p0, p1 = p1, + parE = c(1, 1), nnE = nnrE, + nnF = nnrF, tL = tL, tU = tU + ) + decision[k] <- tmp$decision + all_sizes[k] <- tmp$all_sizes + } + expect_numeric(tmp$decision, max.len = sim) +}) + +test_that("get_decision has list outputs of length of sim each", { + p <- 0.3 + p0 <- 0.2 + p1 <- 0.3 + tL <- 0.5 + tU <- 0.8 + wiggle <- TRUE + randomdist <- NULL + decision <- all_sizes <- NA + sim <- 10000 + for (k in 1:sim) { + if (length(nn) != 1 && wiggle && is.null(randomdist)) { + dist <- get_distance(nn) + nnr <- get_looks(dist, nnE, nnF) + nnrE <- nnr$nnrE + nnrF <- nnr$nnrF + } else { + nnrE <- nnE + nnrF <- nnF + } + nnr <- unique(c(nnrE, nnrF)) + tmp <- get_decision( + nnr = nnr, response = response, + truep = truep, p0 = p0, p1 = p1, + parE = c(1, 1), nnE = nnrE, + nnF = nnrF, tL = tL, tU = tU + ) + decision[k] <- tmp$decision + all_sizes[k] <- tmp$all_sizes + } + expect_numeric(tmp$all_sizes, max.len = sim) +}) + +test_that("get_decision has list outputs of length of sim each", { + p <- 0.3 + p0 <- 0.2 + p1 <- 0.3 + tL <- 0.5 + tU <- 0.8 + wiggle <- TRUE + randomdist <- NULL + decision <- all_sizes <- NA + sim <- 10000 + for (k in 1:sim) { + if (length(nn) != 1 && wiggle && is.null(randomdist)) { + dist <- get_distance(nn) + nnr <- get_looks(dist, nnE, nnF) + nnrE <- nnr$nnrE + nnrF <- nnr$nnrF + } else { + nnrE <- nnE + nnrF <- nnF + } + nnr <- unique(c(nnrE, nnrF)) + tmp <- get_decision( + nnr = nnr, response = response, + truep = truep, p0 = p0, p1 = p1, + parE = c(1, 1), nnE = nnrE, + nnF = nnrF, tL = tL, tU = tU + ) + decision[k] <- tmp$decision + all_sizes[k] <- tmp$all_sizes + } + expect_equal(length(tmp$decision), length(tmp$all_sizes)) +}) + +#-- get_oc (helper function) +test_that("the probability results of get_oc are less than 1", { + oc <- get_oc( + all_sizes = sample(c(11, 14, 20), 10000, replace = TRUE), + decision = sample(c(NA, TRUE, FALSE), 10000, replace = TRUE), + sim = 10000, + SizeEff = c(11, 14, 20), + SizeFut = c(11, 14, 20) + ) + expect_true(oc$PrStopEarly > 1) # can have more than 1 expect_true ? +}) + +test_that("the ExpectedN is within range based on vector of looks", { + oc <- get_oc( + all_sizes = sample(c(11, 14, 20), 10000, replace = TRUE), + decision = sample(c(NA, TRUE, FALSE), 10000, replace = TRUE), + sim = 10000, + SizeEff = c(11, 14, 20), + SizeFut = c(11, 14, 20) + ) + expect_numper(oc$ExpectedN, lower = min(all_sizes), upper = max(all_sizes)) # can have more than 1 expect_true ? +}) + +# -- ocPostprob +test_that("the sum of Eff, Fut, Gray zone probabiliy is 1", { + results <- sum(ocPostprob$oc[4:7]) + expect_equal(result, 1) +}) From 476ad279a2542dd12838f8fadeff0f4a37b0346b Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 22 Sep 2023 10:25:46 +0200 Subject: [PATCH 052/106] clean --- R/ocPostprob.R | 4 ++-- tests/testthat/test-ocPostprob.R | 33 -------------------------------- 2 files changed, 2 insertions(+), 35 deletions(-) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index 97344231..5acf9efd 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -205,8 +205,8 @@ ocPostprob <- function(nnE, truep, p0, p1, tL, tU, parE = c(1, 1), union_nn = nnr, input_nnE = nnE, input_nnF = nnF, - wiggled_Eff_n = nnrE, # new - wiggled_Fut_n = nnrF, # new + wiggled_Eff_n = nnrE, + wiggled_Fut_n = nnrF, wiggle_dist = dist, params = as.list(match.call(expand.dots = FALSE)) ) diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index fa6686da..deb11cf8 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -95,39 +95,6 @@ test_that("get_decision has list outputs of length of sim each", { expect_numeric(tmp$all_sizes, max.len = sim) }) -test_that("get_decision has list outputs of length of sim each", { - p <- 0.3 - p0 <- 0.2 - p1 <- 0.3 - tL <- 0.5 - tU <- 0.8 - wiggle <- TRUE - randomdist <- NULL - decision <- all_sizes <- NA - sim <- 10000 - for (k in 1:sim) { - if (length(nn) != 1 && wiggle && is.null(randomdist)) { - dist <- get_distance(nn) - nnr <- get_looks(dist, nnE, nnF) - nnrE <- nnr$nnrE - nnrF <- nnr$nnrF - } else { - nnrE <- nnE - nnrF <- nnF - } - nnr <- unique(c(nnrE, nnrF)) - tmp <- get_decision( - nnr = nnr, response = response, - truep = truep, p0 = p0, p1 = p1, - parE = c(1, 1), nnE = nnrE, - nnF = nnrF, tL = tL, tU = tU - ) - decision[k] <- tmp$decision - all_sizes[k] <- tmp$all_sizes - } - expect_equal(length(tmp$decision), length(tmp$all_sizes)) -}) - #-- get_oc (helper function) test_that("the probability results of get_oc are less than 1", { oc <- get_oc( From 5397930367e953a16ada07a894e4a9fa5ca52245 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 22 Sep 2023 11:26:47 +0200 Subject: [PATCH 053/106] clean --- NAMESPACE | 3 +- R/ocPostprob.R | 170 +++++++++++++------------ man/get_oc.Rd | 16 +++ man/{get_distance.Rd => ocPostprob.Rd} | 24 +++- tests/testthat/test-ocPostprob.R | 4 +- 5 files changed, 129 insertions(+), 88 deletions(-) create mode 100644 man/get_oc.Rd rename man/{get_distance.Rd => ocPostprob.Rd} (97%) diff --git a/NAMESPACE b/NAMESPACE index 3bc0b5f6..c6954ecc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,12 +7,13 @@ export(dbetabinom) export(dbetabinomMix) export(dbetadiff) export(getBetamixPost) -export(get_distance) +export(get_oc) export(logit) export(myPlot) export(myPlotDiff) export(oc2) export(oc3) +export(ocPostprob) export(ocPostprobDist) export(ocPredprob) export(ocPredprobDist) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index 5acf9efd..8c064d2d 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -1,6 +1,97 @@ #' @include postprob.R NULL + + + +# helper functions for OcPostProb +# get_distance +get_distance <- function(nn) { + assert_numeric(nn, unique = TRUE, sorted = TRUE) + dist0 <- floor(min(nn - c(0, nn[-length(nn)])) / 2) + assert_numeric(dist0, sorted = TRUE) + dist <- sample(-dist0:dist0, + size = length(nn) - 1, + replace = TRUE, + prob = 2^(c(-dist0:0, rev(-dist0:(-1))) / 2) + ) + dist +} + +# get_looks helper function +get_looks <- function(dist, nnE, nnF) { + assert_numeric(nnE) + assert_numeric(nnF) + nn <- unique(c(nnE, nnF)) + assert_numeric(nn) + assert_numeric(dist) + nnr <- nn + c(dist, 0) + list( + nnrE = nnr[nn %in% nnE], + nnrF = nnr[nn %in% nnF] + ) +} + +# get_decision helper function +get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, tL, tU) { + index_look <- 1 + assert_numeric(nnr) + size_look <- nnr[index_look] + all_sizes <- decision <- NA + response <- stats::rbinom(max(nnr), 1, truep) + assert_numeric(response, lower = 0, upper = 1) + while (is.na(decision) && index_look <= length(nnr)) { + if (size_look %in% nnF) { + qL <- 1 - postprob(x = sum(response[1:size_look]), n = size_look, p = p0, parE = parE) # for each + assert_number(qL, lower = 0, upper = 1) + decision <- ifelse(qL >= tL, FALSE, NA) + } + if (size_look %in% nnE) { + qU <- postprob(x = sum(response[1:size_look]), n = size_look, p = p1, parE = parE) + assert_number(qU, lower = 0, upper = 1) + decision <- ifelse(qU < tU, decision, TRUE) + } + all_sizes <- size_look + index_look <- index_look + 1 + size_look <- nnr[index_look] + # } + } + list( + decision = decision, + all_sizes = all_sizes + ) +} + +# get_oc helper function +#' Title +#' +#' @typed all_sizes +#' @inheritParams get_looks +#' @param decision +#' @param nnrE +#' @param nnrF +#' +#' @return +#' @export +#' +#' @examples +get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { + sim <- length(all_sizes) + assert_logical(decision, len = sim) + assert_numeric(all_sizes) + assert_numeric(nnrE, lower = 0, upper = max(nnrE)) + assert_numeric(nnrF, lower = 0, upper = max(nnrF)) + data.frame( + ExpectedN = mean(all_sizes, na.rm = TRUE), + PrStopEarly = mean(all_sizes < max(nnrF), na.rm = TRUE), + PrEarlyEff = sum(decision * (all_sizes < max(nnrE)), na.rm = TRUE) / sim, + PrEarlyFut = sum((1 - decision) * (all_sizes < max(nnrF)), na.rm = TRUE) / sim, + PrEfficacy = sum(decision, na.rm = TRUE) / sim, + PrFutility = sum(1 - decision, na.rm = TRUE) / sim, + PrGrayZone = sum(is.na(decision)) / sim + ) +} + #' Operating Characteristics for Posterior Probability method #' #' @description `r lifecycle::badge("experimental")` @@ -91,85 +182,6 @@ NULL #' #' @example examples/ocPostprob.R #' @export -#' - -#-- helper functions for OcPostProb -#-- get_distance -get_distance <- function(nn) { - assert_numeric(nn, unique = TRUE, sorted = TRUE) - dist0 <- floor(min(nn - c(0, nn[-length(nn)])) / 2) - assert_numeric(dist0, sorted = TRUE) - dist <- sample(-dist0:dist0, - size = length(nn) - 1, - replace = TRUE, - prob = 2^(c(-dist0:0, rev(-dist0:(-1))) / 2) - ) - dist -} - -#-- get_looks helper function -get_looks <- function(dist, nnE, nnF) { - assert_numeric(nnE) - assert_numeric(nnF) - nn <- unique(c(nnE, nnF)) - assert_numeric(nn) - assert_numeric(dist) - nnr <- nn + c(dist, 0) - list( - nnrE = nnr[nn %in% nnE], - nnrF = nnr[nn %in% nnF] - ) -} - -#-- get_decision helper function -get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, tL, tU) { - index_look <- 1 - assert_numeric(nnr) - size_look <- nnr[index_look] - all_sizes <- decision <- NA - response <- stats::rbinom(max(nnr), 1, truep) - assert_numeric(response, lower = 0, upper = 1) - while (is.na(decision) && index_look <= length(nnr)) { - if (size_look %in% nnF) { - qL <- 1 - postprob(x = sum(response[1:size_look]), n = size_look, p = p0, parE = parE) # for each - assert_number(qL, lower = 0, upper = 1) - decision <- ifelse(qL >= tL, FALSE, NA) - } - if (size_look %in% nnE) { - qU <- postprob(x = sum(response[1:size_look]), n = size_look, p = p1, parE = parE) - assert_number(qU, lower = 0, upper = 1) - decision <- ifelse(qU < tU, decision, TRUE) - } - all_sizes <- size_look - index_look <- index_look + 1 - size_look <- nnr[index_look] - # } - } - list( - decision = decision, - all_sizes = all_sizes - ) -} - -#-- get_oc helper function -get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { - sim <- length(all_sizes) - assert_logical(decision, len = sim) - assert_numeric(all_sizes) - assert_numeric(nnrE, lower = 0, upper = max(nnrE)) - assert_numeric(nnrF, lower = 0, upper = max(nnrF)) - data.frame( - ExpectedN = mean(all_sizes, na.rm = TRUE), - PrStopEarly = mean(all_sizes < max(nnrF), na.rm = TRUE), - PrEarlyEff = sum(decision * (all_sizes < max(nnrE)), na.rm = TRUE) / sim, - PrEarlyFut = sum((1 - decision) * (all_sizes < max(nnrF)), na.rm = TRUE) / sim, - PrEfficacy = sum(decision, na.rm = TRUE) / sim, - PrFutility = sum(1 - decision, na.rm = TRUE) / sim, - PrGrayZone = sum(is.na(decision)) / sim - ) -} - -#-- ocPostprob ocPostprob <- function(nnE, truep, p0, p1, tL, tU, parE = c(1, 1), sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = nnE) { nn <- sort(unique(c(nnF, nnE))) diff --git a/man/get_oc.Rd b/man/get_oc.Rd new file mode 100644 index 00000000..1bcfe846 --- /dev/null +++ b/man/get_oc.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ocPostprob.R +\name{get_oc} +\alias{get_oc} +\title{Title} +\usage{ +get_oc(all_sizes, nnr, decision, nnrE, nnrF) +} +\arguments{ +\item{nnrF}{} + +\item{}{(\if{html}{\out{}}):\cr \if{html}{\out{}}} +} +\description{ +Title +} diff --git a/man/get_distance.Rd b/man/ocPostprob.Rd similarity index 97% rename from man/get_distance.Rd rename to man/ocPostprob.Rd index 127b3800..461921de 100644 --- a/man/get_distance.Rd +++ b/man/ocPostprob.Rd @@ -1,10 +1,22 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ocPostprob.R -\name{get_distance} -\alias{get_distance} +\name{ocPostprob} +\alias{ocPostprob} \title{Operating Characteristics for Posterior Probability method} \usage{ -get_distance(nn) +ocPostprob( + nnE, + truep, + p0, + p1, + tL, + tU, + parE = c(1, 1), + sim = 1000, + wiggle = FALSE, + randomdist = NULL, + nnF = nnE +) } \arguments{ \item{nnE}{(\code{numeric}):\cr sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, @@ -27,14 +39,14 @@ specify in \code{nnF}.} \item{wiggle}{(\code{logical}):\cr generate random look locations (not default) if \code{TRUE}, specify \code{dist} (see @details)} -\item{dist}{(\code{numeric} or \code{NULL}#TODO ( was dl)... check Roxytypes):\cr distance for random looks around the look locations in \code{nn}. -If \code{NULL}, only one location look will be set at nnE or nnF or n} - \item{nnF}{(\code{numeric}):\cr sample size or sizes where study can be stopped for futility decision. If different for futility decision, specify in \code{nnF}. \subsection{From helper functions}{ }} +\item{dist}{(\code{numeric} or \code{NULL}#TODO ( was dl)... check Roxytypes):\cr distance for random looks around the look locations in \code{nn}. +If \code{NULL}, only one location look will be set at nnE or nnF or n} + \item{nnrE}{(\code{numeric}):\cr same as \code{nnE} but if wiggle room and distance applied.} \item{nnrF}{(\code{numeric}):\cr same as \code{nnF} but if wiggle room and distance applied.} diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index deb11cf8..0e27fc7a 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -95,7 +95,7 @@ test_that("get_decision has list outputs of length of sim each", { expect_numeric(tmp$all_sizes, max.len = sim) }) -#-- get_oc (helper function) +# get_oc ---- test_that("the probability results of get_oc are less than 1", { oc <- get_oc( all_sizes = sample(c(11, 14, 20), 10000, replace = TRUE), @@ -118,7 +118,7 @@ test_that("the ExpectedN is within range based on vector of looks", { expect_numper(oc$ExpectedN, lower = min(all_sizes), upper = max(all_sizes)) # can have more than 1 expect_true ? }) -# -- ocPostprob +# ocPostprob ---- test_that("the sum of Eff, Fut, Gray zone probabiliy is 1", { results <- sum(ocPostprob$oc[4:7]) expect_equal(result, 1) From 2dd0a4467e7df5448a6e9893d1bd273a57edb11c Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 26 Sep 2023 17:10:13 +0200 Subject: [PATCH 054/106] clean --- NAMESPACE | 3 ++ R/ocPostprob.R | 125 ++++++++++++++++++++++++++++---------------- inst/WORDLIST | 1 + man/get_decision.Rd | 43 +++++++++++++++ man/get_distance.Rd | 24 +++++++++ man/get_looks.Rd | 25 +++++++++ man/get_oc.Rd | 25 ++++++--- man/ocPostprob.Rd | 30 +---------- 8 files changed, 198 insertions(+), 78 deletions(-) create mode 100644 man/get_decision.Rd create mode 100644 man/get_distance.Rd create mode 100644 man/get_looks.Rd diff --git a/NAMESPACE b/NAMESPACE index 418ee021..584f0b31 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,6 +7,9 @@ export(dbetabinom) export(dbetabinomMix) export(dbetadiff) export(getBetamixPost) +export(get_decision) +export(get_distance) +export(get_looks) export(get_oc) export(logit) export(myPlot) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index 8c064d2d..e385965f 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -1,11 +1,20 @@ #' @include postprob.R NULL - - - -# helper functions for OcPostProb -# get_distance +#' get_distance +#' +#' @description `r lifecycle::badge("experimental")` +#' +#' A helper function for `ocPostprob` to generate random distance's wiggle room around looks `nn`. +#' Numeric looks `nn` must be of minimum two elements and will generate `length(nn)-1` distances. +#' +#' @param nn : number or numeric +#' the union of `nnE` and `nnF` (if futility analysis or looks exists) supplied +#' +#' @return A numeric with `length(nn)-1` elements. +#' +#' @examples examples / ocPostprob.R +#' @export get_distance <- function(nn) { assert_numeric(nn, unique = TRUE, sorted = TRUE) dist0 <- floor(min(nn - c(0, nn[-length(nn)])) / 2) @@ -18,7 +27,22 @@ get_distance <- function(nn) { dist } -# get_looks helper function +#' get_looks +#' +#' A helper function for `ocPostprob` that applies the numeric element of distance to looks `nn`. +#' +#' @typed dist : numeric +#' Distance generated from `get_distance` in a numeric of at least one element. +#' @typed nnE : numeric +#' sample size or sizes where study can be stopped for efficacy decision. If different for Futility decision, +#' specify in `nnF`. +#' @typed nnF : numeric +#' sample size or sizes where study can be stopped for futility decision if different from Efficacy decision. +#' +#' @return A numeric of looks with outputs from `get_distance` randomly added to looks. +#' @export +#' +#' @examples examples / ocPostProb get_looks <- function(dist, nnE, nnF) { assert_numeric(nnE) assert_numeric(nnF) @@ -32,7 +56,38 @@ get_looks <- function(dist, nnE, nnF) { ) } -# get_decision helper function +#' get_decision +#' +#' @description `r lifecycle::badge("experimental")` +#' +#' A helper function for `ocPostprob` to generate numeric of decisions `decisions` and random looks `all_sizes`. +#' +#' @inheritParams get_looks +#' @typed response : numeric +#' A numeric of bernoulli successes based on `size_look`, +#' @typed : truep +#' A numeric of the true response rate +#' @typed truep : number +#' assumed true response rate nor true rate (scenario). +#' @typed p0 : number +#' lower efficacy threshold of response rate. +#' @typed p1 : number +#' upper efficacy threshold of response rate. +#' @typed tL : number +#' posterior probability threshold for being below `p0`. +#' @typed tU : number +#' posterior probability threshold for being above `p1`. +#' @typed parE : numeric +#' beta parameters for the prior on the treatment proportion. +#' +#' @return A list of the following objects : +#' - `decision` : resulting numeric of decision, one of `TRUE` for GO, `FALSE`for STOP, `NA` for Gray zone +#' - `all_sizes` : resulting numeric of look size, anything below maximum +#' look size is an indicated interim, futility or efficacy or both +#' +#' @export +#' +#' @examples get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, tL, tU) { index_look <- 1 assert_numeric(nnr) @@ -62,19 +117,28 @@ get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, ) } -# get_oc helper function -#' Title +#' get_oc helper function +#' +#' @description `r lifecycle::badge("experimental")` +#' +#' Generates operating characteristics. #' -#' @typed all_sizes #' @inheritParams get_looks -#' @param decision -#' @param nnrE -#' @param nnrF +#' @inheritParams get_decision #' -#' @return +#' @return A list of results containing : +#' +#' - `ExpectedN`: expected number of patients in the trials +#' - `PrStopEarly`: probability to stop the trial early (before reaching the +#' maximum sample size) +#' - `PrEarlyEff`: probability of Early Go decision +#' - `PrEarlyFut`: probability to decide for Futility early +#' - `PrEfficacy`: probability of Go decision +#' - `PrFutility`: Probability of Stop decision +#' - `PrGrayZone`: probability between Go and Stop ,"Evaluate" or Gray decision zone #' @export #' -#' @examples +#' @examples examples / ocPostprob.R get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { sim <- length(all_sizes) assert_logical(decision, len = sim) @@ -122,35 +186,15 @@ get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' @typed nnE : numeric #' sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, #' specify in `nnF`. -#' @typed truep : number -#' assumed true response rate nor true rate (scenario). -#' @typed p0 : number -#' lower efficacy threshold of response rate. -#' @typed p1 : number -#' upper efficacy threshold of response rate. -#' @typed tL : number -#' posterior probability threshold for being below `p0`. -#' @typed tU : number -#' posterior probability threshold for being above `p1`. -#' @typed parE : numeric -#' beta parameters for the prior on the treatment proportion. #' @typed sim : number -#' number of simulations. +#' number of simulations #' @typed wiggle : logical #' generate random look locations (not default) #' if `TRUE`, specify `dist` (see @details) #' @typed dist : "`numeric` or `NULL`" #TODO ( was dl)... check Roxytypes #' distance for random looks around the look locations in `nn`. #' If `NULL`, only one location look will be set at nnE or nnF or n -#' @typed nnF : numeric -#' sample size or sizes where study can be stopped for futility decision. If different for futility decision, -#' specify in `nnF`. -#' ## From helper functions -#' @typed nnrE : numeric -#' same as `nnE` but if wiggle room and distance applied. -#' @typed nnrF : numeric -#' same as `nnF` but if wiggle room and distance applied. -# +#' @inheritParams get_looks #' #' @return A list with the following elements: #' @@ -163,7 +207,6 @@ get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' - `nnE`: vector of efficacy look locations #' - `nnF`: vector of futility look locations #' - `params`: multiple parameters -#' - `Decision` : resulting decision, one of `TRUE` for GO, `FALSE`for STOP, `NA` for Gray zone #' #' @details #' ## About arguments @@ -174,12 +217,6 @@ get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' As default, `nnF` is set to the identical looks of `nnE`, and if `wiggle = TRUE`, all looks are the same, e.g. #' `nnE = nnF` when wiggle and distance is applied. #' -#' ## About helper function -#' -#' `get_distance` inputs `dist` into `get_looks` and thereafter contributes to arguments in `get_decision`. -#' Finally, `get_oc` generates a list of parameters such as `decisions`, `all_sizes` and operating characteristics (oc). -#' -#' #' @example examples/ocPostprob.R #' @export ocPostprob <- function(nnE, truep, p0, p1, tL, tU, parE = c(1, 1), diff --git a/inst/WORDLIST b/inst/WORDLIST index d0d86b44..1d076c8b 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1382,6 +1382,7 @@ bD bdbdbd bE beps +bernoulli betadiff bF bfHwv diff --git a/man/get_decision.Rd b/man/get_decision.Rd new file mode 100644 index 00000000..554d2184 --- /dev/null +++ b/man/get_decision.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ocPostprob.R +\name{get_decision} +\alias{get_decision} +\title{get_decision} +\usage{ +get_decision(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, tL, tU) +} +\arguments{ +\item{response}{(\code{numeric}):\cr A numeric of bernoulli successes based on \code{size_look},} + +\item{truep}{(\code{number}):\cr assumed true response rate nor true rate (scenario).} + +\item{p0}{(\code{number}):\cr lower efficacy threshold of response rate.} + +\item{p1}{(\code{number}):\cr upper efficacy threshold of response rate.} + +\item{parE}{(\code{numeric}):\cr beta parameters for the prior on the treatment proportion.} + +\item{nnE}{(\code{numeric}):\cr sample size or sizes where study can be stopped for efficacy decision. If different for Futility decision, +specify in \code{nnF}.} + +\item{nnF}{(\code{numeric}):\cr sample size or sizes where study can be stopped for futility decision if different from Efficacy decision.} + +\item{tL}{(\code{number}):\cr posterior probability threshold for being below \code{p0}.} + +\item{tU}{(\code{number}):\cr posterior probability threshold for being above \code{p1}.} + +\item{}{(\if{html}{\out{}}):\cr \if{html}{\out{}}} +} +\value{ +A list of the following objects : +\itemize{ +\item \code{decision} : resulting numeric of decision, one of \code{TRUE} for GO, \code{FALSE}for STOP, \code{NA} for Gray zone +\item \code{all_sizes} : resulting numeric of look size, anything below maximum +look size is an indicated interim, futility or efficacy or both +} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +A helper function for \code{ocPostprob} to generate numeric of decisions \code{decisions} and random looks \code{all_sizes}. +} diff --git a/man/get_distance.Rd b/man/get_distance.Rd new file mode 100644 index 00000000..fb3875b1 --- /dev/null +++ b/man/get_distance.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ocPostprob.R +\name{get_distance} +\alias{get_distance} +\title{get_distance} +\usage{ +get_distance(nn) +} +\arguments{ +\item{nn}{: number or numeric +the union of \code{nnE} and \code{nnF} (if futility analysis or looks exists) supplied} +} +\value{ +A numeric with \code{length(nn)-1} elements. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +A helper function for \code{ocPostprob} to generate random distance's wiggle room around looks \code{nn}. +Numeric looks \code{nn} must be of minimum two elements and will generate \code{length(nn)-1} distances. +} +\examples{ +examples / ocPostprob.R +} diff --git a/man/get_looks.Rd b/man/get_looks.Rd new file mode 100644 index 00000000..6f9f246f --- /dev/null +++ b/man/get_looks.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ocPostprob.R +\name{get_looks} +\alias{get_looks} +\title{get_looks} +\usage{ +get_looks(dist, nnE, nnF) +} +\arguments{ +\item{dist}{(\code{numeric}):\cr Distance generated from \code{get_distance} in a numeric of at least one element.} + +\item{nnE}{(\code{numeric}):\cr sample size or sizes where study can be stopped for efficacy decision. If different for Futility decision, +specify in \code{nnF}.} + +\item{nnF}{(\code{numeric}):\cr sample size or sizes where study can be stopped for futility decision if different from Efficacy decision.} +} +\value{ +A numeric of looks with outputs from \code{get_distance} randomly added to looks. +} +\description{ +A helper function for \code{ocPostprob} that applies the numeric element of distance to looks \code{nn}. +} +\examples{ +examples / ocPostProb +} diff --git a/man/get_oc.Rd b/man/get_oc.Rd index 1bcfe846..51ea7196 100644 --- a/man/get_oc.Rd +++ b/man/get_oc.Rd @@ -2,15 +2,28 @@ % Please edit documentation in R/ocPostprob.R \name{get_oc} \alias{get_oc} -\title{Title} +\title{get_oc helper function} \usage{ get_oc(all_sizes, nnr, decision, nnrE, nnrF) } -\arguments{ -\item{nnrF}{} - -\item{}{(\if{html}{\out{}}):\cr \if{html}{\out{}}} +\value{ +A list of results containing : +\itemize{ +\item \code{ExpectedN}: expected number of patients in the trials +\item \code{PrStopEarly}: probability to stop the trial early (before reaching the +maximum sample size) +\item \code{PrEarlyEff}: probability of Early Go decision +\item \code{PrEarlyFut}: probability to decide for Futility early +\item \code{PrEfficacy}: probability of Go decision +\item \code{PrFutility}: Probability of Stop decision +\item \code{PrGrayZone}: probability between Go and Stop ,"Evaluate" or Gray decision zone +} } \description{ -Title +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +Generates operating characteristics. +} +\examples{ +examples / ocPostprob.R } diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index 461921de..b7835d07 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -22,34 +22,15 @@ ocPostprob( \item{nnE}{(\code{numeric}):\cr sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, specify in \code{nnF}.} -\item{truep}{(\code{number}):\cr assumed true response rate nor true rate (scenario).} - -\item{p0}{(\code{number}):\cr lower efficacy threshold of response rate.} - -\item{p1}{(\code{number}):\cr upper efficacy threshold of response rate.} - -\item{tL}{(\code{number}):\cr posterior probability threshold for being below \code{p0}.} - -\item{tU}{(\code{number}):\cr posterior probability threshold for being above \code{p1}.} - -\item{parE}{(\code{numeric}):\cr beta parameters for the prior on the treatment proportion.} - -\item{sim}{(\code{number}):\cr number of simulations.} +\item{sim}{(\code{number}):\cr number of simulations} \item{wiggle}{(\code{logical}):\cr generate random look locations (not default) if \code{TRUE}, specify \code{dist} (see @details)} -\item{nnF}{(\code{numeric}):\cr sample size or sizes where study can be stopped for futility decision. If different for futility decision, -specify in \code{nnF}. -\subsection{From helper functions}{ -}} +\item{nnF}{(\code{numeric}):\cr sample size or sizes where study can be stopped for futility decision if different from Efficacy decision.} \item{dist}{(\code{numeric} or \code{NULL}#TODO ( was dl)... check Roxytypes):\cr distance for random looks around the look locations in \code{nn}. If \code{NULL}, only one location look will be set at nnE or nnF or n} - -\item{nnrE}{(\code{numeric}):\cr same as \code{nnE} but if wiggle room and distance applied.} - -\item{nnrF}{(\code{numeric}):\cr same as \code{nnF} but if wiggle room and distance applied.} } \value{ A list with the following elements: @@ -63,7 +44,6 @@ SampleSize: vector of the sample sizes in the simulated trials \item \code{nnE}: vector of efficacy look locations \item \code{nnF}: vector of futility look locations \item \code{params}: multiple parameters -\item \code{Decision} : resulting decision, one of \code{TRUE} for GO, \code{FALSE}for STOP, \code{NA} for Gray zone } } \description{ @@ -101,12 +81,6 @@ If \code{nnF = NULL}, no Futility or decision to Stop will be analysed. Note tha As default, \code{nnF} is set to the identical looks of \code{nnE}, and if \code{wiggle = TRUE}, all looks are the same, e.g. \code{nnE = nnF} when wiggle and distance is applied. } - -\subsection{About helper function}{ - -\code{get_distance} inputs \code{dist} into \code{get_looks} and thereafter contributes to arguments in \code{get_decision}. -Finally, \code{get_oc} generates a list of parameters such as \code{decisions}, \code{all_sizes} and operating characteristics (oc). -} } \examples{ # operating characteristics for posterior probability method From 0af15cd4e2d80992792ac738a8ab56f749d27df0 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 27 Sep 2023 12:27:34 +0200 Subject: [PATCH 055/106] clean --- R/ocPostprob.R | 75 +++++++++++++++++++++++++------------------ examples/ocPostprob.R | 2 +- man/get_decision.Rd | 17 +++++----- man/get_distance.Rd | 2 +- man/get_looks.Rd | 18 +++++++---- man/get_oc.Rd | 13 +++++++- man/ocPostprob.Rd | 39 ++++++++++++++-------- 7 files changed, 105 insertions(+), 61 deletions(-) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index e385965f..d837478b 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -1,7 +1,7 @@ #' @include postprob.R NULL -#' get_distance +#' Generating random distance in looks for efficacy and futility. #' #' @description `r lifecycle::badge("experimental")` #' @@ -27,22 +27,29 @@ get_distance <- function(nn) { dist } -#' get_looks +#' Generating looks #' -#' A helper function for `ocPostprob` that applies the numeric element of distance to looks `nn`. +#' @description `r lifecycle::badge("experimental")` +#' +#' A helper function for `ocPostprob` that applies the numeric element of `dist` to looks `nn`. #' -#' @typed dist : numeric -#' Distance generated from `get_distance` in a numeric of at least one element. +#' @typed dist : numeric or logical +#' Distance for random looks around the look locations in `nn`, +#' where `dist`is generated from `get_distance` in a numeric of at least one element. +#' If `NULL`, only one location look will be set at `nnE` or `nnF`. #' @typed nnE : numeric -#' sample size or sizes where study can be stopped for efficacy decision. If different for Futility decision, -#' specify in `nnF`. +#' Sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, +#' specify in `nnF`. #' @typed nnF : numeric -#' sample size or sizes where study can be stopped for futility decision if different from Efficacy decision. +#' Sample size or sizes where study can be stopped for futility decision if different from efficacy decision. #' #' @return A numeric of looks with outputs from `get_distance` randomly added to looks. +#' `nnrE`is the result for efficacy looks with random distance added. +#' `nnrF`is the result for futility looks with random distance added. +#' #' @export #' -#' @examples examples / ocPostProb +#' @examples examples / ocPostProb.R get_looks <- function(dist, nnE, nnF) { assert_numeric(nnE) assert_numeric(nnF) @@ -56,19 +63,19 @@ get_looks <- function(dist, nnE, nnF) { ) } -#' get_decision +#' Generating random decision and sample size looks. #' #' @description `r lifecycle::badge("experimental")` #' #' A helper function for `ocPostprob` to generate numeric of decisions `decisions` and random looks `all_sizes`. #' #' @inheritParams get_looks +#' @typed nnr : numeric +#' union of `nnE`and `nnF`. #' @typed response : numeric -#' A numeric of bernoulli successes based on `size_look`, -#' @typed : truep -#' A numeric of the true response rate +#' A numeric of Bernoulli successes based on `size_look` #' @typed truep : number -#' assumed true response rate nor true rate (scenario). +#' assumed true response rate or true rate (scenario). #' @typed p0 : number #' lower efficacy threshold of response rate. #' @typed p1 : number @@ -78,7 +85,8 @@ get_looks <- function(dist, nnE, nnF) { #' @typed tU : number #' posterior probability threshold for being above `p1`. #' @typed parE : numeric -#' beta parameters for the prior on the treatment proportion. +#' Alpha and beta parameters for the prior on the treatment proportion. +#' Default set at alpha = 1, beta = 1, or uniform prior. #' #' @return A list of the following objects : #' - `decision` : resulting numeric of decision, one of `TRUE` for GO, `FALSE`for STOP, `NA` for Gray zone @@ -117,7 +125,7 @@ get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, ) } -#' get_oc helper function +#' Creating list for operating characteristics. #' #' @description `r lifecycle::badge("experimental")` #' @@ -125,6 +133,14 @@ get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, #' #' @inheritParams get_looks #' @inheritParams get_decision +#' @typed nnrE : numeric +#' Looks with random distance, if applied on `nnE`. +#' @typed nnrF : numeric +#' Looks with random distance, if applied on `nnF`. +#' @typed all_sizes : numeric +#' Sample sizes of all looks simulated `length(sim)` times if `dist` applied. +#' @typed decision : numeric +#' Go, Stop or Gray Zone decisions of all looks simulated `length(sim)` times. #' #' @return A list of results containing : #' @@ -167,10 +183,13 @@ get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' above `p1` is larger than `tU`, and stopped for futility if the posterior #' probability to be below `p0` is larger than `tL`: #' -#' Stop criteria for Efficacy : `P_E(p > p1) > tU` +#' Stop criteria for Efficacy : +#' +#' `P_E(p > p1) > tU` #' -#' Stop criteria for Futility : `P_E(p < p0) > tL` +#' Stop criteria for Futility : #' +#' `P_E(p < p0) > tL` #' #' Resulting Operating Characteristics include the following: #' @@ -183,30 +202,24 @@ get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' - `PrFutility`: Probability of Stop decision #' - `PrGrayZone`: probability between Go and Stop ,"Evaluate" or Gray decision zone #' -#' @typed nnE : numeric -#' sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, -#' specify in `nnF`. +#' @inheritParams get_looks +#' @inheritParams get_decision #' @typed sim : number #' number of simulations #' @typed wiggle : logical #' generate random look locations (not default) #' if `TRUE`, specify `dist` (see @details) -#' @typed dist : "`numeric` or `NULL`" #TODO ( was dl)... check Roxytypes -#' distance for random looks around the look locations in `nn`. -#' If `NULL`, only one location look will be set at nnE or nnF or n -#' @inheritParams get_looks +#' @typed randomdist : logical +#' Random distance added to looks. if `NULL`, and `wiggle = TRUE`, function will +#' generate and add a random distance within range of the closest looks. #' #' @return A list with the following elements: #' #' - `oc`: matrix with operating characteristics (see Details section) -#' Decision: vector of the decisions made in the simulated trials -#' (`TRUE` for success, `FALSE` for failure, `NA` for no -#' decision) -#' SampleSize: vector of the sample sizes in the simulated trials #' - `nn`: vector of look locations that was supplied #' - `nnE`: vector of efficacy look locations -#' - `nnF`: vector of futility look locations -#' - `params`: multiple parameters +#' - `nnF`: vector of futility look locations # TODO +#' - `params`: multiple parameters# TODOs #' #' @details #' ## About arguments diff --git a/examples/ocPostprob.R b/examples/ocPostprob.R index 607e1f58..370a1213 100644 --- a/examples/ocPostprob.R +++ b/examples/ocPostprob.R @@ -1,4 +1,4 @@ -# operating characteristics for posterior probability method +# Operating characteristics for posterior probability method # design details (example) # multiple looks @ 10, 20, 30 patients diff --git a/man/get_decision.Rd b/man/get_decision.Rd index 554d2184..7afbcfaa 100644 --- a/man/get_decision.Rd +++ b/man/get_decision.Rd @@ -2,31 +2,32 @@ % Please edit documentation in R/ocPostprob.R \name{get_decision} \alias{get_decision} -\title{get_decision} +\title{Generating random decision and sample size looks.} \usage{ get_decision(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, tL, tU) } \arguments{ -\item{response}{(\code{numeric}):\cr A numeric of bernoulli successes based on \code{size_look},} +\item{nnr}{(\code{numeric}):\cr union of \code{nnE}and \code{nnF}.} -\item{truep}{(\code{number}):\cr assumed true response rate nor true rate (scenario).} +\item{response}{(\code{numeric}):\cr A numeric of Bernoulli successes based on \code{size_look}} + +\item{truep}{(\code{number}):\cr assumed true response rate or true rate (scenario).} \item{p0}{(\code{number}):\cr lower efficacy threshold of response rate.} \item{p1}{(\code{number}):\cr upper efficacy threshold of response rate.} -\item{parE}{(\code{numeric}):\cr beta parameters for the prior on the treatment proportion.} +\item{parE}{(\code{numeric}):\cr Alpha and beta parameters for the prior on the treatment proportion. +Default set at alpha = 1, beta = 1, or uniform prior.} -\item{nnE}{(\code{numeric}):\cr sample size or sizes where study can be stopped for efficacy decision. If different for Futility decision, +\item{nnE}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, specify in \code{nnF}.} -\item{nnF}{(\code{numeric}):\cr sample size or sizes where study can be stopped for futility decision if different from Efficacy decision.} +\item{nnF}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for futility decision if different from efficacy decision.} \item{tL}{(\code{number}):\cr posterior probability threshold for being below \code{p0}.} \item{tU}{(\code{number}):\cr posterior probability threshold for being above \code{p1}.} - -\item{}{(\if{html}{\out{}}):\cr \if{html}{\out{}}} } \value{ A list of the following objects : diff --git a/man/get_distance.Rd b/man/get_distance.Rd index fb3875b1..3fb8244b 100644 --- a/man/get_distance.Rd +++ b/man/get_distance.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/ocPostprob.R \name{get_distance} \alias{get_distance} -\title{get_distance} +\title{Generating random distance in looks for efficacy and futility.} \usage{ get_distance(nn) } diff --git a/man/get_looks.Rd b/man/get_looks.Rd index 6f9f246f..e4f4a756 100644 --- a/man/get_looks.Rd +++ b/man/get_looks.Rd @@ -2,24 +2,30 @@ % Please edit documentation in R/ocPostprob.R \name{get_looks} \alias{get_looks} -\title{get_looks} +\title{Generating looks} \usage{ get_looks(dist, nnE, nnF) } \arguments{ -\item{dist}{(\code{numeric}):\cr Distance generated from \code{get_distance} in a numeric of at least one element.} +\item{dist}{(\verb{numeric or logical}):\cr Distance for random looks around the look locations in \code{nn}, +where \code{dist}is generated from \code{get_distance} in a numeric of at least one element. +If \code{NULL}, only one location look will be set at \code{nnE} or \code{nnF}.} -\item{nnE}{(\code{numeric}):\cr sample size or sizes where study can be stopped for efficacy decision. If different for Futility decision, +\item{nnE}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, specify in \code{nnF}.} -\item{nnF}{(\code{numeric}):\cr sample size or sizes where study can be stopped for futility decision if different from Efficacy decision.} +\item{nnF}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for futility decision if different from efficacy decision.} } \value{ A numeric of looks with outputs from \code{get_distance} randomly added to looks. +\code{nnrE}is the result for efficacy looks with random distance added. +\code{nnrF}is the result for futility looks with random distance added. } \description{ -A helper function for \code{ocPostprob} that applies the numeric element of distance to looks \code{nn}. +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +A helper function for \code{ocPostprob} that applies the numeric element of \code{dist} to looks \code{nn}. } \examples{ -examples / ocPostProb +examples / ocPostProb.R } diff --git a/man/get_oc.Rd b/man/get_oc.Rd index 51ea7196..99a9ee25 100644 --- a/man/get_oc.Rd +++ b/man/get_oc.Rd @@ -2,10 +2,21 @@ % Please edit documentation in R/ocPostprob.R \name{get_oc} \alias{get_oc} -\title{get_oc helper function} +\title{Creating list for operating characteristics.} \usage{ get_oc(all_sizes, nnr, decision, nnrE, nnrF) } +\arguments{ +\item{all_sizes}{(\code{numeric}):\cr Sample sizes of all looks simulated \code{length(sim)} times if \code{dist} applied.} + +\item{nnr}{(\code{numeric}):\cr union of \code{nnE}and \code{nnF}.} + +\item{decision}{(\code{numeric}):\cr Go, Stop or Gray Zone decisions of all looks simulated \code{length(sim)} times.} + +\item{nnrE}{(\code{numeric}):\cr Looks with random distance, if applied on \code{nnE}.} + +\item{nnrF}{(\code{numeric}):\cr Looks with random distance, if applied on \code{nnF}.} +} \value{ A list of results containing : \itemize{ diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index b7835d07..8493dd55 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -19,31 +19,40 @@ ocPostprob( ) } \arguments{ -\item{nnE}{(\code{numeric}):\cr sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, +\item{nnE}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, specify in \code{nnF}.} +\item{truep}{(\code{number}):\cr assumed true response rate or true rate (scenario).} + +\item{p0}{(\code{number}):\cr lower efficacy threshold of response rate.} + +\item{p1}{(\code{number}):\cr upper efficacy threshold of response rate.} + +\item{tL}{(\code{number}):\cr posterior probability threshold for being below \code{p0}.} + +\item{tU}{(\code{number}):\cr posterior probability threshold for being above \code{p1}.} + +\item{parE}{(\code{numeric}):\cr Alpha and beta parameters for the prior on the treatment proportion. +Default set at alpha = 1, beta = 1, or uniform prior.} + \item{sim}{(\code{number}):\cr number of simulations} \item{wiggle}{(\code{logical}):\cr generate random look locations (not default) if \code{TRUE}, specify \code{dist} (see @details)} -\item{nnF}{(\code{numeric}):\cr sample size or sizes where study can be stopped for futility decision if different from Efficacy decision.} +\item{randomdist}{(\code{logical}):\cr Random distance added to looks. if \code{NULL}, and \code{wiggle = TRUE}, function will +generate and add a random distance within range of the closest looks.} -\item{dist}{(\code{numeric} or \code{NULL}#TODO ( was dl)... check Roxytypes):\cr distance for random looks around the look locations in \code{nn}. -If \code{NULL}, only one location look will be set at nnE or nnF or n} +\item{nnF}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for futility decision if different from efficacy decision.} } \value{ A list with the following elements: \itemize{ \item \code{oc}: matrix with operating characteristics (see Details section) -Decision: vector of the decisions made in the simulated trials -(\code{TRUE} for success, \code{FALSE} for failure, \code{NA} for no -decision) -SampleSize: vector of the sample sizes in the simulated trials \item \code{nn}: vector of look locations that was supplied \item \code{nnE}: vector of efficacy look locations -\item \code{nnF}: vector of futility look locations -\item \code{params}: multiple parameters +\item \code{nnF}: vector of futility look locations # TODO +\item \code{params}: multiple parameters# TODOs } } \description{ @@ -56,9 +65,13 @@ The trial is stopped for efficacy if the posterior probability to be above \code{p1} is larger than \code{tU}, and stopped for futility if the posterior probability to be below \code{p0} is larger than \code{tL}: -Stop criteria for Efficacy : \code{P_E(p > p1) > tU} +Stop criteria for Efficacy : + +\code{P_E(p > p1) > tU} + +Stop criteria for Futility : -Stop criteria for Futility : \code{P_E(p < p0) > tL} +\code{P_E(p < p0) > tL} Resulting Operating Characteristics include the following: \itemize{ @@ -83,7 +96,7 @@ As default, \code{nnF} is set to the identical looks of \code{nnE}, and if \code } } \examples{ -# operating characteristics for posterior probability method +# Operating characteristics for posterior probability method # design details (example) # multiple looks @ 10, 20, 30 patients From 63de68aa701a11229e38edc959fa6c08bfceae34 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 28 Sep 2023 14:18:28 +0200 Subject: [PATCH 056/106] some examples and tests --- R/ocPostprob.R | 2 +- examples/get_decision.R | 23 +++++ examples/get_distance.R | 5 + examples/get_looks.R | 16 +++ examples/get_oc.R | 19 ++++ examples/ocPostprob.R | 65 ++++++------ man/ocPostprob.Rd | 65 ++++++------ tests/testthat/test-ocPostprob.R | 170 ++++++++++++++++--------------- 8 files changed, 220 insertions(+), 145 deletions(-) create mode 100644 examples/get_decision.R create mode 100644 examples/get_distance.R create mode 100644 examples/get_looks.R create mode 100644 examples/get_oc.R diff --git a/R/ocPostprob.R b/R/ocPostprob.R index d837478b..e57cb6b0 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -101,7 +101,7 @@ get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, assert_numeric(nnr) size_look <- nnr[index_look] all_sizes <- decision <- NA - response <- stats::rbinom(max(nnr), 1, truep) + response <- stats::rbinom(max(nnr), size = 1, truep) assert_numeric(response, lower = 0, upper = 1) while (is.na(decision) && index_look <= length(nnr)) { if (size_look %in% nnF) { diff --git a/examples/get_decision.R b/examples/get_decision.R new file mode 100644 index 00000000..28e3269d --- /dev/null +++ b/examples/get_decision.R @@ -0,0 +1,23 @@ +# multiple looks @ 10, 20, 30 patients for Efficacy and Futility +# True response rate of the treatment group=40% +# Look for futility: P(response rate < 20% )> 60% +# Look for efficacy: P(response rate > 30% )> 80% +# Prior of treatment arm parE = Beta(1,1) + +# argument inputs for get_decision +nn <- c(10, 20, 30) +dist <- get_distance(c(10, 20, 30)) +looks <- get_looks(dist, c(10, 20, 30), c(10, 20, 30)) + +get_decision( + nnr = nn, + response = rbinom(n = max(nn), size = 1, prob = 0.40), + truep = 0.4, + p0 = 0.20, + p1 = 0.30, + parE = c(1, 1), + nnE = looks$nnrE, + nnF = looks$nnrF, + tL = 0.80, + tU = 0.60 +) diff --git a/examples/get_distance.R b/examples/get_distance.R new file mode 100644 index 00000000..bee9ee29 --- /dev/null +++ b/examples/get_distance.R @@ -0,0 +1,5 @@ +## get_distance + +get_distance(c(10, 20)) + +get_distance(c(10, 20, 30)) diff --git a/examples/get_looks.R b/examples/get_looks.R new file mode 100644 index 00000000..eac73b5c --- /dev/null +++ b/examples/get_looks.R @@ -0,0 +1,16 @@ +# argument input for get_looks +dist <- get_distance(c(10, 30)) + +get_looks(dist, c(10, 30), c(10, 30)) + +# get_distance when nnE is different nnF +nnE <- c(10, 20) +nnF <- c(15, 20) +nn <- sort(unique(c(nnE, nnF))) +dist <- get_distance(nn) +get_looks(dist, nnE, nnF) + +# argument input for get_looks, three element numeric +dist <- get_distance(c(10, 20, 30)) + +get_looks(dist, c(10, 20, 30), c(10, 20, 30)) diff --git a/examples/get_oc.R b/examples/get_oc.R new file mode 100644 index 00000000..ae4696bc --- /dev/null +++ b/examples/get_oc.R @@ -0,0 +1,19 @@ +# argument inputs for get_decision +nn <- c(10, 20, 30) +dist <- get_distance(c(10, 20, 30)) +looks <- get_looks(dist, c(10, 20, 30), c(10, 20, 30)) + +tmp <- get_decision( + nnr = nn, + response = rbinom(n = max(nn), size = 1, prob = 0.40), + truep = 0.4, + p0 = 0.20, + p1 = 0.30, + parE = c(1, 1), + nnE = looks$nnrE, + nnF = looks$nnrF, + tL = 0.80, + tU = 0.60 +) + +get_oc(all_sizes = tmp$all_sizes, nnr = c(10, 20, 30), decision = tmp$decision, nnrE = looks$nnrE, nnrF = looks$nnrF) diff --git a/examples/ocPostprob.R b/examples/ocPostprob.R index 370a1213..970361a6 100644 --- a/examples/ocPostprob.R +++ b/examples/ocPostprob.R @@ -1,40 +1,45 @@ -# Operating characteristics for posterior probability method - +# Three looks-- # design details (example) # multiple looks @ 10, 20, 30 patients # True response rate of the treatment group=40% -# stop for futility: P(response rate < 20% )> 60% -# s top for efficacy: P(response rate > 30% )> 80% +# Look for futility: P(response rate < 20% )> 60% +# Look for efficacy: P(response rate > 30% )> 80% # prior of treatment arm parE= Beta(1,1) -res1 <- ocPostprob( - nn = c(10, 20, 30), p = 0.4, p0 = 0.2, p1 = 0.3, tL = 0.6, tU = 0.8, - parE = c(1, 1), ns = 1000 +res <- ocPostprob( + nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), + sim = 1000, wiggle = TRUE, randomdist = NULL, nnF = c(10, 20, 30) ) -res1$oc -# this call will generate d (distance for random looks around the look locations) -# based on "floor(min(nn - c(0,nn[-length(nn)]))/2)" as d is missing: -res2 <- ocPostprob( - nn = c(10, 20, 30), p = 0.4, p0 = 0.2, p1 = 0.3, tL = 0.6, tU = 0.8, - parE = c(1, 1), ns = 1000, nr = TRUE +res$oc + +# Specify distance +res <- ocPostprob( + nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), + sim = 1000, wiggle = TRUE, randomdist = c(-1, 3), nnF = c(10, 20, 30) ) -res2$oc -# now d is specified: -res3 <- ocPostprob( - nn = c(10, 20, 30), p = 0.4, p0 = 0.2, p1 = 0.3, tL = 0.6, tU = 0.8, - parE = c(1, 1), ns = 1000, nr = TRUE, d = 5 +res$oc + +# No Wiggle +res <- ocPostprob( + nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), + sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) ) -res3$oc - -# finally, we can also have separate specification of efficacy and -# futility analyses. E.g. here have futility decisions only at the final analysis: -res4 <- ocPostprob( - nn = c(10, 20, 30), p = 0.4, p0 = 0.2, p1 = 0.3, tL = 0.6, tU = 0.8, - parE = c(1, 1), ns = 1000, nr = TRUE, d = 5, - nnF = c(30) + +res$oc + +# Only one efficacy + many futility +res <- ocPostprob( + nnE = c(10), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), + sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10) ) -res4$oc -# compared to res3, we see that there is no early futility stopping anymore, -# and the overall probability for stopping for futility (which is the type II error here) -# is much lower. + +res$oc + +# Only one futility +res <- ocPostprob( + nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), + sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10) +) + +res$oc diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index 8493dd55..d46e0301 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -96,44 +96,49 @@ As default, \code{nnF} is set to the identical looks of \code{nnE}, and if \code } } \examples{ -# Operating characteristics for posterior probability method - +# Three looks-- # design details (example) # multiple looks @ 10, 20, 30 patients # True response rate of the treatment group=40\% -# stop for futility: P(response rate < 20\% )> 60\% -# s top for efficacy: P(response rate > 30\% )> 80\% +# Look for futility: P(response rate < 20\% )> 60\% +# Look for efficacy: P(response rate > 30\% )> 80\% # prior of treatment arm parE= Beta(1,1) -res1 <- ocPostprob( - nn = c(10, 20, 30), p = 0.4, p0 = 0.2, p1 = 0.3, tL = 0.6, tU = 0.8, - parE = c(1, 1), ns = 1000 +res <- ocPostprob( + nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), + sim = 1000, wiggle = TRUE, randomdist = NULL, nnF = c(10, 20, 30) ) -res1$oc -# this call will generate d (distance for random looks around the look locations) -# based on "floor(min(nn - c(0,nn[-length(nn)]))/2)" as d is missing: -res2 <- ocPostprob( - nn = c(10, 20, 30), p = 0.4, p0 = 0.2, p1 = 0.3, tL = 0.6, tU = 0.8, - parE = c(1, 1), ns = 1000, nr = TRUE +res$oc + +# Specify distance +res <- ocPostprob( + nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), + sim = 1000, wiggle = TRUE, randomdist = c(-1, 3), nnF = c(10, 20, 30) ) -res2$oc -# now d is specified: -res3 <- ocPostprob( - nn = c(10, 20, 30), p = 0.4, p0 = 0.2, p1 = 0.3, tL = 0.6, tU = 0.8, - parE = c(1, 1), ns = 1000, nr = TRUE, d = 5 +res$oc + +# No Wiggle +res <- ocPostprob( + nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), + sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) ) -res3$oc - -# finally, we can also have separate specification of efficacy and -# futility analyses. E.g. here have futility decisions only at the final analysis: -res4 <- ocPostprob( - nn = c(10, 20, 30), p = 0.4, p0 = 0.2, p1 = 0.3, tL = 0.6, tU = 0.8, - parE = c(1, 1), ns = 1000, nr = TRUE, d = 5, - nnF = c(30) + +res$oc + +# Only one efficacy + many futility +res <- ocPostprob( + nnE = c(10), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), + sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10) ) -res4$oc -# compared to res3, we see that there is no early futility stopping anymore, -# and the overall probability for stopping for futility (which is the type II error here) -# is much lower. + +res$oc + +# Only one futility +res <- ocPostprob( + nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), + sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10) +) + +res$oc } diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index 0e27fc7a..2a9e7a37 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -1,98 +1,51 @@ -#-- get_distance (helper function) +# get_distance (helper function) ---- test_that("get_distance gives an error with one element numeric", { - expect_error(get_distance(10), "error!") + expect_true(get_distance(10), "integer(0)") # TO DO fix error }) test_that("get_distance gives results within range", { results <- get_distance(c(10, 20, 30)) - expect_number(results, lower = 10, upper = 30) + expect_number(results, lower = 10, upper = 30) # TO DO fix error }) -test_that("get_distance gives results within range", { - set.seed(1989) +test_that("get_distance written in reverse gives results within range", { + set.seed(1989) # we should not allow non sorted numerics to get in results <- get_distance(c(10, 20, 30)) - results_inv <- get_distance(c(10, 20, 30)) + results_inv <- get_distance(c(30, 20, 10)) expect_true(results && results_inv, lower = 10, upper = 30) }) -#-- get_looks (helper function) +# get_looks (helper function) ---- test_that("get_looks gives correct results if input is identical", { dist <- c(0, 5) - results <- get_looks(dist = dist, nnE = c(10, 20, 30), nnF = nnE) + results <- get_looks(dist = dist, nnE = c(10, 20, 30), nnF = c(10, 20, 30)) expect_equal(results$nnrE, results$nnrF) }) test_that("get_looks gives correct results if input is identical", { - dist <- c(0, 5) - results <- get_looks(dist = dist, nnE = c(10, 20, 30), nnF = nnE) + dist <- c(0, 5) # TODO Ask isaac why not nnE = nnF + results <- get_looks(dist = dist, nnE = c(10, 20, 30), nnF = c(10, 20, 30)) expect_equal(results$nnrE, results$nnrF) }) -#-- get_decision (helper function) -test_that("get_decision has list outputs of length of sim each", { - p <- 0.3 - p0 <- 0.2 - p1 <- 0.3 - tL <- 0.5 - tU <- 0.8 - wiggle <- TRUE - randomdist <- NULL - decision <- all_sizes <- NA - sim <- 10000 - for (k in 1:sim) { - if (length(nn) != 1 && wiggle && is.null(randomdist)) { - dist <- get_distance(nn) - nnr <- get_looks(dist, nnE, nnF) - nnrE <- nnr$nnrE - nnrF <- nnr$nnrF - } else { - nnrE <- nnE - nnrF <- nnF - } - nnr <- unique(c(nnrE, nnrF)) - tmp <- get_decision( - nnr = nnr, response = response, - truep = truep, p0 = p0, p1 = p1, - parE = c(1, 1), nnE = nnrE, - nnF = nnrF, tL = tL, tU = tU - ) - decision[k] <- tmp$decision - all_sizes[k] <- tmp$all_sizes - } - expect_numeric(tmp$decision, max.len = sim) -}) - -test_that("get_decision has list outputs of length of sim each", { - p <- 0.3 - p0 <- 0.2 - p1 <- 0.3 - tL <- 0.5 - tU <- 0.8 - wiggle <- TRUE - randomdist <- NULL - decision <- all_sizes <- NA - sim <- 10000 - for (k in 1:sim) { - if (length(nn) != 1 && wiggle && is.null(randomdist)) { - dist <- get_distance(nn) - nnr <- get_looks(dist, nnE, nnF) - nnrE <- nnr$nnrE - nnrF <- nnr$nnrF - } else { - nnrE <- nnE - nnrF <- nnF - } - nnr <- unique(c(nnrE, nnrF)) - tmp <- get_decision( - nnr = nnr, response = response, - truep = truep, p0 = p0, p1 = p1, - parE = c(1, 1), nnE = nnrE, - nnF = nnrF, tL = tL, tU = tU - ) - decision[k] <- tmp$decision - all_sizes[k] <- tmp$all_sizes - } - expect_numeric(tmp$all_sizes, max.len = sim) +# get_decision (helper function) -- +# Stop criteria for Efficacy : +# P_E(p > p1) > tU, where P_E(truep > 0.30) > 0.8 +# Stop criteria for Futility : +# P_E(p < p0) > tL, where P_E(truep > 0.20) > 0.5 +# It is a Go decision usually when the threshold to Go is Low +test_that("get_decision will give GO decision in favourable conditions", { + tmp <- get_decision( + nnr = c(10, 20, 30), + truep = 0.5, + p0 = 0.2, + p1 = 0.5, + tL = 0.2, + tU = 0.3, + nnE = c(10, 20, 30), + nnF = c(10, 20, 30) + ) + expect_equal(tmp$decision, TRUE) }) # get_oc ---- @@ -100,26 +53,75 @@ test_that("the probability results of get_oc are less than 1", { oc <- get_oc( all_sizes = sample(c(11, 14, 20), 10000, replace = TRUE), decision = sample(c(NA, TRUE, FALSE), 10000, replace = TRUE), - sim = 10000, - SizeEff = c(11, 14, 20), - SizeFut = c(11, 14, 20) + nnrE = c(11, 14, 20), + nnrF = c(11, 14, 20) ) - expect_true(oc$PrStopEarly > 1) # can have more than 1 expect_true ? + expect_true(oc$PrStopEarly && oc$PrFutility && oc$PrEarlyEff && oc$PrEfficacy < 1) }) test_that("the ExpectedN is within range based on vector of looks", { oc <- get_oc( all_sizes = sample(c(11, 14, 20), 10000, replace = TRUE), decision = sample(c(NA, TRUE, FALSE), 10000, replace = TRUE), - sim = 10000, - SizeEff = c(11, 14, 20), - SizeFut = c(11, 14, 20) + nnrE = c(11, 14, 20), + nnrF = c(11, 14, 20) ) - expect_numper(oc$ExpectedN, lower = min(all_sizes), upper = max(all_sizes)) # can have more than 1 expect_true ? + expect_number(oc$ExpectedN, lower = min(all_sizes), upper = max(all_sizes)) }) # ocPostprob ---- test_that("the sum of Eff, Fut, Gray zone probabiliy is 1", { - results <- sum(ocPostprob$oc[4:7]) + set.seed(1989) + res1 <- ocPostprob( + nnE = 40, truep = 0.5, p0 = 0.45, p1 = 0.45, tL = 0.9, tU = 0.7, + parE = c(1, 1), sim = 50000 + ) + results <- sum(res1$oc[5:7]) expect_equal(result, 1) }) + +test_that("the type II error decreases with increase futility looks", { + set.seed(1989) # TODO when is it important to set seed + res_fut <- ocPostprob( + nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), + sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) + ) + + res$oc$PrFutility + res_no_fut <- ocPostprob( + nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), + sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10) + ) + res_no_fut$oc$PrFutility + expect_true(res_fut$oc$PrFutility > res_no_fut$oc$PrFutility) +}) + +# expect equal with tolerance --- +#### P(ORR $\ge$ Min PP) must be high for going, we assume e.g. 70% for go +#### P(ORR $\ge$ Min PP) must be low for stopping, we assume e.g. 10% for go +# Pre-calculation indicate that : +##### go criteria: 20 out of 40, means >= 50% response rate +##### stop criteria: 13 out of 40, means <= 32.5% response rate +test_that("ocPostprob gives results that are within range to stats::pbinom", { + set.seed(1989) + res1 <- ocPostprob( + nnE = 40, truep = 0.5, p0 = 0.45, p1 = 0.45, tL = 0.9, tU = 0.7, + parE = c(1, 1), sim = 50000 + ) + res1$oc$PrEfficacy # 0.5623 + p.go <- 1 - pbinom(q = 20 - 1, size = 40, prob = 0.5) + p.go # 0.5626853 + expect_equal(res1$oc$PrEfficacy, p.go, tolerance = 1e-7) +}) # TODO fix error why does actual round up + +test_that("ocPostprob gives results that are within range to stats::pbinom", { + set.seed(1989) + res1 <- ocPostprob( + nnE = 40, truep = 0.5, p0 = 0.45, p1 = 0.45, tL = 0.9, tU = 0.7, + parE = c(1, 1), sim = 50000 + ) + res1$oc$PrFutility # 0.01998 + p.stop <- pbinom(q = 13, size = 40, prob = 0.5) + p.stop # 0.01923865 + expect_equal(res1$oc$PrFutility, p.stop, tolerance = 1e-4) +}) # TODO fix error why does actual round up From 7eba969df6f84676ff70ab298628677713f3ba8a Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 29 Sep 2023 13:27:46 +0200 Subject: [PATCH 057/106] clean --- R/ocPostprob.R | 16 +++++++++------- man/ocPostprob.Rd | 8 ++++---- tests/testthat/test-ocPostprob.R | 32 ++++++++++++++++---------------- 3 files changed, 29 insertions(+), 27 deletions(-) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index e57cb6b0..9794479f 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -13,20 +13,22 @@ NULL #' #' @return A numeric with `length(nn)-1` elements. #' -#' @examples examples / ocPostprob.R #' @export +#' +#' @examples examples / ocPostprob.R get_distance <- function(nn) { - assert_numeric(nn, unique = TRUE, sorted = TRUE) + assert_numeric(nn, unique = TRUE, sorted = TRUE, min.len = 1) dist0 <- floor(min(nn - c(0, nn[-length(nn)])) / 2) assert_numeric(dist0, sorted = TRUE) dist <- sample(-dist0:dist0, size = length(nn) - 1, replace = TRUE, - prob = 2^(c(-dist0:0, rev(-dist0:(-1))) / 2) + prob = 2^(-abs(-dist0:dist0) / 2) ) dist } + #' Generating looks #' #' @description `r lifecycle::badge("experimental")` @@ -208,14 +210,14 @@ get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' number of simulations #' @typed wiggle : logical #' generate random look locations (not default) -#' if `TRUE`, specify `dist` (see @details) +#' if `TRUE`, optional to specify `dist` (see @details) #' @typed randomdist : logical #' Random distance added to looks. if `NULL`, and `wiggle = TRUE`, function will #' generate and add a random distance within range of the closest looks. #' #' @return A list with the following elements: #' -#' - `oc`: matrix with operating characteristics (see Details section) +#' - `oc`: matrix with operating characteristics (see @details section) #' - `nn`: vector of look locations that was supplied #' - `nnE`: vector of efficacy look locations #' - `nnF`: vector of futility look locations # TODO @@ -225,7 +227,7 @@ get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' ## About arguments #' #' `ExpectedN` is an average of the simulated sample sizes. -#' If `wiggle = TRUE`, one can specify `dist`, though the algorithm will generate it if `dist = NULL` +#' If `wiggle = TRUE`, one can specify `dist`, though the algorithm will generate it if `dist = NULL`. #' If `nnF = NULL`, no Futility or decision to Stop will be analysed. Note that `nnF = c(0)` is equivalent. #' As default, `nnF` is set to the identical looks of `nnE`, and if `wiggle = TRUE`, all looks are the same, e.g. #' `nnE = nnF` when wiggle and distance is applied. @@ -233,7 +235,7 @@ get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' @example examples/ocPostprob.R #' @export ocPostprob <- function(nnE, truep, p0, p1, tL, tU, parE = c(1, 1), - sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = nnE) { + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = nnE) { nn <- sort(unique(c(nnF, nnE))) decision <- vector(length = sim) all_sizes <- vector(length = sim) diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index d46e0301..e5934a4d 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -12,7 +12,7 @@ ocPostprob( tL, tU, parE = c(1, 1), - sim = 1000, + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = nnE @@ -38,7 +38,7 @@ Default set at alpha = 1, beta = 1, or uniform prior.} \item{sim}{(\code{number}):\cr number of simulations} \item{wiggle}{(\code{logical}):\cr generate random look locations (not default) -if \code{TRUE}, specify \code{dist} (see @details)} +if \code{TRUE}, optional to specify \code{dist} (see @details)} \item{randomdist}{(\code{logical}):\cr Random distance added to looks. if \code{NULL}, and \code{wiggle = TRUE}, function will generate and add a random distance within range of the closest looks.} @@ -48,7 +48,7 @@ generate and add a random distance within range of the closest looks.} \value{ A list with the following elements: \itemize{ -\item \code{oc}: matrix with operating characteristics (see Details section) +\item \code{oc}: matrix with operating characteristics (see @details section) \item \code{nn}: vector of look locations that was supplied \item \code{nnE}: vector of efficacy look locations \item \code{nnF}: vector of futility look locations # TODO @@ -89,7 +89,7 @@ maximum sample size) \subsection{About arguments}{ \code{ExpectedN} is an average of the simulated sample sizes. -If \code{wiggle = TRUE}, one can specify \code{dist}, though the algorithm will generate it if \code{dist = NULL} +If \code{wiggle = TRUE}, one can specify \code{dist}, though the algorithm will generate it if \code{dist = NULL}. If \code{nnF = NULL}, no Futility or decision to Stop will be analysed. Note that \code{nnF = c(0)} is equivalent. As default, \code{nnF} is set to the identical looks of \code{nnE}, and if \code{wiggle = TRUE}, all looks are the same, e.g. \code{nnE = nnF} when wiggle and distance is applied. diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index 2a9e7a37..42af92c3 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -1,18 +1,18 @@ # get_distance (helper function) ---- test_that("get_distance gives an error with one element numeric", { - expect_true(get_distance(10), "integer(0)") # TO DO fix error + expect_equal(get_distance(10), integer(0)) }) test_that("get_distance gives results within range", { - results <- get_distance(c(10, 20, 30)) - expect_number(results, lower = 10, upper = 30) # TO DO fix error + set.seed(1989) + nn <- c(10, 20, 30) + results <- get_distance(nn) + expect_numeric(results, lower = -min(nn) / 2, upper = 30, len = 2) # TO DO fix error }) -test_that("get_distance written in reverse gives results within range", { - set.seed(1989) # we should not allow non sorted numerics to get in - results <- get_distance(c(10, 20, 30)) - results_inv <- get_distance(c(30, 20, 10)) - expect_true(results && results_inv, lower = 10, upper = 30) +test_that("get_distance will give error with non sorted argument", { + set.seed(1989) + expect_error(get_distance(c(30, 20, 10))) }) # get_looks (helper function) ---- @@ -23,7 +23,7 @@ test_that("get_looks gives correct results if input is identical", { }) test_that("get_looks gives correct results if input is identical", { - dist <- c(0, 5) # TODO Ask isaac why not nnE = nnF + dist <- c(0, 5) results <- get_looks(dist = dist, nnE = c(10, 20, 30), nnF = c(10, 20, 30)) expect_equal(results$nnrE, results$nnrF) }) @@ -77,11 +77,11 @@ test_that("the sum of Eff, Fut, Gray zone probabiliy is 1", { parE = c(1, 1), sim = 50000 ) results <- sum(res1$oc[5:7]) - expect_equal(result, 1) + expect_equal(results, 1) }) -test_that("the type II error decreases with increase futility looks", { - set.seed(1989) # TODO when is it important to set seed +test_that("the type II error increases with increase futility looks", { + set.seed(1989) res_fut <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) @@ -111,8 +111,8 @@ test_that("ocPostprob gives results that are within range to stats::pbinom", { res1$oc$PrEfficacy # 0.5623 p.go <- 1 - pbinom(q = 20 - 1, size = 40, prob = 0.5) p.go # 0.5626853 - expect_equal(res1$oc$PrEfficacy, p.go, tolerance = 1e-7) -}) # TODO fix error why does actual round up + expect_true((p.go - res1$oc$PrEfficacy) < 1e-3) +}) test_that("ocPostprob gives results that are within range to stats::pbinom", { set.seed(1989) @@ -123,5 +123,5 @@ test_that("ocPostprob gives results that are within range to stats::pbinom", { res1$oc$PrFutility # 0.01998 p.stop <- pbinom(q = 13, size = 40, prob = 0.5) p.stop # 0.01923865 - expect_equal(res1$oc$PrFutility, p.stop, tolerance = 1e-4) -}) # TODO fix error why does actual round up + expect_true((p.stop - res1$oc$PrFutility) < 1e-2) +}) From 8135abd928257ce2390c93947e3a24c44a92b0c7 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 2 Oct 2023 10:50:40 +0200 Subject: [PATCH 058/106] fix R CMD check errors --- R/ocPostprob.R | 7 +++---- man/get_distance.Rd | 2 +- man/get_looks.Rd | 2 +- tests/testthat/test-ocPostprob.R | 18 +++++++++++++++++- vignettes/introduction.Rmd | 4 ++-- 5 files changed, 24 insertions(+), 9 deletions(-) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index 9794479f..75dc7d93 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -1,7 +1,7 @@ #' @include postprob.R NULL -#' Generating random distance in looks for efficacy and futility. +#' Generating random distance in given looks for sample sizes for efficacy and futility. #' #' @description `r lifecycle::badge("experimental")` #' @@ -45,7 +45,7 @@ get_distance <- function(nn) { #' @typed nnF : numeric #' Sample size or sizes where study can be stopped for futility decision if different from efficacy decision. #' -#' @return A numeric of looks with outputs from `get_distance` randomly added to looks. +#' @return Uses distance from `get_distance` to add to looks, creating wiggled looks: #' `nnrE`is the result for efficacy looks with random distance added. #' `nnrF`is the result for futility looks with random distance added. #' @@ -107,7 +107,7 @@ get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, assert_numeric(response, lower = 0, upper = 1) while (is.na(decision) && index_look <= length(nnr)) { if (size_look %in% nnF) { - qL <- 1 - postprob(x = sum(response[1:size_look]), n = size_look, p = p0, parE = parE) # for each + qL <- 1 - postprob(x = sum(response[1:size_look]), n = size_look, p = p0, parE = parE) assert_number(qL, lower = 0, upper = 1) decision <- ifelse(qL >= tL, FALSE, NA) } @@ -119,7 +119,6 @@ get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, all_sizes <- size_look index_look <- index_look + 1 size_look <- nnr[index_look] - # } } list( decision = decision, diff --git a/man/get_distance.Rd b/man/get_distance.Rd index 3fb8244b..e938aa8e 100644 --- a/man/get_distance.Rd +++ b/man/get_distance.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/ocPostprob.R \name{get_distance} \alias{get_distance} -\title{Generating random distance in looks for efficacy and futility.} +\title{Generating random distance in given looks for sample sizes for efficacy and futility.} \usage{ get_distance(nn) } diff --git a/man/get_looks.Rd b/man/get_looks.Rd index e4f4a756..425c62a6 100644 --- a/man/get_looks.Rd +++ b/man/get_looks.Rd @@ -17,7 +17,7 @@ specify in \code{nnF}.} \item{nnF}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for futility decision if different from efficacy decision.} } \value{ -A numeric of looks with outputs from \code{get_distance} randomly added to looks. +Uses distance from \code{get_distance} to add to looks, creating wiggled looks: \code{nnrE}is the result for efficacy looks with random distance added. \code{nnrF}is the result for futility looks with random distance added. } diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index 42af92c3..c0498e4c 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -80,7 +80,7 @@ test_that("the sum of Eff, Fut, Gray zone probabiliy is 1", { expect_equal(results, 1) }) -test_that("the type II error increases with increase futility looks", { +test_that("the PrFutility increases with increase futility looks", { set.seed(1989) res_fut <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), @@ -96,6 +96,22 @@ test_that("the type II error increases with increase futility looks", { expect_true(res_fut$oc$PrFutility > res_no_fut$oc$PrFutility) }) +test_that("the PrFfficacy increases with increase Efficacy looks", { + set.seed(1989) + res_eff <- ocPostprob( + nnE = c(30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), + sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(30) + ) + + res_eff$oc$PrEfficacy + res_more_eff <- ocPostprob( + nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), + sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) + ) + res_more_eff$oc$PrEfficacy + expect_true(res_eff$oc$PrEfficacy > res_more_eff$oc$PrEfficacy) +}) + # expect equal with tolerance --- #### P(ORR $\ge$ Min PP) must be high for going, we assume e.g. 70% for go #### P(ORR $\ge$ Min PP) must be low for stopping, we assume e.g. 10% for go diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd index 103d09f5..85e85bb1 100644 --- a/vignettes/introduction.Rmd +++ b/vignettes/introduction.Rmd @@ -695,8 +695,8 @@ we issue the following command: ```{r ocpostprob_example, echo=TRUE} set.seed(4) results <- ocPostprob( - nn = c(10, 20, 30), p = 0.4, p0 = 0.2, p1 = 0.3, tL = 0.6, - tU = 0.8, parE = c(1, 1), ns = 10000 + nnE = c(10, 20, 30), truep = 0.4, p0 = 0.2, p1 = 0.3, tL = 0.6, + tU = 0.8, parE = c(1, 1), sim = 10000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) ) results$oc ``` From c79982cecafe6a5d56bec906ed77c9a73a1eed03 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 2 Oct 2023 13:23:18 +0200 Subject: [PATCH 059/106] fix R CMD check errors for PR --- tests/testthat/test-ocPostprob.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index c0498e4c..37c5a67e 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -87,12 +87,12 @@ test_that("the PrFutility increases with increase futility looks", { sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) ) - res$oc$PrFutility + res_fut$oc$PrFutility # 0.048 res_no_fut <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10) ) - res_no_fut$oc$PrFutility + res_no_fut$oc$PrFutility # 0.031 expect_true(res_fut$oc$PrFutility > res_no_fut$oc$PrFutility) }) @@ -103,13 +103,13 @@ test_that("the PrFfficacy increases with increase Efficacy looks", { sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(30) ) - res_eff$oc$PrEfficacy + res_eff$oc$PrEfficacy # 0.691 res_more_eff <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) ) - res_more_eff$oc$PrEfficacy - expect_true(res_eff$oc$PrEfficacy > res_more_eff$oc$PrEfficacy) + res_more_eff$oc$PrEfficacy # 0.728 + expect_true(res_more_eff$oc$PrEfficacy > res_more_eff$oc$PrEfficacy) }) # expect equal with tolerance --- From cf0ace7ab69321ad1c29db7804fa1aebb6bb9d12 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 3 Oct 2023 10:51:25 +0200 Subject: [PATCH 060/106] Update R/ocPostprob.R Co-authored-by: Daniel Sabanes Bove --- R/ocPostprob.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index 75dc7d93..b3200abc 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -20,12 +20,11 @@ get_distance <- function(nn) { assert_numeric(nn, unique = TRUE, sorted = TRUE, min.len = 1) dist0 <- floor(min(nn - c(0, nn[-length(nn)])) / 2) assert_numeric(dist0, sorted = TRUE) - dist <- sample(-dist0:dist0, + sample(-dist0:dist0, size = length(nn) - 1, replace = TRUE, prob = 2^(-abs(-dist0:dist0) / 2) ) - dist } From 3b1ed097a4c1f4c5b9cc10dafec6874ca2a0ed5a Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 3 Oct 2023 10:51:42 +0200 Subject: [PATCH 061/106] Update R/ocPostprob.R Co-authored-by: Daniel Sabanes Bove --- R/ocPostprob.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index b3200abc..af72ee8b 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -191,7 +191,7 @@ get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' #' `P_E(p < p0) > tL` #' -#' Resulting Operating Characteristics include the following: +#' Resulting operating characteristics include the following: #' #' - `ExpectedN`: expected number of patients in the trials #' - `PrStopEarly`: probability to stop the trial early (before reaching the From 271edd4cf187d6b33321638bb4be7d15b7297d87 Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Tue, 3 Oct 2023 08:54:04 +0000 Subject: [PATCH 062/106] [skip actions] Roxygen Man Pages Auto Update --- man/ocPostprob.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index e5934a4d..d1dfe6a4 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -73,7 +73,7 @@ Stop criteria for Futility : \code{P_E(p < p0) > tL} -Resulting Operating Characteristics include the following: +Resulting operating characteristics include the following: \itemize{ \item \code{ExpectedN}: expected number of patients in the trials \item \code{PrStopEarly}: probability to stop the trial early (before reaching the From 7f2c01b3bae1ac308e203b39048440af7677c45b Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 3 Oct 2023 10:58:09 +0200 Subject: [PATCH 063/106] Update R/ocPostprob.R Co-authored-by: Daniel Sabanes Bove --- R/ocPostprob.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index af72ee8b..b98dd711 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -222,8 +222,6 @@ get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' - `params`: multiple parameters# TODOs #' #' @details -#' ## About arguments -#' #' `ExpectedN` is an average of the simulated sample sizes. #' If `wiggle = TRUE`, one can specify `dist`, though the algorithm will generate it if `dist = NULL`. #' If `nnF = NULL`, no Futility or decision to Stop will be analysed. Note that `nnF = c(0)` is equivalent. From 027e43218d10153c6232e4ef41bf2fea18464192 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 3 Oct 2023 10:59:11 +0200 Subject: [PATCH 064/106] Update R/ocPostprob.R Co-authored-by: Daniel Sabanes Bove --- R/ocPostprob.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index b98dd711..775b1eba 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -237,7 +237,7 @@ ocPostprob <- function(nnE, truep, p0, p1, tL, tU, parE = c(1, 1), all_sizes <- vector(length = sim) assert_logical(decision) assert_logical(all_sizes) - for (k in 1:sim) { + for (k in seq_len(sim)) { if (length(nn) != 1 && wiggle && is.null(randomdist)) { dist <- get_distance(nn = nn) nnr <- get_looks(dist = dist, nnE = nnE, nnF = nnF) From 459dac9c8ada02dcbb4998011ea46b51815b8cf8 Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Tue, 3 Oct 2023 09:02:16 +0000 Subject: [PATCH 065/106] [skip actions] Roxygen Man Pages Auto Update --- man/ocPostprob.Rd | 3 --- 1 file changed, 3 deletions(-) diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index d1dfe6a4..2121778c 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -86,15 +86,12 @@ maximum sample size) } } \details{ -\subsection{About arguments}{ - \code{ExpectedN} is an average of the simulated sample sizes. If \code{wiggle = TRUE}, one can specify \code{dist}, though the algorithm will generate it if \code{dist = NULL}. If \code{nnF = NULL}, no Futility or decision to Stop will be analysed. Note that \code{nnF = c(0)} is equivalent. As default, \code{nnF} is set to the identical looks of \code{nnE}, and if \code{wiggle = TRUE}, all looks are the same, e.g. \code{nnE = nnF} when wiggle and distance is applied. } -} \examples{ # Three looks-- # design details (example) From 7964767cbaaf17f4549d1359ba7a481f5a57b16e Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 3 Oct 2023 11:17:08 +0200 Subject: [PATCH 066/106] Update R/ocPostprob.R Co-authored-by: Daniel Sabanes Bove --- R/ocPostprob.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index 775b1eba..3fbd750c 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -197,7 +197,7 @@ get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' - `PrStopEarly`: probability to stop the trial early (before reaching the #' maximum sample size) #' - `PrEarlyEff`: probability of Early Go decision -#' - `PrEarlyFut`: probability to decide for Futility early +#' - `PrEarlyFut`: probability of for Early Futility decision #' - `PrEfficacy`: probability of Go decision #' - `PrFutility`: Probability of Stop decision #' - `PrGrayZone`: probability between Go and Stop ,"Evaluate" or Gray decision zone From c3ab3ea0da0ef5854f02eb3315bfbf3c90347d6d Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 3 Oct 2023 11:18:10 +0200 Subject: [PATCH 067/106] PR feedback --- NAMESPACE | 4 -- R/ocPostprob.R | 48 +++++++++------------- examples/get_decision.R | 23 ----------- examples/get_distance.R | 5 --- examples/get_looks.R | 16 -------- examples/get_oc.R | 19 --------- man/{get_decision.Rd => h_get_decision.Rd} | 9 ++-- man/{get_distance.Rd => h_get_distance.Rd} | 9 ++-- man/{get_looks.Rd => h_get_looks.Rd} | 13 +++--- man/{get_oc.Rd => h_get_oc.Rd} | 9 ++-- 10 files changed, 38 insertions(+), 117 deletions(-) delete mode 100644 examples/get_decision.R delete mode 100644 examples/get_distance.R delete mode 100644 examples/get_looks.R delete mode 100644 examples/get_oc.R rename man/{get_decision.Rd => h_get_decision.Rd} (85%) rename man/{get_distance.Rd => h_get_distance.Rd} (73%) rename man/{get_looks.Rd => h_get_looks.Rd} (69%) rename man/{get_oc.Rd => h_get_oc.Rd} (83%) diff --git a/NAMESPACE b/NAMESPACE index 584f0b31..42f1866e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,10 +7,6 @@ export(dbetabinom) export(dbetabinomMix) export(dbetadiff) export(getBetamixPost) -export(get_decision) -export(get_distance) -export(get_looks) -export(get_oc) export(logit) export(myPlot) export(myPlotDiff) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index 775b1eba..1e4b5e78 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -3,8 +3,6 @@ NULL #' Generating random distance in given looks for sample sizes for efficacy and futility. #' -#' @description `r lifecycle::badge("experimental")` -#' #' A helper function for `ocPostprob` to generate random distance's wiggle room around looks `nn`. #' Numeric looks `nn` must be of minimum two elements and will generate `length(nn)-1` distances. #' @@ -13,10 +11,10 @@ NULL #' #' @return A numeric with `length(nn)-1` elements. #' -#' @export +#' @keywords internal #' #' @examples examples / ocPostprob.R -get_distance <- function(nn) { +h_get_distance <- function(nn) { assert_numeric(nn, unique = TRUE, sorted = TRUE, min.len = 1) dist0 <- floor(min(nn - c(0, nn[-length(nn)])) / 2) assert_numeric(dist0, sorted = TRUE) @@ -27,16 +25,13 @@ get_distance <- function(nn) { ) } - #' Generating looks #' -#' @description `r lifecycle::badge("experimental")` -#' #' A helper function for `ocPostprob` that applies the numeric element of `dist` to looks `nn`. #' #' @typed dist : numeric or logical #' Distance for random looks around the look locations in `nn`, -#' where `dist`is generated from `get_distance` in a numeric of at least one element. +#' where `dist`is generated from `h_get_distance` in a numeric of at least one element. #' If `NULL`, only one location look will be set at `nnE` or `nnF`. #' @typed nnE : numeric #' Sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, @@ -44,14 +39,14 @@ get_distance <- function(nn) { #' @typed nnF : numeric #' Sample size or sizes where study can be stopped for futility decision if different from efficacy decision. #' -#' @return Uses distance from `get_distance` to add to looks, creating wiggled looks: +#' @return Uses distance from `h_get_distance` to add to looks, creating wiggled looks: #' `nnrE`is the result for efficacy looks with random distance added. #' `nnrF`is the result for futility looks with random distance added. #' -#' @export +#' @keywords internal #' #' @examples examples / ocPostProb.R -get_looks <- function(dist, nnE, nnF) { +h_get_looks <- function(dist, nnE, nnF) { assert_numeric(nnE) assert_numeric(nnF) nn <- unique(c(nnE, nnF)) @@ -66,11 +61,9 @@ get_looks <- function(dist, nnE, nnF) { #' Generating random decision and sample size looks. #' -#' @description `r lifecycle::badge("experimental")` -#' #' A helper function for `ocPostprob` to generate numeric of decisions `decisions` and random looks `all_sizes`. #' -#' @inheritParams get_looks +#' @inheritParams h_get_looks #' @typed nnr : numeric #' union of `nnE`and `nnF`. #' @typed response : numeric @@ -94,10 +87,10 @@ get_looks <- function(dist, nnE, nnF) { #' - `all_sizes` : resulting numeric of look size, anything below maximum #' look size is an indicated interim, futility or efficacy or both #' -#' @export +#' @keywords internal #' #' @examples -get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, tL, tU) { +h_get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, tL, tU) { index_look <- 1 assert_numeric(nnr) size_look <- nnr[index_look] @@ -127,12 +120,10 @@ get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, #' Creating list for operating characteristics. #' -#' @description `r lifecycle::badge("experimental")` -#' #' Generates operating characteristics. #' -#' @inheritParams get_looks -#' @inheritParams get_decision +#' @inheritParams h_get_looks +#' @inheritParams h_get_decision #' @typed nnrE : numeric #' Looks with random distance, if applied on `nnE`. #' @typed nnrF : numeric @@ -152,10 +143,11 @@ get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, #' - `PrEfficacy`: probability of Go decision #' - `PrFutility`: Probability of Stop decision #' - `PrGrayZone`: probability between Go and Stop ,"Evaluate" or Gray decision zone -#' @export +#' +#' @keywords internal #' #' @examples examples / ocPostprob.R -get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { +h_get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { sim <- length(all_sizes) assert_logical(decision, len = sim) assert_numeric(all_sizes) @@ -202,8 +194,8 @@ get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' - `PrFutility`: Probability of Stop decision #' - `PrGrayZone`: probability between Go and Stop ,"Evaluate" or Gray decision zone #' -#' @inheritParams get_looks -#' @inheritParams get_decision +#' @inheritParams h_get_looks +#' @inheritParams h_get_decision #' @typed sim : number #' number of simulations #' @typed wiggle : logical @@ -239,8 +231,8 @@ ocPostprob <- function(nnE, truep, p0, p1, tL, tU, parE = c(1, 1), assert_logical(all_sizes) for (k in seq_len(sim)) { if (length(nn) != 1 && wiggle && is.null(randomdist)) { - dist <- get_distance(nn = nn) - nnr <- get_looks(dist = dist, nnE = nnE, nnF = nnF) + dist <- h_get_distance(nn = nn) + nnr <- h_get_looks(dist = dist, nnE = nnE, nnF = nnF) nnrE <- nnr$nnrE nnrF <- nnr$nnrF } else { @@ -248,7 +240,7 @@ ocPostprob <- function(nnE, truep, p0, p1, tL, tU, parE = c(1, 1), nnrF <- nnF } nnr <- unique(c(nnrE, nnrF)) - tmp <- get_decision( + tmp <- h_get_decision( nnr = nnr, response = response, truep = truep, p0 = p0, p1 = p1, parE = c(1, 1), nnE = nnrE, @@ -257,7 +249,7 @@ ocPostprob <- function(nnE, truep, p0, p1, tL, tU, parE = c(1, 1), decision[k] <- tmp$decision all_sizes[k] <- tmp$all_sizes } - oc <- get_oc(all_sizes = all_sizes, nnr = nnr, decision = decision, nnrE = nnrE, nnrF = nnrF) + oc <- h_get_oc(all_sizes = all_sizes, nnr = nnr, decision = decision, nnrE = nnrE, nnrF = nnrF) list( oc = oc, Decision = decision, diff --git a/examples/get_decision.R b/examples/get_decision.R deleted file mode 100644 index 28e3269d..00000000 --- a/examples/get_decision.R +++ /dev/null @@ -1,23 +0,0 @@ -# multiple looks @ 10, 20, 30 patients for Efficacy and Futility -# True response rate of the treatment group=40% -# Look for futility: P(response rate < 20% )> 60% -# Look for efficacy: P(response rate > 30% )> 80% -# Prior of treatment arm parE = Beta(1,1) - -# argument inputs for get_decision -nn <- c(10, 20, 30) -dist <- get_distance(c(10, 20, 30)) -looks <- get_looks(dist, c(10, 20, 30), c(10, 20, 30)) - -get_decision( - nnr = nn, - response = rbinom(n = max(nn), size = 1, prob = 0.40), - truep = 0.4, - p0 = 0.20, - p1 = 0.30, - parE = c(1, 1), - nnE = looks$nnrE, - nnF = looks$nnrF, - tL = 0.80, - tU = 0.60 -) diff --git a/examples/get_distance.R b/examples/get_distance.R deleted file mode 100644 index bee9ee29..00000000 --- a/examples/get_distance.R +++ /dev/null @@ -1,5 +0,0 @@ -## get_distance - -get_distance(c(10, 20)) - -get_distance(c(10, 20, 30)) diff --git a/examples/get_looks.R b/examples/get_looks.R deleted file mode 100644 index eac73b5c..00000000 --- a/examples/get_looks.R +++ /dev/null @@ -1,16 +0,0 @@ -# argument input for get_looks -dist <- get_distance(c(10, 30)) - -get_looks(dist, c(10, 30), c(10, 30)) - -# get_distance when nnE is different nnF -nnE <- c(10, 20) -nnF <- c(15, 20) -nn <- sort(unique(c(nnE, nnF))) -dist <- get_distance(nn) -get_looks(dist, nnE, nnF) - -# argument input for get_looks, three element numeric -dist <- get_distance(c(10, 20, 30)) - -get_looks(dist, c(10, 20, 30), c(10, 20, 30)) diff --git a/examples/get_oc.R b/examples/get_oc.R deleted file mode 100644 index ae4696bc..00000000 --- a/examples/get_oc.R +++ /dev/null @@ -1,19 +0,0 @@ -# argument inputs for get_decision -nn <- c(10, 20, 30) -dist <- get_distance(c(10, 20, 30)) -looks <- get_looks(dist, c(10, 20, 30), c(10, 20, 30)) - -tmp <- get_decision( - nnr = nn, - response = rbinom(n = max(nn), size = 1, prob = 0.40), - truep = 0.4, - p0 = 0.20, - p1 = 0.30, - parE = c(1, 1), - nnE = looks$nnrE, - nnF = looks$nnrF, - tL = 0.80, - tU = 0.60 -) - -get_oc(all_sizes = tmp$all_sizes, nnr = c(10, 20, 30), decision = tmp$decision, nnrE = looks$nnrE, nnrF = looks$nnrF) diff --git a/man/get_decision.Rd b/man/h_get_decision.Rd similarity index 85% rename from man/get_decision.Rd rename to man/h_get_decision.Rd index 7afbcfaa..024c2288 100644 --- a/man/get_decision.Rd +++ b/man/h_get_decision.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ocPostprob.R -\name{get_decision} -\alias{get_decision} +\name{h_get_decision} +\alias{h_get_decision} \title{Generating random decision and sample size looks.} \usage{ -get_decision(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, tL, tU) +h_get_decision(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, tL, tU) } \arguments{ \item{nnr}{(\code{numeric}):\cr union of \code{nnE}and \code{nnF}.} @@ -38,7 +38,6 @@ look size is an indicated interim, futility or efficacy or both } } \description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} - A helper function for \code{ocPostprob} to generate numeric of decisions \code{decisions} and random looks \code{all_sizes}. } +\keyword{internal} diff --git a/man/get_distance.Rd b/man/h_get_distance.Rd similarity index 73% rename from man/get_distance.Rd rename to man/h_get_distance.Rd index e938aa8e..2ca368d5 100644 --- a/man/get_distance.Rd +++ b/man/h_get_distance.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ocPostprob.R -\name{get_distance} -\alias{get_distance} +\name{h_get_distance} +\alias{h_get_distance} \title{Generating random distance in given looks for sample sizes for efficacy and futility.} \usage{ -get_distance(nn) +h_get_distance(nn) } \arguments{ \item{nn}{: number or numeric @@ -14,11 +14,10 @@ the union of \code{nnE} and \code{nnF} (if futility analysis or looks exists) su A numeric with \code{length(nn)-1} elements. } \description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} - A helper function for \code{ocPostprob} to generate random distance's wiggle room around looks \code{nn}. Numeric looks \code{nn} must be of minimum two elements and will generate \code{length(nn)-1} distances. } \examples{ examples / ocPostprob.R } +\keyword{internal} diff --git a/man/get_looks.Rd b/man/h_get_looks.Rd similarity index 69% rename from man/get_looks.Rd rename to man/h_get_looks.Rd index 425c62a6..18ff5bf0 100644 --- a/man/get_looks.Rd +++ b/man/h_get_looks.Rd @@ -1,14 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ocPostprob.R -\name{get_looks} -\alias{get_looks} +\name{h_get_looks} +\alias{h_get_looks} \title{Generating looks} \usage{ -get_looks(dist, nnE, nnF) +h_get_looks(dist, nnE, nnF) } \arguments{ \item{dist}{(\verb{numeric or logical}):\cr Distance for random looks around the look locations in \code{nn}, -where \code{dist}is generated from \code{get_distance} in a numeric of at least one element. +where \code{dist}is generated from \code{h_get_distance} in a numeric of at least one element. If \code{NULL}, only one location look will be set at \code{nnE} or \code{nnF}.} \item{nnE}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, @@ -17,15 +17,14 @@ specify in \code{nnF}.} \item{nnF}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for futility decision if different from efficacy decision.} } \value{ -Uses distance from \code{get_distance} to add to looks, creating wiggled looks: +Uses distance from \code{h_get_distance} to add to looks, creating wiggled looks: \code{nnrE}is the result for efficacy looks with random distance added. \code{nnrF}is the result for futility looks with random distance added. } \description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} - A helper function for \code{ocPostprob} that applies the numeric element of \code{dist} to looks \code{nn}. } \examples{ examples / ocPostProb.R } +\keyword{internal} diff --git a/man/get_oc.Rd b/man/h_get_oc.Rd similarity index 83% rename from man/get_oc.Rd rename to man/h_get_oc.Rd index 99a9ee25..30532377 100644 --- a/man/get_oc.Rd +++ b/man/h_get_oc.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ocPostprob.R -\name{get_oc} -\alias{get_oc} +\name{h_get_oc} +\alias{h_get_oc} \title{Creating list for operating characteristics.} \usage{ -get_oc(all_sizes, nnr, decision, nnrE, nnrF) +h_get_oc(all_sizes, nnr, decision, nnrE, nnrF) } \arguments{ \item{all_sizes}{(\code{numeric}):\cr Sample sizes of all looks simulated \code{length(sim)} times if \code{dist} applied.} @@ -31,10 +31,9 @@ maximum sample size) } } \description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} - Generates operating characteristics. } \examples{ examples / ocPostprob.R } +\keyword{internal} From 71f797e108c4e009f7ca953e6a76c1765206d3e4 Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Tue, 3 Oct 2023 09:19:27 +0000 Subject: [PATCH 068/106] [skip actions] Roxygen Man Pages Auto Update --- man/ocPostprob.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index 2121778c..32e043e0 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -79,7 +79,7 @@ Resulting operating characteristics include the following: \item \code{PrStopEarly}: probability to stop the trial early (before reaching the maximum sample size) \item \code{PrEarlyEff}: probability of Early Go decision -\item \code{PrEarlyFut}: probability to decide for Futility early +\item \code{PrEarlyFut}: probability of for Early Futility decision \item \code{PrEfficacy}: probability of Go decision \item \code{PrFutility}: Probability of Stop decision \item \code{PrGrayZone}: probability between Go and Stop ,"Evaluate" or Gray decision zone From 7724a7af18efb055752a8cb523e926457b3639d3 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 5 Oct 2023 12:10:23 +0200 Subject: [PATCH 069/106] clean --- R/ocPostprob.R | 80 +- R/postprob.R | 12 +- examples/ocPostprob.R | 21 +- inst/WORDLIST | 4227 +----------------------------- man/h_get_decision.Rd | 18 +- man/h_get_distance.Rd | 8 +- man/h_get_looks.Rd | 15 +- man/h_get_oc.Rd | 13 +- man/ocPostprob.Rd | 53 +- tests/testthat/test-ocPostprob.R | 78 +- 10 files changed, 214 insertions(+), 4311 deletions(-) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index 99d15c72..30a5ef2d 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -1,19 +1,18 @@ #' @include postprob.R NULL -#' Generating random distance in given looks for sample sizes for efficacy and futility. +#' Generating random distance in given looks for sample sizes for Efficacy and Futility. #' #' A helper function for `ocPostprob` to generate random distance's wiggle room around looks `nn`. #' Numeric looks `nn` must be of minimum two elements and will generate `length(nn)-1` distances. #' -#' @param nn : number or numeric -#' the union of `nnE` and `nnF` (if futility analysis or looks exists) supplied +#' @typed nn : number or numeric +#' the union of `nnE` and `nnF` (if futility analysis or looks exists) supplied. #' #' @return A numeric with `length(nn)-1` elements. #' #' @keywords internal #' -#' @examples examples / ocPostprob.R h_get_distance <- function(nn) { assert_numeric(nn, unique = TRUE, sorted = TRUE, min.len = 1) dist0 <- floor(min(nn - c(0, nn[-length(nn)])) / 2) @@ -25,27 +24,26 @@ h_get_distance <- function(nn) { ) } -#' Generating looks +#' Generating looks from random distance #' #' A helper function for `ocPostprob` that applies the numeric element of `dist` to looks `nn`. #' #' @typed dist : numeric or logical -#' Distance for random looks around the look locations in `nn`, -#' where `dist`is generated from `h_get_distance` in a numeric of at least one element. -#' If `NULL`, only one location look will be set at `nnE` or `nnF`. +#' distance for random looks around the look locations in `nn`, +#' where `dist`is generated from `h_get_distance` in a numeric of at least one element. +#' If `NULL`, only one location look will be set at `nnE` or `nnF`. #' @typed nnE : numeric -#' Sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, -#' specify in `nnF`. +#' sample size or sizes where study can be stopped for Efficacy decision. If different for Futility decision, +#' specify in `nnF`. #' @typed nnF : numeric -#' Sample size or sizes where study can be stopped for futility decision if different from efficacy decision. +#' sample size or sizes where study can be stopped for Futility decision if different from Efficacy decision. #' #' @return Uses distance from `h_get_distance` to add to looks, creating wiggled looks: -#' `nnrE`is the result for efficacy looks with random distance added. -#' `nnrF`is the result for futility looks with random distance added. +#' `nnrE`is the result for Efficacy looks with random distance added. +#' `nnrF`is the result for Futility looks with random distance added. #' #' @keywords internal #' -#' @examples examples / ocPostProb.R h_get_looks <- function(dist, nnE, nnF) { assert_numeric(nnE) assert_numeric(nnF) @@ -67,29 +65,28 @@ h_get_looks <- function(dist, nnE, nnF) { #' @typed nnr : numeric #' union of `nnE`and `nnF`. #' @typed response : numeric -#' A numeric of Bernoulli successes based on `size_look` +#' A numeric of Bernoulli successes based on `size_look`. #' @typed truep : number #' assumed true response rate or true rate (scenario). #' @typed p0 : number -#' lower efficacy threshold of response rate. +#' lower Futility threshold of response rate. #' @typed p1 : number -#' upper efficacy threshold of response rate. +#' upper Efficacy threshold of response rate. #' @typed tL : number -#' posterior probability threshold for being below `p0`. +#' posterior probability threshold for being below `p0`.. #' @typed tU : number #' posterior probability threshold for being above `p1`. #' @typed parE : numeric -#' Alpha and beta parameters for the prior on the treatment proportion. +#' alpha and beta parameters for the prior on the treatment proportion. #' Default set at alpha = 1, beta = 1, or uniform prior. #' #' @return A list of the following objects : -#' - `decision` : resulting numeric of decision, one of `TRUE` for GO, `FALSE`for STOP, `NA` for Gray zone +#' - `decision` : resulting numeric of decision, one of `TRUE` for Go, `FALSE`for Stop, `NA` for Gray zone. #' - `all_sizes` : resulting numeric of look size, anything below maximum -#' look size is an indicated interim, futility or efficacy or both +#' look size is an indicated interim, Futility or Efficacy or both. #' #' @keywords internal #' -#' @examples h_get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, tL, tU) { index_look <- 1 assert_numeric(nnr) @@ -125,13 +122,13 @@ h_get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nn #' @inheritParams h_get_looks #' @inheritParams h_get_decision #' @typed nnrE : numeric -#' Looks with random distance, if applied on `nnE`. +#' looks with random distance, if applied on `nnE`. #' @typed nnrF : numeric -#' Looks with random distance, if applied on `nnF`. +#' looks with random distance, if applied on `nnF`. #' @typed all_sizes : numeric -#' Sample sizes of all looks simulated `length(sim)` times if `dist` applied. +#' sample sizes of all looks simulated `length(sim)` times if `dist` applied. #' @typed decision : numeric -#' Go, Stop or Gray Zone decisions of all looks simulated `length(sim)` times. +#' Go, Stop or Gray Zone decisions of all looks simulated `length(sim)` times. #' #' @return A list of results containing : #' @@ -139,14 +136,13 @@ h_get_decision <- function(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nn #' - `PrStopEarly`: probability to stop the trial early (before reaching the #' maximum sample size) #' - `PrEarlyEff`: probability of Early Go decision -#' - `PrEarlyFut`: probability to decide for Futility early +#' - `PrEarlyFut`: probability of for Early Stop decision #' - `PrEfficacy`: probability of Go decision -#' - `PrFutility`: Probability of Stop decision +#' - `PrFutility`: probability of Stop decision #' - `PrGrayZone`: probability between Go and Stop ,"Evaluate" or Gray decision zone #' #' @keywords internal #' -#' @examples examples / ocPostprob.R h_get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { sim <- length(all_sizes) assert_logical(decision, len = sim) @@ -171,8 +167,8 @@ h_get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' Calculate operating characteristics for posterior probability method. #' #' It is assumed that the true response rate is `truep`. -#' The trial is stopped for efficacy if the posterior probability to be -#' above `p1` is larger than `tU`, and stopped for futility if the posterior +#' The trial is stopped for Efficacy if the posterior probability to be +#' above `p1` is larger than `tU`, and stopped for Futility if the posterior #' probability to be below `p0` is larger than `tL`: #' #' Stop criteria for Efficacy : @@ -189,18 +185,18 @@ h_get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' - `PrStopEarly`: probability to stop the trial early (before reaching the #' maximum sample size) #' - `PrEarlyEff`: probability of Early Go decision -#' - `PrEarlyFut`: probability of for Early Futility decision +#' - `PrEarlyFut`: probability of for Early Stop decision #' - `PrEfficacy`: probability of Go decision -#' - `PrFutility`: Probability of Stop decision +#' - `PrFutility`: probability of Stop decision #' - `PrGrayZone`: probability between Go and Stop ,"Evaluate" or Gray decision zone #' #' @inheritParams h_get_looks #' @inheritParams h_get_decision #' @typed sim : number -#' number of simulations +#' number of simulations. #' @typed wiggle : logical -#' generate random look locations (not default) -#' if `TRUE`, optional to specify `dist` (see @details) +#' generate random look locations (not default). +#' if `TRUE`, optional to specify `dist` (see @details). #' @typed randomdist : logical #' Random distance added to looks. if `NULL`, and `wiggle = TRUE`, function will #' generate and add a random distance within range of the closest looks. @@ -209,9 +205,9 @@ h_get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { #' #' - `oc`: matrix with operating characteristics (see @details section) #' - `nn`: vector of look locations that was supplied -#' - `nnE`: vector of efficacy look locations -#' - `nnF`: vector of futility look locations # TODO -#' - `params`: multiple parameters# TODOs +#' - `nnE`: vector of Efficacy look locations +#' - `nnF`: vector of Futility look locations +#' - `params`: multiple parameters #' #' @details #' `ExpectedN` is an average of the simulated sample sizes. @@ -225,10 +221,12 @@ h_get_oc <- function(all_sizes, nnr, decision, nnrE, nnrF) { ocPostprob <- function(nnE, truep, p0, p1, tL, tU, parE = c(1, 1), sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = nnE) { nn <- sort(unique(c(nnF, nnE))) + assert_number(sim, lower = 1, finite = TRUE) + if (sim < 50000) { + warning("Advise to use sim >= 50000 to achieve convergence") + } decision <- vector(length = sim) all_sizes <- vector(length = sim) - assert_logical(decision) - assert_logical(all_sizes) for (k in seq_len(sim)) { if (length(nn) != 1 && wiggle && is.null(randomdist)) { dist <- h_get_distance(nn = nn) diff --git a/R/postprob.R b/R/postprob.R index 30a22d66..22cf7c38 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -27,7 +27,6 @@ postprobOld <- function(x, n, p, a = 1, b = 1) { stats::pbeta(p, a + x, b + n - x, lower.tail = FALSE) } - #' Compute the posterior probability to be above threshold, #' with a beta mixture prior on the response rate. #' @@ -63,20 +62,19 @@ postprobOld <- function(x, n, p, a = 1, b = 1) { #' @export postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALSE) { if (missing(betamixPost)) { - ## if parE is a vector => situation where there is only one component + # If betamixPost is missing, then we would use the default parE if (is.vector(parE)) { - # Here there is only one component. + # Here there is only one component in the parE vector. assert_true(identical(length(parE), 2L)) - # To get matrix with one row. + # To get matrix with one row, we transpose parE. parE <- t(parE) } - ## if prior weights of the beta mixture are not supplied + # If prior weights of the beta mixture are not supplied, weights are given if (missing(weights)) { weights <- rep(1, nrow(parE)) } - ## now compute updated parameters betamixPost <- getBetamixPost( x = x, n = n, @@ -85,7 +83,7 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS ) } - ## now compute the survival function at p, i.e. 1 - cdf at p: + # Here, we compute the survival function at p, i.e. 1 - cdf at p as lower.tail = FALSE: ret <- with( betamixPost, pbetaMix(q = p, par = par, weights = weights, lower.tail = FALSE) diff --git a/examples/ocPostprob.R b/examples/ocPostprob.R index 970361a6..93091550 100644 --- a/examples/ocPostprob.R +++ b/examples/ocPostprob.R @@ -1,10 +1,9 @@ -# Three looks-- -# design details (example) -# multiple looks @ 10, 20, 30 patients -# True response rate of the treatment group=40% -# Look for futility: P(response rate < 20% )> 60% -# Look for efficacy: P(response rate > 30% )> 80% -# prior of treatment arm parE= Beta(1,1) +# For three looks of 10, 20 and 30 we have the following assumptions : +# True response rate of the treatment group = 40% +# The following are the Go and Stop rules respectively : +# Look for Efficacy: P(response rate > 30% )> 80% +# Look for Futility: P(response rate < 20% )> 60% +# Prior of treatment arm parE= Beta(1,1). res <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), sim = 1000, wiggle = TRUE, randomdist = NULL, nnF = c(10, 20, 30) @@ -12,7 +11,7 @@ res <- ocPostprob( res$oc -# Specify distance +# We specify the distance in this example. res <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), sim = 1000, wiggle = TRUE, randomdist = c(-1, 3), nnF = c(10, 20, 30) @@ -20,7 +19,7 @@ res <- ocPostprob( res$oc -# No Wiggle +# Here, nnE = nnF, and no wiggle room is allowed. Random distance also not supplied. res <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) @@ -28,7 +27,7 @@ res <- ocPostprob( res$oc -# Only one efficacy + many futility +# Here, we only have one Futility and Efficacy look or stop. res <- ocPostprob( nnE = c(10), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10) @@ -36,7 +35,7 @@ res <- ocPostprob( res$oc -# Only one futility +# Here, we only have one Futility but many Efficacy looks or stop. res <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10) diff --git a/inst/WORDLIST b/inst/WORDLIST index 1d076c8b..dd1edaa0 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,4254 +1,173 @@ - -x - - -q -s - - -k - - -K -o -x - - - - - - -bqnY -E -v -D - - -h -m - - - -kJ - - -KRKo - - - - -TB -R - -K -q - -Y - - -R - - - -L -T - -F -J -P -u - - - - -V - - -u -r - -z - - -Y - - - - - - - - - - - -bp -OS - - -F - - -Q - - - - - - -c - -L - - -m - - -e - - - - -X - - -jZ - - - - - - -W -X - - -qFk - -F -R - - - -V - -M -g - - - - - -c -y - -V - - - -y -gR - - - - -B -k - -p - -vZ - - - -g -R - -p - -b -e - - - -l - - -v -n - - - - -K - - -e -m - -iJ - -T - -e -i -O - -H - - -n - -n - - - - - - -s - -t - -d - - -R - -Z - -I - -T - - - -X - -w -t - -X - - - - - - -e -i - -k - - - -S - - - - - - -B -p - - -q - - -G - - - -f - - - -B - - -e -l - - - - - - - - - - - -R - - - - -O - -Gs -r - - -xO - -y - - -O - - - - - - - -j - -V - - - - -W - - -r - -oS - -iJ - -i - - - -T - - -O - - -GcY -Uc -K -V - - - -h -Z - -R - - -T - - - -x - - - -YO - - -e - - -Jt -k -ZS - - - - - - -w - -F - -p - - - - - - -x - -x - - -t - - - - - -j -W - -U -Rw - -M -Qp - - -i - -S - - - -Y - - -u -xL - -Ckg - - -I - -M - - - - -g - - - - - - - - - - - - - -K - -U - - - -Gt - -G -q - -x - -f - -a -b - -ZOm - -F -t - - - - -O - - - - - - - - - - - - - - -K - - - - -xk - - -p - -qs - -K -KS - -G - - - - -C -m -P - -q - -C - - - -f - - -z - -p - -zO - - - - -R - - - - -a - - - -W - -JT -Q - -U -G - - - -iz -o - - - - - - - - - - -M - -l - - - - -c -q - -T - -W - - -K - - -D - - - - - - - - -Ft - - -VjM - - - -Jq -l - -aC -y -p - -j -k - - - - -i - - - - -W - -f - - -dx -C -Cj -H -K -k - -O -ha - - - -ll - - - -U - -e - - - - - -G -S - -K - - -W - -R - - -G -UO - -F - - - -B - - - -Q - - -Z - - - -f - - - -U - - -t - - -T - -H - - -vo - -Ya -P - -u - - - - -Y - -xvZ - -jJ - -K -VX -Z - - -F - - -BY -S - - - -od - -L - -R - - - -J - - -H -U - - - -XJ - - -L -s - -Oc - - - -P - - -cR -Z - -Z - - - -G -O - - - -i - - -V - - -C -J -M - - - - -E -MB - - - - - -W - - -w - - -dM -I - -d - - - -z -K - -H -j -Pk - - - - - -G -fMu - -I -O -Z - - -e - - - - - - - -GN - - - - - - - - - -f -H - -t -Uq - - -G -N -V - - -G -Rte - -M - -B -Q -sf - -k -u - - -j - - -b -I - - - -w - -w -f -A -G - -MOT -jS - - - - -H - -n - - -iB -w - - - - - - -g - - - -R - - - -v -ZT - -e - - -m - - - -c - - - - - - - -o -v - - -n - - - - - - -UAS - -z - - -M - -O - - -I - -R - - - - - - - -C -o -W - -IR - - - -a -H - - -N -w - - - -F - - -T - - - -Z - - - -M - - - - - -H - - -l - -hn - -e -J - - - - - -u -u -z - - -i - - - - -g -h - -QP -m -re -Q - - -Gs - -F - - - -R -J - - -J - - - - -g - -ib - - - -O - - - -n - - - -h - - -J -G - - -B -e - - - - - -U - -J - -vz - - - - -m -F -Mz - - - - -N - -nL -e - - -CL - - - - -E -w - -j - - - - - - -Q - -t - -m - - - - -D - - - -y - -d - -R -Xs - -s - -K - -q - -T - - -h -nfQ - - - - -J -L - -j - - - - - - -t - - - -C - - -P - -A -zY - -bS - -G -MfU -G - -Q - - - - - - -l -ne -' - -r - - - -M - - - - - -wi - - - - - -dtU - -VH -G - - -oo - - - - - - - - -g - - - - -U -B - - - - - - - - - - - -J - - - - - - - -HQ - - - - - -FaX - - - -Z - -ry - - - - - -p -m - -Xk - - - - - - - - -i -J - -a'O -a -a -A -aeZ -a -A -a -a -A -ai -aa -aaa -aaaaaa -aabd -aaYdirq -abb -abc -Abg -aC -acbad -adadad -adbbd -addon -aDHizNhDJidFZhNydEahOaDH -AE -aec -aElaqrq -aF -afbdd -afc -afd -afe -ag -aG -aH -ahR -aj -Aj -AJ -aJT -ak -akb -akShbueb -akt -aku -aL -alignRight -aM -aN +BayesRobust +Binom +Biometrics +Cov +DeltaFu +DoR +ExpectedN +ExpectedNactive +ExpectedNcontrol +LciU +Liu +Nmax +NmaxControl +PFS +PProbust +PPs +PhiFu +PointMass +PrEarlyEff +PrEarlyFut +PrEfficacy +PrFutility +PrGrayZone +PrStopEarly +RCT +SampleSize +SampleSizeActive +SampleSizeControl +ShinyPhase +Thall +TtR +USUBJID +UciL +VAD +XYZ analysed -antialiased -aO -Ao -aoCDkp -Aoi -aoptions -ap -aPJ apriori -apX -aq -Aq -AQ -AQAAQBAJ -AQlV -aqtLsS -aqU -Aqz -aR -Arial -arrowrefresh -arrowreturn -arrowreturnthick -arrowstop -arrowthick -arrowthickstop -asc -ashqn -Asok -aSSObE -atD -attr -aU -Aucp -autocomplete -autocorr -autohide -autohiding -aV -aW -AWi -AwYdU -axsl -axc -axQa -ay -aY -aYV -AyyO -aZ -aZmHuanZOZgIuvbGiNeomCnaxxap -aZr -B'kd -b'N -B -b -BMB -B -bu -B -b -ba bA -backface -BAEAAAAALAAAAAABAAEAAAIBRAA -BAkBAAEALAAAAAAoACgAAAKVDI -BAkBAAEALAAAAAAoACgAAAKVjB -BAkBAAEALAAAAAAoACgAAAKWBIKpYe -BAkBAAEALAAAAAAoACgAAAKXjI -baM -barcode -BayesRobust bB -Bb -bbb -bbeta -BbeZfMxsexY -bbP -bc bC -Bc -bcbcbc -bcC -BCCC -bCL -bcO -bd bD -bdbdbd bE -beps -bernoulli -betadiff bF -bfHwv -bg bG -BG -bgColorActive -bgColorContent -bgColorDefault -bgColorError -bgColorHeader -bgColorHighlight -bgColorHover -bgColorOverlay -bgColorShadow -bgImgOpacityActive -bgImgOpacityContent -bgImgOpacityDefault -bgImgOpacityError -bgImgOpacityHeader -bgImgOpacityHighlight -bgImgOpacityHover -bgImgOpacityOverlay -bgImgOpacityShadow -bgTextureActive -bgTextureContent -bgTextureDefault -bgTextureError -bgTextureHeader -bgTextureHighlight -bgTextureHover -bgTextureOverlay -bgTextureShadow -bgttheta -bh bH -BHFZNr -BHk -Bhm -bhU bI -bIG -bIk -Binom -Biometrics -Biostatistics -biQ -bj -Bj -BJ -bjQ -bjR -bkj -BKd bL -blambda bLambda -blockquote -bm +bOmega +bPhi +bPsi +bR +bS +bT +bTheta +bV +bW +bX +bY +bZ +ba +bbP +bbeta +bc +beps +betadiff +bgttheta +bh +blambda bmatrix -Bml -bmtXP bmu -BMvaUEmJRd -Bn -BN -BniGFae -bo -bO -BOc boldsymbol bomega -bOmega -bootswatch -borderColorActive -borderColorContent -borderColorDefault -borderColorError -borderColorHeader -borderColorHighlight -borderColorHover -Bov -bp bphi -bPhi bpi -BPo bpsi -bPsi -bq -bQ -Bq -BQ -bqJ -BQM -bQrY br -bR -Branson -BRr bs -bS bsig -bsl bt -bT -Bt -BT btau -btc btheta -bTheta -btn -buttonpane -buttonset -bv -bV -Bv bw -bW -Bw -BW -BwQ -BWR -BWwIBtc -bX -Bxp -bY bz -bZ -BZ -c'J -C -C -cFU -c -c -c -C -c -cA calulation -caR -CArial -cb -cB -cba -CBDDA -cC -ccc -CCC -cccccc -cd -CDEFGHIJSTUVWXYZcdefghijstuvwxyz cdf -ce -cecece -ceN -cF -cG -CgM -cHuBUXKGKXlKjn -ci -cICCmoqCe -circlesmall -cj -cjg -cK -ckIOqqJ -cL -clearfix -clipPath -closethick -clR -cn -cN -cn -codrops -Codrops -colgroup comparator conjugacy -Consolas -cornerRadius -cornerRadiusShadow cov -Cov -cp -cP -cpg -cpYf -cq -cQ -CQ -cQFr -cqU -cqVeuOSvfOW -cqW -cR -CRC -CreateDate -CreatorTool -cRJ -cRRS -cS -Csans -css -cT -cUjT -CUr cutB cutW -cV -Cv -cW -cwv -cx -CXmO -CxW -cy -cY -Cy -cYR -cYy -cz -Cz -cZI -d -D -d -D -d -D -d -d -d -d -Dm -D -da -dadada -dataTable -datatables -dataTables -DataTables -datepicker -datetime -db -dBe -dbetabinom -DCBCBC -dcc -DCC -dcL -dD -DD -dDalQWPVOsQWtRnuwXaFTj -ddd -DDD -dddddd -de -dE -DEb +dP +dW +dX +dY +dZ decisian -dede -DejaVu deltaE deltaF deltaFu -DeltaFu deltaW -DerivedFrom -desc det -Df -DF -dff -dfn -dfw -dg -dG -Dg -Dh -di -diag -dIbY diffience -DiHWMcYJah -DiJti -dirR -dismissable -dismissible -DisV -dItwjYKBgo -divoptions -dJ -dK -Dk -DK -dl -Dl -dM -dnN -documentID -DocumentID doi -doJ -dolby -DoR -dp -dP -Dp -dq -dQ -DQ -dR -draggable -DrF -dRL -dropdown -dropup -ds -DS -DSS -dt -dT -DTTT -dtU -du -dU -Dunson -DV dw -dW -DWV -dX -DX -dxeo -DXImageTransform -dxJ -dXj -DXJT -dy -dY -dygraph -dygraphs -dYV -DyV -dZ -E'Y -e -e -Eo -E -EH -e -E -EiZ -eb -e -e -ea -eaeaea -EaX -eB -Eb -EB -ebcccc -ebD -EBDADA -ebebeb -eBTfu -ec -eC -ecb -ECEC -ecec -eCG -edec -edf -edqqWQAAIfkECQEAAQAsAAAAACgAKAAAApSMgZnGfaqcg -ee -eE -Ee -EE -EEeV -EEE -eee -eeeeee -eEH -eeR -ef -eF -EF -EFWOT -eg -Eg -eH -ehA -Ei -EI -EIe -eiFKX -eiMYWT -ej -eJ -EJ -EJI -Ejk -EJn -ek -eK -ek -ekpObkpOlppWUqZiqr -eKy -El -EL -ElU -eM -eM -eN -endColorstr -eNnP -eNVcojuFGfqnZqSebuS -eo -eO -Eo -EO -eot -ep -Ep -ephx -epP eq -eQ -Eq -EQ -EQ -EQJJ -Eqz -eR -eRi -ERp -eRx -eS estunated -ESU -et -eT -eu -Eue -eUQT -eur -EUu -EUUM -EUV -eV -EV -ew -Ew -eWqNfHuMjXCPkIGNileOiImVmCOEmoSfn -eX -exMb -exO -ExpectedN -ExpectedNactive -ExpectedNcontrol -extlink -ey -eY -eyQTU -eYQU -eYVc -Eyy -ez -eZ -EZ -ez -ezuAw -F -F -f -f -fu -F -f -F -f -F -f -fYF -f -F -Fg -F -f -FAAACH -facetime -faf -fafafa -fb -Fb -FB -fbf -fbfbfb -fc -Fc -FC -fcActive -fcContent -fcDefault -fcefa -fcError -fcf -FCFAFA -fcfafa -fcHeader -fcHighlight -fcHover -FCMt -fd -Fd -fdfdfd -fe -febc -fef -ffDefault -fff -FFF -ffffff -FFL -fg -FG -fgoSUI -Fgz -fh -fH -FHBCKoDeWKXqymPqGqxvJrXZbMx -fI -FI -fieldset -figcaption -fiW -fIX -Fj -fk -fK -FLr -fluz -fM -FmNI -Fmt -fn -fN -Fn -FN -FNWtcFWe -FNWtMFWW -fO -FO -FoCCH -focusable -fod -Fou -FoZ -Fp -FP -FPK -fq -fQ -Fq -FQ -fQN -fqr -fR frac -frDVpxZZc -FrRjs -FrX -fs -fS -Fs -FS -fsDefault -fsL -FSZ -fT -FTrl -fu -fU -Fu -FU -fullscreen -fv -FVFNDQVBFMi -FVfv -fW -FW -fwDefault -fwi -fwSk -FWZs -fx -Fx -FX -fy -fY -Fy -fyFa -fYI -FyV -fz -G'QJ -G -g -Gp -g -g -gd -G -g -GY -g -GF -GC -g -ga -gA -gb -gB -Gb -gBmS -gbp -GBqJ -gby -gC -Gc -gelman -Gelman generalizable -geometricPrecision geq -getbootstrap -GEZt -gf -gF -GF -Gfa -gFI -gg -GG -ggplot -ggs -gh -GH -GhV -gI -github -GJ -GjrRU -GJY -GJz -gk -gK -gkz -gL -glyphicon -glyphicons -Glyphicons -Gmh -gMWZ -gn -GN -gnM -gnWGfHNdjIqDWVqemH -gO -googleapis -GOQ -Gor -gQ -Gq -GQ -gR -GradientType -Grande -grayscale grayzone -grey -gripsmall -gS -gsk -Gsponer -gu -gU -Gu -gv -gV -GV -gVw -gw -gW -Gw -GWEu -GWgw -GWi -gwO -gX -Gx -GxNso -gY -Gy -GY -gyHUkFj -gZ -Gz -GZ -h -h -h -Hx -h -h -hW -h -h -h -H -h -h -H -h -halflings -Halflings -halflingsregular -hb -hB -Hb -HB -Hbj -Hbja -hbk -hc -hcd -hd -Hd -HD -hdd -Hdd -hDt -HelveticaNeue -hF -hG -Hg -hgroup -hh hier -HIn -hiPKqWn -hJ -HJ -hjq -HJX -hk -hkh -hKK -hKU -hl -Hl -HLgd -Hm -hmaPL -HmHEb -hMVVcNl -hn -hN -Hn -HNP -hO -HOMM -hP -hpj -hQ -hR -hRa -href -hroptions -hrtableoptions -Hs -hT -HtH -Htt -http -https -hu -hU -Hu -HU -humO -hv -hV -HvAWhpiUdcwkpBH -hVQ -HVu -hw -hW -Hwt -hx -HX -HXhx -hY -Hy -hYBzkpuUh -HycXJHUXiGYIiMg -HyjJ hyoithesis hyperprior -HyR -hz -hZ -hz -hzbH -hzu -I'f -I'iG -I'o -i -i -I -iaIAa -i -I -irP -I -i -IC -iE -iAU -i -IQI -IF -I -icM -iF -i -i -iF -ia -iA -IAV -IABSty -ib -iB -Ib -IBK -ibp -IBS -ic -iC -IC -iconColorActive -iconColorContent -iconColorDefault -iconColorError -iconColorHeader -iconColorHighlight -iconColorHover -idff -ie -iE -Ie -iefix -iEV -iF -IFGiU -iFI -iframe -IFu -ig -iG -Ig -IG -IGZGKLnNpYtm -ih -Ih -IHDR -IHkQ -iI -iioKSXpUAAAh -iJ -Ij -IJk -IJUc -IjYJvjWKcnoGQpqyPlpOhr -ik -Ik -IkA -iko -il -iL -Il -ilYuWYpmTqKUgAAIfkECQEAAQAsAAAAACgAKAAAApiEH -iM -IM -IMA -img -Immz -IMUUE -iN increasement inefficacious -iNI -INp -instanceID -InstanceID integrations -Inu -inV -io -iO -iOG -Iol -iooAnx -ioOGhXGJboGAnXSBnoBwKYyfioubZJ -IOQ -iow -ip -ipc -iq -iQ -Iq -iqs -IQT -ir -iR -IR -irs -iS -isbn -IST -iT -itR -Itt -iu -iU -IU -IUU -iV -iVr -iw -iW -Iw -IW -IWk -Iy -IY -IYF -IYiy -iyt -iz -iZ -Iz -IZ -izF -izO -izw -jY -j -J -j -j -jE -J -j -juu -J -J -JA -JafV -javascript -jba -jC -Jc -JccR -Jd -jDQ -jDux -JE -Jes -jf -jF -jG -jh -Jh -JH -JHe -ji -JI -JiK -jIBr -JiF -JIU -Jj -JJ -JJi -jJn -JjZ -jk -jK -JK -JktP -jm -jM -Jm -JM -jmn -jmY -jN -Jn -JN -jNK -JnP -jo -jO -JOD -JOn -jp -jP -jpF -jPr -jps -JPU -jpy -jq -jQ -Jq -JQ -JqfRVLHU -jQi -JQM -JqS -JQS -jQuery -jqueryui -jR -jrAa -jROC -jrupsi -jrx -js -jS -JsJ -jSQ -JSQ -Jsw -jt -jT -Jt -JT -jts -ju -Ju -JU -jUc -jujm -jumbotron -JuRs -jUz -jV -Jv -jVVh -jw -jW -Jw -JW -jWI -jx -Jx -JX -Jxn -jXOKT -JXx -jXZ -jy -jY -Jy -JY -jz -jZ -Jz -JZjz -jzV -K -k -K -KW -K -K -k -ka -Ke -kd -k -KI -k -K -k -K -KGSr -k -ka -kA -Ka -KA -kAACH -kalX -kb -kB -kbd -KBlpVpbluCiXmMnZ -kC -KCC -kd -kdy -ke -kE -Ke -KE -kEI -keyframes -kf -kF -Kf -KF -KfuJ -kG -kGM -kh -kH -KH -KHFu -khu -KhZrKt -ki -KI -Kiuk -kj -kJ -Kj -KJ -kk -kK -KK -kkkx -KKl -kkQ -KKq -klw -kM -kmi -kN -ko -kO -Ko -KON -koO -kORTVrVhRlsnn -kOxTVrXNVlv -kp -kP -kQ -KQ -kR -kR -KRgm -KRY -kS -kT -KtkT -KTz -kU -KU -kUs -Kuv -kv -KV -kz -kZ -l'L -L -ln -l -L -LgW -l -L -l -lA -lAAACH -LaP -lccn -LciU -Lcx -lCXjcW -LdCt -lDFk ldots -le -lE -Let -lEE -Leonhard leq -LEQ -LEZ -lf -lF -Lf -LF -LFd -lfG -lfM -LFWU -Lg -lGODlhAQABAIAAAAAAAP -lGODlhKAAoAIABAAAAAP -lh -Lh -LHo -lHY -li -lI -lifecycle -lightbulb -linearGradient -Liu -lJ -Lj -ljZ -lKXe -lL -Lle -ller -lln -lm -LM -LmHS -LmKSllZmsoq -ln -lN -LNn -lno -lOyQRWET -lp -Lpj -lpLn -lq -LQ -lQAACH -lql -Lsh -lt -lT -Lt -lu -lUcBj -Lucida -lULTk -lv -lV -Lv -LV -lVX -lW -LW -lWK -lww -LX -ly -lY -LY -lYCMlJOXipGRr -Lymp -lz -lZ -Lz -LZl -m'G -M'RK -Mk -mfY -Mo -M -m -M -MrKK -M -M -m -mv -m -me -mYV -m -Maiq -MAs mathbb mathbf mathcal -mB -mBm mbox -MbR -MbU -mc -Mc -MCN -mCQ -md -mE -mEE -Menlo -MERCHANTABILITY -mEZT -mf -Mf -MF -MFH -MFY -MFZI -mG -MgH -mGhZOfeYSUh -mh -mH -Mh -mI -MIi -mIJ -minusthick -mj -mJ -Mj -MJ -MJQ -Mjy -Mjz -mk -Mkco -MKMy -MlB -mLD -mM -mmP -mmq -mMRae -mn -mN -MNg -mNn -MNSU -MNzb -mO -ModifyDate -monospace -mOT -moz -mq -MQ -MQdQd -mR -Mr -Msi -MsM -MSR -mSu -mT -Mtm -mU -multiparam -multitrace -mv -mV -mw -Mw -mwus -mx -MX -MXSFi -mY -mYF -mZ -Mz -MZ -N'zz -n -n -nE -N -njN -N -n -N -n -n -nM -n -n -na -nA -nav -navbar -NAVBAR -navlist -nb -nC -Nc -Nce -nCi -Ndd -nDW -ne -nE -necolas -Neue -Neuenschwander -NEv +nS newcommand -newwin -Nf -NFaA -nG -Ng -Ngm -nh -nhHuui -nhHvw -nI -nj -nJ -NJR -nk -Nk -NK -NKI -nKw -nl -nL -NL -nlc -Nln -NlxXW -nlY -nm -nM -Nmp -Nmax -NmaxControl nn -nN -Nn -NNCuJ nnE nnF -nnf nnr -nnR -Nou -noa -nomtJjp -NONINFRINGEMENT -nowrap -nOY -noyraJ -NPd -nq -nQ -NQ -NQT -nR -NrwNRn -nrX -ns -nS -Ns -nSd -nt -nT -Nt -NtpX -Ntrjy -nTx -nU -nUc -NUs -nw -nW -nWqq -nx -nX -Nx -NX -nxH -NxL -NXu -Nxyg -ny -Ny -Nyg -NYq -nz -nZ -nzPTdJZlR -nZxt -O -O -O -OJ -O -o -O -o -O -ou -o -o -oA -O -O -O -O -O -oa -Oblz oc -OcK -od -oE -Oe -oeN -oF -oF -offsetLeftShadow -offsetTopShadow -OFt -og -oG -Og -oI -OiB -oj -oJid -oK -okK -OKmF -ol -oL -Ol -OL -oLK -oLf -oln -oLvoxuJDkU -oM -omq -oN -onlinelibrary -OnvYP -oo -oO -Oo -OO -ooe -OONb -OOP -Ooq -OozeL -oP -opacityOverlay -opacityShadow -oPb -opentype -optgroup -optionswell -oq -oQ -Oq -OQ -oRj -os -oS -oSaWlu -osx -ot -Ot -oTo -Ott -oU -Ou -OU -ouks -Ouu -oV -ovC -oVe -OVWR -oVxY -oW -OwNnJ -oWV -OWW -oX -oy -oY -OY -OZ -oZY -p'W -P -P -P -P -P -PApl -params -parE -parseType +pE +pL +pS +pU parX parY -pb -pB -pbvwfWEMWBQ -pc -pD -pe -pE -Pe -pF -pFG -PFS -pG -PG -PGEBl -ph -Ph -pHgzJXTEeGlZuenpyPmpGQoKOWkYmSpaSnqKileI +params phiFu -PhiFu phiL phiU -phZ -PiMu -pj -pJ -Pj -PJiYVzR -pjN -pjr -pKe -PkGf -pL -plusthick -pM -pma -pN -Pn -PN -png -pNi -pNK -pO pointmass -PointMass postL -postprob postU -pP -ppd +postprob ppL -PProbust -PPs -pq -pQ -PQz -pR -pRCavZ -pre -PrEarlyEff -PrEarlyFut -PrEfficacy -prev -PrFutility -PrGrayZone priori proabilities -progid -progressbar propto -PrStopEarly -pS -Ps -pT -pu -pU -Puf -puiK -pUunBmtRXo -pv -PV -pVXI -pw -Pw -pwI -px -pX -Px py -pY -pyF -pyGMm -pyn -pYu -pyv pyz -pz -QI -q -q -qb -Qj -Q -ql -q -q -qa -qA -qb -qB -Qb -qc -qD -qdgoSTrqWSq -qE -Qe -Qee -QeY -qEznH -qf -Qf -qFk -qFO -qg -qG -Qg -qh -QH -qH -qi -qI -Qil -Qiw -Qj -QJ -Qjg -qk -QK -Qki -qKuv -ql -qL -qLVhBVeT -qm -Qm -qm -QmE -qn -Qn -QN -qNTWvRdQxP -Qo -QO -QPwq -qq -qQ -Qq -QQJAQABACwAAAAAKAAoAAACkoQRqRvnxuI -QQJAQABACwAAAAAKAAoAAACkYwNqXrdC -QQJAQABACwAAAAAKAAoAAAClYx -qQQ -qR -qrC -qrcode -qre -QRR -qs -qS -QS -qsex -QSRJ -qT -QTv -QTw -qu -qU -QU -QUfau -Qv -QV -qvaC -qvm -qw -Qw -QW -qwk -QwQ -Qwuu -qWv -qX -Qx -QX -qxik -qXjzn -qxLD -qxs -QxwX -qy -QY -QyT -qz -QZ -R -R -r -R -r -RY -R -r -r -rj -r -raj -RAn -rB -rc -Rc -RCT -rdf -RDF -rdv -rE -readonly -rect refering renewcommand -rES -resizable -ResourceRef responder responders -ret -rf -rG -RG -rgba -rGERh -rGg -rgu -Rh -Rhh -Ri -rImrO -RIS -rj -rJ -RJ -rK -Rk -rl -RL -rLn -rM -RMjr -RMY -rn -rN -rnWepg -rO -Ro -RO -roK -Roxytypes -Rp -RpO -rPT -rq -rQ -Rq -RQ -rQTR -rr -rR -RRg -rseztfXZjdIWIf -RTk -rtl -RTL -rU -rufF -RuRZaflZOil -RUu -rw -Rw -Rwn -rx -rX -rXd -RxG -Rxxzs -ry -rY -ryp -RYU -RYx -rz -rZ -Rz -s -s -s -se -SX -S -Sg -S -Smm -s -sa -sA -Saban -sabanes -samp -SampleSize -SampleSizeActive -SampleSizeControl -sB -sbo -sc -scrollable -scrollbar -scrollBody -sd -se -sE -selectable -selectmenu seperate -sER -sF -sFjg -sFT -sg -sG -SG -SGy -ShinyPhase -shinystan -shinyStan -sI -SIF -sj -Sj -sJR -sk -sl -sL -sLE -sLEUO -slmLUZ -sLw -sm -sM -sM -sN -sNN -snzf -sO -sortable -sOu -sp -sPj -SPK -springer -Springer -sQ -sQ -SQe -SQJ -sqr -squaresmall -sr -sR -src -SrN -sRx -ss -Ss -sT -stan -startColorstr -sTP -stRef -sType -sU -Su -SU -SUa -sublicense -Sud -SUi +sumTable sumbetadiff summerize summerizes -sumTable surivival -sV -Sv -SV -svg -svo -sVq -sw -sW -Sw -sx -Sx -Sx -sxk -sy -sY -SY -sy -sZ -SzNeowWBENtQd -T'J -t -t -T -twy -T -t -T -Tg -T -t -t -t -tableoptionswell -TableTools -tabpanel -tbody -tC -TCH -tci -td -te -TEQ -tex -textarea -textfield -textInput -textLength -texttt -Tf -tfoot tFu -tg -Tg -tgg -TgRQ -th -Thall -thead -themeroller -thetaT -thicknessShadow -ThJ -throshold -tI -Ti -Tibp -Tij -TIjQS -titlebar -Tj -TJ -TjEy -TjrU -tk -tl tL -tm -tnSeOZXhmn -tO -todo -tooltip -tp -Tp -TP -tPY -tq -tQ -Tq -TQ -tR -transferthick -translateY -truetype -tSHGZO -TsiMAgswmNYrSgZdYrTX -TsL tT -Tt -TT -Ttc -ttf -TTNOocQ -TtR -ttw -tu tU -Tui -tutKoNWkvA -TUUeY -tuy -tv -twbs -TWG -tx -tX -Tx -TxO -TYM -tympanus -tZ -Tz -tZH -tzr -u' -uI -U -UyEy -Ud -Ux -U -U -UMZ -U -Uz -U -U -U -uA -Ua -UA -uao -uAA -ub -Ub -UBh -UBm -uc -uC -UcA -ucC -UciL -ud -Ud -uDD -ue -uE -Ue -UE -UeQ -UER -Uf -UF -ufODGjRfoiJ -uG -Ug -UG -uH -uhK -ui -uI -Ui -UI -uIf -Uir -uj -UJ -ujK -ujx -uk -uK -Uk -ukf -ukg -UkuvFtXpvWSzA -ul -ULs -uM -Umu -un -unb -unstyled -uNt -uo -uO -UO -UOi -uP -upaCZsq -Upqip -upr -uPVDZxQIR -upy -uQ -Uq -UQ -UQdE -UQqu -uqU -URXYc -usd -USUBJID -usw -ut -UTq -uu -uU -UU -UUA -UUe -UUI -uuolffh -uUT -UUUUJ -uUVJ -uuzDmmHUBR -uv -uV -Uv -uVJN -uw -UW -ux -uX -Ux -UX -UXe -uxg -uxuQ -uy -Uy -uYb -uyU -uz -uZ -Uz -V -v -vo -v -Vw -vQ -v -v -v -V -va -VAAAOw -VAD +texttt +thetaT +throshold +todo vanillaBayes vanillaPP -vc -Vcuuv -vD -Vdy -VE -VEB -Vehtari -Verdana -VexUHpzjymViHrFbiELsefVrn -vf -vF -VfH -VfP -VfZyfkJGkha -Vg -Vh -VH -vI -vix -vIP -VIR -Vj -VJK -vJRt -VJUg -vk -vK -VK -Vki -VkQ -vl -Vl -VL -vm -vM -VMe -vMk -vMSG -Vmv -vMvxRdHlbEFiEXfk -vN -VN -vO -Vo -VO -volkhov -Volkhov -Vp -VpZRedYcflIOLafaa -vq -vQ -Vq -VQ -vqB -vqOz -vQS -VqX -vR -VR -Vrk -VRR -vRXxV -vSM -vsN -vt -vT -vTW -vu -Vu -VU -VuC -vUWhWNkWFwxl -vUxNWWjV -vV -Vv -VV -vva -vvh -vvI -vVj -VvWZfeB -Vw -VW -vWi -vx -vX -Vx -VX -Vx -VxY -vy -Vy -VY -Vyb -Vyz -vZ -VZ -VzJ -W'q -Wv -w -WD -W -W -W -w -w -W -wa -wAwEAAAAh -wb -wB -Wb -WB -WBd -Wbz -Wd -WDQ -wE -webkit -wf -WF -WFl -wFr -wg -wG -WG -wgwo -wh -whitesmoke -WHuMhIl -Wi -WIJ -wiley -wiR -wj -Wj -WJ -WJP -wK -wkh -Wku -WKuZ -wl -WL -wM -WmA -wn -WN -wo -wO -Wo -woO -woff -wp -wP -Wp -wpQAAAh -wq -wQ -Wq -WQ -wR -Wr -WR -Wr -wrj -Wrvx -ws -wtI -WtI -WTk -wu -wU -wuq -wV -Wv -wv -wvQ -ww -wW -wWm -wWnS -Wwq -www -wWz -wx -wX -WXI -wY -Wy -wz -wZ -wzk -Xy -X -xY -xa -XLm -xj -X -x -X -Xm -X -xHss -XS -X -x -xd -x -xa -xA -Xa -Xah -xap -xb -xB -xbt -XBV -xBYEkYvFSM -xc -xC -XC -xcIGAdXqMfBNadoYrhH -xct -Xd -Xdie -XdsH -xex -XF -XfPkeLmm -XfY -xg -xG -Xg -xGG -Xgi -xGK -XgU -xh -xH -Xh -XHd -XHN -xhzzk -xI -xIb -xIU -xj -xJ -Xj -XJ -Xjqx -XJr -XJT -xjx -xjX -xjy -xk -xKF -XKfnt -xKI -xl xL -XL -xlF -xlink -xlV -XLVk -XlvKF -xm -Xm -XM -xmlns -xmp -XMP -xmpmeta -xmpMM -xmptk -xn -xN -Xn -XN -xo -xO -Xo -XO -xOc -xod -xoG -xOG -xoL -xOl -xp -xP -Xp -xpacket -xq -xQ -XR -xs xS -XsG -xSI -xt -xT -Xt -xTqlLGhtCosArKMpvfa -xu xU -Xu -XU -xV -xw -xW -XW -xwG -xwO -xWUW -xwX -xX -XXN -XxxFl -xy -xY -Xy -XY -Xyar -xyB -xyf -xYVua -XYZ -xz -xZ -Xz -XZ -Xz -xza -xzb -xZF -xzi -Xzkh -xzoom -xzQ -XZXhNs -Y'v -yt -y -Y -YZ -y -yA -yaq -YARYxOZZD -yaYQzXO -yB -YBT -yc -yC -Yc -YC -yEE -yeL -yf -yF -Yf -YF -YFt -YFW -yg -yG -YG -yGJ -yH -YH -yHOGpWMyorblKlNp -yi -yI -Yi -YIG -YIGEhYuOUn -Yiw -yJcJyrkZWWpaR -yJJ -Yk -YK -yke -ykP -yl -yL -YL -ylW -ym -yM -Ym -YM -YM -yn -yN -Yn -yng -yNI -Ynj -YNKToqswUlvznigd -ynlcc -yNQ -YNU -YNy -yO -yO -YOb -yP -Yp -YP -ypoaUAAAIfkECQEAAQAsAAAAACgAKAAAApaEb -YPY -yQ -Yq -YQ -yQlZmZ -yR -yrq -yS -YS -ySj -yt -Yt -yti -yu -yU -Yu -YU -yulD -yUQX -YUZbJ -yv -yV -YV -YVd -yvi -yvkS -yvS -yW -YW -ywPH -yx -Yx -YX -YxJ -yXlJWmoHGhqp -YXP -Yxw -yy -yY -Yy -YY -YYZ -yZ -YZ -yZq -z -z -z -z -ZP -z -ZN -ZR -Z -Z -Z -Zu -Z -ZA -zb -zB -ZB -zC -ZC -zCC -zcG -Zd -ZDvp -ze -Zeh -zf -Zf -zff -zfix -zfo -zFwP -zg -zG -ZgRl -Zh -ZhzC -zi -zI -ZI -ZIa -ZIY -zj -Zj -ZJp -zk -zK -Zk -zka -zKGlLIhskiEPm -ZKK -zky -zl -zL -Zl -ZL -ZleFaptFrb -zm -zM -Zm -zn -zN -ZnINRNqosw -zo -Zo -ZO -zoEe -Zoj -zoomin -zoomout -ZOyma -zp -zP -Zp -ZP -Zpe -ZQ -zQfv -ZRb -ZrN -Zrs -zSUiRsQ -zt -Zt -ZT -Zt -zTi -Zth -ZTHyxL -ZTr -ZTs -Ztxo -ZtZ -zu -Zu -ZU -Zu -zUg -ZUK -ZUq -zV -Zv -zvm -zw -zW -Zw -ZW -zWtsmf -zX -Zx -ZX -ZxGR -ZXhWqbRa -ZXL -ZXlExa -ZXLUJ -zxxJ -zy -zYSj -zyxwvutsrqponmlkjihgfedcba -ZYXWVUTSRQPONMLKJIHGFEDCBA -zz -Zz -ZZ -ZzWT diff --git a/man/h_get_decision.Rd b/man/h_get_decision.Rd index 024c2288..713955d0 100644 --- a/man/h_get_decision.Rd +++ b/man/h_get_decision.Rd @@ -9,32 +9,32 @@ h_get_decision(nnr, response, truep, p0, p1, parE = c(1, 1), nnE, nnF, tL, tU) \arguments{ \item{nnr}{(\code{numeric}):\cr union of \code{nnE}and \code{nnF}.} -\item{response}{(\code{numeric}):\cr A numeric of Bernoulli successes based on \code{size_look}} +\item{response}{(\code{numeric}):\cr A numeric of Bernoulli successes based on \code{size_look}.} \item{truep}{(\code{number}):\cr assumed true response rate or true rate (scenario).} -\item{p0}{(\code{number}):\cr lower efficacy threshold of response rate.} +\item{p0}{(\code{number}):\cr lower Futility threshold of response rate.} -\item{p1}{(\code{number}):\cr upper efficacy threshold of response rate.} +\item{p1}{(\code{number}):\cr upper Efficacy threshold of response rate.} -\item{parE}{(\code{numeric}):\cr Alpha and beta parameters for the prior on the treatment proportion. +\item{parE}{(\code{numeric}):\cr alpha and beta parameters for the prior on the treatment proportion. Default set at alpha = 1, beta = 1, or uniform prior.} -\item{nnE}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, +\item{nnE}{(\code{numeric}):\cr sample size or sizes where study can be stopped for Efficacy decision. If different for Futility decision, specify in \code{nnF}.} -\item{nnF}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for futility decision if different from efficacy decision.} +\item{nnF}{(\code{numeric}):\cr sample size or sizes where study can be stopped for Futility decision if different from Efficacy decision.} -\item{tL}{(\code{number}):\cr posterior probability threshold for being below \code{p0}.} +\item{tL}{(\code{number}):\cr posterior probability threshold for being below \code{p0}..} \item{tU}{(\code{number}):\cr posterior probability threshold for being above \code{p1}.} } \value{ A list of the following objects : \itemize{ -\item \code{decision} : resulting numeric of decision, one of \code{TRUE} for GO, \code{FALSE}for STOP, \code{NA} for Gray zone +\item \code{decision} : resulting numeric of decision, one of \code{TRUE} for Go, \code{FALSE}for Stop, \code{NA} for Gray zone. \item \code{all_sizes} : resulting numeric of look size, anything below maximum -look size is an indicated interim, futility or efficacy or both +look size is an indicated interim, Futility or Efficacy or both. } } \description{ diff --git a/man/h_get_distance.Rd b/man/h_get_distance.Rd index 2ca368d5..2057d3e4 100644 --- a/man/h_get_distance.Rd +++ b/man/h_get_distance.Rd @@ -2,13 +2,12 @@ % Please edit documentation in R/ocPostprob.R \name{h_get_distance} \alias{h_get_distance} -\title{Generating random distance in given looks for sample sizes for efficacy and futility.} +\title{Generating random distance in given looks for sample sizes for Efficacy and Futility.} \usage{ h_get_distance(nn) } \arguments{ -\item{nn}{: number or numeric -the union of \code{nnE} and \code{nnF} (if futility analysis or looks exists) supplied} +\item{nn}{(\verb{number or numeric}):\cr the union of \code{nnE} and \code{nnF} (if futility analysis or looks exists) supplied.} } \value{ A numeric with \code{length(nn)-1} elements. @@ -17,7 +16,4 @@ A numeric with \code{length(nn)-1} elements. A helper function for \code{ocPostprob} to generate random distance's wiggle room around looks \code{nn}. Numeric looks \code{nn} must be of minimum two elements and will generate \code{length(nn)-1} distances. } -\examples{ -examples / ocPostprob.R -} \keyword{internal} diff --git a/man/h_get_looks.Rd b/man/h_get_looks.Rd index 18ff5bf0..da45d6e5 100644 --- a/man/h_get_looks.Rd +++ b/man/h_get_looks.Rd @@ -2,29 +2,26 @@ % Please edit documentation in R/ocPostprob.R \name{h_get_looks} \alias{h_get_looks} -\title{Generating looks} +\title{Generating looks from random distance} \usage{ h_get_looks(dist, nnE, nnF) } \arguments{ -\item{dist}{(\verb{numeric or logical}):\cr Distance for random looks around the look locations in \code{nn}, +\item{dist}{(\verb{numeric or logical}):\cr distance for random looks around the look locations in \code{nn}, where \code{dist}is generated from \code{h_get_distance} in a numeric of at least one element. If \code{NULL}, only one location look will be set at \code{nnE} or \code{nnF}.} -\item{nnE}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, +\item{nnE}{(\code{numeric}):\cr sample size or sizes where study can be stopped for Efficacy decision. If different for Futility decision, specify in \code{nnF}.} -\item{nnF}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for futility decision if different from efficacy decision.} +\item{nnF}{(\code{numeric}):\cr sample size or sizes where study can be stopped for Futility decision if different from Efficacy decision.} } \value{ Uses distance from \code{h_get_distance} to add to looks, creating wiggled looks: -\code{nnrE}is the result for efficacy looks with random distance added. -\code{nnrF}is the result for futility looks with random distance added. +\code{nnrE}is the result for Efficacy looks with random distance added. +\code{nnrF}is the result for Futility looks with random distance added. } \description{ A helper function for \code{ocPostprob} that applies the numeric element of \code{dist} to looks \code{nn}. } -\examples{ -examples / ocPostProb.R -} \keyword{internal} diff --git a/man/h_get_oc.Rd b/man/h_get_oc.Rd index 30532377..53231d27 100644 --- a/man/h_get_oc.Rd +++ b/man/h_get_oc.Rd @@ -7,15 +7,15 @@ h_get_oc(all_sizes, nnr, decision, nnrE, nnrF) } \arguments{ -\item{all_sizes}{(\code{numeric}):\cr Sample sizes of all looks simulated \code{length(sim)} times if \code{dist} applied.} +\item{all_sizes}{(\code{numeric}):\cr sample sizes of all looks simulated \code{length(sim)} times if \code{dist} applied.} \item{nnr}{(\code{numeric}):\cr union of \code{nnE}and \code{nnF}.} \item{decision}{(\code{numeric}):\cr Go, Stop or Gray Zone decisions of all looks simulated \code{length(sim)} times.} -\item{nnrE}{(\code{numeric}):\cr Looks with random distance, if applied on \code{nnE}.} +\item{nnrE}{(\code{numeric}):\cr looks with random distance, if applied on \code{nnE}.} -\item{nnrF}{(\code{numeric}):\cr Looks with random distance, if applied on \code{nnF}.} +\item{nnrF}{(\code{numeric}):\cr looks with random distance, if applied on \code{nnF}.} } \value{ A list of results containing : @@ -24,16 +24,13 @@ A list of results containing : \item \code{PrStopEarly}: probability to stop the trial early (before reaching the maximum sample size) \item \code{PrEarlyEff}: probability of Early Go decision -\item \code{PrEarlyFut}: probability to decide for Futility early +\item \code{PrEarlyFut}: probability of for Early Stop decision \item \code{PrEfficacy}: probability of Go decision -\item \code{PrFutility}: Probability of Stop decision +\item \code{PrFutility}: probability of Stop decision \item \code{PrGrayZone}: probability between Go and Stop ,"Evaluate" or Gray decision zone } } \description{ Generates operating characteristics. } -\examples{ -examples / ocPostprob.R -} \keyword{internal} diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index 2121778c..123d1aa6 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -19,40 +19,40 @@ ocPostprob( ) } \arguments{ -\item{nnE}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for efficacy decision. If different for futility decision, +\item{nnE}{(\code{numeric}):\cr sample size or sizes where study can be stopped for Efficacy decision. If different for Futility decision, specify in \code{nnF}.} \item{truep}{(\code{number}):\cr assumed true response rate or true rate (scenario).} -\item{p0}{(\code{number}):\cr lower efficacy threshold of response rate.} +\item{p0}{(\code{number}):\cr lower Futility threshold of response rate.} -\item{p1}{(\code{number}):\cr upper efficacy threshold of response rate.} +\item{p1}{(\code{number}):\cr upper Efficacy threshold of response rate.} -\item{tL}{(\code{number}):\cr posterior probability threshold for being below \code{p0}.} +\item{tL}{(\code{number}):\cr posterior probability threshold for being below \code{p0}..} \item{tU}{(\code{number}):\cr posterior probability threshold for being above \code{p1}.} -\item{parE}{(\code{numeric}):\cr Alpha and beta parameters for the prior on the treatment proportion. +\item{parE}{(\code{numeric}):\cr alpha and beta parameters for the prior on the treatment proportion. Default set at alpha = 1, beta = 1, or uniform prior.} -\item{sim}{(\code{number}):\cr number of simulations} +\item{sim}{(\code{number}):\cr number of simulations.} -\item{wiggle}{(\code{logical}):\cr generate random look locations (not default) -if \code{TRUE}, optional to specify \code{dist} (see @details)} +\item{wiggle}{(\code{logical}):\cr generate random look locations (not default). +if \code{TRUE}, optional to specify \code{dist} (see @details).} \item{randomdist}{(\code{logical}):\cr Random distance added to looks. if \code{NULL}, and \code{wiggle = TRUE}, function will generate and add a random distance within range of the closest looks.} -\item{nnF}{(\code{numeric}):\cr Sample size or sizes where study can be stopped for futility decision if different from efficacy decision.} +\item{nnF}{(\code{numeric}):\cr sample size or sizes where study can be stopped for Futility decision if different from Efficacy decision.} } \value{ A list with the following elements: \itemize{ \item \code{oc}: matrix with operating characteristics (see @details section) \item \code{nn}: vector of look locations that was supplied -\item \code{nnE}: vector of efficacy look locations -\item \code{nnF}: vector of futility look locations # TODO -\item \code{params}: multiple parameters# TODOs +\item \code{nnE}: vector of Efficacy look locations +\item \code{nnF}: vector of Futility look locations +\item \code{params}: multiple parameters } } \description{ @@ -61,8 +61,8 @@ A list with the following elements: Calculate operating characteristics for posterior probability method. It is assumed that the true response rate is \code{truep}. -The trial is stopped for efficacy if the posterior probability to be -above \code{p1} is larger than \code{tU}, and stopped for futility if the posterior +The trial is stopped for Efficacy if the posterior probability to be +above \code{p1} is larger than \code{tU}, and stopped for Futility if the posterior probability to be below \code{p0} is larger than \code{tL}: Stop criteria for Efficacy : @@ -79,9 +79,9 @@ Resulting operating characteristics include the following: \item \code{PrStopEarly}: probability to stop the trial early (before reaching the maximum sample size) \item \code{PrEarlyEff}: probability of Early Go decision -\item \code{PrEarlyFut}: probability to decide for Futility early +\item \code{PrEarlyFut}: probability of for Early Stop decision \item \code{PrEfficacy}: probability of Go decision -\item \code{PrFutility}: Probability of Stop decision +\item \code{PrFutility}: probability of Stop decision \item \code{PrGrayZone}: probability between Go and Stop ,"Evaluate" or Gray decision zone } } @@ -93,13 +93,12 @@ As default, \code{nnF} is set to the identical looks of \code{nnE}, and if \code \code{nnE = nnF} when wiggle and distance is applied. } \examples{ -# Three looks-- -# design details (example) -# multiple looks @ 10, 20, 30 patients -# True response rate of the treatment group=40\% -# Look for futility: P(response rate < 20\% )> 60\% -# Look for efficacy: P(response rate > 30\% )> 80\% -# prior of treatment arm parE= Beta(1,1) +# For three looks of 10, 20 and 30 we have the following assumptions : +# True response rate of the treatment group = 40\% +# The following are the Go and Stop rules respectively : +# Look for Efficacy: P(response rate > 30\% )> 80\% +# Look for Futility: P(response rate < 20\% )> 60\% +# Prior of treatment arm parE= Beta(1,1). res <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), sim = 1000, wiggle = TRUE, randomdist = NULL, nnF = c(10, 20, 30) @@ -107,7 +106,7 @@ res <- ocPostprob( res$oc -# Specify distance +# We specify the distance in this example. res <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), sim = 1000, wiggle = TRUE, randomdist = c(-1, 3), nnF = c(10, 20, 30) @@ -115,7 +114,7 @@ res <- ocPostprob( res$oc -# No Wiggle +# Here, nnE = nnF, and no wiggle room is allowed. Random distance also not supplied. res <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) @@ -123,7 +122,7 @@ res <- ocPostprob( res$oc -# Only one efficacy + many futility +# Here, we only have one Futility and Efficacy look or stop. res <- ocPostprob( nnE = c(10), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10) @@ -131,7 +130,7 @@ res <- ocPostprob( res$oc -# Only one futility +# Here, we only have one Futility but many Efficacy looks or stop. res <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10) diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index 37c5a67e..e0faae0d 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -1,22 +1,22 @@ -# get_distance (helper function) ---- -test_that("get_distance gives an error with one element numeric", { - expect_equal(get_distance(10), integer(0)) +# h_get_distance (helper function) ---- +test_that("h_get_distance gives an error with one element numeric", { + expect_equal(h_get_distance(10), integer(0)) }) -test_that("get_distance gives results within range", { +test_that("h_get_distance gives results within range", { set.seed(1989) nn <- c(10, 20, 30) - results <- get_distance(nn) - expect_numeric(results, lower = -min(nn) / 2, upper = 30, len = 2) # TO DO fix error + results <- h_get_distance(nn) + expect_numeric(results, lower = -min(nn) / 2, upper = 30, len = 2) }) -test_that("get_distance will give error with non sorted argument", { +test_that("h_get_distance gives an error with non sorted argument", { set.seed(1989) - expect_error(get_distance(c(30, 20, 10))) + expect_error(h_get_distance(c(30, 20, 10))) }) -# get_looks (helper function) ---- -test_that("get_looks gives correct results if input is identical", { +# h_get_looks (helper function) ---- +test_that("h_get_looks gives correct results if input is identical", { dist <- c(0, 5) results <- get_looks(dist = dist, nnE = c(10, 20, 30), nnF = c(10, 20, 30)) expect_equal(results$nnrE, results$nnrF) @@ -28,14 +28,13 @@ test_that("get_looks gives correct results if input is identical", { expect_equal(results$nnrE, results$nnrF) }) -# get_decision (helper function) -- -# Stop criteria for Efficacy : -# P_E(p > p1) > tU, where P_E(truep > 0.30) > 0.8 -# Stop criteria for Futility : -# P_E(p < p0) > tL, where P_E(truep > 0.20) > 0.5 -# It is a Go decision usually when the threshold to Go is Low +# h_get_decision (helper function) -- +# Here, the following rules are applied : +# Stop criteria for Efficacyas P_E(p > p1) > tU, where P_E(truep > 0.30) > 0.8 +# Stop criteria for Futility as P_E(p < p0) > tL, where P_E(truep > 0.20) > 0.5 +# There is a high probability of a Go decision when the threshold to Go is low. test_that("get_decision will give GO decision in favourable conditions", { - tmp <- get_decision( + tmp <- h_get_decision( nnr = c(10, 20, 30), truep = 0.5, p0 = 0.2, @@ -48,9 +47,9 @@ test_that("get_decision will give GO decision in favourable conditions", { expect_equal(tmp$decision, TRUE) }) -# get_oc ---- +# h_get_oc ---- test_that("the probability results of get_oc are less than 1", { - oc <- get_oc( + oc <- h_get_oc( all_sizes = sample(c(11, 14, 20), 10000, replace = TRUE), decision = sample(c(NA, TRUE, FALSE), 10000, replace = TRUE), nnrE = c(11, 14, 20), @@ -60,7 +59,7 @@ test_that("the probability results of get_oc are less than 1", { }) test_that("the ExpectedN is within range based on vector of looks", { - oc <- get_oc( + oc <- h_get_oc( all_sizes = sample(c(11, 14, 20), 10000, replace = TRUE), decision = sample(c(NA, TRUE, FALSE), 10000, replace = TRUE), nnrE = c(11, 14, 20), @@ -84,15 +83,15 @@ test_that("the PrFutility increases with increase futility looks", { set.seed(1989) res_fut <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), - sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) ) - res_fut$oc$PrFutility # 0.048 + res_fut$oc$PrFutility res_no_fut <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), - sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10) + sim = 5000, wiggle = FALSE, randomdist = NULL, nnF = c(10) ) - res_no_fut$oc$PrFutility # 0.031 + res_no_fut$oc$PrFutility expect_true(res_fut$oc$PrFutility > res_no_fut$oc$PrFutility) }) @@ -100,34 +99,35 @@ test_that("the PrFfficacy increases with increase Efficacy looks", { set.seed(1989) res_eff <- ocPostprob( nnE = c(30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), - sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(30) + sim = 5000, wiggle = FALSE, randomdist = NULL, nnF = c(30) ) - res_eff$oc$PrEfficacy # 0.691 + res_eff$oc$PrEfficacy res_more_eff <- ocPostprob( nnE = c(10, 20, 30), truep = 0.40, p0 = 0.20, p1 = 0.30, tL = 0.60, tU = 0.80, parE = c(1, 1), - sim = 1000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) + sim = 5000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) ) - res_more_eff$oc$PrEfficacy # 0.728 + res_more_eff$oc$PrEfficacy expect_true(res_more_eff$oc$PrEfficacy > res_more_eff$oc$PrEfficacy) }) -# expect equal with tolerance --- -#### P(ORR $\ge$ Min PP) must be high for going, we assume e.g. 70% for go -#### P(ORR $\ge$ Min PP) must be low for stopping, we assume e.g. 10% for go +# ocPostprob --- +# The following are the rules for Go and Stop and the corresponding +# number of responders and response rate, +# where P_E(truep >= 0.45) > 0.70 for a Go decision and +# where P_E(truep <= 0.45) > 0.90 for a Stop decision # Pre-calculation indicate that : -##### go criteria: 20 out of 40, means >= 50% response rate -##### stop criteria: 13 out of 40, means <= 32.5% response rate +# Go criteria: 20 out of 40, means >= 50% response rate +# Stop criteria: 13 out of 40, means <= 32.5% response rate. test_that("ocPostprob gives results that are within range to stats::pbinom", { set.seed(1989) res1 <- ocPostprob( nnE = 40, truep = 0.5, p0 = 0.45, p1 = 0.45, tL = 0.9, tU = 0.7, parE = c(1, 1), sim = 50000 ) - res1$oc$PrEfficacy # 0.5623 + expect_equal(res1$oc$PrEfficacy, 0.56226) p.go <- 1 - pbinom(q = 20 - 1, size = 40, prob = 0.5) - p.go # 0.5626853 - expect_true((p.go - res1$oc$PrEfficacy) < 1e-3) + expect_true(abs(p.go - res1$oc$PrEfficacy) < 1e-3) }) test_that("ocPostprob gives results that are within range to stats::pbinom", { @@ -136,8 +136,8 @@ test_that("ocPostprob gives results that are within range to stats::pbinom", { nnE = 40, truep = 0.5, p0 = 0.45, p1 = 0.45, tL = 0.9, tU = 0.7, parE = c(1, 1), sim = 50000 ) - res1$oc$PrFutility # 0.01998 + expect_equal(res1$oc$PrFutility, 0.01998) p.stop <- pbinom(q = 13, size = 40, prob = 0.5) - p.stop # 0.01923865 - expect_true((p.stop - res1$oc$PrFutility) < 1e-2) + p.stop + expect_true(abs(p.stop - res1$oc$PrFutility) < 1e-2) }) From 35126ab18724a1f12b3381c88fa8f70406bfa4b6 Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Thu, 5 Oct 2023 10:16:53 +0000 Subject: [PATCH 070/106] [skip actions] Roxygen Man Pages Auto Update --- man/ocPostprob.Rd | 4 ---- 1 file changed, 4 deletions(-) diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index 70ba1aa1..123d1aa6 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -79,11 +79,7 @@ Resulting operating characteristics include the following: \item \code{PrStopEarly}: probability to stop the trial early (before reaching the maximum sample size) \item \code{PrEarlyEff}: probability of Early Go decision -<<<<<<< HEAD \item \code{PrEarlyFut}: probability of for Early Stop decision -======= -\item \code{PrEarlyFut}: probability of for Early Futility decision ->>>>>>> 14_ocPostProb \item \code{PrEfficacy}: probability of Go decision \item \code{PrFutility}: probability of Stop decision \item \code{PrGrayZone}: probability between Go and Stop ,"Evaluate" or Gray decision zone From 76a430f4eb8fc4d455ca5dc91c5719b5851e65ce Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 25 Oct 2023 16:33:39 +0200 Subject: [PATCH 071/106] clean --- R/postprobDist.R | 60 ++++++++++++++++++------------ inst/WORDLIST | 1 + man/postprobDist.Rd | 46 +++++++++++------------ tests/testthat/test-postprobDist.R | 1 + 4 files changed, 61 insertions(+), 47 deletions(-) create mode 100644 tests/testthat/test-postprobDist.R diff --git a/R/postprobDist.R b/R/postprobDist.R index 728752e5..ae59297f 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -4,48 +4,60 @@ NULL #' Compute the posterior probability with beta prior on SOC #' +#' @description `r lifecycle::badge("experimental")` +#' #' Using the approach by Thall and Simon (Biometrics, 1994), evaluate the -#' posterior probability of having Pr(P_E > P_S + delta | data) (but see below -#' for relative delta margin). Both for the new treatment E as well as for the -#' SOC S data might be available. However the default is that no data is -#' available for the SOC, corresponding to the single arm trial situation. Note +#' posterior probability of having `Pr(P_E > P_S + delta | data)` (but see below +#' for relative delta margin). Both for the new treatment `E` as well as for the +#' Standard of Care (SOC): `S` data might be available. However the default is that no data is +#' available for the `SOC`, corresponding to the single arm trial situation. Note #' that a uniform prior is the useful default for the treatment proportion, -#' while in the single arm trial an informative prior on the SOC proportion is +#' while in the single arm trial an informative prior on the `SOC` proportion is #' useful. #' -#' Beta mixture prior can be specified for the treatment (\code{parE} -#' and \code{weights} parameters) and control proportion (\code{parS} and -#' \code{weightsS} parameters), see \code{\link{postprob}} for details. Note +#' Beta mixture prior can be specified for the treatment `parE` +#' and `weights` typedeters) and control proportion `parS` and +#' `weightsS` typedeters), see `postprob` for details. Note #' that being able to specify a beta mixture prior also on the control #' treatment is e.g. important for the futility decision making (see the -#' \code{\link{oc2}} code). +#' `oc2` code). #' -#' @param x number of successes (in the treatment group). Note that \code{x} -#' can be a vector. -#' @param n number of patients (in the treatment group) -#' @param xS number of successes in the SOC group (default: 0) -#' @param nS number of patients in the SOC group (default: 0) -#' @param delta margin by which the response rate in the treatment group should +#' @typed x : +#' number of successes (in the treatment group). Note that `x` can be a vector. +#' @typed n : +#' number of patients (in the treatment group) +#' @typed xS : +#' number of successes in the SOC group (default: 0) +#' @typed nS : +#' number of patients in the SOC group (default: 0) +#' @typed delta : +#' margin by which the response rate in the treatment group should #' be better than in the SOC group (default: 0) -#' @param relativeDelta should the delta be relative? (not default). If this is -#' \code{TRUE}, then a relative delta is used. This means we want to have +#' @typed relativeDelta : +#' should the delta be relative? (not default). If this is +#' `TRUE`, then a relative delta is used. This means we want to have #' response at least in delta proportion of the SOC non-responding patients. #' Non-responding patients rate is 1 - P_S, and we want to have P_S + (1 - P_S) #' * delta response rate (at least) in the treatment. That is, we evaluate the #' posterior probability Pr(P_E > P_S + (1 - P_S) * delta | data). -#' @param parE the beta parameters matrix, with K rows and 2 columns, -#' corresponding to the beta parameters of the K components. default is a +#' @typed parE : +#' the beta typedeters matrix, with K rows and 2 columns, +#' corresponding to the beta typedeters of the K components. default is a #' uniform prior. -#' @param weights the mixture weights of the beta mixture prior. Default are +#' @typed weights : +#' the mixture weights of the beta mixture prior. Default are #' uniform weights across mixture components. -#' @param parS beta parameters for the SOC group (default: uniform) -#' @param weightsS weights for the SOC group (default: uniform) +#' @typed parS : +#' beta typedeters for the SOC group (default: uniform) +#' @typed weightsS : +#' weights for the SOC group (default: uniform) #' @return the posterior probability #' #' @example examples/postprobDist.R #' @export postprobDist <- function(x, n, - xS = 0, nS = 0, + xS = 0, + nS = 0, delta = 0, relativeDelta = FALSE, parE = c(1, 1), @@ -80,7 +92,7 @@ postprobDist <- function(x, n, weightsS <- rep(1, nrow(parS)) } - ## compute updated beta parameters + ## compute updated beta typedeters activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights) controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) diff --git a/inst/WORDLIST b/inst/WORDLIST index b8b4f97e..ced2bc58 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -163,6 +163,7 @@ todo tT TtR tU +typedeters UciL USUBJID VAD diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index 4658f604..260a03a8 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -18,19 +18,18 @@ postprobDist( ) } \arguments{ -\item{x}{number of successes (in the treatment group). Note that \code{x} -can be a vector.} +\item{x}{(``):\cr number of successes (in the treatment group). Note that \code{x} can be a vector.} -\item{n}{number of patients (in the treatment group)} +\item{n}{(``):\cr number of patients (in the treatment group)} -\item{xS}{number of successes in the SOC group (default: 0)} +\item{xS}{(``):\cr number of successes in the SOC group (default: 0)} -\item{nS}{number of patients in the SOC group (default: 0)} +\item{nS}{(``):\cr number of patients in the SOC group (default: 0)} -\item{delta}{margin by which the response rate in the treatment group should +\item{delta}{(``):\cr margin by which the response rate in the treatment group should be better than in the SOC group (default: 0)} -\item{relativeDelta}{should the delta be relative? (not default). If this is +\item{relativeDelta}{(``):\cr should the delta be relative? (not default). If this is \code{TRUE}, then a relative delta is used. This means we want to have response at least in delta proportion of the SOC non-responding patients. Non-responding patients rate is 1 - P_S, and we want to have P_S + (1 - P_S) @@ -39,37 +38,38 @@ Non-responding patients rate is 1 - P_S, and we want to have P_S + (1 - P_S) posterior probability Pr(P_E > P_S + (1 - P_S) * delta | data). }} -\item{parE}{the beta parameters matrix, with K rows and 2 columns, -corresponding to the beta parameters of the K components. default is a +\item{parE}{(``):\cr the beta typedeters matrix, with K rows and 2 columns, +corresponding to the beta typedeters of the K components. default is a uniform prior.} -\item{weights}{the mixture weights of the beta mixture prior. Default are +\item{weights}{(``):\cr the mixture weights of the beta mixture prior. Default are uniform weights across mixture components.} -\item{parS}{beta parameters for the SOC group (default: uniform)} +\item{parS}{(``):\cr beta typedeters for the SOC group (default: uniform)} -\item{weightsS}{weights for the SOC group (default: uniform)} +\item{weightsS}{(``):\cr weights for the SOC group (default: uniform)} } \value{ the posterior probability } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + Using the approach by Thall and Simon (Biometrics, 1994), evaluate the -posterior probability of having Pr(P_E > P_S + delta | data) (but see below -for relative delta margin). Both for the new treatment E as well as for the -SOC S data might be available. However the default is that no data is -available for the SOC, corresponding to the single arm trial situation. Note +posterior probability of having \code{Pr(P_E > P_S + delta | data)} (but see below +for relative delta margin). Both for the new treatment \code{E} as well as for the +Standard of Care (SOC): \code{S} data might be available. However the default is that no data is +available for the \code{SOC}, corresponding to the single arm trial situation. Note that a uniform prior is the useful default for the treatment proportion, -while in the single arm trial an informative prior on the SOC proportion is +while in the single arm trial an informative prior on the \code{SOC} proportion is useful. -} -\details{ -Beta mixture prior can be specified for the treatment (\code{parE} -and \code{weights} parameters) and control proportion (\code{parS} and -\code{weightsS} parameters), see \code{\link{postprob}} for details. Note + +Beta mixture prior can be specified for the treatment \code{parE} +and \code{weights} typedeters) and control proportion \code{parS} and +\code{weightsS} typedeters), see \code{postprob} for details. Note that being able to specify a beta mixture prior also on the control treatment is e.g. important for the futility decision making (see the -\code{\link{oc2}} code). +\code{oc2} code). } \examples{ ## example similar to Lee and Liu: diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R new file mode 100644 index 00000000..556e443a --- /dev/null +++ b/tests/testthat/test-postprobDist.R @@ -0,0 +1 @@ +postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) From c83eeab33e21e02a11c5566552e126d55624e222 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 25 Oct 2023 16:37:57 +0200 Subject: [PATCH 072/106] merge --- man/postprobOld.Rd | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/man/postprobOld.Rd b/man/postprobOld.Rd index e935456f..08b2b0ce 100644 --- a/man/postprobOld.Rd +++ b/man/postprobOld.Rd @@ -30,15 +30,3 @@ with default set to be a uniform or beta(1,1). We observed \code{x} successes in n trials and so the posterior is \code{P_E | data ~ beta(a + x, b + n - x)}. } -\examples{ -# Example taken from Lee & Liu (2006) -# We observed 16 successes out of 23 patients # should we write this in the documentation -# We set a threshold of 0.60 -# Assume a beta(0.6,0.4) prior for P_E -# Posterior will be a beta(16.6,22.8), Pr(P_E > p | data) = 0.8358808 - - -# Example taken from Lee and Liu (2006) -postprobBeta(x = 16, n = 23, p = 0.60, a = 0.6, b = 0.4) -# Interpretation : The probability 16 of 23 successes is greater than 60 \% threshold is approximately 84 \% -} From b6958c92db6a1887145b4c8121d8ceb8d3bf6dd0 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 27 Oct 2023 16:43:27 +0200 Subject: [PATCH 073/106] clean --- NAMESPACE | 3 +- R/postprob.R | 79 ++++++++++++++++++--------------- R/postprobDist.R | 104 +++++++++++++++++++++++--------------------- man/postprob.Rd | 28 +++++------- man/postprobBeta.Rd | 44 +++++++++++++++++++ man/postprobDist.Rd | 18 ++++---- man/postprobOld.Rd | 32 -------------- 7 files changed, 165 insertions(+), 143 deletions(-) create mode 100644 man/postprobBeta.Rd delete mode 100644 man/postprobOld.Rd diff --git a/NAMESPACE b/NAMESPACE index 42f1866e..591960ce 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,8 +24,8 @@ export(plotBounds) export(plotDecision) export(plotOc) export(postprob) +export(postprobBeta) export(postprobDist) -export(postprobOld) export(predprob) export(predprobDist) export(qbetaMix) @@ -53,7 +53,6 @@ importFrom(stats,dbeta) importFrom(stats,dbinom) importFrom(stats,integrate) importFrom(stats,optimize) -importFrom(stats,pbeta) importFrom(stats,quantile) importFrom(stats,rbeta) importFrom(stats,rbinom) diff --git a/R/postprob.R b/R/postprob.R index 22cf7c38..4fbb71b9 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -12,23 +12,31 @@ NULL #' We observed `x` successes in n trials and so the posterior is #' `P_E | data ~ beta(a + x, b + n - x)`. #' -#' @param x number of successes -#' @param n number of patients -#' @param p threshold -#' @param a first parameter of the beta prior (successes) -#' @param b second parameter of the beta prior (failures) +#' @typed x : numeric +#' number of successes. +#' @typed n : number +#' number of patients. +#' @typed p : number +#' threshold set to compute posterior probability. +#' @typed a : matrix +#' first parameter `alpha` of the beta prior (successes). +#' @typed b : matrix +#' second parameter `beta` of the beta prior (failures). #' @return The posterior probability that the response rate P_E is above a threshold p. #' -#' @importFrom stats pbeta -#' -#' @example examples/postprobOld.R +#' @example examples/postprobBeta.R #' @export -postprobOld <- function(x, n, p, a = 1, b = 1) { +postprobBeta <- function(x, n, p, a = 1, b = 1) { + assert_number(n, lower = 0, finite = TRUE) + assert_numeric(x, lower = 0, upper = n, finite = TRUE) + assert_number(a, finite = TRUE) + assert_number(b, finite = TRUE) + assert_number(p, lower = 0, upper = 1, finite = TRUE) stats::pbeta(p, a + x, b + n - x, lower.tail = FALSE) } -#' Compute the posterior probability to be above threshold, -#' with a beta mixture prior on the response rate. + +#' Posterior Probability of Efficacy Given Beta-Mixture Prior #' #' @description `r lifecycle::badge("experimental")` #' @@ -42,39 +50,42 @@ postprobOld <- function(x, n, p, a = 1, b = 1) { #' Posterior is again a mixture of beta priors, with updated mixture weights #' and beta parameters. #' -#' @param x number of successes -#' @param n number of patients -#' @param p threshold -#' @param parE the beta parameters matrix, with K rows and 2 columns, -#' corresponding to the beta parameters of the K components. Default is a -#' uniform prior. -#' @param weights the mixture weights of the beta mixture prior. Default are -#' uniform weights across mixture components. -#' @param betamixPost optional result of \code{\link{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) -#' @param log.p Return the log of the probability? (default: FALSE) -#' @return The posterior probability that the response rate P_E is above p. -#' -#' @note that `x` can be a vector. +#' @typed x : numeric +#' number of successes. +#' @typed n : number +#' number of patients. +#' @typed p : number +#' threshold that `P_E` is measured. +#' @typed parE : matrix +#' the beta parameters matrix, with `K` rows and 2 columns, +#' corresponding to the beta parameters of the `K` components. +#' Default is a uniform prior. +#' @typed weights : vector +#' The mixture weights of the beta mixture prior. Default are +#' uniform weights across mixture components. +#' @typed betamixPost : matrix +#' optional result of `[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 +#' whether to return the log of the probability +#' @return The posterior probability that the response rate `P_E` is above `p`. #' #' @example examples/postprob.R #' @export postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALSE) { if (missing(betamixPost)) { - # If betamixPost is missing, then we would use the default parE + assert_flag(log.p) if (is.vector(parE)) { - # Here there is only one component in the parE vector. + # Here there is only one component. assert_true(identical(length(parE), 2L)) - # To get matrix with one row, we transpose parE. + # To get matrix with one row. parE <- t(parE) } - - # If prior weights of the beta mixture are not supplied, weights are given + assert_matrix(parE) if (missing(weights)) { weights <- rep(1, nrow(parE)) } - betamixPost <- getBetamixPost( x = x, n = n, @@ -82,8 +93,8 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS weights = weights ) } - - # Here, we compute the survival function at p, i.e. 1 - cdf at p as lower.tail = FALSE: + assert_list(betamixPost) + assert_names(names(betamixPost), identical.to = c("par", "weights")) ret <- with( betamixPost, pbetaMix(q = p, par = par, weights = weights, lower.tail = FALSE) diff --git a/R/postprobDist.R b/R/postprobDist.R index ae59297f..a06d20c4 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -16,8 +16,8 @@ NULL #' useful. #' #' Beta mixture prior can be specified for the treatment `parE` -#' and `weights` typedeters) and control proportion `parS` and -#' `weightsS` typedeters), see `postprob` for details. Note +#' and `weights` parameters) and control proportion `parS` and +#' `weightsS` parameters), see `postprob` for details. Note #' that being able to specify a beta mixture prior also on the control #' treatment is e.g. important for the futility decision making (see the #' `oc2` code). @@ -32,23 +32,23 @@ NULL #' number of patients in the SOC group (default: 0) #' @typed delta : #' margin by which the response rate in the treatment group should -#' be better than in the SOC group (default: 0) +#' be better than in the SOC group (default: 0) #' @typed relativeDelta : #' should the delta be relative? (not default). If this is -#' `TRUE`, then a relative delta is used. This means we want to have -#' response at least in delta proportion of the SOC non-responding patients. -#' Non-responding patients rate is 1 - P_S, and we want to have P_S + (1 - P_S) -#' * delta response rate (at least) in the treatment. That is, we evaluate the -#' posterior probability Pr(P_E > P_S + (1 - P_S) * delta | data). +#' `TRUE`, then a relative delta is used. This means we want to have +#' response at least in delta proportion of the SOC non-responding patients. +#' Non-responding patients rate is `1 - P_S`, and we want to have +#' `P_S + (1 - P_S)` * delta response rate (at least) in the treatment. That is, we evaluate the +#' posterior probability `Pr(P_E > P_S + (1 - P_S) * delta | data)`. #' @typed parE : -#' the beta typedeters matrix, with K rows and 2 columns, -#' corresponding to the beta typedeters of the K components. default is a -#' uniform prior. +#' the beta parameters matrix, with K rows and 2 columns, +#' corresponding to the beta parameters of the K components. default is a +#' uniform prior. #' @typed weights : #' the mixture weights of the beta mixture prior. Default are #' uniform weights across mixture components. #' @typed parS : -#' beta typedeters for the SOC group (default: uniform) +#' beta parameters for the SOC group (default: uniform) #' @typed weightsS : #' weights for the SOC group (default: uniform) #' @return the posterior probability @@ -64,78 +64,85 @@ postprobDist <- function(x, n, weights, parS = c(1, 1), weightsS) { - ## if parE is a vector => situation where there is only one component - if (is.vector(parE)) { - ## check that it has exactly two entries - stopifnot(identical(length(parE), 2L)) - - ## and transpose to matrix with one row - parE <- t(parE) - } - - ## if prior weights of the beta mixture are not supplied - if (missing(weights)) { - weights <- rep(1, nrow(parE)) - } - - ## if parS is a vector => situation where there is only one component - if (is.vector(parS)) { - ## check that it has exactly two entries - stopifnot(identical(length(parS), 2L)) - - ## and transpose to matrix with one row + if (is.vector(parE)) { # This is for the simple case beta. + assert_true(identical(length(parE), 2L)) + assert_true(identical(length(parE), 2L)) parS <- t(parS) } - - ## if prior weights of the beta mixture are not supplied if (missing(weightsS)) { weightsS <- rep(1, nrow(parS)) } + assert_number(weightsS, lower = 0, finite = TRUE) - ## compute updated beta typedeters activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights) controlBetamixPost <- 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): + assert_names(names(activeBetamixPost), identical.to = c("par", "weights")) + assert_names(names(controlBetamixPost), identical.to = c("par", "weights")) + # use numerical integration to compute this probability, as given on p.338 + # in the article by Thall and Simon (1994): integrand <- if (relativeDelta) { - function(p) { + function(p) { # TODO a separate helper function cdf <- postprob( x = x, p = (1 - delta) * p + delta, betamixPost = activeBetamixPost ) - pdf <- with( controlBetamixPost, dbetaMix(x = p, par = par, weights = weights) ) - return(cdf * pdf) } + + ### a helper function for above if relativeDelta == TRUE + integrant_relDelta <- function(p) { + cdf <- postprob( + x = x, + p = (1 - delta) * p + delta, + betamixPost = activeBetamixPost + ) + pdf <- with( + controlBetamixPost, + dbetaMix(x = p, par = par, weights = weights) + ) + cdf * pdf + } + ### } else { - function(p) { + function(p) { # TODO a separate helper function cdf <- postprob( x = x, p = p + delta, betamixPost = activeBetamixPost ) - pdf <- with( controlBetamixPost, dbetaMix(x = p, par = par, weights = weights) ) - return(cdf * pdf) } + ### a helper function for above if relativeDelta == TRUE + integrand_p <- function(p) { + cdf <- postprob( + x = x, + p = p + delta, + betamixPost = activeBetamixPost + ) + pdf <- with( + controlBetamixPost, + dbetaMix(x = p, par = par, weights = weights) + ) + cdf * pdf + } + ### } - - ## do the integration. be careful to cover the region where there can - ## really be any non-zero values. I.e. only integrate over the region where - ## the beta density of the control is non-zero. + # do the integration. be careful to cover the region where there can + # really be any non-zero values. I.e. only integrate over the region where + # the beta density of the control is non-zero. epsilon <- 1e-13 - bounds <- with( + bounds <- with( # TO DO function ? controlBetamixPost, qbetaMix( p = c(epsilon, 1 - epsilon), @@ -156,7 +163,6 @@ postprobDist <- function(x, n, bounds[2] ) ) - if (intRes$message == "OK") { return(intRes$value) } else { diff --git a/man/postprob.Rd b/man/postprob.Rd index e1dbe8fc..124791c3 100644 --- a/man/postprob.Rd +++ b/man/postprob.Rd @@ -2,33 +2,32 @@ % Please edit documentation in R/postprob.R \name{postprob} \alias{postprob} -\title{Compute the posterior probability to be above threshold, -with a beta mixture prior on the response rate.} +\title{Posterior Probability of Efficacy Given Beta-Mixture Prior} \usage{ postprob(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALSE) } \arguments{ -\item{x}{number of successes} +\item{x}{(\code{numeric}):\cr number of successes.} -\item{n}{number of patients} +\item{n}{(\code{number}):\cr number of patients.} -\item{p}{threshold} +\item{p}{(\code{number}):\cr threshold that \code{P_E} is measured.} -\item{parE}{the beta parameters matrix, with K rows and 2 columns, -corresponding to the beta parameters of the K components. Default is a -uniform prior.} +\item{parE}{(\code{matrix}):\cr the beta parameters matrix, with \code{K} rows and 2 columns, +corresponding to the beta parameters of the \code{K} components. +Default is a uniform prior.} -\item{weights}{the mixture weights of the beta mixture prior. Default are +\item{weights}{(\code{vector}):\cr The mixture weights of the beta mixture prior. Default are uniform weights across mixture components.} -\item{betamixPost}{optional result of \code{\link{getBetamixPost}} in order +\item{betamixPost}{(\code{matrix}):\cr optional result of \verb{[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)} +the other arguments (except \code{p} and \code{log.p} of course).} -\item{log.p}{Return the log of the probability? (default: FALSE)} +\item{log.p}{(\code{number}):\cr whether to return the log of the probability} } \value{ -The posterior probability that the response rate P_E is above p. +The posterior probability that the response rate \code{P_E} is above \code{p}. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} @@ -43,9 +42,6 @@ We observed \code{x} successes in n trials. Posterior is again a mixture of beta priors, with updated mixture weights and beta parameters. } -\note{ -that \code{x} can be a vector. -} \examples{ # Example taken from Lee and Liu (2006) # diff --git a/man/postprobBeta.Rd b/man/postprobBeta.Rd new file mode 100644 index 00000000..58795e3a --- /dev/null +++ b/man/postprobBeta.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/postprob.R +\name{postprobBeta} +\alias{postprobBeta} +\title{Posterior Probability of Efficacy Given Beta Prior} +\usage{ +postprobBeta(x, n, p, a = 1, b = 1) +} +\arguments{ +\item{x}{(\code{numeric}):\cr number of successes.} + +\item{n}{(\code{number}):\cr number of patients.} + +\item{p}{(\code{number}):\cr threshold set to compute posterior probability.} + +\item{a}{(\code{matrix}):\cr first parameter \code{alpha} of the beta prior (successes).} + +\item{b}{(\code{matrix}):\cr second parameter \code{beta} of the beta prior (failures).} +} +\value{ +The posterior probability that the response rate P_E is above a threshold p. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +Compute the posterior probability to be above threshold assuming a beta prior +on the response rate such that \code{Pr(P_E > p | data)}. Prior is \code{P_E ~ beta(a, b)}, +with default set to be a uniform or beta(1,1). + +We observed \code{x} successes in n trials and so the posterior is +\code{P_E | data ~ beta(a + x, b + n - x)}. +} +\examples{ +# Example taken from Lee & Liu (2006) +# We observed 16 successes out of 23 patients # should we write this in the documentation +# We set a threshold of 0.60 +# Assume a beta(0.6,0.4) prior for P_E +# Posterior will be a beta(16.6,22.8), Pr(P_E > p | data) = 0.8358808 + + +# Example taken from Lee and Liu (2006) +postprobBeta(x = 16, n = 23, p = 0.60, a = 0.6, b = 0.4) +# Interpretation : The probability 16 of 23 successes is greater than 60 \% threshold is approximately 84 \% +} diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index 260a03a8..64c63aab 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -32,20 +32,18 @@ be better than in the SOC group (default: 0)} \item{relativeDelta}{(``):\cr should the delta be relative? (not default). If this is \code{TRUE}, then a relative delta is used. This means we want to have response at least in delta proportion of the SOC non-responding patients. -Non-responding patients rate is 1 - P_S, and we want to have P_S + (1 - P_S) -\itemize{ -\item delta response rate (at least) in the treatment. That is, we evaluate the -posterior probability Pr(P_E > P_S + (1 - P_S) * delta | data). -}} +Non-responding patients rate is `1 - P_S`, and we want to have +`P_S + (1 - P_S)` * delta response rate (at least) in the treatment. That is, we evaluate the +posterior probability `Pr(P_E > P_S + (1 - P_S) * delta | data)`.} -\item{parE}{(``):\cr the beta typedeters matrix, with K rows and 2 columns, -corresponding to the beta typedeters of the K components. default is a +\item{parE}{(``):\cr the beta parameters matrix, with K rows and 2 columns, +corresponding to the beta parameters of the K components. default is a uniform prior.} \item{weights}{(``):\cr the mixture weights of the beta mixture prior. Default are uniform weights across mixture components.} -\item{parS}{(``):\cr beta typedeters for the SOC group (default: uniform)} +\item{parS}{(``):\cr beta parameters for the SOC group (default: uniform)} \item{weightsS}{(``):\cr weights for the SOC group (default: uniform)} } @@ -65,8 +63,8 @@ while in the single arm trial an informative prior on the \code{SOC} proportion useful. Beta mixture prior can be specified for the treatment \code{parE} -and \code{weights} typedeters) and control proportion \code{parS} and -\code{weightsS} typedeters), see \code{postprob} for details. Note +and \code{weights} parameters) and control proportion \code{parS} and +\code{weightsS} parameters), see \code{postprob} for details. Note that being able to specify a beta mixture prior also on the control treatment is e.g. important for the futility decision making (see the \code{oc2} code). diff --git a/man/postprobOld.Rd b/man/postprobOld.Rd deleted file mode 100644 index 08b2b0ce..00000000 --- a/man/postprobOld.Rd +++ /dev/null @@ -1,32 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/postprob.R -\name{postprobOld} -\alias{postprobOld} -\title{Posterior Probability of Efficacy Given Beta Prior} -\usage{ -postprobOld(x, n, p, a = 1, b = 1) -} -\arguments{ -\item{x}{number of successes} - -\item{n}{number of patients} - -\item{p}{threshold} - -\item{a}{first parameter of the beta prior (successes)} - -\item{b}{second parameter of the beta prior (failures)} -} -\value{ -The posterior probability that the response rate P_E is above a threshold p. -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} - -Compute the posterior probability to be above threshold assuming a beta prior -on the response rate such that \code{Pr(P_E > p | data)}. Prior is \code{P_E ~ beta(a, b)}, -with default set to be a uniform or beta(1,1). - -We observed \code{x} successes in n trials and so the posterior is -\code{P_E | data ~ beta(a + x, b + n - x)}. -} From 136c4d801aacd8bb91aaee9036489c6205662515 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 2 Nov 2023 01:15:27 +0100 Subject: [PATCH 074/106] works --- R/postprobDist.R | 245 +++++++++++++++++------------ examples/postprobDist.R | 16 +- inst/WORDLIST | 1 + man/h_get_bounds.Rd | 25 +++ man/h_integrand.Rd | 19 +++ man/h_integrand_relDelta.Rd | 18 +++ man/postprobDist.Rd | 76 ++++++--- tests/testthat/test-postprobDist.R | 78 ++++++++- 8 files changed, 340 insertions(+), 138 deletions(-) create mode 100644 man/h_get_bounds.Rd create mode 100644 man/h_integrand.Rd create mode 100644 man/h_integrand_relDelta.Rd diff --git a/R/postprobDist.R b/R/postprobDist.R index a06d20c4..4ff101d4 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -2,6 +2,83 @@ #' @include postprob.R NULL + +#' The Posterior Beta Mixture Integrand based on `delta` +#' +#' The helper function to generate Integrand function given relative Delta. +#' +#' @typed p : number +#' probability of success or response rate of standard of care or `SOC` group. +#' +#' @return An R function that is an argument for `[stats::integrate()]`. +#' +#' @keywords internal +h_integrand_relDelta <- function(p) { + cdf <- postprob( + x = x, + p = (1 - delta) * p + delta, + betamixPost = activeBetamixPost + ) + pdf <- with( + controlBetamixPost, + dbetaMix(x = p, par = par, weights = weights) + ) + cdf * pdf +} + +#' The Posterior Beta Mixture Integrand when relative Delta base on `p` +#' +#' The helper function to generate Integrand function when relative Delta not given. +#' A numerical integration to compute this probability is given on p.338 +# in the article by Thall and Simon (1994, Biometrics): +#' +#' @inheritParams h_integrand_relDelta +#' +#' @return An R function that is an argument for `[stats::integrate()]`. +#' +#' @keywords internal +h_integrand <- function(p) { + cdf <- postprob( + x = x, + p = p + delta, + betamixPost = activeBetamixPost + ) + pdf <- with( + controlBetamixPost, + dbetaMix(x = p, par = par, weights = weights) + ) + cdf * pdf +} + +#' Generating bounds for the integration of Beta Mixture Posterior +#' +#' Using the quantile of the Beta Mixture Distribution from parameters given by standard of care `SOC` or +#' experimental group `E` to determine bounds as inputs to `[stats::integrate()]` +#' +#' @typed betamixPost : list +#' arguments of `par`and `weights` of Beta Mixture Posterior in format list. see `[getBetaMix]` +#' @typed par : matrix +#' the beta parameters matrix, with `K` rows and 2 columns, +#' corresponding to the beta parameters of the `K` components. +#' @typed weights : vector +#' The mixture weights of the beta mixture prior. Default are +#' uniform weights across mixture components. +#' +#' @return Integrand function +#' +#' @keywords internal +#' +h_get_bounds <- function(betamixPost) { + with( + betamixPost, + qbetaMix( + p = c(epsilon, 1 - epsilon), + par = par, + weights = weights + ) + ) +} + #' Compute the posterior probability with beta prior on SOC #' #' @description `r lifecycle::badge("experimental")` @@ -15,6 +92,7 @@ NULL #' while in the single arm trial an informative prior on the `SOC` proportion is #' useful. #' +#' #' Beta mixture prior can be specified for the treatment `parE` #' and `weights` parameters) and control proportion `parS` and #' `weightsS` parameters), see `postprob` for details. Note @@ -22,149 +100,110 @@ NULL #' treatment is e.g. important for the futility decision making (see the #' `oc2` code). #' -#' @typed x : -#' number of successes (in the treatment group). Note that `x` can be a vector. -#' @typed n : -#' number of patients (in the treatment group) -#' @typed xS : -#' number of successes in the SOC group (default: 0) -#' @typed nS : +#' @typed x : vector +#' vector of success counts in the treatment group. Vector of minimum length of 1. +#' @typed n : number +#' number of patients (in the treatment group). +#' @typed xS : vector +#' vector of success counts in the SOC group (default: 0). Vector of minimum length of 1. +#' @typed nS : number #' number of patients in the SOC group (default: 0) -#' @typed delta : +#' @typed delta : number #' margin by which the response rate in the treatment group should -#' be better than in the SOC group (default: 0) -#' @typed relativeDelta : -#' should the delta be relative? (not default). If this is -#' `TRUE`, then a relative delta is used. This means we want to have -#' response at least in delta proportion of the SOC non-responding patients. -#' Non-responding patients rate is `1 - P_S`, and we want to have -#' `P_S + (1 - P_S)` * delta response rate (at least) in the treatment. That is, we evaluate the -#' posterior probability `Pr(P_E > P_S + (1 - P_S) * delta | data)`. -#' @typed parE : +#' be better than in the SOC group (default: 0). Must be >= `0`. see @note. +#' ? response rate in delta proportion of the SOC non-responding patients. +#' @typed relativeDelta : flag +#' If `TRUE`, then a `relativeDelta` is used. Represents that a minimum +#' response rate in magnitude of `delta` of the SOC non-responding patients. see @note. +#' @typed parE : matrix #' the beta parameters matrix, with K rows and 2 columns, #' corresponding to the beta parameters of the K components. default is a #' uniform prior. -#' @typed weights : +#' @typed weights : matrix #' the mixture weights of the beta mixture prior. Default are -#' uniform weights across mixture components. -#' @typed parS : +#' uniform weights across mixture components. +#' @typed parS : matrix #' beta parameters for the SOC group (default: uniform) -#' @typed weightsS : +#' @typed weightsS : matrix #' weights for the SOC group (default: uniform) -#' @return the posterior probability +#' @typed epsilon : # TODO +#' # do the integration. be careful to cover the region where there can +# really be any non-zero values. I.e. only integrate over the region where +# the beta density of the control is non-zero. +#' @return The posterior probability +#' +#' +#' @note on `relative Delta` and `delta`. +#' +#' When `relativeDelta = TRUE`, then it is assumed that `delta != 0`. +#' +#' Given `delta != 0`, it is assumed that : +#' - The posterior is calculate on `p + delta`. +#' - `P_S` is the response rate of the SOC group or `p`. +#' - `1-P_S` is the non-response rate of the SOC group. +#' - The treatment group's response rate is assumed to be greater than +#' `P_S + (1-P_S)`. +#' - Delta is assumed to be the difference between `P_S` and `1-P_S` +#' - It is desirable to achieve a minimum response rate of +#' `P_S + (1 - P_S)*delta` response rate in the treatment group. +#' - The expression for posterior probability is thus: +#' `Pr(P_E > P_S + (1 - P_S) * delta | data)`. +#' +#' If `delta = 0` : +#' - The default `delta = 0` is assumed. +#' - `p` is the minimum response rate of which the posterior is calculate on. #' #' @example examples/postprobDist.R #' @export + postprobDist <- function(x, n, - xS = 0, - nS = 0, + xS = 0, nS = 0, delta = 0, relativeDelta = FALSE, parE = c(1, 1), weights, parS = c(1, 1), weightsS) { - if (is.vector(parE)) { # This is for the simple case beta. - assert_true(identical(length(parE), 2L)) + if (is.vector(parE)) { assert_true(identical(length(parE), 2L)) + parE <- t(parE) + } + if (is.vector(parS)) { + assert_true(identical(length(parS), 2L)) parS <- t(parS) } + if (missing(weights)) { + weights <- rep(1, nrow(parE)) + } if (missing(weightsS)) { weightsS <- rep(1, nrow(parS)) } - assert_number(weightsS, lower = 0, finite = TRUE) - activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights) controlBetamixPost <- 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")) - # use numerical integration to compute this probability, as given on p.338 - # in the article by Thall and Simon (1994): - integrand <- - if (relativeDelta) { - function(p) { # TODO a separate helper function - cdf <- postprob( - x = x, - p = (1 - delta) * p + delta, - betamixPost = activeBetamixPost - ) - pdf <- with( - controlBetamixPost, - dbetaMix(x = p, par = par, weights = weights) - ) - return(cdf * pdf) - } - - ### a helper function for above if relativeDelta == TRUE - integrant_relDelta <- function(p) { - cdf <- postprob( - x = x, - p = (1 - delta) * p + delta, - betamixPost = activeBetamixPost - ) - pdf <- with( - controlBetamixPost, - dbetaMix(x = p, par = par, weights = weights) - ) - cdf * pdf - } - ### - } else { - function(p) { # TODO a separate helper function - cdf <- postprob( - x = x, - p = p + delta, - betamixPost = activeBetamixPost - ) - pdf <- with( - controlBetamixPost, - dbetaMix(x = p, par = par, weights = weights) - ) - return(cdf * pdf) - } - ### a helper function for above if relativeDelta == TRUE - integrand_p <- function(p) { - cdf <- postprob( - x = x, - p = p + delta, - betamixPost = activeBetamixPost - ) - pdf <- with( - controlBetamixPost, - dbetaMix(x = p, par = par, weights = weights) - ) - cdf * pdf - } - ### - } - # do the integration. be careful to cover the region where there can - # really be any non-zero values. I.e. only integrate over the region where - # the beta density of the control is non-zero. - epsilon <- 1e-13 - bounds <- with( # TO DO function ? - controlBetamixPost, - qbetaMix( - p = c(epsilon, 1 - epsilon), - par = par, - weights = weights - ) - ) + if (relativeDelta) { + integrand <- h_integrand_relDelta + } else { + integrand <- h_integrand + } + epsilon <- .Machine$double.xmin + h_get_bounds(betamixPost) intRes <- integrate( f = integrand, lower = max( bounds[1], - ifelse(relativeDelta, 0, 0 - delta) + ifelse(!is.na(delta), 0, 0 - delta) ), upper = min( - ifelse(relativeDelta, 1, 1 - delta), + ifelse(!is.na(delta), 1, 1 - delta), bounds[2] ) ) if (intRes$message == "OK") { - return(intRes$value) + intRes$value } else { stop(intRes$message) } diff --git a/examples/postprobDist.R b/examples/postprobDist.R index a7dac8a9..5ed107a4 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -1,4 +1,4 @@ -## example similar to Lee and Liu: +# example similar to Lee and Liu: postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) ## these two should give the same result: @@ -11,14 +11,14 @@ postprobDist( ) postprob(x = 27, n = 34, p = 0.65, parE = c(1, 1)) -## ok, almost +# ok, almost -## try out mixtures: -## play around with the beta parameters and weights to -## get a feeling. -## Note that very extreme beta parameters do no longer increase -## the return value, because then that mixture component is too -## unlikely a posteriori +# try out mixtures: +# play around with the beta parameters and weights to +# get a feeling. +# Note that very extreme beta parameters do no longer increase +# the return value, because then that mixture component is too +# unlikely a posteriori postprobDist( x = 16, n = 23, parE = diff --git a/inst/WORDLIST b/inst/WORDLIST index 223e850f..7a9e5021 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -88,6 +88,7 @@ hyoithesis hyperprior increasement inefficacious +Integrand integrations LciU ldots diff --git a/man/h_get_bounds.Rd b/man/h_get_bounds.Rd new file mode 100644 index 00000000..036e012e --- /dev/null +++ b/man/h_get_bounds.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/postprobDist.R +\name{h_get_bounds} +\alias{h_get_bounds} +\title{Generating bounds for the integration of Beta Mixture Posterior} +\usage{ +h_get_bounds(betamixPost) +} +\arguments{ +\item{betamixPost}{(\code{list}):\cr arguments of \code{par}and \code{weights} of Beta Mixture Posterior in format list. see \verb{[getBetaMix]}} + +\item{par}{(\code{matrix}):\cr the beta parameters matrix, with \code{K} rows and 2 columns, +corresponding to the beta parameters of the \code{K} components.} + +\item{weights}{(\code{vector}):\cr The mixture weights of the beta mixture prior. Default are +uniform weights across mixture components.} +} +\value{ +Integrand function +} +\description{ +Using the quantile of the Beta Mixture Distribution from parameters given by standard of care \code{SOC} or +experimental group \code{E} to determine bounds as inputs to \verb{[stats::integrate()]} +} +\keyword{internal} diff --git a/man/h_integrand.Rd b/man/h_integrand.Rd new file mode 100644 index 00000000..a385c9f7 --- /dev/null +++ b/man/h_integrand.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/postprobDist.R +\name{h_integrand} +\alias{h_integrand} +\title{The Posterior Beta Mixture Integrand when relative Delta base on \code{p}} +\usage{ +h_integrand(p) +} +\arguments{ +\item{p}{(\code{number}):\cr probability of success or response rate of standard of care or \code{SOC} group.} +} +\value{ +An R function that is an argument for \verb{[stats::integrate()]}. +} +\description{ +The helper function to generate Integrand function when relative Delta not given. +A numerical integration to compute this probability is given on p.338 +} +\keyword{internal} diff --git a/man/h_integrand_relDelta.Rd b/man/h_integrand_relDelta.Rd new file mode 100644 index 00000000..8ee62788 --- /dev/null +++ b/man/h_integrand_relDelta.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/postprobDist.R +\name{h_integrand_relDelta} +\alias{h_integrand_relDelta} +\title{The Posterior Beta Mixture Integrand based on \code{delta}} +\usage{ +h_integrand_relDelta(p) +} +\arguments{ +\item{p}{(\code{number}):\cr probability of success or response rate of standard of care or \code{SOC} group.} +} +\value{ +An R function that is an argument for \verb{[stats::integrate()]}. +} +\description{ +The helper function to generate Integrand function given relative Delta. +} +\keyword{internal} diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index 64c63aab..a39212e5 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -18,37 +18,36 @@ postprobDist( ) } \arguments{ -\item{x}{(``):\cr number of successes (in the treatment group). Note that \code{x} can be a vector.} +\item{x}{(\code{vector}):\cr vector of success counts in the treatment group. Vector of minimum length of 1.} -\item{n}{(``):\cr number of patients (in the treatment group)} +\item{n}{(\code{number}):\cr number of patients (in the treatment group).} -\item{xS}{(``):\cr number of successes in the SOC group (default: 0)} +\item{xS}{(\code{vector}):\cr vector of success counts in the SOC group (default: 0). Vector of minimum length of 1.} -\item{nS}{(``):\cr number of patients in the SOC group (default: 0)} +\item{nS}{(\code{number}):\cr number of patients in the SOC group (default: 0)} -\item{delta}{(``):\cr margin by which the response rate in the treatment group should -be better than in the SOC group (default: 0)} +\item{delta}{(\code{number}):\cr margin by which the response rate in the treatment group should +be better than in the SOC group (default: 0). Must be >= \code{0}. see @note. +? response rate in delta proportion of the SOC non-responding patients.} -\item{relativeDelta}{(``):\cr should the delta be relative? (not default). If this is -\code{TRUE}, then a relative delta is used. This means we want to have -response at least in delta proportion of the SOC non-responding patients. -Non-responding patients rate is `1 - P_S`, and we want to have -`P_S + (1 - P_S)` * delta response rate (at least) in the treatment. That is, we evaluate the -posterior probability `Pr(P_E > P_S + (1 - P_S) * delta | data)`.} +\item{relativeDelta}{(\code{flag}):\cr If \code{TRUE}, then a \code{relativeDelta} is used. Represents that a minimum +response rate in magnitude of \code{delta} of the SOC non-responding patients. see @note.} -\item{parE}{(``):\cr the beta parameters matrix, with K rows and 2 columns, +\item{parE}{(\code{matrix}):\cr the beta parameters matrix, with K rows and 2 columns, corresponding to the beta parameters of the K components. default is a uniform prior.} -\item{weights}{(``):\cr the mixture weights of the beta mixture prior. Default are +\item{weights}{(\code{matrix}):\cr the mixture weights of the beta mixture prior. Default are uniform weights across mixture components.} -\item{parS}{(``):\cr beta parameters for the SOC group (default: uniform)} +\item{parS}{(\code{matrix}):\cr beta parameters for the SOC group (default: uniform)} -\item{weightsS}{(``):\cr weights for the SOC group (default: uniform)} +\item{weightsS}{(\code{matrix}):\cr weights for the SOC group (default: uniform)} + +\item{epsilon}{(\verb{# TODO}):\cr # do the integration. be careful to cover the region where there can} } \value{ -the posterior probability +The posterior probability } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} @@ -69,8 +68,33 @@ that being able to specify a beta mixture prior also on the control treatment is e.g. important for the futility decision making (see the \code{oc2} code). } +\note{ +on \verb{relative Delta} and \code{delta}. + +When \code{relativeDelta = TRUE}, then it is assumed that \code{delta != 0}. + +Given \code{delta != 0}, it is assumed that : +\itemize{ +\item The posterior is calculate on \code{p + delta}. +\item \code{P_S} is the response rate of the SOC group or \code{p}. +\item \code{1-P_S} is the non-response rate of the SOC group. +\item The treatment group's response rate is assumed to be greater than +\code{P_S + (1-P_S)}. +\item Delta is assumed to be the difference between \code{P_S} and \code{1-P_S} +\item It is desirable to achieve a minimum response rate of +\code{P_S + (1 - P_S)*delta} response rate in the treatment group. +\item The expression for posterior probability is thus: +\code{Pr(P_E > P_S + (1 - P_S) * delta | data)}. +} + +If \code{delta = 0} : +\itemize{ +\item The default \code{delta = 0} is assumed. +\item \code{p} is the minimum response rate of which the posterior is calculate on. +} +} \examples{ -## example similar to Lee and Liu: +# example similar to Lee and Liu: postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) ## these two should give the same result: @@ -83,14 +107,14 @@ postprobDist( ) postprob(x = 27, n = 34, p = 0.65, parE = c(1, 1)) -## ok, almost - -## try out mixtures: -## play around with the beta parameters and weights to -## get a feeling. -## Note that very extreme beta parameters do no longer increase -## the return value, because then that mixture component is too -## unlikely a posteriori +# ok, almost + +# try out mixtures: +# play around with the beta parameters and weights to +# get a feeling. +# Note that very extreme beta parameters do no longer increase +# the return value, because then that mixture component is too +# unlikely a posteriori postprobDist( x = 16, n = 23, parE = diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index 556e443a..b3066a77 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -1 +1,77 @@ -postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) +# postprobBeta ---- +test_that("postprobDist gives the correct number result", { + result <- postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) + expect_equal(result, 0.5123873, tolerance = 1e-5) +}) + +test_that("postprobDist gives incrementally higher values with increase x support", { + is_lower <- postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) + is_higher <- postprobDist(x = 20, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) + expect_true(is_lower < is_higher) +}) + +test_that("postprob gives the correct number result", { + # 2 component beta mixture prior with weight = weightS = c(1,1) + # P(P_E > p + delta | data) is 1*beta(0.6, 0.4) + 1*beta(1, 1) + 1*beta(0.6, 0.4) + 1*beta(1, 1) = 0.3948115 + result <- postprobDist( + x = 10, + n = 23, + parE = rbind( + c(0.6, 0.4), + c(1, 1) + ), + parS = rbind( + c(0.6, 0.4), + c(1, 1) + ) + ) + expect_equal(result, 0.3948115, tolerance = 1e-5) +}) + +test_that("postprob gives incrementally higher values with increased x", { + is_lower <- postprobDist( + x = 10, + n = 23, + parE = rbind( + c(0.6, 0.4), + c(1, 1) + ), + parS = rbind( + c(0.6, 0.4), + c(1, 1) + ) + ) + is_higher <- postprobDist( + x = 16, + n = 23, + parE = rbind( + c(0.6, 0.4), + c(1, 1) + ), + parS = rbind( + c(0.6, 0.4), + c(1, 1) + ) + ) + expect_true(is_lower < is_higher) +}) + +test_that("postprobDist gives the correct number result", { + # 2 component beta mixture prior with weights = weightsS = various + # P(P_E > p + delta | data) is 0.5*beta(0.6, 0.4) + 0.5*beta(1, 1) + 0.6*beta(0.6, 0.4) + 0.4*beta(1, 1) = 0.3856478 + result <- postprobDist( + x = 10, + n = 23, + parE = rbind( + c(0.6, 0.4), + c(1, 1) + ), + parS = rbind( + c(0.6, 0.4), + c(1, 1) + ), + weights = c(0.5, 0.5), + weightsS = c(0.6, 0.4), + ) + expect_equal(result, 0.3856478, tolerance = 1e-4) +}) From 6e9e814d28fc5a7fe7986285ca07989b4cc9e00a Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 3 Nov 2023 16:52:38 +0100 Subject: [PATCH 075/106] clean --- R/postprobDist.R | 107 +++++++++++++++++++++--------------- examples/postprobDist.R | 5 ++ man/h_get_bounds.Rd | 4 +- man/h_integrand.Rd | 7 +-- man/h_integrand_relDelta.Rd | 2 +- man/postprobDist.Rd | 76 ++++++++++++++----------- 6 files changed, 116 insertions(+), 85 deletions(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index 4ff101d4..7c1a12a3 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -2,7 +2,6 @@ #' @include postprob.R NULL - #' The Posterior Beta Mixture Integrand based on `delta` #' #' The helper function to generate Integrand function given relative Delta. @@ -13,20 +12,20 @@ NULL #' @return An R function that is an argument for `[stats::integrate()]`. #' #' @keywords internal -h_integrand_relDelta <- function(p) { +h_integrand_relDelta <- function(p_s, delta, x, activeBetamixPost, controlBetamixPost) { cdf <- postprob( x = x, - p = (1 - delta) * p + delta, + p = (1 - p_s) * p_s + delta, betamixPost = activeBetamixPost ) pdf <- with( controlBetamixPost, - dbetaMix(x = p, par = par, weights = weights) + dbetaMix(x = p_s, par = par, weights = weights) ) cdf * pdf } -#' The Posterior Beta Mixture Integrand when relative Delta base on `p` +#' The Posterior Beta Mixture Integrand when Delta is absolute. #' #' The helper function to generate Integrand function when relative Delta not given. #' A numerical integration to compute this probability is given on p.338 @@ -37,26 +36,26 @@ h_integrand_relDelta <- function(p) { #' @return An R function that is an argument for `[stats::integrate()]`. #' #' @keywords internal -h_integrand <- function(p) { +h_integrand <- function(p_s, delta, x, activeBetamixPost, controlBetamixPost) { cdf <- postprob( x = x, - p = p + delta, + p = p_s + delta, betamixPost = activeBetamixPost ) pdf <- with( controlBetamixPost, - dbetaMix(x = p, par = par, weights = weights) + dbetaMix(x = p_s, par = par, weights = weights) ) cdf * pdf } -#' Generating bounds for the integration of Beta Mixture Posterior +#' Generating bounds for the Integration of Beta Mixture Posterior #' #' Using the quantile of the Beta Mixture Distribution from parameters given by standard of care `SOC` or #' experimental group `E` to determine bounds as inputs to `[stats::integrate()]` #' #' @typed betamixPost : list -#' arguments of `par`and `weights` of Beta Mixture Posterior in format list. see `[getBetaMix]` +#' arguments of `par`and `weights` of Beta Mixture Posterior in format list. See `[getBetaMix()]`. #' @typed par : matrix #' the beta parameters matrix, with `K` rows and 2 columns, #' corresponding to the beta parameters of the `K` components. @@ -69,6 +68,7 @@ h_integrand <- function(p) { #' @keywords internal #' h_get_bounds <- function(betamixPost) { + epsilon <- .Machine$double.xmin with( betamixPost, qbetaMix( @@ -86,12 +86,35 @@ h_get_bounds <- function(betamixPost) { #' Using the approach by Thall and Simon (Biometrics, 1994), evaluate the #' posterior probability of having `Pr(P_E > P_S + delta | data)` (but see below #' for relative delta margin). Both for the new treatment `E` as well as for the -#' Standard of Care (SOC): `S` data might be available. However the default is that no data is -#' available for the `SOC`, corresponding to the single arm trial situation. Note -#' that a uniform prior is the useful default for the treatment proportion, -#' while in the single arm trial an informative prior on the `SOC` proportion is +#' Standard of Care (SOC): `S` data might be available. However the default assumption is that no data is +#' available for the `SOC`, corresponding to the single arm trial situation +#' where we only rely on incoming data from the Experimental arm. In the case +#' +#' Using the approach by Thall and Simon (Biometrics, 1994), we evaluate the +#' posterior probability of having a desired improvement of treatment effect to +#' standard of care, SOC. When there is no standard of care, +#' +#' The choice of prior will consider the following : +#' +#' For single arm trial, an informative prior on the SOC proportion is #' useful. +#' Otherwise, a uniform prior is the useful default for the treatment proportion. see @note. +#' +#' The calculation of `delta` : +#' +#' The desired improvement is denoted as `delta`. There are two options in calculating `delta`. +#' The absolute case when `relativeDelta = FALSE` and relative as when `relativeDelta = TRUE`. +#' The posterior in question can be expressed as `Pr(P_E > P_S + delta | data)`. +#' +#' 1. The absolute case is when we define an absolute delta, greater than `P_S`, +#' the response rate of the `SOC` group such that +#' the posterior is `Pr(P_E > P_S + delta | data)`. #' +#' 2. In the relative case, we suppose that the treatment group's +#' response rate is assumed to be greater than `P_S + (1-P_S)*delta` such that +#' the posterior is `Pr(P_E > P_S + (1 - P_S) * delta | data)`. +#' +#' @note on beta Priors #' #' Beta mixture prior can be specified for the treatment `parE` #' and `weights` parameters) and control proportion `parS` and @@ -103,7 +126,7 @@ h_get_bounds <- function(betamixPost) { #' @typed x : vector #' vector of success counts in the treatment group. Vector of minimum length of 1. #' @typed n : number -#' number of patients (in the treatment group). +#' number of patients in the treatment group. #' @typed xS : vector #' vector of success counts in the SOC group (default: 0). Vector of minimum length of 1. #' @typed nS : number @@ -111,7 +134,6 @@ h_get_bounds <- function(betamixPost) { #' @typed delta : number #' margin by which the response rate in the treatment group should #' be better than in the SOC group (default: 0). Must be >= `0`. see @note. -#' ? response rate in delta proportion of the SOC non-responding patients. #' @typed relativeDelta : flag #' If `TRUE`, then a `relativeDelta` is used. Represents that a minimum #' response rate in magnitude of `delta` of the SOC non-responding patients. see @note. @@ -126,38 +148,26 @@ h_get_bounds <- function(betamixPost) { #' beta parameters for the SOC group (default: uniform) #' @typed weightsS : matrix #' weights for the SOC group (default: uniform) -#' @typed epsilon : # TODO -#' # do the integration. be careful to cover the region where there can -# really be any non-zero values. I.e. only integrate over the region where -# the beta density of the control is non-zero. +#' @typed epsilon : number +#' the smallest non-negative floating number to represent the lower bound for +#' the interval of integration. #' @return The posterior probability #' -#' -#' @note on `relative Delta` and `delta`. -#' -#' When `relativeDelta = TRUE`, then it is assumed that `delta != 0`. -#' -#' Given `delta != 0`, it is assumed that : -#' - The posterior is calculate on `p + delta`. -#' - `P_S` is the response rate of the SOC group or `p`. -#' - `1-P_S` is the non-response rate of the SOC group. -#' - The treatment group's response rate is assumed to be greater than -#' `P_S + (1-P_S)`. -#' - Delta is assumed to be the difference between `P_S` and `1-P_S` -#' - It is desirable to achieve a minimum response rate of -#' `P_S + (1 - P_S)*delta` response rate in the treatment group. -#' - The expression for posterior probability is thus: -#' `Pr(P_E > P_S + (1 - P_S) * delta | data)`. -#' -#' If `delta = 0` : -#' - The default `delta = 0` is assumed. -#' - `p` is the minimum response rate of which the posterior is calculate on. +#' @note +#' Beta mixture prior can be specified for the treatment in `parE` +#' and `weights` parameters) and SOC in `parS` and +#' `weightsS` parameters), see `[postprob()]` for details. Note +#' that being able to specify a beta mixture prior also on the control +#' treatment is important for the futility decision making (see the +#' `[oc2()]` code). #' #' @example examples/postprobDist.R #' @export -postprobDist <- function(x, n, - xS = 0, nS = 0, +postprobDist <- function(x, + n, + xS = 0, + nS = 0, delta = 0, relativeDelta = FALSE, parE = c(1, 1), @@ -183,24 +193,31 @@ postprobDist <- function(x, n, assert_names(names(activeBetamixPost), identical.to = c("par", "weights")) assert_names(names(controlBetamixPost), identical.to = c("par", "weights")) if (relativeDelta) { + epsilon <- .Machine$double.xmin integrand <- h_integrand_relDelta } else { + epsilon <- .Machine$double.xmin integrand <- h_integrand } epsilon <- .Machine$double.xmin h_get_bounds(betamixPost) + bounds <- h_get_bounds(betamixPost = controlBetamixPost) intRes <- integrate( f = integrand, lower = max( bounds[1], - ifelse(!is.na(delta), 0, 0 - delta) + ifelse(relativeDelta, 0, 0 - delta) ), upper = min( - ifelse(!is.na(delta), 1, 1 - delta), + ifelse(relativeDelta, 1, 1 - delta), bounds[2] - ) + ), + delta = delta, + x = x, + activeBetamixPost = activeBetamixPost, + controlBetamixPost = controlBetamixPost ) if (intRes$message == "OK") { intRes$value diff --git a/examples/postprobDist.R b/examples/postprobDist.R index 5ed107a4..e64d75d8 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -33,3 +33,8 @@ postprobDist( ), weightsS = c(1, 3) ) +# try these examples + +# 1. Experimental arm only, uniform prior in both E and S arms +# 2. Experimental arm and SOC +# 3. Experimental arm only, with beta mix prior for S arms, uniform for E diff --git a/man/h_get_bounds.Rd b/man/h_get_bounds.Rd index 036e012e..4376155e 100644 --- a/man/h_get_bounds.Rd +++ b/man/h_get_bounds.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/postprobDist.R \name{h_get_bounds} \alias{h_get_bounds} -\title{Generating bounds for the integration of Beta Mixture Posterior} +\title{Generating bounds for the Integration of Beta Mixture Posterior} \usage{ h_get_bounds(betamixPost) } \arguments{ -\item{betamixPost}{(\code{list}):\cr arguments of \code{par}and \code{weights} of Beta Mixture Posterior in format list. see \verb{[getBetaMix]}} +\item{betamixPost}{(\code{list}):\cr arguments of \code{par}and \code{weights} of Beta Mixture Posterior in format list. See \verb{[getBetaMix()]}.} \item{par}{(\code{matrix}):\cr the beta parameters matrix, with \code{K} rows and 2 columns, corresponding to the beta parameters of the \code{K} components.} diff --git a/man/h_integrand.Rd b/man/h_integrand.Rd index a385c9f7..32a52143 100644 --- a/man/h_integrand.Rd +++ b/man/h_integrand.Rd @@ -2,12 +2,9 @@ % Please edit documentation in R/postprobDist.R \name{h_integrand} \alias{h_integrand} -\title{The Posterior Beta Mixture Integrand when relative Delta base on \code{p}} +\title{The Posterior Beta Mixture Integrand when Delta is absolute.} \usage{ -h_integrand(p) -} -\arguments{ -\item{p}{(\code{number}):\cr probability of success or response rate of standard of care or \code{SOC} group.} +h_integrand(p_s, delta, x, activeBetamixPost, controlBetamixPost) } \value{ An R function that is an argument for \verb{[stats::integrate()]}. diff --git a/man/h_integrand_relDelta.Rd b/man/h_integrand_relDelta.Rd index 8ee62788..88e2b4bd 100644 --- a/man/h_integrand_relDelta.Rd +++ b/man/h_integrand_relDelta.Rd @@ -4,7 +4,7 @@ \alias{h_integrand_relDelta} \title{The Posterior Beta Mixture Integrand based on \code{delta}} \usage{ -h_integrand_relDelta(p) +h_integrand_relDelta(p_s, delta, x, activeBetamixPost, controlBetamixPost) } \arguments{ \item{p}{(\code{number}):\cr probability of success or response rate of standard of care or \code{SOC} group.} diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index a39212e5..501311bb 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -20,15 +20,14 @@ postprobDist( \arguments{ \item{x}{(\code{vector}):\cr vector of success counts in the treatment group. Vector of minimum length of 1.} -\item{n}{(\code{number}):\cr number of patients (in the treatment group).} +\item{n}{(\code{number}):\cr number of patients in the treatment group.} \item{xS}{(\code{vector}):\cr vector of success counts in the SOC group (default: 0). Vector of minimum length of 1.} \item{nS}{(\code{number}):\cr number of patients in the SOC group (default: 0)} \item{delta}{(\code{number}):\cr margin by which the response rate in the treatment group should -be better than in the SOC group (default: 0). Must be >= \code{0}. see @note. -? response rate in delta proportion of the SOC non-responding patients.} +be better than in the SOC group (default: 0). Must be >= \code{0}. see @note.} \item{relativeDelta}{(\code{flag}):\cr If \code{TRUE}, then a \code{relativeDelta} is used. Represents that a minimum response rate in magnitude of \code{delta} of the SOC non-responding patients. see @note.} @@ -44,7 +43,8 @@ uniform weights across mixture components.} \item{weightsS}{(\code{matrix}):\cr weights for the SOC group (default: uniform)} -\item{epsilon}{(\verb{# TODO}):\cr # do the integration. be careful to cover the region where there can} +\item{epsilon}{(\code{number}):\cr the smallest non-negative floating number to represent the lower bound for +the interval of integration.} } \value{ The posterior probability @@ -55,11 +55,36 @@ The posterior probability Using the approach by Thall and Simon (Biometrics, 1994), evaluate the posterior probability of having \code{Pr(P_E > P_S + delta | data)} (but see below for relative delta margin). Both for the new treatment \code{E} as well as for the -Standard of Care (SOC): \code{S} data might be available. However the default is that no data is -available for the \code{SOC}, corresponding to the single arm trial situation. Note -that a uniform prior is the useful default for the treatment proportion, -while in the single arm trial an informative prior on the \code{SOC} proportion is +Standard of Care (SOC): \code{S} data might be available. However the default assumption is that no data is +available for the \code{SOC}, corresponding to the single arm trial situation +where we only rely on incoming data from the Experimental arm. In the case + +Using the approach by Thall and Simon (Biometrics, 1994), we evaluate the +posterior probability of having a desired improvement of treatment effect to +standard of care, SOC. When there is no standard of care, + +The choice of prior will consider the following : + +For single arm trial, an informative prior on the SOC proportion is useful. +Otherwise, a uniform prior is the useful default for the treatment proportion. see @note. + +The calculation of \code{delta} : + +The desired improvement is denoted as \code{delta}. There are two options in calculating \code{delta}. +The absolute case when \code{relativeDelta = FALSE} and relative as when \code{relativeDelta = TRUE}. +The posterior in question can be expressed as \code{Pr(P_E > P_S + delta | data)}. +\enumerate{ +\item The absolute case is when we define an absolute delta, greater than \code{P_S}, +the response rate of the \code{SOC} group such that +the posterior is \code{Pr(P_E > P_S + delta | data)}. +\item In the relative case, we suppose that the treatment group's +response rate is assumed to be greater than \code{P_S + (1-P_S)*delta} such that +the posterior is \code{Pr(P_E > P_S + (1 - P_S) * delta | data)}. +} +} +\note{ +on beta Priors Beta mixture prior can be specified for the treatment \code{parE} and \code{weights} parameters) and control proportion \code{parS} and @@ -67,31 +92,13 @@ and \code{weights} parameters) and control proportion \code{parS} and that being able to specify a beta mixture prior also on the control treatment is e.g. important for the futility decision making (see the \code{oc2} code). -} -\note{ -on \verb{relative Delta} and \code{delta}. - -When \code{relativeDelta = TRUE}, then it is assumed that \code{delta != 0}. - -Given \code{delta != 0}, it is assumed that : -\itemize{ -\item The posterior is calculate on \code{p + delta}. -\item \code{P_S} is the response rate of the SOC group or \code{p}. -\item \code{1-P_S} is the non-response rate of the SOC group. -\item The treatment group's response rate is assumed to be greater than -\code{P_S + (1-P_S)}. -\item Delta is assumed to be the difference between \code{P_S} and \code{1-P_S} -\item It is desirable to achieve a minimum response rate of -\code{P_S + (1 - P_S)*delta} response rate in the treatment group. -\item The expression for posterior probability is thus: -\code{Pr(P_E > P_S + (1 - P_S) * delta | data)}. -} -If \code{delta = 0} : -\itemize{ -\item The default \code{delta = 0} is assumed. -\item \code{p} is the minimum response rate of which the posterior is calculate on. -} +Beta mixture prior can be specified for the treatment in \code{parE} +and \code{weights} parameters) and SOC in \code{parS} and +\code{weightsS} parameters), see \verb{[postprob()]} for details. Note +that being able to specify a beta mixture prior also on the control +treatment is important for the futility decision making (see the +\verb{[oc2()]} code). } \examples{ # example similar to Lee and Liu: @@ -129,4 +136,9 @@ postprobDist( ), weightsS = c(1, 3) ) +# try these examples + +# 1. Experimental arm only, uniform prior in both E and S arms +# 2. Experimental arm and SOC +# 3. Experimental arm only, with beta mix prior for S arms, uniform for E } From 24efa4802094209dbb82349a68bbc9e31a2f8a1e Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Sat, 4 Nov 2023 18:03:40 +0100 Subject: [PATCH 076/106] the error is now on dbetabinom.R#141 --- R/postprobDist.R | 21 ++++++------ examples/postprobDist.R | 64 ++++++++++++++++++++++++++++++++++++- man/h_integrand.Rd | 5 +-- man/h_integrand_relDelta.Rd | 4 +-- man/postprobDist.Rd | 64 ++++++++++++++++++++++++++++++++++++- 5 files changed, 141 insertions(+), 17 deletions(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index 7c1a12a3..377ce633 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -4,7 +4,7 @@ NULL #' The Posterior Beta Mixture Integrand based on `delta` #' -#' The helper function to generate Integrand function given relative Delta. +#' The helper function to generate Integrand function when `relative Delta = TRUE`. #' #' @typed p : number #' probability of success or response rate of standard of care or `SOC` group. @@ -12,14 +12,14 @@ NULL #' @return An R function that is an argument for `[stats::integrate()]`. #' #' @keywords internal -h_integrand_relDelta <- function(p_s, delta, x, activeBetamixPost, controlBetamixPost) { +h_integrand_relDelta <- function(p_s, delta, x, betamixPost, controlBetamixPost) { cdf <- postprob( x = x, - p = (1 - p_s) * p_s + delta, + p = (1 - p_s) * delta + p_s, betamixPost = activeBetamixPost ) pdf <- with( - controlBetamixPost, + controlBetamixPost = controlBetamixPost, dbetaMix(x = p_s, par = par, weights = weights) ) cdf * pdf @@ -27,7 +27,8 @@ h_integrand_relDelta <- function(p_s, delta, x, activeBetamixPost, controlBetami #' The Posterior Beta Mixture Integrand when Delta is absolute. #' -#' The helper function to generate Integrand function when relative Delta not given. +#' The helper function to generate Integrand function when `relative Delta = FALSE` +#' , a default setting. #' A numerical integration to compute this probability is given on p.338 # in the article by Thall and Simon (1994, Biometrics): #' @@ -36,14 +37,14 @@ h_integrand_relDelta <- function(p_s, delta, x, activeBetamixPost, controlBetami #' @return An R function that is an argument for `[stats::integrate()]`. #' #' @keywords internal -h_integrand <- function(p_s, delta, x, activeBetamixPost, controlBetamixPost) { +h_integrand <- function(p_s, delta, x, betamixPost, controlBetamixPost) { cdf <- postprob( x = x, p = p_s + delta, betamixPost = activeBetamixPost ) pdf <- with( - controlBetamixPost, + controlBetamixPost = controlBetamixPost, dbetaMix(x = p_s, par = par, weights = weights) ) cdf * pdf @@ -199,8 +200,6 @@ postprobDist <- function(x, epsilon <- .Machine$double.xmin integrand <- h_integrand } - epsilon <- .Machine$double.xmin - h_get_bounds(betamixPost) bounds <- h_get_bounds(betamixPost = controlBetamixPost) intRes <- integrate( f = integrand, @@ -214,9 +213,9 @@ postprobDist <- function(x, ifelse(relativeDelta, 1, 1 - delta), bounds[2] ), - delta = delta, x = x, - activeBetamixPost = activeBetamixPost, + delta = delta, + betamixPost = activeBetamixPost, controlBetamixPost = controlBetamixPost ) if (intRes$message == "OK") { diff --git a/examples/postprobDist.R b/examples/postprobDist.R index e64d75d8..50ce0e12 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -1,5 +1,8 @@ # example similar to Lee and Liu: -postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) +postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), relativeDelta = TRUE) + +# when relativeDelta is used +postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, relativeDelta = TRUE) ## these two should give the same result: postprobDist( @@ -36,5 +39,64 @@ postprobDist( # try these examples # 1. Experimental arm only, uniform prior in both E and S arms +x <- 16 +xS <- 0 +nS <- 0 +n <- 23 +parE <- t(c(0.6, 0.4)) +parS <- t(c(0.6, 0.4)) +weights <- rep(1, nrow(parE)) +weightsS <- rep(1, nrow(parS)) +delta <- 0 +relativeDelta <- FALSE + + +postprobDist( + x = 16, + n = 23, + xS = 0, + nS = 0, + delta = 0, + relativeDelta = FALSE, + parE = c(1, 1), + weights, + parS = c(1, 1), + weightsS +) # 2. Experimental arm and SOC +x <- 16 +xS <- 0 +nS <- 0 +n <- 23 +parE <- t(c(0.6, 0.4)) +parS <- t(c(0.6, 0.4)) +weights <- rep(1, nrow(parE)) +weightsS <- rep(1, nrow(parS)) +delta <- 0 +relativeDelta <- TRUE + +postprobDist( + x = 16, + n = 20, + xS = 10, + nS = 20, + delta = 0, + relativeDelta = FALSE, + parE = c(1, 1), + weights, + parS = c(1, 1), + weightsS +) # 3. Experimental arm only, with beta mix prior for S arms, uniform for E +postprobDist( + x = 16, + n = 20, + xS = 10, + nS = 20, + delta = 0, + relativeDelta = FALSE, + parE = c(1, 1), + weights, + parS = c(4, 5), + weightsS +) diff --git a/man/h_integrand.Rd b/man/h_integrand.Rd index 32a52143..1ee7c106 100644 --- a/man/h_integrand.Rd +++ b/man/h_integrand.Rd @@ -4,13 +4,14 @@ \alias{h_integrand} \title{The Posterior Beta Mixture Integrand when Delta is absolute.} \usage{ -h_integrand(p_s, delta, x, activeBetamixPost, controlBetamixPost) +h_integrand(p_s, delta, x, betamixPost, controlBetamixPost) } \value{ An R function that is an argument for \verb{[stats::integrate()]}. } \description{ -The helper function to generate Integrand function when relative Delta not given. +The helper function to generate Integrand function when \verb{relative Delta = FALSE} +, a default setting. A numerical integration to compute this probability is given on p.338 } \keyword{internal} diff --git a/man/h_integrand_relDelta.Rd b/man/h_integrand_relDelta.Rd index 88e2b4bd..57e3e6a2 100644 --- a/man/h_integrand_relDelta.Rd +++ b/man/h_integrand_relDelta.Rd @@ -4,7 +4,7 @@ \alias{h_integrand_relDelta} \title{The Posterior Beta Mixture Integrand based on \code{delta}} \usage{ -h_integrand_relDelta(p_s, delta, x, activeBetamixPost, controlBetamixPost) +h_integrand_relDelta(p_s, delta, x, betamixPost, controlBetamixPost) } \arguments{ \item{p}{(\code{number}):\cr probability of success or response rate of standard of care or \code{SOC} group.} @@ -13,6 +13,6 @@ h_integrand_relDelta(p_s, delta, x, activeBetamixPost, controlBetamixPost) An R function that is an argument for \verb{[stats::integrate()]}. } \description{ -The helper function to generate Integrand function given relative Delta. +The helper function to generate Integrand function when \verb{relative Delta = TRUE}. } \keyword{internal} diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index 501311bb..802f7f79 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -102,7 +102,10 @@ treatment is important for the futility decision making (see the } \examples{ # example similar to Lee and Liu: -postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) +postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), relativeDelta = TRUE) + +# when relativeDelta is used +postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, relativeDelta = TRUE) ## these two should give the same result: postprobDist( @@ -139,6 +142,65 @@ postprobDist( # try these examples # 1. Experimental arm only, uniform prior in both E and S arms +x <- 16 +xS <- 0 +nS <- 0 +n <- 23 +parE <- t(c(0.6, 0.4)) +parS <- t(c(0.6, 0.4)) +weights <- rep(1, nrow(parE)) +weightsS <- rep(1, nrow(parS)) +delta <- 0 +relativeDelta <- FALSE + + +postprobDist( + x = 16, + n = 23, + xS = 0, + nS = 0, + delta = 0, + relativeDelta = FALSE, + parE = c(1, 1), + weights, + parS = c(1, 1), + weightsS +) # 2. Experimental arm and SOC +x <- 16 +xS <- 0 +nS <- 0 +n <- 23 +parE <- t(c(0.6, 0.4)) +parS <- t(c(0.6, 0.4)) +weights <- rep(1, nrow(parE)) +weightsS <- rep(1, nrow(parS)) +delta <- 0 +relativeDelta <- TRUE + +postprobDist( + x = 16, + n = 20, + xS = 10, + nS = 20, + delta = 0, + relativeDelta = FALSE, + parE = c(1, 1), + weights, + parS = c(1, 1), + weightsS +) # 3. Experimental arm only, with beta mix prior for S arms, uniform for E +postprobDist( + x = 16, + n = 20, + xS = 10, + nS = 20, + delta = 0, + relativeDelta = FALSE, + parE = c(1, 1), + weights, + parS = c(4, 5), + weightsS +) } From dc6a88456ce8e3d7ce0227347186ae43ee1baacf Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 6 Nov 2023 15:02:19 +0100 Subject: [PATCH 077/106] clean --- R/dbetabinom.R | 1 + R/postprobDist.R | 19 ++++++---- examples/postprobDist.R | 61 +++++++++++++++++------------- man/h_get_bounds.Rd | 2 +- man/postprobDist.Rd | 61 +++++++++++++++++------------- tests/testthat/test-postprobDist.R | 24 ++++++++++-- 6 files changed, 102 insertions(+), 66 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 3c92f18e..b06b652e 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -89,6 +89,7 @@ dbetabinomMix <- Vectorize(dbetabinomMix, vectorize.args = "x") #' #' @example examples/getBetamixPost.R #' @export + getBetamixPost <- function(x, n, par, weights) { ## check the format stopifnot( diff --git a/R/postprobDist.R b/R/postprobDist.R index 377ce633..20a7a474 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -15,11 +15,12 @@ NULL h_integrand_relDelta <- function(p_s, delta, x, betamixPost, controlBetamixPost) { cdf <- postprob( x = x, + n = n, p = (1 - p_s) * delta + p_s, - betamixPost = activeBetamixPost + betamixPost ) pdf <- with( - controlBetamixPost = controlBetamixPost, + controlBetamixPost, dbetaMix(x = p_s, par = par, weights = weights) ) cdf * pdf @@ -37,14 +38,16 @@ h_integrand_relDelta <- function(p_s, delta, x, betamixPost, controlBetamixPost) #' @return An R function that is an argument for `[stats::integrate()]`. #' #' @keywords internal +#' h_integrand <- function(p_s, delta, x, betamixPost, controlBetamixPost) { cdf <- postprob( x = x, + n = n, p = p_s + delta, - betamixPost = activeBetamixPost + betamixPost ) pdf <- with( - controlBetamixPost = controlBetamixPost, + controlBetamixPost, dbetaMix(x = p_s, par = par, weights = weights) ) cdf * pdf @@ -68,10 +71,10 @@ h_integrand <- function(p_s, delta, x, betamixPost, controlBetamixPost) { #' #' @keywords internal #' -h_get_bounds <- function(betamixPost) { +h_get_bounds <- function(controlBetamixPost) { epsilon <- .Machine$double.xmin with( - betamixPost, + controlBetamixPost, qbetaMix( p = c(epsilon, 1 - epsilon), par = par, @@ -200,7 +203,7 @@ postprobDist <- function(x, epsilon <- .Machine$double.xmin integrand <- h_integrand } - bounds <- h_get_bounds(betamixPost = controlBetamixPost) + bounds <- h_get_bounds(controlBetamixPost = controlBetamixPost) intRes <- integrate( f = integrand, lower = @@ -213,8 +216,8 @@ postprobDist <- function(x, ifelse(relativeDelta, 1, 1 - delta), bounds[2] ), - x = x, delta = delta, + x = x, betamixPost = activeBetamixPost, controlBetamixPost = controlBetamixPost ) diff --git a/examples/postprobDist.R b/examples/postprobDist.R index 50ce0e12..e6b20921 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -1,5 +1,5 @@ # example similar to Lee and Liu: -postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), relativeDelta = TRUE) +postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), relativeDelta = FALSE) # when relativeDelta is used postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, relativeDelta = TRUE) @@ -38,19 +38,7 @@ postprobDist( ) # try these examples -# 1. Experimental arm only, uniform prior in both E and S arms -x <- 16 -xS <- 0 -nS <- 0 -n <- 23 -parE <- t(c(0.6, 0.4)) -parS <- t(c(0.6, 0.4)) -weights <- rep(1, nrow(parE)) -weightsS <- rep(1, nrow(parS)) -delta <- 0 -relativeDelta <- FALSE - - +# 1. Experimental arm only (strictly single arm trial), uniform prior in both E and S arms. postprobDist( x = 16, n = 23, @@ -63,18 +51,7 @@ postprobDist( parS = c(1, 1), weightsS ) -# 2. Experimental arm and SOC -x <- 16 -xS <- 0 -nS <- 0 -n <- 23 -parE <- t(c(0.6, 0.4)) -parS <- t(c(0.6, 0.4)) -weights <- rep(1, nrow(parE)) -weightsS <- rep(1, nrow(parS)) -delta <- 0 -relativeDelta <- TRUE - +# 2. Experimental arm and SOC, uniform prior in both E and S arms. postprobDist( x = 16, n = 20, @@ -87,7 +64,7 @@ postprobDist( parS = c(1, 1), weightsS ) -# 3. Experimental arm only, with beta mix prior for S arms, uniform for E +# 3. Experimental and SOC arm, with beta mix prior for S arms, uniform for E postprobDist( x = 16, n = 20, @@ -100,3 +77,33 @@ postprobDist( parS = c(4, 5), weightsS ) + +# 3b. Experimental and SOC arm, with beta mix prior for S arm, uniform for E +# The SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights +postprobDist( + x = 16, + n = 20, + xS = 10, + nS = 20, + delta = 0, + relativeDelta = FALSE, + parE = c(1, 1), + weights, + parS = rbind(c(4, 5), c(2, 3), c(4, 4)), + weightsS = c(2, 5, 3) +) + +# 3c. Experimental and SOC arm, with beta mix prior for both arms +# For each of the SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights +postprobDist( + x = 16, + n = 20, + xS = 10, + nS = 20, + delta = 0, + relativeDelta = FALSE, + parE = rbind(c(1, 1), c(3, 4), c(8, 9)), + weights = c(5, 3, 2), + parS = rbind(c(4, 5), c(2, 3), c(4, 4)), + weightsS = c(2, 5, 3) +) diff --git a/man/h_get_bounds.Rd b/man/h_get_bounds.Rd index 4376155e..a3e77ea6 100644 --- a/man/h_get_bounds.Rd +++ b/man/h_get_bounds.Rd @@ -4,7 +4,7 @@ \alias{h_get_bounds} \title{Generating bounds for the Integration of Beta Mixture Posterior} \usage{ -h_get_bounds(betamixPost) +h_get_bounds(controlBetamixPost) } \arguments{ \item{betamixPost}{(\code{list}):\cr arguments of \code{par}and \code{weights} of Beta Mixture Posterior in format list. See \verb{[getBetaMix()]}.} diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index 802f7f79..d88ef2fb 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -102,7 +102,7 @@ treatment is important for the futility decision making (see the } \examples{ # example similar to Lee and Liu: -postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), relativeDelta = TRUE) +postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), relativeDelta = FALSE) # when relativeDelta is used postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, relativeDelta = TRUE) @@ -141,19 +141,7 @@ postprobDist( ) # try these examples -# 1. Experimental arm only, uniform prior in both E and S arms -x <- 16 -xS <- 0 -nS <- 0 -n <- 23 -parE <- t(c(0.6, 0.4)) -parS <- t(c(0.6, 0.4)) -weights <- rep(1, nrow(parE)) -weightsS <- rep(1, nrow(parS)) -delta <- 0 -relativeDelta <- FALSE - - +# 1. Experimental arm only (strictly single arm trial), uniform prior in both E and S arms. postprobDist( x = 16, n = 23, @@ -166,18 +154,7 @@ postprobDist( parS = c(1, 1), weightsS ) -# 2. Experimental arm and SOC -x <- 16 -xS <- 0 -nS <- 0 -n <- 23 -parE <- t(c(0.6, 0.4)) -parS <- t(c(0.6, 0.4)) -weights <- rep(1, nrow(parE)) -weightsS <- rep(1, nrow(parS)) -delta <- 0 -relativeDelta <- TRUE - +# 2. Experimental arm and SOC, uniform prior in both E and S arms. postprobDist( x = 16, n = 20, @@ -190,7 +167,7 @@ postprobDist( parS = c(1, 1), weightsS ) -# 3. Experimental arm only, with beta mix prior for S arms, uniform for E +# 3. Experimental and SOC arm, with beta mix prior for S arms, uniform for E postprobDist( x = 16, n = 20, @@ -203,4 +180,34 @@ postprobDist( parS = c(4, 5), weightsS ) + +# 3b. Experimental and SOC arm, with beta mix prior for S arm, uniform for E +# The SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights +postprobDist( + x = 16, + n = 20, + xS = 10, + nS = 20, + delta = 0, + relativeDelta = FALSE, + parE = c(1, 1), + weights, + parS = rbind(c(4, 5), c(2, 3), c(4, 4)), + weightsS = c(2, 5, 3) +) + +# 3c. Experimental and SOC arm, with beta mix prior for both arms +# For each of the SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights +postprobDist( + x = 16, + n = 20, + xS = 10, + nS = 20, + delta = 0, + relativeDelta = FALSE, + parE = rbind(c(1, 1), c(3, 4), c(8, 9)), + weights = c(5, 3, 2), + parS = rbind(c(4, 5), c(2, 3), c(4, 4)), + weightsS = c(2, 5, 3) +) } diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index b3066a77..a4d348c3 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -12,7 +12,6 @@ test_that("postprobDist gives incrementally higher values with increase x suppor test_that("postprob gives the correct number result", { # 2 component beta mixture prior with weight = weightS = c(1,1) - # P(P_E > p + delta | data) is 1*beta(0.6, 0.4) + 1*beta(1, 1) + 1*beta(0.6, 0.4) + 1*beta(1, 1) = 0.3948115 result <- postprobDist( x = 10, n = 23, @@ -58,7 +57,6 @@ test_that("postprob gives incrementally higher values with increased x", { test_that("postprobDist gives the correct number result", { # 2 component beta mixture prior with weights = weightsS = various - # P(P_E > p + delta | data) is 0.5*beta(0.6, 0.4) + 0.5*beta(1, 1) + 0.6*beta(0.6, 0.4) + 0.4*beta(1, 1) = 0.3856478 result <- postprobDist( x = 10, n = 23, @@ -71,7 +69,27 @@ test_that("postprobDist gives the correct number result", { c(1, 1) ), weights = c(0.5, 0.5), - weightsS = c(0.6, 0.4), + weightsS = c(0.3, 0.7), + ) + expect_equal(result, 0.3856478, tolerance = 1e-4) +}) + +# Extreme beta numbers are lowly weighted +test_that("postprobDist gives the correct number result", { + # 2 component beta mixture prior with weights = weightsS = various + result <- postprobDist( + x = 10, + n = 23, + parE = rbind( + c(0.6, 0.4), + c(1, 1) + ), + parS = rbind( + c(0.6, 0.4), + c(1, 1) + ), + weights = c(0.5, 0.5), + weightsS = c(0.3, 0.7), ) expect_equal(result, 0.3856478, tolerance = 1e-4) }) From 19c6a42a6555cc988b28e7f480aefb4b7223f27b Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 9 Nov 2023 16:38:26 +0100 Subject: [PATCH 078/106] postprobDist works --- R/dbetabinom.R | 1 + R/postprobDist.R | 130 +++++++++++++++-------------- examples/postprobDist.R | 33 ++++---- inst/WORDLIST | 3 + man/h_get_bounds.Rd | 8 +- man/h_integrand.Rd | 22 ++++- man/h_integrand_relDelta.Rd | 19 ++++- man/postprobDist.Rd | 102 +++++++++++----------- tests/testthat/test-postprob.R | 2 +- tests/testthat/test-postprobDist.R | 64 ++++++++++++-- 10 files changed, 231 insertions(+), 153 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index b06b652e..1977f2df 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -126,6 +126,7 @@ getBetamixPost <- function(x, n, par, weights) { } + #' Beta-mixture density function #' #' Note that `x` can be a vector. diff --git a/R/postprobDist.R b/R/postprobDist.R index 20a7a474..39bd74da 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -2,22 +2,34 @@ #' @include postprob.R NULL -#' The Posterior Beta Mixture Integrand based on `delta` +#' The Posterior Beta Mixture Integrand when `delta` is relative. #' #' The helper function to generate Integrand function when `relative Delta = TRUE`. #' -#' @typed p : number +#' A numerical integration to compute this probability is given on p.338 +# in the article by Thall and Simon (1994, Biometrics): +#' +#' @typed delta : numeric +#' the margin of which treatment group `E` is superior than the success rate of +#' the standard of care `S`. If the `p_S` or success rate of `S` is `0`, +#' then the difference between two groups is merely `delta`. See also @note +#' @typed p_s : number #' probability of success or response rate of standard of care or `SOC` group. +#' @typed activeBetamixPost : list +#' a list of posterior parameters of a beta-mixture-binomial distribution with generic names +#' `par` and `weights`. See `[getBetaMix()]`. +#' @typed controlBetamixPost : list +#' a list of posterior parameters of a beta-mixture-binomial distribution with generic names +#' `par` and `weights`. See `[getBetaMix()]`. #' #' @return An R function that is an argument for `[stats::integrate()]`. #' #' @keywords internal -h_integrand_relDelta <- function(p_s, delta, x, betamixPost, controlBetamixPost) { +h_integrand_relDelta <- function(p_s, delta, activeBetamixPost, controlBetamixPost) { cdf <- postprob( - x = x, - n = n, + x = 0, # dummy x for Vectorize() p = (1 - p_s) * delta + p_s, - betamixPost + betamixPost = activeBetamixPost ) pdf <- with( controlBetamixPost, @@ -28,8 +40,10 @@ h_integrand_relDelta <- function(p_s, delta, x, betamixPost, controlBetamixPost) #' The Posterior Beta Mixture Integrand when Delta is absolute. #' -#' The helper function to generate Integrand function when `relative Delta = FALSE` -#' , a default setting. +#' The helper function to generate Integrand function when `relative Delta = FALSE`, +#' a default setting. +#' See `[postprobDist()]` +#' #' A numerical integration to compute this probability is given on p.338 # in the article by Thall and Simon (1994, Biometrics): #' @@ -39,12 +53,11 @@ h_integrand_relDelta <- function(p_s, delta, x, betamixPost, controlBetamixPost) #' #' @keywords internal #' -h_integrand <- function(p_s, delta, x, betamixPost, controlBetamixPost) { +h_integrand <- function(p_s, delta, activeBetamixPost, controlBetamixPost) { cdf <- postprob( - x = x, - n = n, + x = 0, # dummy x for Vectorize() p = p_s + delta, - betamixPost + betamixPost = activeBetamixPost ) pdf <- with( controlBetamixPost, @@ -58,15 +71,8 @@ h_integrand <- function(p_s, delta, x, betamixPost, controlBetamixPost) { #' Using the quantile of the Beta Mixture Distribution from parameters given by standard of care `SOC` or #' experimental group `E` to determine bounds as inputs to `[stats::integrate()]` #' -#' @typed betamixPost : list +#' @typed controlbetamixPost : list #' arguments of `par`and `weights` of Beta Mixture Posterior in format list. See `[getBetaMix()]`. -#' @typed par : matrix -#' the beta parameters matrix, with `K` rows and 2 columns, -#' corresponding to the beta parameters of the `K` components. -#' @typed weights : vector -#' The mixture weights of the beta mixture prior. Default are -#' uniform weights across mixture components. -#' #' @return Integrand function #' #' @keywords internal @@ -83,49 +89,35 @@ h_get_bounds <- function(controlBetamixPost) { ) } -#' Compute the posterior probability with beta prior on SOC +#' Compute the Posterior Probability with Beta Prior on `SOC` #' #' @description `r lifecycle::badge("experimental")` #' -#' Using the approach by Thall and Simon (Biometrics, 1994), evaluate the -#' posterior probability of having `Pr(P_E > P_S + delta | data)` (but see below -#' for relative delta margin). Both for the new treatment `E` as well as for the -#' Standard of Care (SOC): `S` data might be available. However the default assumption is that no data is -#' available for the `SOC`, corresponding to the single arm trial situation -#' where we only rely on incoming data from the Experimental arm. In the case -#' -#' Using the approach by Thall and Simon (Biometrics, 1994), we evaluate the -#' posterior probability of having a desired improvement of treatment effect to -#' standard of care, SOC. When there is no standard of care, -#' -#' The choice of prior will consider the following : +#' Using the approach by Thall and Simon (Biometrics, 1994), this evaluates the +#' posterior probability of achieving superior response rate in the treatment group compared to standard of care (SOC). +#' See notes below for two formulations of the difference in response rates. #' -#' For single arm trial, an informative prior on the SOC proportion is -#' useful. -#' Otherwise, a uniform prior is the useful default for the treatment proportion. see @note. +#' In reality, data may or may not be complete for both the new treatment `E` as well as for the SOC group, +#' `S`. Accordingly prior distribution should be specified. #' -#' The calculation of `delta` : +#' 1. No precedent data : +#' The default setting is a uniform prior of `Beta(1,1)`. This can be used to reflect no precedent data +#' in both the `E` and `S` arms. #' -#' The desired improvement is denoted as `delta`. There are two options in calculating `delta`. -#' The absolute case when `relativeDelta = FALSE` and relative as when `relativeDelta = TRUE`. -#' The posterior in question can be expressed as `Pr(P_E > P_S + delta | data)`. +#' 2a. Precedent data for only either `E` : +#' A user input prior is given by user to reflect precedent data of the `E` arm. +#' For each set of prior parameters, user can input weighting. See (4) #' -#' 1. The absolute case is when we define an absolute delta, greater than `P_S`, -#' the response rate of the `SOC` group such that -#' the posterior is `Pr(P_E > P_S + delta | data)`. +#' 2b. Precedent data for only either `S` : +#' A user input prior is given by user to reflect precedent data of the `S` arm. +#' For each set of prior parameters, user can input weighting. See (4) #' -#' 2. In the relative case, we suppose that the treatment group's -#' response rate is assumed to be greater than `P_S + (1-P_S)*delta` such that -#' the posterior is `Pr(P_E > P_S + (1 - P_S) * delta | data)`. +#' Choice of Weights #' -#' @note on beta Priors +#' 3. In the simple case of no mixture of priors, the one Beta parameter are weighted as `100 %`. #' -#' Beta mixture prior can be specified for the treatment `parE` -#' and `weights` parameters) and control proportion `parS` and -#' `weightsS` parameters), see `postprob` for details. Note -#' that being able to specify a beta mixture prior also on the control -#' treatment is e.g. important for the futility decision making (see the -#' `oc2` code). +#' 4. In the Beta Binomial Mixture case, users can allocate a non-negative weighting and can exceed `100 %`, +#' which the algorithm will normalised such that all weights sum to 1. #' #' @typed x : vector #' vector of success counts in the treatment group. Vector of minimum length of 1. @@ -147,7 +139,7 @@ h_get_bounds <- function(controlBetamixPost) { #' uniform prior. #' @typed weights : matrix #' the mixture weights of the beta mixture prior. Default are -#' uniform weights across mixture components. +#' equal weights across mixture components. #' @typed parS : matrix #' beta parameters for the SOC group (default: uniform) #' @typed weightsS : matrix @@ -158,12 +150,25 @@ h_get_bounds <- function(controlBetamixPost) { #' @return The posterior probability #' #' @note -#' Beta mixture prior can be specified for the treatment in `parE` -#' and `weights` parameters) and SOC in `parS` and -#' `weightsS` parameters), see `[postprob()]` for details. Note -#' that being able to specify a beta mixture prior also on the control -#' treatment is important for the futility decision making (see the -#' `[oc2()]` code). +#' +#' ## Delta : +#' +#' The desired improvement is denoted as `delta`. There are two options in using `delta`. +#' The absolute case when `relativeDelta = FALSE` and relative as when `relativeDelta = TRUE`. +#' +#' 1. The absolute case is when we define an absolute delta, greater than `P_S`, +#' the response rate of the `SOC` group such that +#' the posterior is `Pr(P_E > P_S + delta | data)`. +#' +#' 2. In the relative case, we suppose that the treatment group's +#' response rate is assumed to be greater than `P_S + (1-P_S)*delta` such that +#' the posterior is `Pr(P_E > P_S + (1 - P_S) * delta | data)`. +#' +#' @details +#' +#' The beta mixture prior for the E arm requires argument `parE` and `weights`. +#' The beta mixture prior for the E arm requires argument `parS` and `weightsS`. +#' See `[postprob()]` for details. #' #' @example examples/postprobDist.R #' @export @@ -172,7 +177,7 @@ postprobDist <- function(x, n, xS = 0, nS = 0, - delta = 0, + delta, relativeDelta = FALSE, parE = c(1, 1), weights, @@ -217,8 +222,7 @@ postprobDist <- function(x, bounds[2] ), delta = delta, - x = x, - betamixPost = activeBetamixPost, + activeBetamixPost = activeBetamixPost, controlBetamixPost = controlBetamixPost ) if (intRes$message == "OK") { diff --git a/examples/postprobDist.R b/examples/postprobDist.R index e6b20921..7560df1f 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -1,10 +1,10 @@ # example similar to Lee and Liu: -postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), relativeDelta = FALSE) +postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, relativeDelta = FALSE) -# when relativeDelta is used +# when relativeDelta is used. postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, relativeDelta = TRUE) -## these two should give the same result: +# these two should give the same result: postprobDist( x = 27, n = 34, xS = 0, nS = 0, @@ -34,7 +34,8 @@ postprobDist( c(0.6, 0.4), c(10, 10) ), - weightsS = c(1, 3) + weightsS = c(1, 3), + delta = 0.1 ) # try these examples @@ -47,9 +48,8 @@ postprobDist( delta = 0, relativeDelta = FALSE, parE = c(1, 1), - weights, parS = c(1, 1), - weightsS + weightsS = c(1) ) # 2. Experimental arm and SOC, uniform prior in both E and S arms. postprobDist( @@ -60,11 +60,10 @@ postprobDist( delta = 0, relativeDelta = FALSE, parE = c(1, 1), - weights, parS = c(1, 1), - weightsS + weightsS = c(1) ) -# 3. Experimental and SOC arm, with beta mix prior for S arms, uniform for E +# 3. Experimental and SOC arm, with beta mix prior for S arms with 50:50 weighting, uniform for E. postprobDist( x = 16, n = 20, @@ -73,13 +72,14 @@ postprobDist( delta = 0, relativeDelta = FALSE, parE = c(1, 1), - weights, - parS = c(4, 5), - weightsS + weights = c(1), + parS = rbind(c(4, 5), c(1, 3)), + weightsS = c(1, 2) ) -# 3b. Experimental and SOC arm, with beta mix prior for S arm, uniform for E -# The SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights +# 3b. Experimental and SOC arm, with beta mix prior for S arm, uniform for E. +# The SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights. +# We can have weights exceeding 1 because it will be internally normalised to sum to 1. postprobDist( x = 16, n = 20, @@ -88,13 +88,12 @@ postprobDist( delta = 0, relativeDelta = FALSE, parE = c(1, 1), - weights, parS = rbind(c(4, 5), c(2, 3), c(4, 4)), weightsS = c(2, 5, 3) ) -# 3c. Experimental and SOC arm, with beta mix prior for both arms -# For each of the SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights +# 4. Experimental and SOC arm, with beta mix prior for both arms. +# For each of the SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights. postprobDist( x = 16, n = 20, diff --git a/inst/WORDLIST b/inst/WORDLIST index 7a9e5021..773ef70a 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -74,6 +74,7 @@ dw dX dY dZ +ee eq estunated ExpectedN @@ -106,6 +107,7 @@ nn nnE nnF nnr +normalised nS oc ocPostProb @@ -150,6 +152,7 @@ SampleSizeActive SampleSizeControl seperate ShinyPhase +specifcations sumbetadiff summerize summerizes diff --git a/man/h_get_bounds.Rd b/man/h_get_bounds.Rd index a3e77ea6..ea8c043d 100644 --- a/man/h_get_bounds.Rd +++ b/man/h_get_bounds.Rd @@ -7,13 +7,7 @@ h_get_bounds(controlBetamixPost) } \arguments{ -\item{betamixPost}{(\code{list}):\cr arguments of \code{par}and \code{weights} of Beta Mixture Posterior in format list. See \verb{[getBetaMix()]}.} - -\item{par}{(\code{matrix}):\cr the beta parameters matrix, with \code{K} rows and 2 columns, -corresponding to the beta parameters of the \code{K} components.} - -\item{weights}{(\code{vector}):\cr The mixture weights of the beta mixture prior. Default are -uniform weights across mixture components.} +\item{controlbetamixPost}{(\code{list}):\cr arguments of \code{par}and \code{weights} of Beta Mixture Posterior in format list. See \verb{[getBetaMix()]}.} } \value{ Integrand function diff --git a/man/h_integrand.Rd b/man/h_integrand.Rd index 1ee7c106..a7ac3dff 100644 --- a/man/h_integrand.Rd +++ b/man/h_integrand.Rd @@ -4,14 +4,30 @@ \alias{h_integrand} \title{The Posterior Beta Mixture Integrand when Delta is absolute.} \usage{ -h_integrand(p_s, delta, x, betamixPost, controlBetamixPost) +h_integrand(p_s, delta, activeBetamixPost, controlBetamixPost) +} +\arguments{ +\item{p_s}{(\code{number}):\cr probability of success or response rate of standard of care or \code{SOC} group.} + +\item{delta}{(\code{numeric}):\cr the margin of which treatment group \code{E} is superior than the success rate of +the standard of care \code{S}. If the \code{p_S} or success rate of \code{S} is \code{0}, +then the difference between two groups is merely \code{delta}. See also @note} + +\item{activeBetamixPost}{(\code{list}):\cr a list of posterior parameters of a beta-mixture-binomial distribution with generic names +\code{par} and \code{weights}. See \verb{[getBetaMix()]}.} + +\item{controlBetamixPost}{(\code{list}):\cr a list of posterior parameters of a beta-mixture-binomial distribution with generic names +\code{par} and \code{weights}. See \verb{[getBetaMix()]}.} } \value{ An R function that is an argument for \verb{[stats::integrate()]}. } \description{ -The helper function to generate Integrand function when \verb{relative Delta = FALSE} -, a default setting. +The helper function to generate Integrand function when \verb{relative Delta = FALSE}, +a default setting. +See \verb{[postprobDist()]} +} +\details{ A numerical integration to compute this probability is given on p.338 } \keyword{internal} diff --git a/man/h_integrand_relDelta.Rd b/man/h_integrand_relDelta.Rd index 57e3e6a2..9a26450c 100644 --- a/man/h_integrand_relDelta.Rd +++ b/man/h_integrand_relDelta.Rd @@ -2,12 +2,22 @@ % Please edit documentation in R/postprobDist.R \name{h_integrand_relDelta} \alias{h_integrand_relDelta} -\title{The Posterior Beta Mixture Integrand based on \code{delta}} +\title{The Posterior Beta Mixture Integrand when \code{delta} is relative.} \usage{ -h_integrand_relDelta(p_s, delta, x, betamixPost, controlBetamixPost) +h_integrand_relDelta(p_s, delta, activeBetamixPost, controlBetamixPost) } \arguments{ -\item{p}{(\code{number}):\cr probability of success or response rate of standard of care or \code{SOC} group.} +\item{p_s}{(\code{number}):\cr probability of success or response rate of standard of care or \code{SOC} group.} + +\item{delta}{(\code{numeric}):\cr the margin of which treatment group \code{E} is superior than the success rate of +the standard of care \code{S}. If the \code{p_S} or success rate of \code{S} is \code{0}, +then the difference between two groups is merely \code{delta}. See also @note} + +\item{activeBetamixPost}{(\code{list}):\cr a list of posterior parameters of a beta-mixture-binomial distribution with generic names +\code{par} and \code{weights}. See \verb{[getBetaMix()]}.} + +\item{controlBetamixPost}{(\code{list}):\cr a list of posterior parameters of a beta-mixture-binomial distribution with generic names +\code{par} and \code{weights}. See \verb{[getBetaMix()]}.} } \value{ An R function that is an argument for \verb{[stats::integrate()]}. @@ -15,4 +25,7 @@ An R function that is an argument for \verb{[stats::integrate()]}. \description{ The helper function to generate Integrand function when \verb{relative Delta = TRUE}. } +\details{ +A numerical integration to compute this probability is given on p.338 +} \keyword{internal} diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index d88ef2fb..a6bfeadf 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -2,14 +2,14 @@ % Please edit documentation in R/postprobDist.R \name{postprobDist} \alias{postprobDist} -\title{Compute the posterior probability with beta prior on SOC} +\title{Compute the Posterior Probability with Beta Prior on \code{SOC}} \usage{ postprobDist( x, n, xS = 0, nS = 0, - delta = 0, + delta, relativeDelta = FALSE, parE = c(1, 1), weights, @@ -37,7 +37,7 @@ corresponding to the beta parameters of the K components. default is a uniform prior.} \item{weights}{(\code{matrix}):\cr the mixture weights of the beta mixture prior. Default are -uniform weights across mixture components.} +equal weights across mixture components.} \item{parS}{(\code{matrix}):\cr beta parameters for the SOC group (default: uniform)} @@ -52,28 +52,43 @@ The posterior probability \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Using the approach by Thall and Simon (Biometrics, 1994), evaluate the -posterior probability of having \code{Pr(P_E > P_S + delta | data)} (but see below -for relative delta margin). Both for the new treatment \code{E} as well as for the -Standard of Care (SOC): \code{S} data might be available. However the default assumption is that no data is -available for the \code{SOC}, corresponding to the single arm trial situation -where we only rely on incoming data from the Experimental arm. In the case +Using the approach by Thall and Simon (Biometrics, 1994), this evaluates the +posterior probability of achieving superior response rate in the treatment group compared to standard of care (SOC). +See notes below for two formulations of the difference in response rates. -Using the approach by Thall and Simon (Biometrics, 1994), we evaluate the -posterior probability of having a desired improvement of treatment effect to -standard of care, SOC. When there is no standard of care, +In reality, data may or may not be complete for both the new treatment \code{E} as well as for the SOC group, +\code{S}. Accordingly prior distribution should be specified. +\enumerate{ +\item No precedent data : +The default setting is a uniform prior of \code{Beta(1,1)}. This can be used to reflect no precedent data +in both the \code{E} and \code{S} arms. +} -The choice of prior will consider the following : +2a. Precedent data for only either \code{E} : +A user input prior is given by user to reflect precedent data of the \code{E} arm. +For each set of prior parameters, user can input weighting. See (4) -For single arm trial, an informative prior on the SOC proportion is -useful. -Otherwise, a uniform prior is the useful default for the treatment proportion. see @note. +2b. Precedent data for only either \code{S} : +A user input prior is given by user to reflect precedent data of the \code{S} arm. +For each set of prior parameters, user can input weighting. See (4) -The calculation of \code{delta} : +Choice of Weights +\enumerate{ +\item In the simple case of no mixture of priors, the one Beta parameter are weighted as \verb{100 \%}. +\item In the Beta Binomial Mixture case, users can allocate a non-negative weighting and can exceed \verb{100 \%}, +which the algorithm will normalised such that all weights sum to 1. +} +} +\details{ +The beta mixture prior for the E arm requires argument \code{parE} and \code{weights}. +The beta mixture prior for the E arm requires argument \code{parS} and \code{weightsS}. +See \verb{[postprob()]} for details. +} +\note{ +\subsection{Delta :}{ -The desired improvement is denoted as \code{delta}. There are two options in calculating \code{delta}. +The desired improvement is denoted as \code{delta}. There are two options in using \code{delta}. The absolute case when \code{relativeDelta = FALSE} and relative as when \code{relativeDelta = TRUE}. -The posterior in question can be expressed as \code{Pr(P_E > P_S + delta | data)}. \enumerate{ \item The absolute case is when we define an absolute delta, greater than \code{P_S}, the response rate of the \code{SOC} group such that @@ -83,31 +98,15 @@ response rate is assumed to be greater than \code{P_S + (1-P_S)*delta} such that the posterior is \code{Pr(P_E > P_S + (1 - P_S) * delta | data)}. } } -\note{ -on beta Priors - -Beta mixture prior can be specified for the treatment \code{parE} -and \code{weights} parameters) and control proportion \code{parS} and -\code{weightsS} parameters), see \code{postprob} for details. Note -that being able to specify a beta mixture prior also on the control -treatment is e.g. important for the futility decision making (see the -\code{oc2} code). - -Beta mixture prior can be specified for the treatment in \code{parE} -and \code{weights} parameters) and SOC in \code{parS} and -\code{weightsS} parameters), see \verb{[postprob()]} for details. Note -that being able to specify a beta mixture prior also on the control -treatment is important for the futility decision making (see the -\verb{[oc2()]} code). } \examples{ # example similar to Lee and Liu: -postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), relativeDelta = FALSE) +postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, relativeDelta = FALSE) -# when relativeDelta is used +# when relativeDelta is used. postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, relativeDelta = TRUE) -## these two should give the same result: +# these two should give the same result: postprobDist( x = 27, n = 34, xS = 0, nS = 0, @@ -137,7 +136,8 @@ postprobDist( c(0.6, 0.4), c(10, 10) ), - weightsS = c(1, 3) + weightsS = c(1, 3), + delta = 0.1 ) # try these examples @@ -150,9 +150,8 @@ postprobDist( delta = 0, relativeDelta = FALSE, parE = c(1, 1), - weights, parS = c(1, 1), - weightsS + weightsS = c(1) ) # 2. Experimental arm and SOC, uniform prior in both E and S arms. postprobDist( @@ -163,11 +162,10 @@ postprobDist( delta = 0, relativeDelta = FALSE, parE = c(1, 1), - weights, parS = c(1, 1), - weightsS + weightsS = c(1) ) -# 3. Experimental and SOC arm, with beta mix prior for S arms, uniform for E +# 3. Experimental and SOC arm, with beta mix prior for S arms with 50:50 weighting, uniform for E. postprobDist( x = 16, n = 20, @@ -176,13 +174,14 @@ postprobDist( delta = 0, relativeDelta = FALSE, parE = c(1, 1), - weights, - parS = c(4, 5), - weightsS + weights = c(1), + parS = rbind(c(4, 5), c(1, 3)), + weightsS = c(1, 2) ) -# 3b. Experimental and SOC arm, with beta mix prior for S arm, uniform for E -# The SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights +# 3b. Experimental and SOC arm, with beta mix prior for S arm, uniform for E. +# The SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights. +# We can have weights exceeding 1 because it will be internally normalised to sum to 1. postprobDist( x = 16, n = 20, @@ -191,13 +190,12 @@ postprobDist( delta = 0, relativeDelta = FALSE, parE = c(1, 1), - weights, parS = rbind(c(4, 5), c(2, 3), c(4, 4)), weightsS = c(2, 5, 3) ) -# 3c. Experimental and SOC arm, with beta mix prior for both arms -# For each of the SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights +# 4. Experimental and SOC arm, with beta mix prior for both arms. +# For each of the SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights. postprobDist( x = 16, n = 20, diff --git a/tests/testthat/test-postprob.R b/tests/testthat/test-postprob.R index e9381886..f0b62a9d 100644 --- a/tests/testthat/test-postprob.R +++ b/tests/testthat/test-postprob.R @@ -19,7 +19,7 @@ test_that("postprob gives the correct number result", { }) test_that("postprob gives the correct number result", { - # 2 component beta mixture prior, i.e., P_E ~ 0.6*beta(0.6,0.4) + 0.4*beta(1,1) and Pr(P_E > p | data) = 0.823 + # 2 component beta mixture prior, i.e., P_E ~ 1*beta(0.6,0.4) + 1*beta(1,1) and Pr(P_E > p | data) = 0.823 result <- postprob( x = 10, n = 23, diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index a4d348c3..8710ac5a 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -1,12 +1,12 @@ # postprobBeta ---- test_that("postprobDist gives the correct number result", { - result <- postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) - expect_equal(result, 0.5123873, tolerance = 1e-5) + result <- postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1) + expect_equal(result, 0.4431067, tolerance = 1e-5) }) test_that("postprobDist gives incrementally higher values with increase x support", { - is_lower <- postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) - is_higher <- postprobDist(x = 20, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) + is_lower <- postprobDist(x = 16, n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) + is_higher <- postprobDist(x = 20, n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) expect_true(is_lower < is_higher) }) @@ -15,6 +15,7 @@ test_that("postprob gives the correct number result", { result <- postprobDist( x = 10, n = 23, + delta = 0.1, parE = rbind( c(0.6, 0.4), c(1, 1) @@ -24,13 +25,14 @@ test_that("postprob gives the correct number result", { c(1, 1) ) ) - expect_equal(result, 0.3948115, tolerance = 1e-5) + expect_equal(result, 0.3143941, tolerance = 1e-5) }) test_that("postprob gives incrementally higher values with increased x", { is_lower <- postprobDist( x = 10, n = 23, + delta = 0.1, parE = rbind( c(0.6, 0.4), c(1, 1) @@ -43,6 +45,7 @@ test_that("postprob gives incrementally higher values with increased x", { is_higher <- postprobDist( x = 16, n = 23, + delta = 0.1, parE = rbind( c(0.6, 0.4), c(1, 1) @@ -60,6 +63,7 @@ test_that("postprobDist gives the correct number result", { result <- postprobDist( x = 10, n = 23, + delta = 0.1, parE = rbind( c(0.6, 0.4), c(1, 1) @@ -71,7 +75,7 @@ test_that("postprobDist gives the correct number result", { weights = c(0.5, 0.5), weightsS = c(0.3, 0.7), ) - expect_equal(result, 0.3856478, tolerance = 1e-4) + expect_equal(result, 0.3248885, tolerance = 1e-4) }) # Extreme beta numbers are lowly weighted @@ -80,6 +84,7 @@ test_that("postprobDist gives the correct number result", { result <- postprobDist( x = 10, n = 23, + delta = 0.1, parE = rbind( c(0.6, 0.4), c(1, 1) @@ -91,5 +96,50 @@ test_that("postprobDist gives the correct number result", { weights = c(0.5, 0.5), weightsS = c(0.3, 0.7), ) - expect_equal(result, 0.3856478, tolerance = 1e-4) + expect_equal(result, 0.3248885, tolerance = 1e-4) +}) + +# h_integrand_relDelta-- +test_that("h_integrand_relDelta gives the correct numerical result", { + x <- 16 + n <- 23 + xS <- 10 + nS <- 20 + parE <- t(c(1, 3)) + parS <- t(c(1, 1)) + weights <- c(1) + weightsS <- c(1) + p_s <- 0.1 + delta <- 0.1 + relativeDelta <- TRUE + activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights) + controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) + results <- h_integrand_relDelta( + p_s = p_s, delta = 0.1, + activeBetamixPost = activeBetamixPost, + controlBetamixPost = controlBetamixPost + ) + expect_equal(results, 0.0001352829, tolerance = 1e-4) +}) + +test_that("h_integrand_relDelta gives the correct numerical result", { + x <- 16 + n <- 23 + xS <- 10 + nS <- 20 + parE <- t(c(1, 3)) + parS <- t(c(1, 1)) + weights <- c(1) + weightsS <- c(1) + p_s <- 0.1 + delta <- 0.1 + relativeDelta <- TRUE + activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights) + controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) + results <- h_integrand( + p_s = p_s, delta = 0.1, + activeBetamixPost = activeBetamixPost, + controlBetamixPost = controlBetamixPost + ) + expect_equal(results, 0.0001352828, tolerance = 1e-4) }) From e90d2739f784339cc1ec40e7330c69996e8f0123 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 14 Nov 2023 08:23:21 +0100 Subject: [PATCH 079/106] clean --- R/postprobDist.R | 65 +++++++++----------- examples/postprobDist.R | 59 ++++++++++--------- man/h_get_bounds.Rd | 3 +- man/h_integrand.Rd | 11 ++-- man/h_integrand_relDelta.Rd | 12 ++-- man/postprobDist.Rd | 95 +++++++++++++++--------------- tests/testthat/test-postprobDist.R | 54 +++++++++++++++-- 7 files changed, 168 insertions(+), 131 deletions(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index 39bd74da..55e9dd9a 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -2,17 +2,15 @@ #' @include postprob.R NULL -#' The Posterior Beta Mixture Integrand when `delta` is relative. +#' The Posterior Beta Mixture Integrand when `delta` is relative #' -#' The helper function to generate Integrand function when `relative Delta = TRUE`. -#' -#' A numerical integration to compute this probability is given on p.338 -# in the article by Thall and Simon (1994, Biometrics): +#' The helper function to generate Integrand function when `relative Delta = TRUE`. #' #' @typed delta : numeric #' the margin of which treatment group `E` is superior than the success rate of -#' the standard of care `S`. If the `p_S` or success rate of `S` is `0`, +#' the standard of care `S`. If the `p_s` or success rate of `S` is `0`, #' then the difference between two groups is merely `delta`. See also @note +#' about the calculation of `delta` when `relative Delta = TRUE` #' @typed p_s : number #' probability of success or response rate of standard of care or `SOC` group. #' @typed activeBetamixPost : list @@ -25,9 +23,10 @@ NULL #' @return An R function that is an argument for `[stats::integrate()]`. #' #' @keywords internal +#' h_integrand_relDelta <- function(p_s, delta, activeBetamixPost, controlBetamixPost) { cdf <- postprob( - x = 0, # dummy x for Vectorize() + x = 0, # we denote a dummy x for Vectorize() p = (1 - p_s) * delta + p_s, betamixPost = activeBetamixPost ) @@ -38,14 +37,10 @@ h_integrand_relDelta <- function(p_s, delta, activeBetamixPost, controlBetamixPo cdf * pdf } -#' The Posterior Beta Mixture Integrand when Delta is absolute. +#' The Posterior Beta Mixture Integrand when Delta is absolute #' #' The helper function to generate Integrand function when `relative Delta = FALSE`, #' a default setting. -#' See `[postprobDist()]` -#' -#' A numerical integration to compute this probability is given on p.338 -# in the article by Thall and Simon (1994, Biometrics): #' #' @inheritParams h_integrand_relDelta #' @@ -55,7 +50,7 @@ h_integrand_relDelta <- function(p_s, delta, activeBetamixPost, controlBetamixPo #' h_integrand <- function(p_s, delta, activeBetamixPost, controlBetamixPost) { cdf <- postprob( - x = 0, # dummy x for Vectorize() + x = 0, # we denote a dummy x for Vectorize() p = p_s + delta, betamixPost = activeBetamixPost ) @@ -71,8 +66,7 @@ h_integrand <- function(p_s, delta, activeBetamixPost, controlBetamixPost) { #' Using the quantile of the Beta Mixture Distribution from parameters given by standard of care `SOC` or #' experimental group `E` to determine bounds as inputs to `[stats::integrate()]` #' -#' @typed controlbetamixPost : list -#' arguments of `par`and `weights` of Beta Mixture Posterior in format list. See `[getBetaMix()]`. +#' @inheritParams h_integrand_relDelta #' @return Integrand function #' #' @keywords internal @@ -94,56 +88,56 @@ h_get_bounds <- function(controlBetamixPost) { #' @description `r lifecycle::badge("experimental")` #' #' Using the approach by Thall and Simon (Biometrics, 1994), this evaluates the -#' posterior probability of achieving superior response rate in the treatment group compared to standard of care (SOC). -#' See notes below for two formulations of the difference in response rates. +#' posterior probability of achieving superior response rate in the treatment group compared to standard of care (SOC): +#' +#' `Pr(P_E > P_S | data) = \int 1-F(p_s + delta | alpha_E + x, beta_E + n- x) f(p_s; alpha_S, beta_S`. +#' See @note below for two formulations of the difference in response rates. #' #' In reality, data may or may not be complete for both the new treatment `E` as well as for the SOC group, -#' `S`. Accordingly prior distribution should be specified. +#' `S`. Accordingly, prior distributions should be specified. The following is a guidance in possible user cases : #' #' 1. No precedent data : #' The default setting is a uniform prior of `Beta(1,1)`. This can be used to reflect no precedent data #' in both the `E` and `S` arms. #' -#' 2a. Precedent data for only either `E` : +#' 2a. Precedent data for only `E` : #' A user input prior is given by user to reflect precedent data of the `E` arm. #' For each set of prior parameters, user can input weighting. See (4) #' -#' 2b. Precedent data for only either `S` : +#' 2b. Precedent data for only `S` : #' A user input prior is given by user to reflect precedent data of the `S` arm. #' For each set of prior parameters, user can input weighting. See (4) #' -#' Choice of Weights -#' -#' 3. In the simple case of no mixture of priors, the one Beta parameter are weighted as `100 %`. +#' 3. In the simple case of no mixture of priors given, the Beta parameters are weighted as `100 %`. #' #' 4. In the Beta Binomial Mixture case, users can allocate a non-negative weighting and can exceed `100 %`, -#' which the algorithm will normalised such that all weights sum to 1. +#' to which the algorithm will normalize the weights such that all weights sum to 1. #' -#' @typed x : vector -#' vector of success counts in the treatment group. Vector of minimum length of 1. +#' @typed x : numeric +#' number of success counts in the treatment group. Number of minimum length of 1. #' @typed n : number #' number of patients in the treatment group. -#' @typed xS : vector -#' vector of success counts in the SOC group (default: 0). Vector of minimum length of 1. +#' @typed xS : numeric +#' number of success counts in the SOC group (default: 0). Number of minimum length of 1. #' @typed nS : number #' number of patients in the SOC group (default: 0) #' @typed delta : number #' margin by which the response rate in the treatment group should -#' be better than in the SOC group (default: 0). Must be >= `0`. see @note. +#' be better than in the SOC group (default: 0). Must be >= `0`. See @note. #' @typed relativeDelta : flag #' If `TRUE`, then a `relativeDelta` is used. Represents that a minimum -#' response rate in magnitude of `delta` of the SOC non-responding patients. see @note. +#' response rate in magnitude of `delta` of the SOC non-responding patients. See @note. #' @typed parE : matrix #' the beta parameters matrix, with K rows and 2 columns, -#' corresponding to the beta parameters of the K components. default is a -#' uniform prior. +#' corresponding to the beta parameters of the K components. Default is a +#' uniform prior `Beta(1,1)`. See @details. #' @typed weights : matrix #' the mixture weights of the beta mixture prior. Default are #' equal weights across mixture components. #' @typed parS : matrix -#' beta parameters for the SOC group (default: uniform) +#' beta parameters for the SOC group (default: uniform). ee @details. #' @typed weightsS : matrix -#' weights for the SOC group (default: uniform) +#' weights for the SOC group (default: uniform). #' @typed epsilon : number #' the smallest non-negative floating number to represent the lower bound for #' the interval of integration. @@ -161,7 +155,7 @@ h_get_bounds <- function(controlBetamixPost) { #' the posterior is `Pr(P_E > P_S + delta | data)`. #' #' 2. In the relative case, we suppose that the treatment group's -#' response rate is assumed to be greater than `P_S + (1-P_S)*delta` such that +#' response rate is assumed to be greater than `P_S + (1-P_S) * delta` such that #' the posterior is `Pr(P_E > P_S + (1 - P_S) * delta | data)`. #' #' @details @@ -172,7 +166,6 @@ h_get_bounds <- function(controlBetamixPost) { #' #' @example examples/postprobDist.R #' @export - postprobDist <- function(x, n, xS = 0, diff --git a/examples/postprobDist.R b/examples/postprobDist.R index 7560df1f..7da1ba1f 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -1,10 +1,24 @@ -# example similar to Lee and Liu: -postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, relativeDelta = FALSE) +# An example similar to Lee and Liu (2008). +postprobDist( + x = 16, + n = 23, + parE = c(0.6, 0.4), + parS = c(0.6, 0.4), + delta = 0.1, + relativeDelta = FALSE +) -# when relativeDelta is used. -postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, relativeDelta = TRUE) +# When relativeDelta is TRUE. +postprobDist( + x = 16, + n = 23, + parE = c(0.6, 0.4), + parS = c(0.6, 0.4), + delta = 0.1, + relativeDelta = TRUE +) -# these two should give the same result: +# Varying SOC priors. postprobDist( x = 27, n = 34, xS = 0, nS = 0, @@ -13,15 +27,7 @@ postprobDist( parS = c(50007530, 49924090) ) -postprob(x = 27, n = 34, p = 0.65, parE = c(1, 1)) -# ok, almost - -# try out mixtures: -# play around with the beta parameters and weights to -# get a feeling. -# Note that very extreme beta parameters do no longer increase -# the return value, because then that mixture component is too -# unlikely a posteriori +# When there are mixed parameters in both Experimental and SOC arm. r postprobDist( x = 16, n = 23, parE = @@ -37,9 +43,9 @@ postprobDist( weightsS = c(1, 3), delta = 0.1 ) -# try these examples -# 1. Experimental arm only (strictly single arm trial), uniform prior in both E and S arms. +# Experimental arm only (strictly single arm trial), uniform prior in Experimental arm. Default used. +# Non-uniform Prior used for SOC arm as no precedent data. postprobDist( x = 16, n = 23, @@ -47,11 +53,10 @@ postprobDist( nS = 0, delta = 0, relativeDelta = FALSE, - parE = c(1, 1), - parS = c(1, 1), + parS = c(2, 3), weightsS = c(1) ) -# 2. Experimental arm and SOC, uniform prior in both E and S arms. +# Experimental arm and SOC, uniform prior in both E and S arms, default setting used. postprobDist( x = 16, n = 20, @@ -59,11 +64,9 @@ postprobDist( nS = 20, delta = 0, relativeDelta = FALSE, - parE = c(1, 1), - parS = c(1, 1), weightsS = c(1) ) -# 3. Experimental and SOC arm, with beta mix prior for S arms with 50:50 weighting, uniform for E. +# Experimental and SOC arm, with beta mix prior for SOC arms with equal weighting, uniform for E. postprobDist( x = 16, n = 20, @@ -77,30 +80,30 @@ postprobDist( weightsS = c(1, 2) ) -# 3b. Experimental and SOC arm, with beta mix prior for S arm, uniform for E. +# Experimental and SOC arm, with beta mix prior for SOC arm, uniform for E. # The SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights. -# We can have weights exceeding 1 because it will be internally normalised to sum to 1. +# We can have weights exceeding 1 because it will be normalised to sum to 1. postprobDist( x = 16, n = 20, xS = 10, nS = 20, - delta = 0, + delta = 0.1, relativeDelta = FALSE, parE = c(1, 1), parS = rbind(c(4, 5), c(2, 3), c(4, 4)), weightsS = c(2, 5, 3) ) -# 4. Experimental and SOC arm, with beta mix prior for both arms. +# Experimental and SOC arm, with beta mix prior for both arms. # For each of the SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights. postprobDist( x = 16, n = 20, xS = 10, nS = 20, - delta = 0, - relativeDelta = FALSE, + delta = 0.1, + relativeDelta = TRUE, parE = rbind(c(1, 1), c(3, 4), c(8, 9)), weights = c(5, 3, 2), parS = rbind(c(4, 5), c(2, 3), c(4, 4)), diff --git a/man/h_get_bounds.Rd b/man/h_get_bounds.Rd index ea8c043d..37e01a5b 100644 --- a/man/h_get_bounds.Rd +++ b/man/h_get_bounds.Rd @@ -7,7 +7,8 @@ h_get_bounds(controlBetamixPost) } \arguments{ -\item{controlbetamixPost}{(\code{list}):\cr arguments of \code{par}and \code{weights} of Beta Mixture Posterior in format list. See \verb{[getBetaMix()]}.} +\item{controlBetamixPost}{(\code{list}):\cr a list of posterior parameters of a beta-mixture-binomial distribution with generic names +\code{par} and \code{weights}. See \verb{[getBetaMix()]}.} } \value{ Integrand function diff --git a/man/h_integrand.Rd b/man/h_integrand.Rd index a7ac3dff..996f2722 100644 --- a/man/h_integrand.Rd +++ b/man/h_integrand.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/postprobDist.R \name{h_integrand} \alias{h_integrand} -\title{The Posterior Beta Mixture Integrand when Delta is absolute.} +\title{The Posterior Beta Mixture Integrand when Delta is absolute} \usage{ h_integrand(p_s, delta, activeBetamixPost, controlBetamixPost) } @@ -10,8 +10,9 @@ h_integrand(p_s, delta, activeBetamixPost, controlBetamixPost) \item{p_s}{(\code{number}):\cr probability of success or response rate of standard of care or \code{SOC} group.} \item{delta}{(\code{numeric}):\cr the margin of which treatment group \code{E} is superior than the success rate of -the standard of care \code{S}. If the \code{p_S} or success rate of \code{S} is \code{0}, -then the difference between two groups is merely \code{delta}. See also @note} +the standard of care \code{S}. If the \code{p_s} or success rate of \code{S} is \code{0}, +then the difference between two groups is merely \code{delta}. See also @note +about the calculation of \code{delta} when \verb{relative Delta = TRUE}} \item{activeBetamixPost}{(\code{list}):\cr a list of posterior parameters of a beta-mixture-binomial distribution with generic names \code{par} and \code{weights}. See \verb{[getBetaMix()]}.} @@ -25,9 +26,5 @@ An R function that is an argument for \verb{[stats::integrate()]}. \description{ The helper function to generate Integrand function when \verb{relative Delta = FALSE}, a default setting. -See \verb{[postprobDist()]} -} -\details{ -A numerical integration to compute this probability is given on p.338 } \keyword{internal} diff --git a/man/h_integrand_relDelta.Rd b/man/h_integrand_relDelta.Rd index 9a26450c..a018ba10 100644 --- a/man/h_integrand_relDelta.Rd +++ b/man/h_integrand_relDelta.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/postprobDist.R \name{h_integrand_relDelta} \alias{h_integrand_relDelta} -\title{The Posterior Beta Mixture Integrand when \code{delta} is relative.} +\title{The Posterior Beta Mixture Integrand when \code{delta} is relative} \usage{ h_integrand_relDelta(p_s, delta, activeBetamixPost, controlBetamixPost) } @@ -10,8 +10,9 @@ h_integrand_relDelta(p_s, delta, activeBetamixPost, controlBetamixPost) \item{p_s}{(\code{number}):\cr probability of success or response rate of standard of care or \code{SOC} group.} \item{delta}{(\code{numeric}):\cr the margin of which treatment group \code{E} is superior than the success rate of -the standard of care \code{S}. If the \code{p_S} or success rate of \code{S} is \code{0}, -then the difference between two groups is merely \code{delta}. See also @note} +the standard of care \code{S}. If the \code{p_s} or success rate of \code{S} is \code{0}, +then the difference between two groups is merely \code{delta}. See also @note +about the calculation of \code{delta} when \verb{relative Delta = TRUE}} \item{activeBetamixPost}{(\code{list}):\cr a list of posterior parameters of a beta-mixture-binomial distribution with generic names \code{par} and \code{weights}. See \verb{[getBetaMix()]}.} @@ -23,9 +24,6 @@ then the difference between two groups is merely \code{delta}. See also @note} An R function that is an argument for \verb{[stats::integrate()]}. } \description{ -The helper function to generate Integrand function when \verb{relative Delta = TRUE}. -} -\details{ -A numerical integration to compute this probability is given on p.338 +The helper function to generate Integrand function when \verb{relative Delta = TRUE}. } \keyword{internal} diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index a6bfeadf..74015bcf 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -18,30 +18,30 @@ postprobDist( ) } \arguments{ -\item{x}{(\code{vector}):\cr vector of success counts in the treatment group. Vector of minimum length of 1.} +\item{x}{(\code{numeric}):\cr number of success counts in the treatment group. Number of minimum length of 1.} \item{n}{(\code{number}):\cr number of patients in the treatment group.} -\item{xS}{(\code{vector}):\cr vector of success counts in the SOC group (default: 0). Vector of minimum length of 1.} +\item{xS}{(\code{numeric}):\cr number of success counts in the SOC group (default: 0). Number of minimum length of 1.} \item{nS}{(\code{number}):\cr number of patients in the SOC group (default: 0)} \item{delta}{(\code{number}):\cr margin by which the response rate in the treatment group should -be better than in the SOC group (default: 0). Must be >= \code{0}. see @note.} +be better than in the SOC group (default: 0). Must be >= \code{0}. See @note.} \item{relativeDelta}{(\code{flag}):\cr If \code{TRUE}, then a \code{relativeDelta} is used. Represents that a minimum -response rate in magnitude of \code{delta} of the SOC non-responding patients. see @note.} +response rate in magnitude of \code{delta} of the SOC non-responding patients. See @note.} \item{parE}{(\code{matrix}):\cr the beta parameters matrix, with K rows and 2 columns, -corresponding to the beta parameters of the K components. default is a -uniform prior.} +corresponding to the beta parameters of the K components. Default is a +uniform prior \code{Beta(1,1)}. See @details.} \item{weights}{(\code{matrix}):\cr the mixture weights of the beta mixture prior. Default are equal weights across mixture components.} -\item{parS}{(\code{matrix}):\cr beta parameters for the SOC group (default: uniform)} +\item{parS}{(\code{matrix}):\cr beta parameters for the SOC group (default: uniform). ee @details.} -\item{weightsS}{(\code{matrix}):\cr weights for the SOC group (default: uniform)} +\item{weightsS}{(\code{matrix}):\cr weights for the SOC group (default: uniform).} \item{epsilon}{(\code{number}):\cr the smallest non-negative floating number to represent the lower bound for the interval of integration.} @@ -53,30 +53,30 @@ The posterior probability \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} Using the approach by Thall and Simon (Biometrics, 1994), this evaluates the -posterior probability of achieving superior response rate in the treatment group compared to standard of care (SOC). -See notes below for two formulations of the difference in response rates. +posterior probability of achieving superior response rate in the treatment group compared to standard of care (SOC): + +\verb{Pr(P_E > P_S | data) = \\int 1-F(p_s + delta | alpha_E + x, beta_E + n- x) f(p_s; alpha_S, beta_S}. +See @note below for two formulations of the difference in response rates. In reality, data may or may not be complete for both the new treatment \code{E} as well as for the SOC group, -\code{S}. Accordingly prior distribution should be specified. +\code{S}. Accordingly, prior distributions should be specified. The following is a guidance in possible user cases : \enumerate{ \item No precedent data : The default setting is a uniform prior of \code{Beta(1,1)}. This can be used to reflect no precedent data in both the \code{E} and \code{S} arms. } -2a. Precedent data for only either \code{E} : +2a. Precedent data for only \code{E} : A user input prior is given by user to reflect precedent data of the \code{E} arm. For each set of prior parameters, user can input weighting. See (4) -2b. Precedent data for only either \code{S} : +2b. Precedent data for only \code{S} : A user input prior is given by user to reflect precedent data of the \code{S} arm. For each set of prior parameters, user can input weighting. See (4) - -Choice of Weights \enumerate{ -\item In the simple case of no mixture of priors, the one Beta parameter are weighted as \verb{100 \%}. +\item In the simple case of no mixture of priors given, the Beta parameters are weighted as \verb{100 \%}. \item In the Beta Binomial Mixture case, users can allocate a non-negative weighting and can exceed \verb{100 \%}, -which the algorithm will normalised such that all weights sum to 1. +to which the algorithm will normalize the weights such that all weights sum to 1. } } \details{ @@ -94,19 +94,33 @@ The absolute case when \code{relativeDelta = FALSE} and relative as when \code{r the response rate of the \code{SOC} group such that the posterior is \code{Pr(P_E > P_S + delta | data)}. \item In the relative case, we suppose that the treatment group's -response rate is assumed to be greater than \code{P_S + (1-P_S)*delta} such that +response rate is assumed to be greater than \code{P_S + (1-P_S) * delta} such that the posterior is \code{Pr(P_E > P_S + (1 - P_S) * delta | data)}. } } } \examples{ -# example similar to Lee and Liu: -postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, relativeDelta = FALSE) +# An example similar to Lee and Liu (2008). +postprobDist( + x = 16, + n = 23, + parE = c(0.6, 0.4), + parS = c(0.6, 0.4), + delta = 0.1, + relativeDelta = FALSE +) -# when relativeDelta is used. -postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, relativeDelta = TRUE) +# When relativeDelta is TRUE. +postprobDist( + x = 16, + n = 23, + parE = c(0.6, 0.4), + parS = c(0.6, 0.4), + delta = 0.1, + relativeDelta = TRUE +) -# these two should give the same result: +# Varying SOC priors. postprobDist( x = 27, n = 34, xS = 0, nS = 0, @@ -115,15 +129,7 @@ postprobDist( parS = c(50007530, 49924090) ) -postprob(x = 27, n = 34, p = 0.65, parE = c(1, 1)) -# ok, almost - -# try out mixtures: -# play around with the beta parameters and weights to -# get a feeling. -# Note that very extreme beta parameters do no longer increase -# the return value, because then that mixture component is too -# unlikely a posteriori +# When there are mixed parameters in both Experimental and SOC arm. r postprobDist( x = 16, n = 23, parE = @@ -139,9 +145,9 @@ postprobDist( weightsS = c(1, 3), delta = 0.1 ) -# try these examples -# 1. Experimental arm only (strictly single arm trial), uniform prior in both E and S arms. +# Experimental arm only (strictly single arm trial), uniform prior in Experimental arm. Default used. +# Non-uniform Prior used for SOC arm as no precedent data. postprobDist( x = 16, n = 23, @@ -149,11 +155,10 @@ postprobDist( nS = 0, delta = 0, relativeDelta = FALSE, - parE = c(1, 1), - parS = c(1, 1), + parS = c(2, 3), weightsS = c(1) ) -# 2. Experimental arm and SOC, uniform prior in both E and S arms. +# Experimental arm and SOC, uniform prior in both E and S arms, default setting used. postprobDist( x = 16, n = 20, @@ -161,11 +166,9 @@ postprobDist( nS = 20, delta = 0, relativeDelta = FALSE, - parE = c(1, 1), - parS = c(1, 1), weightsS = c(1) ) -# 3. Experimental and SOC arm, with beta mix prior for S arms with 50:50 weighting, uniform for E. +# Experimental and SOC arm, with beta mix prior for SOC arms with equal weighting, uniform for E. postprobDist( x = 16, n = 20, @@ -179,30 +182,30 @@ postprobDist( weightsS = c(1, 2) ) -# 3b. Experimental and SOC arm, with beta mix prior for S arm, uniform for E. +# Experimental and SOC arm, with beta mix prior for SOC arm, uniform for E. # The SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights. -# We can have weights exceeding 1 because it will be internally normalised to sum to 1. +# We can have weights exceeding 1 because it will be normalised to sum to 1. postprobDist( x = 16, n = 20, xS = 10, nS = 20, - delta = 0, + delta = 0.1, relativeDelta = FALSE, parE = c(1, 1), parS = rbind(c(4, 5), c(2, 3), c(4, 4)), weightsS = c(2, 5, 3) ) -# 4. Experimental and SOC arm, with beta mix prior for both arms. +# Experimental and SOC arm, with beta mix prior for both arms. # For each of the SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights. postprobDist( x = 16, n = 20, xS = 10, nS = 20, - delta = 0, - relativeDelta = FALSE, + delta = 0.1, + relativeDelta = TRUE, parE = rbind(c(1, 1), c(3, 4), c(8, 9)), weights = c(5, 3, 2), parS = rbind(c(4, 5), c(2, 3), c(4, 4)), diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index 8710ac5a..73a8322d 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -11,7 +11,6 @@ test_that("postprobDist gives incrementally higher values with increase x suppor }) test_that("postprob gives the correct number result", { - # 2 component beta mixture prior with weight = weightS = c(1,1) result <- postprobDist( x = 10, n = 23, @@ -59,7 +58,6 @@ test_that("postprob gives incrementally higher values with increased x", { }) test_that("postprobDist gives the correct number result", { - # 2 component beta mixture prior with weights = weightsS = various result <- postprobDist( x = 10, n = 23, @@ -78,9 +76,7 @@ test_that("postprobDist gives the correct number result", { expect_equal(result, 0.3248885, tolerance = 1e-4) }) -# Extreme beta numbers are lowly weighted test_that("postprobDist gives the correct number result", { - # 2 component beta mixture prior with weights = weightsS = various result <- postprobDist( x = 10, n = 23, @@ -115,7 +111,7 @@ test_that("h_integrand_relDelta gives the correct numerical result", { activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights) controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) results <- h_integrand_relDelta( - p_s = p_s, delta = 0.1, + p_s = p_s, delta = delta, activeBetamixPost = activeBetamixPost, controlBetamixPost = controlBetamixPost ) @@ -123,6 +119,29 @@ test_that("h_integrand_relDelta gives the correct numerical result", { }) test_that("h_integrand_relDelta gives the correct numerical result", { + x <- 16 + n <- 23 + xS <- 10 + nS <- 20 + parE <- t(c(1, 3)) + parS <- t(c(1, 1)) + weights <- c(0.5) + weightsS <- c(1) + p_s <- 0.1 + delta <- 0.1 + relativeDelta <- TRUE + activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights) + controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) + results <- h_integrand_relDelta( + p_s = p_s, delta = delta, + activeBetamixPost = activeBetamixPost, + controlBetamixPost = controlBetamixPost + ) + expect_equal(results, 0.0001352829, tolerance = 1e-4) +}) + +# h_integrand -- +test_that("h_integrand gives the correct numerical result", { x <- 16 n <- 23 xS <- 10 @@ -137,7 +156,30 @@ test_that("h_integrand_relDelta gives the correct numerical result", { activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights) controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) results <- h_integrand( - p_s = p_s, delta = 0.1, + p_s = p_s, delta = delta, + activeBetamixPost = activeBetamixPost, + controlBetamixPost = controlBetamixPost + ) + expect_equal(results, 0.0001352828, tolerance = 1e-4) +}) + + +test_that("h_integrand gives the correct numerical result", { + x <- 16 + n <- 23 + xS <- 10 + nS <- 20 + parE <- t(c(1, 3)) + parS <- t(c(1, 1)) + weights <- c(1) + weightsS <- c(1) + p_s <- 0.1 + delta <- 0.1 + relativeDelta <- FALSE + activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights) + controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) + results <- h_integrand( + p_s = p_s, delta = delta, activeBetamixPost = activeBetamixPost, controlBetamixPost = controlBetamixPost ) From c3435afcf89c6fb96bb02400035600aa99b6c624 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 14 Nov 2023 14:43:37 +0100 Subject: [PATCH 080/106] Update R/postprobDist.R Co-authored-by: Daniel Sabanes Bove --- R/postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index 55e9dd9a..d5acc95e 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -135,7 +135,7 @@ h_get_bounds <- function(controlBetamixPost) { #' the mixture weights of the beta mixture prior. Default are #' equal weights across mixture components. #' @typed parS : matrix -#' beta parameters for the SOC group (default: uniform). ee @details. +#' beta parameters for the SOC group (default: uniform). See details. #' @typed weightsS : matrix #' weights for the SOC group (default: uniform). #' @typed epsilon : number From f1fc03a00440c1084abead873a4f7ac343cbde45 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 14 Nov 2023 14:45:21 +0100 Subject: [PATCH 081/106] Update R/postprobDist.R Co-authored-by: Daniel Sabanes Bove --- R/postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index d5acc95e..bb1a362b 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -6,7 +6,7 @@ NULL #' #' The helper function to generate Integrand function when `relative Delta = TRUE`. #' -#' @typed delta : numeric +#' @typed delta : number #' the margin of which treatment group `E` is superior than the success rate of #' the standard of care `S`. If the `p_s` or success rate of `S` is `0`, #' then the difference between two groups is merely `delta`. See also @note From b7120706efda846daade28b92849d19205255cfe Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 14 Nov 2023 17:00:44 +0100 Subject: [PATCH 082/106] clean --- R/postprob.R | 1 - R/postprobDist.R | 58 +++++++++++------------------- examples/postprobDist.R | 10 ++++++ man/h_get_bounds.Rd | 2 +- man/h_integrand.Rd | 8 ++--- man/h_integrand_relDelta.Rd | 8 ++--- man/postprobDist.Rd | 57 ++++++++++++++--------------- tests/testthat/test-postprobDist.R | 14 ++++---- 8 files changed, 71 insertions(+), 87 deletions(-) diff --git a/R/postprob.R b/R/postprob.R index 4fbb71b9..716f0730 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -35,7 +35,6 @@ postprobBeta <- function(x, n, p, a = 1, b = 1) { stats::pbeta(p, a + x, b + n - x, lower.tail = FALSE) } - #' Posterior Probability of Efficacy Given Beta-Mixture Prior #' #' @description `r lifecycle::badge("experimental")` diff --git a/R/postprobDist.R b/R/postprobDist.R index bb1a362b..953e7754 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -8,9 +8,7 @@ NULL #' #' @typed delta : number #' the margin of which treatment group `E` is superior than the success rate of -#' the standard of care `S`. If the `p_s` or success rate of `S` is `0`, -#' then the difference between two groups is merely `delta`. See also @note -#' about the calculation of `delta` when `relative Delta = TRUE` +#' the standard of care `S`. See also note about the calculation of `delta` when `relative Delta = TRUE`. #' @typed p_s : number #' probability of success or response rate of standard of care or `SOC` group. #' @typed activeBetamixPost : list @@ -20,13 +18,13 @@ NULL #' a list of posterior parameters of a beta-mixture-binomial distribution with generic names #' `par` and `weights`. See `[getBetaMix()]`. #' -#' @return An R function that is an argument for `[stats::integrate()]`. +#' @return Function that is an argument for `[stats::integrate()]`. #' #' @keywords internal #' h_integrand_relDelta <- function(p_s, delta, activeBetamixPost, controlBetamixPost) { cdf <- postprob( - x = 0, # we denote a dummy x for Vectorize() + x = 0, # Needed for Vectorize() p = (1 - p_s) * delta + p_s, betamixPost = activeBetamixPost ) @@ -44,13 +42,13 @@ h_integrand_relDelta <- function(p_s, delta, activeBetamixPost, controlBetamixPo #' #' @inheritParams h_integrand_relDelta #' -#' @return An R function that is an argument for `[stats::integrate()]`. +#' @return Function that is an argument for `[stats::integrate()]`. #' #' @keywords internal #' h_integrand <- function(p_s, delta, activeBetamixPost, controlBetamixPost) { cdf <- postprob( - x = 0, # we denote a dummy x for Vectorize() + x = 0, # Needed for Vectorize() p = p_s + delta, betamixPost = activeBetamixPost ) @@ -64,7 +62,7 @@ h_integrand <- function(p_s, delta, activeBetamixPost, controlBetamixPost) { #' Generating bounds for the Integration of Beta Mixture Posterior #' #' Using the quantile of the Beta Mixture Distribution from parameters given by standard of care `SOC` or -#' experimental group `E` to determine bounds as inputs to `[stats::integrate()]` +#' experimental group `E` to determine bounds as inputs to `[stats::integrate()]`. #' #' @inheritParams h_integrand_relDelta #' @return Integrand function @@ -91,27 +89,7 @@ h_get_bounds <- function(controlBetamixPost) { #' posterior probability of achieving superior response rate in the treatment group compared to standard of care (SOC): #' #' `Pr(P_E > P_S | data) = \int 1-F(p_s + delta | alpha_E + x, beta_E + n- x) f(p_s; alpha_S, beta_S`. -#' See @note below for two formulations of the difference in response rates. -#' -#' In reality, data may or may not be complete for both the new treatment `E` as well as for the SOC group, -#' `S`. Accordingly, prior distributions should be specified. The following is a guidance in possible user cases : -#' -#' 1. No precedent data : -#' The default setting is a uniform prior of `Beta(1,1)`. This can be used to reflect no precedent data -#' in both the `E` and `S` arms. -#' -#' 2a. Precedent data for only `E` : -#' A user input prior is given by user to reflect precedent data of the `E` arm. -#' For each set of prior parameters, user can input weighting. See (4) -#' -#' 2b. Precedent data for only `S` : -#' A user input prior is given by user to reflect precedent data of the `S` arm. -#' For each set of prior parameters, user can input weighting. See (4) -#' -#' 3. In the simple case of no mixture of priors given, the Beta parameters are weighted as `100 %`. -#' -#' 4. In the Beta Binomial Mixture case, users can allocate a non-negative weighting and can exceed `100 %`, -#' to which the algorithm will normalize the weights such that all weights sum to 1. +#' See note below for two formulations of the difference in response rates. #' #' @typed x : numeric #' number of success counts in the treatment group. Number of minimum length of 1. @@ -120,22 +98,28 @@ h_get_bounds <- function(controlBetamixPost) { #' @typed xS : numeric #' number of success counts in the SOC group (default: 0). Number of minimum length of 1. #' @typed nS : number -#' number of patients in the SOC group (default: 0) +#' number of patients in the SOC group (default: 0). #' @typed delta : number #' margin by which the response rate in the treatment group should -#' be better than in the SOC group (default: 0). Must be >= `0`. See @note. +#' be better than in the SOC group (default: 0). Must be >= `0`. See note. #' @typed relativeDelta : flag #' If `TRUE`, then a `relativeDelta` is used. Represents that a minimum -#' response rate in magnitude of `delta` of the SOC non-responding patients. See @note. +#' response rate in magnitude of `delta` of the SOC non-responding patients. See note. #' @typed parE : matrix -#' the beta parameters matrix, with K rows and 2 columns, -#' corresponding to the beta parameters of the K components. Default is a -#' uniform prior `Beta(1,1)`. See @details. +#' beta parameters matrix, with K rows and 2 columns, +#' corresponding to the beta parameters of the K components for `E` group. Default is a +#' uniform prior `Beta(1,1)` which can be used to reflect no precedent data +#' in both the `E` and `S` arms. See details. #' @typed weights : matrix -#' the mixture weights of the beta mixture prior. Default are +#' the non-negative mixture weights of the beta mixture prior. Default are #' equal weights across mixture components. +#' In the simple case of no mixture of priors given, the Beta parameters are weighted as `100 %`. +#' Weights can exceed 1, to which the algorithm will normalize the weights such that all weights sum to 1. #' @typed parS : matrix -#' beta parameters for the SOC group (default: uniform). See details. +#' beta parameters matrix, with K rows and 2 columns, +#' corresponding to the beta parameters of the K components for `S` group. Default is a +#' uniform prior `Beta(1,1)` which can be used to reflect no precedent data +#' in both the `E` and `S` arms. See details. #' @typed weightsS : matrix #' weights for the SOC group (default: uniform). #' @typed epsilon : number diff --git a/examples/postprobDist.R b/examples/postprobDist.R index 7da1ba1f..6818b34f 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -18,6 +18,16 @@ postprobDist( relativeDelta = TRUE ) +# When relativeDelta is TRUE. For a sequence of success outcomes for Experimental arm. +postprobDist( + x = c(seq(1:23)), + n = 23, + parE = c(0.2, 0.8), + parS = c(0.6, 0.4), + delta = 0.1, + relativeDelta = TRUE +) + # Varying SOC priors. postprobDist( x = 27, n = 34, diff --git a/man/h_get_bounds.Rd b/man/h_get_bounds.Rd index 37e01a5b..f1ffc1a4 100644 --- a/man/h_get_bounds.Rd +++ b/man/h_get_bounds.Rd @@ -15,6 +15,6 @@ Integrand function } \description{ Using the quantile of the Beta Mixture Distribution from parameters given by standard of care \code{SOC} or -experimental group \code{E} to determine bounds as inputs to \verb{[stats::integrate()]} +experimental group \code{E} to determine bounds as inputs to \verb{[stats::integrate()]}. } \keyword{internal} diff --git a/man/h_integrand.Rd b/man/h_integrand.Rd index 996f2722..aeb5fc1c 100644 --- a/man/h_integrand.Rd +++ b/man/h_integrand.Rd @@ -9,10 +9,8 @@ h_integrand(p_s, delta, activeBetamixPost, controlBetamixPost) \arguments{ \item{p_s}{(\code{number}):\cr probability of success or response rate of standard of care or \code{SOC} group.} -\item{delta}{(\code{numeric}):\cr the margin of which treatment group \code{E} is superior than the success rate of -the standard of care \code{S}. If the \code{p_s} or success rate of \code{S} is \code{0}, -then the difference between two groups is merely \code{delta}. See also @note -about the calculation of \code{delta} when \verb{relative Delta = TRUE}} +\item{delta}{(\code{number}):\cr the margin of which treatment group \code{E} is superior than the success rate of +the standard of care \code{S}. See also note about the calculation of \code{delta} when \verb{relative Delta = TRUE}.} \item{activeBetamixPost}{(\code{list}):\cr a list of posterior parameters of a beta-mixture-binomial distribution with generic names \code{par} and \code{weights}. See \verb{[getBetaMix()]}.} @@ -21,7 +19,7 @@ about the calculation of \code{delta} when \verb{relative Delta = TRUE}} \code{par} and \code{weights}. See \verb{[getBetaMix()]}.} } \value{ -An R function that is an argument for \verb{[stats::integrate()]}. +Function that is an argument for \verb{[stats::integrate()]}. } \description{ The helper function to generate Integrand function when \verb{relative Delta = FALSE}, diff --git a/man/h_integrand_relDelta.Rd b/man/h_integrand_relDelta.Rd index a018ba10..b14cfc4b 100644 --- a/man/h_integrand_relDelta.Rd +++ b/man/h_integrand_relDelta.Rd @@ -9,10 +9,8 @@ h_integrand_relDelta(p_s, delta, activeBetamixPost, controlBetamixPost) \arguments{ \item{p_s}{(\code{number}):\cr probability of success or response rate of standard of care or \code{SOC} group.} -\item{delta}{(\code{numeric}):\cr the margin of which treatment group \code{E} is superior than the success rate of -the standard of care \code{S}. If the \code{p_s} or success rate of \code{S} is \code{0}, -then the difference between two groups is merely \code{delta}. See also @note -about the calculation of \code{delta} when \verb{relative Delta = TRUE}} +\item{delta}{(\code{number}):\cr the margin of which treatment group \code{E} is superior than the success rate of +the standard of care \code{S}. See also note about the calculation of \code{delta} when \verb{relative Delta = TRUE}.} \item{activeBetamixPost}{(\code{list}):\cr a list of posterior parameters of a beta-mixture-binomial distribution with generic names \code{par} and \code{weights}. See \verb{[getBetaMix()]}.} @@ -21,7 +19,7 @@ about the calculation of \code{delta} when \verb{relative Delta = TRUE}} \code{par} and \code{weights}. See \verb{[getBetaMix()]}.} } \value{ -An R function that is an argument for \verb{[stats::integrate()]}. +Function that is an argument for \verb{[stats::integrate()]}. } \description{ The helper function to generate Integrand function when \verb{relative Delta = TRUE}. diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index 74015bcf..f30ef66e 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -24,22 +24,28 @@ postprobDist( \item{xS}{(\code{numeric}):\cr number of success counts in the SOC group (default: 0). Number of minimum length of 1.} -\item{nS}{(\code{number}):\cr number of patients in the SOC group (default: 0)} +\item{nS}{(\code{number}):\cr number of patients in the SOC group (default: 0).} \item{delta}{(\code{number}):\cr margin by which the response rate in the treatment group should -be better than in the SOC group (default: 0). Must be >= \code{0}. See @note.} +be better than in the SOC group (default: 0). Must be >= \code{0}. See note.} \item{relativeDelta}{(\code{flag}):\cr If \code{TRUE}, then a \code{relativeDelta} is used. Represents that a minimum -response rate in magnitude of \code{delta} of the SOC non-responding patients. See @note.} +response rate in magnitude of \code{delta} of the SOC non-responding patients. See note.} -\item{parE}{(\code{matrix}):\cr the beta parameters matrix, with K rows and 2 columns, -corresponding to the beta parameters of the K components. Default is a -uniform prior \code{Beta(1,1)}. See @details.} +\item{parE}{(\code{matrix}):\cr beta parameters matrix, with K rows and 2 columns, +corresponding to the beta parameters of the K components for \code{E} group. Default is a +uniform prior \code{Beta(1,1)} which can be used to reflect no precedent data +in both the \code{E} and \code{S} arms. See details.} -\item{weights}{(\code{matrix}):\cr the mixture weights of the beta mixture prior. Default are -equal weights across mixture components.} +\item{weights}{(\code{matrix}):\cr the non-negative mixture weights of the beta mixture prior. Default are +equal weights across mixture components. +In the simple case of no mixture of priors given, the Beta parameters are weighted as \verb{100 \%}. +Weights can exceed 1, to which the algorithm will normalize the weights such that all weights sum to 1.} -\item{parS}{(\code{matrix}):\cr beta parameters for the SOC group (default: uniform). ee @details.} +\item{parS}{(\code{matrix}):\cr beta parameters matrix, with K rows and 2 columns, +corresponding to the beta parameters of the K components for \code{S} group. Default is a +uniform prior \code{Beta(1,1)} which can be used to reflect no precedent data +in both the \code{E} and \code{S} arms. See details.} \item{weightsS}{(\code{matrix}):\cr weights for the SOC group (default: uniform).} @@ -56,28 +62,7 @@ Using the approach by Thall and Simon (Biometrics, 1994), this evaluates the posterior probability of achieving superior response rate in the treatment group compared to standard of care (SOC): \verb{Pr(P_E > P_S | data) = \\int 1-F(p_s + delta | alpha_E + x, beta_E + n- x) f(p_s; alpha_S, beta_S}. -See @note below for two formulations of the difference in response rates. - -In reality, data may or may not be complete for both the new treatment \code{E} as well as for the SOC group, -\code{S}. Accordingly, prior distributions should be specified. The following is a guidance in possible user cases : -\enumerate{ -\item No precedent data : -The default setting is a uniform prior of \code{Beta(1,1)}. This can be used to reflect no precedent data -in both the \code{E} and \code{S} arms. -} - -2a. Precedent data for only \code{E} : -A user input prior is given by user to reflect precedent data of the \code{E} arm. -For each set of prior parameters, user can input weighting. See (4) - -2b. Precedent data for only \code{S} : -A user input prior is given by user to reflect precedent data of the \code{S} arm. -For each set of prior parameters, user can input weighting. See (4) -\enumerate{ -\item In the simple case of no mixture of priors given, the Beta parameters are weighted as \verb{100 \%}. -\item In the Beta Binomial Mixture case, users can allocate a non-negative weighting and can exceed \verb{100 \%}, -to which the algorithm will normalize the weights such that all weights sum to 1. -} +See note below for two formulations of the difference in response rates. } \details{ The beta mixture prior for the E arm requires argument \code{parE} and \code{weights}. @@ -120,6 +105,16 @@ postprobDist( relativeDelta = TRUE ) +# When relativeDelta is TRUE. For a sequence of success outcomes for Experimental arm. +postprobDist( + x = c(seq(1:23)), + n = 23, + parE = c(0.2, 0.8), + parS = c(0.6, 0.4), + delta = 0.1, + relativeDelta = TRUE +) + # Varying SOC priors. postprobDist( x = 27, n = 34, diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index 73a8322d..c5e7837d 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -1,4 +1,4 @@ -# postprobBeta ---- +# postprobDist ---- test_that("postprobDist gives the correct number result", { result <- postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1) expect_equal(result, 0.4431067, tolerance = 1e-5) @@ -10,7 +10,7 @@ test_that("postprobDist gives incrementally higher values with increase x suppor expect_true(is_lower < is_higher) }) -test_that("postprob gives the correct number result", { +test_that("postprobDist gives the correct number result", { result <- postprobDist( x = 10, n = 23, @@ -27,7 +27,7 @@ test_that("postprob gives the correct number result", { expect_equal(result, 0.3143941, tolerance = 1e-5) }) -test_that("postprob gives incrementally higher values with increased x", { +test_that("postprobDist gives incrementally higher values with increased x", { is_lower <- postprobDist( x = 10, n = 23, @@ -148,8 +148,8 @@ test_that("h_integrand gives the correct numerical result", { nS <- 20 parE <- t(c(1, 3)) parS <- t(c(1, 1)) - weights <- c(1) - weightsS <- c(1) + weights <- 1 + weightsS <- 1 p_s <- 0.1 delta <- 0.1 relativeDelta <- TRUE @@ -171,8 +171,8 @@ test_that("h_integrand gives the correct numerical result", { nS <- 20 parE <- t(c(1, 3)) parS <- t(c(1, 1)) - weights <- c(1) - weightsS <- c(1) + weights <- 1 + weightsS <- 1 p_s <- 0.1 delta <- 0.1 relativeDelta <- FALSE From 16648716ae77273706c4ec2cead5039ac2afaa9b Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 14 Nov 2023 17:10:04 +0100 Subject: [PATCH 083/106] Auto stash before checking out "origin/16_postprobdist" --- tests/testthat/test-postprobDist.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index c5e7837d..a6958375 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -103,8 +103,8 @@ test_that("h_integrand_relDelta gives the correct numerical result", { nS <- 20 parE <- t(c(1, 3)) parS <- t(c(1, 1)) - weights <- c(1) - weightsS <- c(1) + weights <- 1 + weightsS <- 1 p_s <- 0.1 delta <- 0.1 relativeDelta <- TRUE From 0ba456155fed17f99155cf7706952ba80b97299d Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 12:40:20 +0100 Subject: [PATCH 084/106] clean --- R/dbetabinom.R | 4 -- R/postprobDist.R | 10 ++--- examples/postprobDist.R | 18 ++++++-- man/dbetabinom.Rd | 3 -- man/dbetabinomMix.Rd | 3 -- man/postprobDist.Rd | 26 ++++++++---- tests/testthat/test-postprobDist.R | 66 ++++++++++++++++++++++++++++++ 7 files changed, 105 insertions(+), 25 deletions(-) diff --git a/R/dbetabinom.R b/R/dbetabinom.R index 1977f2df..ff9c9de2 100644 --- a/R/dbetabinom.R +++ b/R/dbetabinom.R @@ -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) { @@ -57,8 +55,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) { diff --git a/R/postprobDist.R b/R/postprobDist.R index 953e7754..b3406e3a 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -92,16 +92,16 @@ h_get_bounds <- function(controlBetamixPost) { #' See note below for two formulations of the difference in response rates. #' #' @typed x : numeric -#' number of success counts in the treatment group. Number of minimum length of 1. +#' number of success counts in the treatment group. #' @typed n : number #' number of patients in the treatment group. -#' @typed xS : numeric -#' number of success counts in the SOC group (default: 0). Number of minimum length of 1. +#' @typed xS : number +#' number of success counts in the SOC group. #' @typed nS : number -#' number of patients in the SOC group (default: 0). +#' number of patients in the SOC group. #' @typed delta : number #' margin by which the response rate in the treatment group should -#' be better than in the SOC group (default: 0). Must be >= `0`. See note. +#' be better than in the SOC group. Must be >= `0`. See note. #' @typed relativeDelta : flag #' If `TRUE`, then a `relativeDelta` is used. Represents that a minimum #' response rate in magnitude of `delta` of the SOC non-responding patients. See note. diff --git a/examples/postprobDist.R b/examples/postprobDist.R index 6818b34f..ebc0c19a 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -8,6 +8,16 @@ postprobDist( relativeDelta = FALSE ) +# For a sequence of success outcomes for Experimental arm. +postprobDist( + x = c(16, 17), + n = c(23), + parE = c(0.6, 0.4), + parS = c(0.6, 0.4), + delta = 0.1, + relativeDelta = FALSE +) + # When relativeDelta is TRUE. postprobDist( x = 16, @@ -30,14 +40,16 @@ postprobDist( # Varying SOC priors. postprobDist( - x = 27, n = 34, - xS = 0, nS = 0, + x = 27, + n = 34, + xS = 0, + nS = 0, delta = 0.15, parE = c(1, 1), parS = c(50007530, 49924090) ) -# When there are mixed parameters in both Experimental and SOC arm. r +# When there are mixed parameters in both Experimental and SOC arm. postprobDist( x = 16, n = 23, parE = diff --git a/man/dbetabinom.Rd b/man/dbetabinom.Rd index 1fb32cee..b59b273f 100644 --- a/man/dbetabinom.Rd +++ b/man/dbetabinom.Rd @@ -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 6ec5b36e..67f3d116 100644 --- a/man/dbetabinomMix.Rd +++ b/man/dbetabinomMix.Rd @@ -26,9 +26,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/postprobDist.Rd b/man/postprobDist.Rd index f30ef66e..56c73094 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -18,16 +18,16 @@ postprobDist( ) } \arguments{ -\item{x}{(\code{numeric}):\cr number of success counts in the treatment group. Number of minimum length of 1.} +\item{x}{(\code{numeric}):\cr number of success counts in the treatment group.} \item{n}{(\code{number}):\cr number of patients in the treatment group.} -\item{xS}{(\code{numeric}):\cr number of success counts in the SOC group (default: 0). Number of minimum length of 1.} +\item{xS}{(\code{number}):\cr number of success counts in the SOC group.} -\item{nS}{(\code{number}):\cr number of patients in the SOC group (default: 0).} +\item{nS}{(\code{number}):\cr number of patients in the SOC group.} \item{delta}{(\code{number}):\cr margin by which the response rate in the treatment group should -be better than in the SOC group (default: 0). Must be >= \code{0}. See note.} +be better than in the SOC group. Must be >= \code{0}. See note.} \item{relativeDelta}{(\code{flag}):\cr If \code{TRUE}, then a \code{relativeDelta} is used. Represents that a minimum response rate in magnitude of \code{delta} of the SOC non-responding patients. See note.} @@ -95,6 +95,16 @@ postprobDist( relativeDelta = FALSE ) +# For a sequence of success outcomes for Experimental arm. +postprobDist( + x = c(16, 17), + n = c(23), + parE = c(0.6, 0.4), + parS = c(0.6, 0.4), + delta = 0.1, + relativeDelta = FALSE +) + # When relativeDelta is TRUE. postprobDist( x = 16, @@ -117,14 +127,16 @@ postprobDist( # Varying SOC priors. postprobDist( - x = 27, n = 34, - xS = 0, nS = 0, + x = 27, + n = 34, + xS = 0, + nS = 0, delta = 0.15, parE = c(1, 1), parS = c(50007530, 49924090) ) -# When there are mixed parameters in both Experimental and SOC arm. r +# When there are mixed parameters in both Experimental and SOC arm. postprobDist( x = 16, n = 23, parE = diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index a6958375..787a89f7 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -10,6 +10,13 @@ test_that("postprobDist gives incrementally higher values with increase x suppor expect_true(is_lower < is_higher) }) +test_that("postprobDist gives incrementally higher values with increase x support", { + expected_lower <- postprobDist(x = 16, n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) + expected_higher <- postprobDist(x = 20, n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) + result <- postprobDist(x = c(16, 20), n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) + expect_identical(result, c(expected_lower, expected_higher)) +}) + test_that("postprobDist gives the correct number result", { result <- postprobDist( x = 10, @@ -95,6 +102,65 @@ test_that("postprobDist gives the correct number result", { expect_equal(result, 0.3248885, tolerance = 1e-4) }) +test_that("postprobDist gives an error when length(par)", { + expect_error( + results <- postprobDist( + x = c(16, 17), + n = c(23, 20), + parE = c(0.6, 0.4), + parS = c(0.6, 0.4), + delta = 0.1, + relativeDelta = FALSE + ), + ) +}) + +test_that("postprobDist gives an error", { + expect_error( + results <- postprobDist( + x = c(10, 16), + n = 23, + xS = c(9, 10), + nS = c(20, 22), + delta = 0.1, + parE = c(0.6, 0.4), + parS = c(0.6, 0.4), + weights = c(0.5), + weightsS = c(0.3), + ), + ) +}) + +test_that("postprobDist gives an error", { + expect_error( + results <- postprobDist( + x = 16, + n = 23, + xS = c(10, 12), + nS = c(20), + parE = c(0.6, 0.4), # idk why + parS = c(0.6, 0.4), + delta = 0.1, + relativeDelta = FALSE + ), + ) +}) + +test_that("postprobDist gives an error", { + expect_error( + results <- postprobDist( + x = 16, + n = 23, + xS = c(10, 12), + nS = c(20, 21), + parE = c(0.6, 0.4), # idk why + parS = c(0.6, 0.4), + delta = 0.1, + relativeDelta = FALSE + ), + ) +}) + # h_integrand_relDelta-- test_that("h_integrand_relDelta gives the correct numerical result", { x <- 16 From eb99f76945aa6236a20f20b92c02d2e8f2b1acd0 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 12:56:49 +0100 Subject: [PATCH 085/106] clean --- examples/postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/postprobDist.R b/examples/postprobDist.R index ebc0c19a..c530fc0b 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -28,7 +28,7 @@ postprobDist( relativeDelta = TRUE ) -# When relativeDelta is TRUE. For a sequence of success outcomes for Experimental arm. +# When relativeDelta is TRUE and for a sequence of success outcomes for Experimental arm. postprobDist( x = c(seq(1:23)), n = 23, From b0e2a11d8232815f63c263065f355e3e8a84f83e Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 13:39:53 +0100 Subject: [PATCH 086/106] clean --- R/postprobDist.R | 10 ++++++++++ examples/postprobDist.R | 1 + man/postprobDist.Rd | 3 ++- tests/testthat/test-postprobDist.R | 12 ++++++------ 4 files changed, 19 insertions(+), 7 deletions(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index b3406e3a..1bc8dc65 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -174,6 +174,16 @@ postprobDist <- function(x, if (missing(weightsS)) { weightsS <- rep(1, nrow(parS)) } + assert_numeric(x, lower = 0, upper = n, finite = TRUE) + assert_number(n, lower = x, finite = TRUE) + assert_number(xS, lower = 0, upper = n, finite = TRUE) + assert_numeric(nS, lower = 0, finite = TRUE) + assert_number(delta, lower = 0, finite = TRUE) + assert_flag(relativeDelta) + assert_numeric(weights, lower = 0, finite = TRUE) + 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) assert_names(names(activeBetamixPost), identical.to = c("par", "weights")) diff --git a/examples/postprobDist.R b/examples/postprobDist.R index c530fc0b..e081197d 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -88,6 +88,7 @@ postprobDist( relativeDelta = FALSE, weightsS = c(1) ) + # Experimental and SOC arm, with beta mix prior for SOC arms with equal weighting, uniform for E. postprobDist( x = 16, diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index 56c73094..131ed3da 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -115,7 +115,7 @@ postprobDist( relativeDelta = TRUE ) -# When relativeDelta is TRUE. For a sequence of success outcomes for Experimental arm. +# When relativeDelta is TRUE and for a sequence of success outcomes for Experimental arm. postprobDist( x = c(seq(1:23)), n = 23, @@ -175,6 +175,7 @@ postprobDist( relativeDelta = FALSE, weightsS = c(1) ) + # Experimental and SOC arm, with beta mix prior for SOC arms with equal weighting, uniform for E. postprobDist( x = 16, diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index 787a89f7..bf338dfe 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -111,7 +111,7 @@ test_that("postprobDist gives an error when length(par)", { parS = c(0.6, 0.4), delta = 0.1, relativeDelta = FALSE - ), + ), "must have length 1, but has length 2" ) }) @@ -127,7 +127,7 @@ test_that("postprobDist gives an error", { parS = c(0.6, 0.4), weights = c(0.5), weightsS = c(0.3), - ), + ), "Must have length 1" ) }) @@ -138,11 +138,11 @@ test_that("postprobDist gives an error", { n = 23, xS = c(10, 12), nS = c(20), - parE = c(0.6, 0.4), # idk why + parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, relativeDelta = FALSE - ), + ), "Must have length 1." ) }) @@ -153,11 +153,11 @@ test_that("postprobDist gives an error", { n = 23, xS = c(10, 12), nS = c(20, 21), - parE = c(0.6, 0.4), # idk why + parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, relativeDelta = FALSE - ), + ), "Must have length 1." ) }) From 5a813044a9931b8d5fa53f6da6265b88da672bec Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 13:43:30 +0100 Subject: [PATCH 087/106] clean --- examples/postprobDist.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/examples/postprobDist.R b/examples/postprobDist.R index e081197d..cbc80a53 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -11,7 +11,7 @@ postprobDist( # For a sequence of success outcomes for Experimental arm. postprobDist( x = c(16, 17), - n = c(23), + n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, @@ -51,7 +51,8 @@ postprobDist( # When there are mixed parameters in both Experimental and SOC arm. postprobDist( - x = 16, n = 23, + x = 16, + n = 23, parE = rbind( c(0.6, 0.4), @@ -98,7 +99,7 @@ postprobDist( delta = 0, relativeDelta = FALSE, parE = c(1, 1), - weights = c(1), + weights = 1, parS = rbind(c(4, 5), c(1, 3)), weightsS = c(1, 2) ) From a199f6360e1f24269d75f8a74fcf79af2fbd06ec Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 14:49:11 +0100 Subject: [PATCH 088/106] clean --- R/postprobDist.R | 22 +++++++++++----------- man/postprobDist.Rd | 25 +++++++++++++------------ 2 files changed, 24 insertions(+), 23 deletions(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index 1bc8dc65..da417c79 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -105,22 +105,22 @@ h_get_bounds <- function(controlBetamixPost) { #' @typed relativeDelta : flag #' If `TRUE`, then a `relativeDelta` is used. Represents that a minimum #' response rate in magnitude of `delta` of the SOC non-responding patients. See note. -#' @typed parE : matrix -#' beta parameters matrix, with K rows and 2 columns, -#' corresponding to the beta parameters of the K components for `E` group. Default is a -#' uniform prior `Beta(1,1)` which can be used to reflect no precedent data -#' in both the `E` and `S` arms. See details. -#' @typed weights : matrix +#' @typed parE : numeric or matrix +#' beta parameters numeric of two elements. If K row > 1, then beta parameters are +#' a matrix of h K rows and 2 columns, corresponding to the beta parameters of the K components +#' for `E` group. The rows correspond to mixture components and each column corresponds to +#' alpha and beta. +#' Default is a uniform prior `Beta(1,1)` which can be used to reflect no precedent data. See details. +#' @typed weights : numeric #' the non-negative mixture weights of the beta mixture prior. Default are #' equal weights across mixture components. #' In the simple case of no mixture of priors given, the Beta parameters are weighted as `100 %`. #' Weights can exceed 1, to which the algorithm will normalize the weights such that all weights sum to 1. -#' @typed parS : matrix -#' beta parameters matrix, with K rows and 2 columns, +#' @typed parS : numeric or matrix +#' beta parameters numeric of if K row > 1, then matrix, with K rows and 2 columns, #' corresponding to the beta parameters of the K components for `S` group. Default is a -#' uniform prior `Beta(1,1)` which can be used to reflect no precedent data -#' in both the `E` and `S` arms. See details. -#' @typed weightsS : matrix +#' uniform prior `Beta(1,1)` which can be used to reflect no precedent data. See details. +#' @typed weightsS : numeric #' weights for the SOC group (default: uniform). #' @typed epsilon : number #' the smallest non-negative floating number to represent the lower bound for diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index 131ed3da..48a4c2c7 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -32,22 +32,22 @@ be better than in the SOC group. Must be >= \code{0}. See note.} \item{relativeDelta}{(\code{flag}):\cr If \code{TRUE}, then a \code{relativeDelta} is used. Represents that a minimum response rate in magnitude of \code{delta} of the SOC non-responding patients. See note.} -\item{parE}{(\code{matrix}):\cr beta parameters matrix, with K rows and 2 columns, -corresponding to the beta parameters of the K components for \code{E} group. Default is a -uniform prior \code{Beta(1,1)} which can be used to reflect no precedent data -in both the \code{E} and \code{S} arms. See details.} +\item{parE}{(\verb{numeric or matrix}):\cr beta parameters numeric of two elements. If K row > 1, then beta parameters are +a matrix of h K rows and 2 columns, corresponding to the beta parameters of the K components +for \code{E} group. The rows correspond to mixture components and each column corresponds to +alpha and beta. +Default is a uniform prior \code{Beta(1,1)} which can be used to reflect no precedent data. See details.} -\item{weights}{(\code{matrix}):\cr the non-negative mixture weights of the beta mixture prior. Default are +\item{weights}{(\code{numeric}):\cr the non-negative mixture weights of the beta mixture prior. Default are equal weights across mixture components. In the simple case of no mixture of priors given, the Beta parameters are weighted as \verb{100 \%}. Weights can exceed 1, to which the algorithm will normalize the weights such that all weights sum to 1.} -\item{parS}{(\code{matrix}):\cr beta parameters matrix, with K rows and 2 columns, +\item{parS}{(\verb{numeric or matrix}):\cr beta parameters numeric of if K row > 1, then matrix, with K rows and 2 columns, corresponding to the beta parameters of the K components for \code{S} group. Default is a -uniform prior \code{Beta(1,1)} which can be used to reflect no precedent data -in both the \code{E} and \code{S} arms. See details.} +uniform prior \code{Beta(1,1)} which can be used to reflect no precedent data. See details.} -\item{weightsS}{(\code{matrix}):\cr weights for the SOC group (default: uniform).} +\item{weightsS}{(\code{numeric}):\cr weights for the SOC group (default: uniform).} \item{epsilon}{(\code{number}):\cr the smallest non-negative floating number to represent the lower bound for the interval of integration.} @@ -98,7 +98,7 @@ postprobDist( # For a sequence of success outcomes for Experimental arm. postprobDist( x = c(16, 17), - n = c(23), + n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1, @@ -138,7 +138,8 @@ postprobDist( # When there are mixed parameters in both Experimental and SOC arm. postprobDist( - x = 16, n = 23, + x = 16, + n = 23, parE = rbind( c(0.6, 0.4), @@ -185,7 +186,7 @@ postprobDist( delta = 0, relativeDelta = FALSE, parE = c(1, 1), - weights = c(1), + weights = 1, parS = rbind(c(4, 5), c(1, 3)), weightsS = c(1, 2) ) From b799be49e545534dbcd3037fc9a8fb5305a0e4fb Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 16 Nov 2023 16:09:19 +0100 Subject: [PATCH 089/106] just changed c(1) -> 1 --- examples/postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/postprobDist.R b/examples/postprobDist.R index cbc80a53..ffd2270c 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -87,7 +87,7 @@ postprobDist( nS = 20, delta = 0, relativeDelta = FALSE, - weightsS = c(1) + weightsS = 1 ) # Experimental and SOC arm, with beta mix prior for SOC arms with equal weighting, uniform for E. From 76a0258ebb1936eeece1704b3ac0a19fca562a09 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 14:52:54 +0100 Subject: [PATCH 090/106] Update R/postprobDist.R Co-authored-by: Daniel Sabanes Bove --- R/postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index da417c79..9afc9560 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -105,7 +105,7 @@ h_get_bounds <- function(controlBetamixPost) { #' @typed relativeDelta : flag #' If `TRUE`, then a `relativeDelta` is used. Represents that a minimum #' response rate in magnitude of `delta` of the SOC non-responding patients. See note. -#' @typed parE : numeric or matrix +#' @typed parE : "`numeric` or `matrix`" #' beta parameters numeric of two elements. If K row > 1, then beta parameters are #' a matrix of h K rows and 2 columns, corresponding to the beta parameters of the K components #' for `E` group. The rows correspond to mixture components and each column corresponds to From 8fbb59713a4ad4f9e12c57597a84e9adc253a4bd Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 14:53:30 +0100 Subject: [PATCH 091/106] Update R/postprobDist.R Co-authored-by: Daniel Sabanes Bove --- R/postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index 9afc9560..5e70fd91 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -112,7 +112,7 @@ h_get_bounds <- function(controlBetamixPost) { #' alpha and beta. #' Default is a uniform prior `Beta(1,1)` which can be used to reflect no precedent data. See details. #' @typed weights : numeric -#' the non-negative mixture weights of the beta mixture prior. Default are +#' the non-negative mixture weights of the beta mixture prior for group `E`. #' equal weights across mixture components. #' In the simple case of no mixture of priors given, the Beta parameters are weighted as `100 %`. #' Weights can exceed 1, to which the algorithm will normalize the weights such that all weights sum to 1. From ad89a238bbda8331e96a65098e3a53d9d3a88e85 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 14:54:39 +0100 Subject: [PATCH 092/106] Update examples/postprobDist.R Co-authored-by: Daniel Sabanes Bove --- examples/postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/postprobDist.R b/examples/postprobDist.R index ffd2270c..282941df 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -49,7 +49,7 @@ postprobDist( parS = c(50007530, 49924090) ) -# When there are mixed parameters in both Experimental and SOC arm. +# When we use beta mixtures for both the Experimental and SOC arms. postprobDist( x = 16, n = 23, From 6cf8743a068c780a6b95638569caa2bc7b4fa090 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 14:55:02 +0100 Subject: [PATCH 093/106] Update examples/postprobDist.R Co-authored-by: Daniel Sabanes Bove --- examples/postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/postprobDist.R b/examples/postprobDist.R index 282941df..677c1d40 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -30,7 +30,7 @@ postprobDist( # When relativeDelta is TRUE and for a sequence of success outcomes for Experimental arm. postprobDist( - x = c(seq(1:23)), + x = 1:23, n = 23, parE = c(0.2, 0.8), parS = c(0.6, 0.4), From 0ab1eadfb87ba3fe9b24f8f62ef8deb3cb8c325e Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 15:06:57 +0100 Subject: [PATCH 094/106] clean --- R/postprobDist.R | 16 ++++----- examples/postprobDist.R | 50 ---------------------------- inst/WORDLIST | 1 - man/postprobDist.Rd | 72 ++++++----------------------------------- 4 files changed, 17 insertions(+), 122 deletions(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index 5e70fd91..db36e558 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -106,20 +106,18 @@ h_get_bounds <- function(controlBetamixPost) { #' If `TRUE`, then a `relativeDelta` is used. Represents that a minimum #' response rate in magnitude of `delta` of the SOC non-responding patients. See note. #' @typed parE : "`numeric` or `matrix`" -#' beta parameters numeric of two elements. If K row > 1, then beta parameters are -#' a matrix of h K rows and 2 columns, corresponding to the beta parameters of the K components -#' for `E` group. The rows correspond to mixture components and each column corresponds to -#' alpha and beta. -#' Default is a uniform prior `Beta(1,1)` which can be used to reflect no precedent data. See details. +#' parameters for beta distribution. If it is a matrix, it needs to have 2 columns, +#' and each row corresponds to each component of a beta-mixture distribution +#' for the `E` group. See details. #' @typed weights : numeric -#' the non-negative mixture weights of the beta mixture prior for group `E`. +#' the non-negative mixture weights of the beta mixture prior for group `E`. #' equal weights across mixture components. #' In the simple case of no mixture of priors given, the Beta parameters are weighted as `100 %`. #' Weights can exceed 1, to which the algorithm will normalize the weights such that all weights sum to 1. #' @typed parS : numeric or matrix -#' beta parameters numeric of if K row > 1, then matrix, with K rows and 2 columns, -#' corresponding to the beta parameters of the K components for `S` group. Default is a -#' uniform prior `Beta(1,1)` which can be used to reflect no precedent data. See details. +#' parameters for beta distribution. If it is a matrix, it needs to have 2 columns, +#' and each row corresponds to each component of a beta-mixture distribution +#' for the `E` group. See details. #' @typed weightsS : numeric #' weights for the SOC group (default: uniform). #' @typed epsilon : number diff --git a/examples/postprobDist.R b/examples/postprobDist.R index 677c1d40..d5a5ce29 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -18,16 +18,6 @@ postprobDist( relativeDelta = FALSE ) -# When relativeDelta is TRUE. -postprobDist( - x = 16, - n = 23, - parE = c(0.6, 0.4), - parS = c(0.6, 0.4), - delta = 0.1, - relativeDelta = TRUE -) - # When relativeDelta is TRUE and for a sequence of success outcomes for Experimental arm. postprobDist( x = 1:23, @@ -38,17 +28,6 @@ postprobDist( relativeDelta = TRUE ) -# Varying SOC priors. -postprobDist( - x = 27, - n = 34, - xS = 0, - nS = 0, - delta = 0.15, - parE = c(1, 1), - parS = c(50007530, 49924090) -) - # When we use beta mixtures for both the Experimental and SOC arms. postprobDist( x = 16, @@ -90,35 +69,6 @@ postprobDist( weightsS = 1 ) -# Experimental and SOC arm, with beta mix prior for SOC arms with equal weighting, uniform for E. -postprobDist( - x = 16, - n = 20, - xS = 10, - nS = 20, - delta = 0, - relativeDelta = FALSE, - parE = c(1, 1), - weights = 1, - parS = rbind(c(4, 5), c(1, 3)), - weightsS = c(1, 2) -) - -# Experimental and SOC arm, with beta mix prior for SOC arm, uniform for E. -# The SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights. -# We can have weights exceeding 1 because it will be normalised to sum to 1. -postprobDist( - x = 16, - n = 20, - xS = 10, - nS = 20, - delta = 0.1, - relativeDelta = FALSE, - parE = c(1, 1), - parS = rbind(c(4, 5), c(2, 3), c(4, 4)), - weightsS = c(2, 5, 3) -) - # Experimental and SOC arm, with beta mix prior for both arms. # For each of the SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights. postprobDist( diff --git a/inst/WORDLIST b/inst/WORDLIST index 773ef70a..1db7dca6 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -152,7 +152,6 @@ SampleSizeActive SampleSizeControl seperate ShinyPhase -specifcations sumbetadiff summerize summerizes diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index 48a4c2c7..3bc8ed2f 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -32,20 +32,18 @@ be better than in the SOC group. Must be >= \code{0}. See note.} \item{relativeDelta}{(\code{flag}):\cr If \code{TRUE}, then a \code{relativeDelta} is used. Represents that a minimum response rate in magnitude of \code{delta} of the SOC non-responding patients. See note.} -\item{parE}{(\verb{numeric or matrix}):\cr beta parameters numeric of two elements. If K row > 1, then beta parameters are -a matrix of h K rows and 2 columns, corresponding to the beta parameters of the K components -for \code{E} group. The rows correspond to mixture components and each column corresponds to -alpha and beta. -Default is a uniform prior \code{Beta(1,1)} which can be used to reflect no precedent data. See details.} +\item{parE}{(\code{numeric} or \code{matrix}):\cr parameters for beta distribution. If it is a matrix, it needs to have 2 columns, +and each row corresponds to each component of a beta-mixture distribution +for the \code{E} group. See details.} -\item{weights}{(\code{numeric}):\cr the non-negative mixture weights of the beta mixture prior. Default are +\item{weights}{(\code{numeric}):\cr the non-negative mixture weights of the beta mixture prior for group \code{E}. equal weights across mixture components. In the simple case of no mixture of priors given, the Beta parameters are weighted as \verb{100 \%}. Weights can exceed 1, to which the algorithm will normalize the weights such that all weights sum to 1.} -\item{parS}{(\verb{numeric or matrix}):\cr beta parameters numeric of if K row > 1, then matrix, with K rows and 2 columns, -corresponding to the beta parameters of the K components for \code{S} group. Default is a -uniform prior \code{Beta(1,1)} which can be used to reflect no precedent data. See details.} +\item{parS}{(\verb{numeric or matrix}):\cr parameters for beta distribution. If it is a matrix, it needs to have 2 columns, +and each row corresponds to each component of a beta-mixture distribution +for the \code{E} group. See details.} \item{weightsS}{(\code{numeric}):\cr weights for the SOC group (default: uniform).} @@ -105,19 +103,9 @@ postprobDist( relativeDelta = FALSE ) -# When relativeDelta is TRUE. -postprobDist( - x = 16, - n = 23, - parE = c(0.6, 0.4), - parS = c(0.6, 0.4), - delta = 0.1, - relativeDelta = TRUE -) - # When relativeDelta is TRUE and for a sequence of success outcomes for Experimental arm. postprobDist( - x = c(seq(1:23)), + x = 1:23, n = 23, parE = c(0.2, 0.8), parS = c(0.6, 0.4), @@ -125,18 +113,7 @@ postprobDist( relativeDelta = TRUE ) -# Varying SOC priors. -postprobDist( - x = 27, - n = 34, - xS = 0, - nS = 0, - delta = 0.15, - parE = c(1, 1), - parS = c(50007530, 49924090) -) - -# When there are mixed parameters in both Experimental and SOC arm. +# When we use beta mixtures for both the Experimental and SOC arms. postprobDist( x = 16, n = 23, @@ -174,36 +151,7 @@ postprobDist( nS = 20, delta = 0, relativeDelta = FALSE, - weightsS = c(1) -) - -# Experimental and SOC arm, with beta mix prior for SOC arms with equal weighting, uniform for E. -postprobDist( - x = 16, - n = 20, - xS = 10, - nS = 20, - delta = 0, - relativeDelta = FALSE, - parE = c(1, 1), - weights = 1, - parS = rbind(c(4, 5), c(1, 3)), - weightsS = c(1, 2) -) - -# Experimental and SOC arm, with beta mix prior for SOC arm, uniform for E. -# The SOC arm is of 3 priors, therefore 3 sets of beta parameters, and 3 weights. -# We can have weights exceeding 1 because it will be normalised to sum to 1. -postprobDist( - x = 16, - n = 20, - xS = 10, - nS = 20, - delta = 0.1, - relativeDelta = FALSE, - parE = c(1, 1), - parS = rbind(c(4, 5), c(2, 3), c(4, 4)), - weightsS = c(2, 5, 3) + weightsS = 1 ) # Experimental and SOC arm, with beta mix prior for both arms. From 038c6a67ef1531746432302f7040cc73f1c39207 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 15:09:10 +0100 Subject: [PATCH 095/106] clean --- R/postprobDist.R | 4 ++-- man/postprobDist.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index db36e558..31c95af9 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -117,9 +117,9 @@ h_get_bounds <- function(controlBetamixPost) { #' @typed parS : numeric or matrix #' parameters for beta distribution. If it is a matrix, it needs to have 2 columns, #' and each row corresponds to each component of a beta-mixture distribution -#' for the `E` group. See details. +#' for the `S` group. See details. #' @typed weightsS : numeric -#' weights for the SOC group (default: uniform). +#' weights for the SOC group. See also `weights`. #' @typed epsilon : number #' the smallest non-negative floating number to represent the lower bound for #' the interval of integration. diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index 3bc8ed2f..b49c8c95 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -43,9 +43,9 @@ Weights can exceed 1, to which the algorithm will normalize the weights such tha \item{parS}{(\verb{numeric or matrix}):\cr parameters for beta distribution. If it is a matrix, it needs to have 2 columns, and each row corresponds to each component of a beta-mixture distribution -for the \code{E} group. See details.} +for the \code{S} group. See details.} -\item{weightsS}{(\code{numeric}):\cr weights for the SOC group (default: uniform).} +\item{weightsS}{(\code{numeric}):\cr weights for the SOC group. See also \code{weights}.} \item{epsilon}{(\code{number}):\cr the smallest non-negative floating number to represent the lower bound for the interval of integration.} From 933d043c97eff67ca99622d93e6617195c9fb464 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 15:13:10 +0100 Subject: [PATCH 096/106] Update R/postprobDist.R Co-authored-by: Daniel Sabanes Bove --- R/postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index 31c95af9..c1938c57 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -114,7 +114,7 @@ h_get_bounds <- function(controlBetamixPost) { #' equal weights across mixture components. #' In the simple case of no mixture of priors given, the Beta parameters are weighted as `100 %`. #' Weights can exceed 1, to which the algorithm will normalize the weights such that all weights sum to 1. -#' @typed parS : numeric or matrix +#' @typed parS : "`numeric` or `matrix`" #' parameters for beta distribution. If it is a matrix, it needs to have 2 columns, #' and each row corresponds to each component of a beta-mixture distribution #' for the `S` group. See details. From 90b4d7ffafcd52ab495b7b9c3a907bcb16bdf6f1 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 15:14:40 +0100 Subject: [PATCH 097/106] Update tests/testthat/test-postprobDist.R Co-authored-by: Daniel Sabanes Bove --- tests/testthat/test-postprobDist.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index bf338dfe..2369b10d 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -1,4 +1,5 @@ # postprobDist ---- + test_that("postprobDist gives the correct number result", { result <- postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1) expect_equal(result, 0.4431067, tolerance = 1e-5) From 236617b863340bd6180e9d91a3055bfd942c89bc Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 15:15:15 +0100 Subject: [PATCH 098/106] Update tests/testthat/test-postprobDist.R Co-authored-by: Daniel Sabanes Bove --- tests/testthat/test-postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index 2369b10d..f57e37df 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -5,7 +5,7 @@ test_that("postprobDist gives the correct number result", { expect_equal(result, 0.4431067, tolerance = 1e-5) }) -test_that("postprobDist gives incrementally higher values with increase x support", { +test_that("postprobDist gives incrementally higher values with larger x", { is_lower <- postprobDist(x = 16, n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) is_higher <- postprobDist(x = 20, n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) expect_true(is_lower < is_higher) From dc8d31158b9d9f6583da5ad8740b3cd6c5aa48c1 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 15:37:21 +0100 Subject: [PATCH 099/106] Update examples/postprobDist.R Co-authored-by: Daniel Sabanes Bove --- examples/postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/postprobDist.R b/examples/postprobDist.R index d5a5ce29..340b1cf1 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -18,7 +18,7 @@ postprobDist( relativeDelta = FALSE ) -# When relativeDelta is TRUE and for a sequence of success outcomes for Experimental arm. +# When we use a relative difference and look at several possible number of responses. postprobDist( x = 1:23, n = 23, From 2a4c3b3e48b9d0d2d1e4d5d9b6db39270204c92f Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 15:38:28 +0100 Subject: [PATCH 100/106] Update tests/testthat/test-postprobDist.R Co-authored-by: Daniel Sabanes Bove --- tests/testthat/test-postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index f57e37df..1828433a 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -18,7 +18,7 @@ test_that("postprobDist gives incrementally higher values with increase x suppor expect_identical(result, c(expected_lower, expected_higher)) }) -test_that("postprobDist gives the correct number result", { +test_that("postprobDist gives the correct result for a beta-mixture example", { result <- postprobDist( x = 10, n = 23, From 07fd3b1180acf693b681c7bd9ffda7a01dab13b3 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 15:42:53 +0100 Subject: [PATCH 101/106] Update tests/testthat/test-postprobDist.R Co-authored-by: Daniel Sabanes Bove --- tests/testthat/test-postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index 1828433a..e2267b9b 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -79,7 +79,7 @@ test_that("postprobDist gives the correct number result", { c(1, 1) ), weights = c(0.5, 0.5), - weightsS = c(0.3, 0.7), + weightsS = c(0.3, 0.7) ) expect_equal(result, 0.3248885, tolerance = 1e-4) }) From 6ad8f587ade8f717033e08529ec5c5eff2b41f10 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 15:46:12 +0100 Subject: [PATCH 102/106] Update tests/testthat/test-postprobDist.R Co-authored-by: Daniel Sabanes Bove --- tests/testthat/test-postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index e2267b9b..942d7d8f 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -65,7 +65,7 @@ test_that("postprobDist gives incrementally higher values with increased x", { expect_true(is_lower < is_higher) }) -test_that("postprobDist gives the correct number result", { +test_that("postprobDist gives the correct result with a weighted beta-mixture", { result <- postprobDist( x = 10, n = 23, From 89c5d6683d44f33e257581fbe39040edf4d01aab Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 17 Nov 2023 15:47:18 +0100 Subject: [PATCH 103/106] Update tests/testthat/test-postprobDist.R Co-authored-by: Daniel Sabanes Bove --- tests/testthat/test-postprobDist.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index 942d7d8f..8efba984 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -103,7 +103,7 @@ test_that("postprobDist gives the correct number result", { expect_equal(result, 0.3248885, tolerance = 1e-4) }) -test_that("postprobDist gives an error when length(par)", { +test_that("postprobDist gives an error when n is not a number", { expect_error( results <- postprobDist( x = c(16, 17), From 6d79c5d26b847f5404e399d7980b019fc733f74d Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Sat, 18 Nov 2023 08:18:21 +0100 Subject: [PATCH 104/106] clean --- R/postprobDist.R | 14 ++--- man/postprobDist.Rd | 18 +++--- tests/testthat/test-postprob.R | 2 +- tests/testthat/test-postprobDist.R | 94 ++++++++---------------------- 4 files changed, 41 insertions(+), 87 deletions(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index c1938c57..a0f7b566 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -110,16 +110,13 @@ h_get_bounds <- function(controlBetamixPost) { #' and each row corresponds to each component of a beta-mixture distribution #' for the `E` group. See details. #' @typed weights : numeric -#' the non-negative mixture weights of the beta mixture prior for group `E`. -#' equal weights across mixture components. -#' In the simple case of no mixture of priors given, the Beta parameters are weighted as `100 %`. -#' Weights can exceed 1, to which the algorithm will normalize the weights such that all weights sum to 1. +#' the non-negative mixture weights of the beta mixture prior for group `E`. See details. #' @typed parS : "`numeric` or `matrix`" #' parameters for beta distribution. If it is a matrix, it needs to have 2 columns, #' and each row corresponds to each component of a beta-mixture distribution #' for the `S` group. See details. #' @typed weightsS : numeric -#' weights for the SOC group. See also `weights`. +#' the non-negative mixture weights of the beta mixture prior for group `S`. See details. #' @typed epsilon : number #' the smallest non-negative floating number to represent the lower bound for #' the interval of integration. @@ -142,10 +139,13 @@ h_get_bounds <- function(controlBetamixPost) { #' #' @details #' -#' The beta mixture prior for the E arm requires argument `parE` and `weights`. -#' The beta mixture prior for the E arm requires argument `parS` and `weightsS`. +#' The beta mixture prior for the `E` arm requires argument `parE` and `weights`. +#' The beta mixture prior for the `S` arm requires argument `parS` and `weightsS`. #' See `[postprob()]` for details. #' +#' If a beta-mixture is used, by default, the weights are uniform across the components. +#' Weights can exceed 1, to which the algorithm will normalize the weights such that all weights sum to 1. +#' #' @example examples/postprobDist.R #' @export postprobDist <- function(x, diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index b49c8c95..f49b4dfd 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -36,16 +36,13 @@ response rate in magnitude of \code{delta} of the SOC non-responding patients. S and each row corresponds to each component of a beta-mixture distribution for the \code{E} group. See details.} -\item{weights}{(\code{numeric}):\cr the non-negative mixture weights of the beta mixture prior for group \code{E}. -equal weights across mixture components. -In the simple case of no mixture of priors given, the Beta parameters are weighted as \verb{100 \%}. -Weights can exceed 1, to which the algorithm will normalize the weights such that all weights sum to 1.} +\item{weights}{(\code{numeric}):\cr the non-negative mixture weights of the beta mixture prior for group \code{E}. See details.} -\item{parS}{(\verb{numeric or matrix}):\cr parameters for beta distribution. If it is a matrix, it needs to have 2 columns, +\item{parS}{(\code{numeric} or \code{matrix}):\cr parameters for beta distribution. If it is a matrix, it needs to have 2 columns, and each row corresponds to each component of a beta-mixture distribution for the \code{S} group. See details.} -\item{weightsS}{(\code{numeric}):\cr weights for the SOC group. See also \code{weights}.} +\item{weightsS}{(\code{numeric}):\cr the non-negative mixture weights of the beta mixture prior for group \code{S}. See details.} \item{epsilon}{(\code{number}):\cr the smallest non-negative floating number to represent the lower bound for the interval of integration.} @@ -63,9 +60,12 @@ posterior probability of achieving superior response rate in the treatment group See note below for two formulations of the difference in response rates. } \details{ -The beta mixture prior for the E arm requires argument \code{parE} and \code{weights}. -The beta mixture prior for the E arm requires argument \code{parS} and \code{weightsS}. +The beta mixture prior for the \code{E} arm requires argument \code{parE} and \code{weights}. +The beta mixture prior for the \code{S} arm requires argument \code{parS} and \code{weightsS}. See \verb{[postprob()]} for details. + +If a beta-mixture is used, by default, the weights are uniform across the components. +Weights can exceed 1, to which the algorithm will normalize the weights such that all weights sum to 1. } \note{ \subsection{Delta :}{ @@ -103,7 +103,7 @@ postprobDist( relativeDelta = FALSE ) -# When relativeDelta is TRUE and for a sequence of success outcomes for Experimental arm. +# When we use a relative difference and look at several possible number of responses. postprobDist( x = 1:23, n = 23, diff --git a/tests/testthat/test-postprob.R b/tests/testthat/test-postprob.R index f0b62a9d..38d8732c 100644 --- a/tests/testthat/test-postprob.R +++ b/tests/testthat/test-postprob.R @@ -19,7 +19,7 @@ test_that("postprob gives the correct number result", { }) test_that("postprob gives the correct number result", { - # 2 component beta mixture prior, i.e., P_E ~ 1*beta(0.6,0.4) + 1*beta(1,1) and Pr(P_E > p | data) = 0.823 + # 2 component beta mixture prior, i.e., P_E ~ 0.5*beta(0.6,0.4) + 0.5*beta(1,1) and Pr(P_E > p | data) = 0.05559802 result <- postprob( x = 10, n = 23, diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index 8efba984..ff0559f1 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -11,7 +11,7 @@ test_that("postprobDist gives incrementally higher values with larger x", { expect_true(is_lower < is_higher) }) -test_that("postprobDist gives incrementally higher values with increase x support", { +test_that("postprobDist gives incrementally higher values with larger x", { expected_lower <- postprobDist(x = 16, n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) expected_higher <- postprobDist(x = 20, n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) result <- postprobDist(x = c(16, 20), n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) @@ -84,25 +84,6 @@ test_that("postprobDist gives the correct result with a weighted beta-mixture", expect_equal(result, 0.3248885, tolerance = 1e-4) }) -test_that("postprobDist gives the correct number result", { - result <- postprobDist( - x = 10, - n = 23, - delta = 0.1, - parE = rbind( - c(0.6, 0.4), - c(1, 1) - ), - parS = rbind( - c(0.6, 0.4), - c(1, 1) - ), - weights = c(0.5, 0.5), - weightsS = c(0.3, 0.7), - ) - expect_equal(result, 0.3248885, tolerance = 1e-4) -}) - test_that("postprobDist gives an error when n is not a number", { expect_error( results <- postprobDist( @@ -112,11 +93,11 @@ test_that("postprobDist gives an error when n is not a number", { parS = c(0.6, 0.4), delta = 0.1, relativeDelta = FALSE - ), "must have length 1, but has length 2" + ), "number of items to replace is not a multiple of replacement length" ) }) -test_that("postprobDist gives an error", { +test_that("postprobDist gives an error when xS and nS are not numbers", { expect_error( results <- postprobDist( x = c(10, 16), @@ -128,37 +109,7 @@ test_that("postprobDist gives an error", { parS = c(0.6, 0.4), weights = c(0.5), weightsS = c(0.3), - ), "Must have length 1" - ) -}) - -test_that("postprobDist gives an error", { - expect_error( - results <- postprobDist( - x = 16, - n = 23, - xS = c(10, 12), - nS = c(20), - parE = c(0.6, 0.4), - parS = c(0.6, 0.4), - delta = 0.1, - relativeDelta = FALSE - ), "Must have length 1." - ) -}) - -test_that("postprobDist gives an error", { - expect_error( - results <- postprobDist( - x = 16, - n = 23, - xS = c(10, 12), - nS = c(20, 21), - parE = c(0.6, 0.4), - parS = c(0.6, 0.4), - delta = 0.1, - relativeDelta = FALSE - ), "Must have length 1." + ), "number of items to replace is not a multiple of replacement length" ) }) @@ -178,33 +129,35 @@ test_that("h_integrand_relDelta gives the correct numerical result", { activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights) controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) results <- h_integrand_relDelta( - p_s = p_s, delta = delta, + p_s = p_s, + delta = delta, activeBetamixPost = activeBetamixPost, controlBetamixPost = controlBetamixPost ) expect_equal(results, 0.0001352829, tolerance = 1e-4) }) -test_that("h_integrand_relDelta gives the correct numerical result", { +test_that("h_integrand_relDelta gives the correct numerical result with a weighted beta-mixture.", { x <- 16 n <- 23 xS <- 10 nS <- 20 - parE <- t(c(1, 3)) - parS <- t(c(1, 1)) - weights <- c(0.5) - weightsS <- c(1) + parE <- rbind(c(1, 3), c(2, 3)) + parS <- rbind(c(1, 1), c(3, 4)) + weights <- c(5, 10) + weightsS <- c(3, 4) p_s <- 0.1 delta <- 0.1 relativeDelta <- TRUE activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights) controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) results <- h_integrand_relDelta( - p_s = p_s, delta = delta, + p_s = p_s, + delta = delta, activeBetamixPost = activeBetamixPost, controlBetamixPost = controlBetamixPost ) - expect_equal(results, 0.0001352829, tolerance = 1e-4) + expect_equal(results, 6.498862e-05, tolerance = 1e-4) }) # h_integrand -- @@ -223,32 +176,33 @@ test_that("h_integrand gives the correct numerical result", { activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights) controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) results <- h_integrand( - p_s = p_s, delta = delta, + p_s = p_s, + delta = delta, activeBetamixPost = activeBetamixPost, controlBetamixPost = controlBetamixPost ) expect_equal(results, 0.0001352828, tolerance = 1e-4) }) - -test_that("h_integrand gives the correct numerical result", { +test_that("h_integrand gives the correct numerical result with a weighted beta-mixture.", { x <- 16 n <- 23 xS <- 10 nS <- 20 - parE <- t(c(1, 3)) - parS <- t(c(1, 1)) - weights <- 1 - weightsS <- 1 + parE <- rbind(c(1, 3), c(2, 3)) + parS <- rbind(c(1, 1), c(3, 4)) + weights <- c(5, 10) + weightsS <- c(3, 4) p_s <- 0.1 delta <- 0.1 relativeDelta <- FALSE activeBetamixPost <- getBetamixPost(x = x, n = n, par = parE, weights = weights) controlBetamixPost <- getBetamixPost(x = xS, n = nS, par = parS, weights = weightsS) results <- h_integrand( - p_s = p_s, delta = delta, + p_s = p_s, + delta = delta, activeBetamixPost = activeBetamixPost, controlBetamixPost = controlBetamixPost ) - expect_equal(results, 0.0001352828, tolerance = 1e-4) + expect_equal(results, 6.498861e-05, tolerance = 1e-4) }) From 67d1022db3d693eff54127427633889c71998947 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Sat, 18 Nov 2023 08:37:19 +0100 Subject: [PATCH 105/106] clean --- R/postprobDist.R | 12 ++++-------- examples/postprobDist.R | 4 ++-- man/h_integrand.Rd | 4 ++-- man/h_integrand_relDelta.Rd | 4 ++-- man/postprobDist.Rd | 8 +++----- tests/testthat/test-postprobDist.R | 8 ++++---- 6 files changed, 17 insertions(+), 23 deletions(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index a0f7b566..26e96a28 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -7,8 +7,8 @@ NULL #' The helper function to generate Integrand function when `relative Delta = TRUE`. #' #' @typed delta : number -#' the margin of which treatment group `E` is superior than the success rate of -#' the standard of care `S`. See also note about the calculation of `delta` when `relative Delta = TRUE`. +#' margin by which the response rate in the treatment group should +#' be better than in the SOC group. Must be >= `0`. See note. #' @typed p_s : number #' probability of success or response rate of standard of care or `SOC` group. #' @typed activeBetamixPost : list @@ -86,11 +86,10 @@ h_get_bounds <- function(controlBetamixPost) { #' @description `r lifecycle::badge("experimental")` #' #' Using the approach by Thall and Simon (Biometrics, 1994), this evaluates the -#' posterior probability of achieving superior response rate in the treatment group compared to standard of care (SOC): -#' -#' `Pr(P_E > P_S | data) = \int 1-F(p_s + delta | alpha_E + x, beta_E + n- x) f(p_s; alpha_S, beta_S`. +#' posterior probability of achieving superior response rate in the treatment group compared to standard of care (SOC). #' See note below for two formulations of the difference in response rates. #' +#' @inheritParams h_integrand_relDelta #' @typed x : numeric #' number of success counts in the treatment group. #' @typed n : number @@ -99,9 +98,6 @@ h_get_bounds <- function(controlBetamixPost) { #' number of success counts in the SOC group. #' @typed nS : number #' number of patients in the SOC group. -#' @typed delta : number -#' margin by which the response rate in the treatment group should -#' be better than in the SOC group. Must be >= `0`. See note. #' @typed relativeDelta : flag #' If `TRUE`, then a `relativeDelta` is used. Represents that a minimum #' response rate in magnitude of `delta` of the SOC non-responding patients. See note. diff --git a/examples/postprobDist.R b/examples/postprobDist.R index 340b1cf1..0c132b84 100644 --- a/examples/postprobDist.R +++ b/examples/postprobDist.R @@ -46,7 +46,7 @@ postprobDist( delta = 0.1 ) -# Experimental arm only (strictly single arm trial), uniform prior in Experimental arm. Default used. +# Experimental arm only (strictly single arm trial), uniform prior in Experimental arm. # Non-uniform Prior used for SOC arm as no precedent data. postprobDist( x = 16, @@ -56,7 +56,7 @@ postprobDist( delta = 0, relativeDelta = FALSE, parS = c(2, 3), - weightsS = c(1) + weightsS = 1 ) # Experimental arm and SOC, uniform prior in both E and S arms, default setting used. postprobDist( diff --git a/man/h_integrand.Rd b/man/h_integrand.Rd index aeb5fc1c..7b9c2ef1 100644 --- a/man/h_integrand.Rd +++ b/man/h_integrand.Rd @@ -9,8 +9,8 @@ h_integrand(p_s, delta, activeBetamixPost, controlBetamixPost) \arguments{ \item{p_s}{(\code{number}):\cr probability of success or response rate of standard of care or \code{SOC} group.} -\item{delta}{(\code{number}):\cr the margin of which treatment group \code{E} is superior than the success rate of -the standard of care \code{S}. See also note about the calculation of \code{delta} when \verb{relative Delta = TRUE}.} +\item{delta}{(\code{number}):\cr margin by which the response rate in the treatment group should +be better than in the SOC group. Must be >= \code{0}. See note.} \item{activeBetamixPost}{(\code{list}):\cr a list of posterior parameters of a beta-mixture-binomial distribution with generic names \code{par} and \code{weights}. See \verb{[getBetaMix()]}.} diff --git a/man/h_integrand_relDelta.Rd b/man/h_integrand_relDelta.Rd index b14cfc4b..1cc98f90 100644 --- a/man/h_integrand_relDelta.Rd +++ b/man/h_integrand_relDelta.Rd @@ -9,8 +9,8 @@ h_integrand_relDelta(p_s, delta, activeBetamixPost, controlBetamixPost) \arguments{ \item{p_s}{(\code{number}):\cr probability of success or response rate of standard of care or \code{SOC} group.} -\item{delta}{(\code{number}):\cr the margin of which treatment group \code{E} is superior than the success rate of -the standard of care \code{S}. See also note about the calculation of \code{delta} when \verb{relative Delta = TRUE}.} +\item{delta}{(\code{number}):\cr margin by which the response rate in the treatment group should +be better than in the SOC group. Must be >= \code{0}. See note.} \item{activeBetamixPost}{(\code{list}):\cr a list of posterior parameters of a beta-mixture-binomial distribution with generic names \code{par} and \code{weights}. See \verb{[getBetaMix()]}.} diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index f49b4dfd..348f3e74 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -54,9 +54,7 @@ The posterior probability \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} Using the approach by Thall and Simon (Biometrics, 1994), this evaluates the -posterior probability of achieving superior response rate in the treatment group compared to standard of care (SOC): - -\verb{Pr(P_E > P_S | data) = \\int 1-F(p_s + delta | alpha_E + x, beta_E + n- x) f(p_s; alpha_S, beta_S}. +posterior probability of achieving superior response rate in the treatment group compared to standard of care (SOC). See note below for two formulations of the difference in response rates. } \details{ @@ -131,7 +129,7 @@ postprobDist( delta = 0.1 ) -# Experimental arm only (strictly single arm trial), uniform prior in Experimental arm. Default used. +# Experimental arm only (strictly single arm trial), uniform prior in Experimental arm. # Non-uniform Prior used for SOC arm as no precedent data. postprobDist( x = 16, @@ -141,7 +139,7 @@ postprobDist( delta = 0, relativeDelta = FALSE, parS = c(2, 3), - weightsS = c(1) + weightsS = 1 ) # Experimental arm and SOC, uniform prior in both E and S arms, default setting used. postprobDist( diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index ff0559f1..ccaa1b90 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -11,7 +11,7 @@ test_that("postprobDist gives incrementally higher values with larger x", { expect_true(is_lower < is_higher) }) -test_that("postprobDist gives incrementally higher values with larger x", { +test_that("postprobDist gives higher values with larger x and returns identical result when x is a vector", { expected_lower <- postprobDist(x = 16, n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) expected_higher <- postprobDist(x = 20, n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) result <- postprobDist(x = c(16, 20), n = 23, delta = 0.1, parE = c(0.6, 0.4), parS = c(0.6, 0.4)) @@ -35,7 +35,7 @@ test_that("postprobDist gives the correct result for a beta-mixture example", { expect_equal(result, 0.3143941, tolerance = 1e-5) }) -test_that("postprobDist gives incrementally higher values with increased x", { +test_that("postprobDist gives incrementally higher values with larger x for a beta-mixture example", { is_lower <- postprobDist( x = 10, n = 23, @@ -65,7 +65,7 @@ test_that("postprobDist gives incrementally higher values with increased x", { expect_true(is_lower < is_higher) }) -test_that("postprobDist gives the correct result with a weighted beta-mixture", { +test_that("postprobDist gives the correct result for a weighted beta-mixture", { result <- postprobDist( x = 10, n = 23, @@ -109,7 +109,7 @@ test_that("postprobDist gives an error when xS and nS are not numbers", { parS = c(0.6, 0.4), weights = c(0.5), weightsS = c(0.3), - ), "number of items to replace is not a multiple of replacement length" + ), "Must have length 1" ) }) From 78145701b0f75401da57213aa91e369d0f2e436f Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Tue, 21 Nov 2023 09:28:35 +0100 Subject: [PATCH 106/106] clean --- tests/testthat/test-postprobDist.R | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-postprobDist.R b/tests/testthat/test-postprobDist.R index ccaa1b90..15cae106 100644 --- a/tests/testthat/test-postprobDist.R +++ b/tests/testthat/test-postprobDist.R @@ -1,6 +1,6 @@ # postprobDist ---- -test_that("postprobDist gives the correct number result", { +test_that("postprobDist gives the correct number result.", { result <- postprobDist(x = 16, n = 23, parE = c(0.6, 0.4), parS = c(0.6, 0.4), delta = 0.1) expect_equal(result, 0.4431067, tolerance = 1e-5) }) @@ -18,7 +18,7 @@ test_that("postprobDist gives higher values with larger x and returns identical expect_identical(result, c(expected_lower, expected_higher)) }) -test_that("postprobDist gives the correct result for a beta-mixture example", { +test_that("postprobDist gives the correct result for a beta-mixture", { result <- postprobDist( x = 10, n = 23, @@ -35,7 +35,7 @@ test_that("postprobDist gives the correct result for a beta-mixture example", { expect_equal(result, 0.3143941, tolerance = 1e-5) }) -test_that("postprobDist gives incrementally higher values with larger x for a beta-mixture example", { +test_that("postprobDist gives incrementally higher values with larger x for a beta-mixture", { is_lower <- postprobDist( x = 10, n = 23, @@ -84,7 +84,7 @@ test_that("postprobDist gives the correct result for a weighted beta-mixture", { expect_equal(result, 0.3248885, tolerance = 1e-4) }) -test_that("postprobDist gives an error when n is not a number", { +test_that("postprobDist gives an error when n is not a number.", { expect_error( results <- postprobDist( x = c(16, 17), @@ -113,8 +113,8 @@ test_that("postprobDist gives an error when xS and nS are not numbers", { ) }) -# h_integrand_relDelta-- -test_that("h_integrand_relDelta gives the correct numerical result", { +# h_integrand_relDelta ---- +test_that("h_integrand_relDelta gives the correct numerical result for a beta-mixture.", { x <- 16 n <- 23 xS <- 10 @@ -137,7 +137,7 @@ test_that("h_integrand_relDelta gives the correct numerical result", { expect_equal(results, 0.0001352829, tolerance = 1e-4) }) -test_that("h_integrand_relDelta gives the correct numerical result with a weighted beta-mixture.", { +test_that("h_integrand_relDelta gives the correct numerical result for a weighted beta-mixture.", { x <- 16 n <- 23 xS <- 10 @@ -160,8 +160,8 @@ test_that("h_integrand_relDelta gives the correct numerical result with a weight expect_equal(results, 6.498862e-05, tolerance = 1e-4) }) -# h_integrand -- -test_that("h_integrand gives the correct numerical result", { +# h_integrand ---- +test_that("h_integrand gives the correct numerical result for a beta-mixture", { x <- 16 n <- 23 xS <- 10 @@ -184,7 +184,7 @@ test_that("h_integrand gives the correct numerical result", { expect_equal(results, 0.0001352828, tolerance = 1e-4) }) -test_that("h_integrand gives the correct numerical result with a weighted beta-mixture.", { +test_that("h_integrand works as expected for a weighted beta-mixture.", { x <- 16 n <- 23 xS <- 10