From 50ef5b122e82f0e67295af746781431bc501c026 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Mon, 14 Aug 2023 17:53:05 +0200 Subject: [PATCH 01/91] 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 02/91] 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 03/91] 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 04/91] 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 05/91] 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 06/91] 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 07/91] 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 08/91] 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 09/91] 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 10/91] 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 11/91] 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 12/91] 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 13/91] [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 14/91] 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 15/91] 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 16/91] 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 17/91] 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 18/91] 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 19/91] 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 20/91] 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 21/91] 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 22/91] 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 23/91] 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 24/91] 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 25/91] [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 26/91] 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 27/91] 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 28/91] 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 29/91] 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 30/91] 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 31/91] 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 32/91] 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 33/91] 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 34/91] [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 35/91] 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 36/91] 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 37/91] 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 38/91] 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 39/91] 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 40/91] 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 41/91] 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 42/91] 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 43/91] 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 44/91] 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 45/91] 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 46/91] 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 47/91] 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 48/91] 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 49/91] 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 50/91] 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 51/91] 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 52/91] 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 53/91] 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 54/91] 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 55/91] 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 56/91] 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 57/91] 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 58/91] 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 59/91] 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 60/91] 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 61/91] 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 62/91] [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 63/91] 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 64/91] 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 65/91] [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 66/91] 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 67/91] 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 68/91] [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 69/91] 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 70/91] [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 55939e9f77cd41ac159c5f64db4d0d2fde26930f Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 11 Oct 2023 14:15:52 +0200 Subject: [PATCH 71/91] clean --- R/postprobDist.R | 61 +++++++++++++++++++++++---------------------- inst/WORDLIST | 1 + man/postprobDist.Rd | 31 ++++++++++++----------- 3 files changed, 48 insertions(+), 45 deletions(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index 728752e5..4578d9b8 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -4,6 +4,8 @@ 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 @@ -13,33 +15,43 @@ 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 (\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` 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 -#' \code{\link{oc2}} code). +#' [oc2] code). #' -#' @param x number of successes (in the treatment group). Note that \code{x} +#' @typed 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 -#' 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 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). +#' @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, +#' @typed 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 +#' @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 parameters for the SOC group (default: uniform). +#' @typed weightsS : +#' weights for the SOC group (default: uniform). #' @return the posterior probability #' #' @example examples/postprobDist.R @@ -56,34 +68,27 @@ postprobDist <- function(x, n, 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)) { + if (is.na(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 parS <- t(parS) } - ## if prior weights of the beta mixture are not supplied if (missing(weightsS)) { weightsS <- rep(1, nrow(parS)) } - ## compute updated beta parameters 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): integrand <- @@ -94,13 +99,11 @@ postprobDist <- function(x, n, p = (1 - delta) * p + delta, betamixPost = activeBetamixPost ) - pdf <- with( controlBetamixPost, dbetaMix(x = p, par = par, weights = weights) ) - - return(cdf * pdf) + cdf * pdf } } else { function(p) { @@ -115,10 +118,9 @@ postprobDist <- function(x, n, dbetaMix(x = p, par = par, weights = weights) ) - return(cdf * pdf) + 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. @@ -144,7 +146,6 @@ postprobDist <- function(x, n, bounds[2] ) ) - if (intRes$message == "OK") { return(intRes$value) } else { diff --git a/inst/WORDLIST b/inst/WORDLIST index b8b4f97e..cc3f20ec 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -92,6 +92,7 @@ integrations LciU ldots leq +lifecycle Liu mathbb mathbf diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index 4658f604..d6321edf 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -18,19 +18,19 @@ postprobDist( ) } \arguments{ -\item{x}{number of successes (in the treatment group). Note that \code{x} +\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 -be better than 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{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,21 +39,23 @@ 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, +\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}{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 parameters 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{ +`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 @@ -62,14 +64,13 @@ 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 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 +\code{weightsS} parameters), see \link{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). +\link{oc2} code). } \examples{ ## example similar to Lee and Liu: From a9c991ff30e49e2535f96f4bac9177b75acd4ea1 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 11 Oct 2023 15:15:48 +0200 Subject: [PATCH 72/91] Revert "[skip actions] Roxygen Man Pages Auto Update" This reverts commit 35126ab18724a1f12b3381c88fa8f70406bfa4b6. --- man/ocPostprob.Rd | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index 123d1aa6..70ba1aa1 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -79,7 +79,11 @@ 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 147146ccb7084b542d379cf6a0db130ad3836ab2 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 11 Oct 2023 15:16:17 +0200 Subject: [PATCH 73/91] Revert "clean" This reverts commit 55939e9f77cd41ac159c5f64db4d0d2fde26930f. --- R/postprobDist.R | 61 ++++++++++++++++++++++----------------------- inst/WORDLIST | 1 - man/postprobDist.Rd | 31 +++++++++++------------ 3 files changed, 45 insertions(+), 48 deletions(-) diff --git a/R/postprobDist.R b/R/postprobDist.R index 4578d9b8..728752e5 100644 --- a/R/postprobDist.R +++ b/R/postprobDist.R @@ -4,8 +4,6 @@ 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 @@ -15,43 +13,33 @@ 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 +#' 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 #' 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). +#' \code{\link{oc2}} code). #' -#' @typed x : -#' number of successes (in the treatment group). Note that \code{x} +#' @param x number of successes (in the treatment group). Note that \code{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). -#' @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 +#' @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 +#' 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 #' 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 parameters matrix, with K rows and 2 columns, +#' @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. -#' @typed weights : -#' the mixture weights of the beta mixture prior. Default are +#' @param weights the mixture weights of the beta mixture prior. Default are #' uniform weights across mixture components. -#' @typed parS : -#' beta parameters for the SOC group (default: uniform). -#' @typed weightsS : -#' weights for the SOC group (default: uniform). +#' @param parS beta parameters for the SOC group (default: uniform) +#' @param weightsS weights for the SOC group (default: uniform) #' @return the posterior probability #' #' @example examples/postprobDist.R @@ -68,27 +56,34 @@ postprobDist <- function(x, n, 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 (is.na(weights)) { + 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 parS <- t(parS) } + ## if prior weights of the beta mixture are not supplied if (missing(weightsS)) { weightsS <- rep(1, nrow(parS)) } + ## compute updated beta parameters 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): integrand <- @@ -99,11 +94,13 @@ postprobDist <- function(x, n, p = (1 - delta) * p + delta, betamixPost = activeBetamixPost ) + pdf <- with( controlBetamixPost, dbetaMix(x = p, par = par, weights = weights) ) - cdf * pdf + + return(cdf * pdf) } } else { function(p) { @@ -118,9 +115,10 @@ postprobDist <- function(x, n, dbetaMix(x = p, par = par, weights = weights) ) - cdf * pdf + return(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. @@ -146,6 +144,7 @@ postprobDist <- function(x, n, bounds[2] ) ) + if (intRes$message == "OK") { return(intRes$value) } else { diff --git a/inst/WORDLIST b/inst/WORDLIST index cc3f20ec..b8b4f97e 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -92,7 +92,6 @@ integrations LciU ldots leq -lifecycle Liu mathbb mathbf diff --git a/man/postprobDist.Rd b/man/postprobDist.Rd index d6321edf..4658f604 100644 --- a/man/postprobDist.Rd +++ b/man/postprobDist.Rd @@ -18,19 +18,19 @@ postprobDist( ) } \arguments{ -\item{x}{(``):\cr number of successes (in the treatment group). Note that \code{x} +\item{x}{number of successes (in the treatment group). Note that \code{x} can be a vector.} -\item{n}{(``):\cr number of patients (in the treatment group).} +\item{n}{number of patients (in the treatment group)} -\item{xS}{(``):\cr number of successes in the SOC group (default: 0).} +\item{xS}{number of successes in the SOC group (default: 0)} -\item{nS}{(``):\cr number of patients in the SOC group (default: 0).} +\item{nS}{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}{margin by which the response rate in the treatment group should +be better than in the SOC group (default: 0)} -\item{relativeDelta}{(``):\cr should the delta be relative? (not default). If this is +\item{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 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,23 +39,21 @@ 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}{(``):\cr the beta parameters matrix, with K rows and 2 columns, +\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}{(``):\cr the mixture weights of the beta mixture prior. Default are +\item{weights}{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}{beta parameters for the SOC group (default: uniform)} -\item{weightsS}{(``):\cr weights for the SOC group (default: uniform).} +\item{weightsS}{weights for the SOC group (default: uniform)} } \value{ the posterior probability } \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 @@ -64,13 +62,14 @@ 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 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 \link{postprob} for details. Note +\code{weightsS} parameters), see \code{\link{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 -\link{oc2} code). +\code{\link{oc2}} code). } \examples{ ## example similar to Lee and Liu: From ac6cb698b19a108314095e4354bc0c37753de3b8 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Wed, 11 Oct 2023 15:16:52 +0200 Subject: [PATCH 74/91] clean --- 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 bd78bbe16b61818b9cef8f6000d288fe0eaa702f Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 12 Oct 2023 09:15:07 +0200 Subject: [PATCH 75/91] clean --- examples/ocPostprob.R | 10 +++++----- examples/plotOc.R | 5 ++++- man/plotOc.Rd | 2 +- tests/testthat/test-ocPostprob.R | 6 +++--- 4 files changed, 13 insertions(+), 10 deletions(-) diff --git a/examples/ocPostprob.R b/examples/ocPostprob.R index 93091550..14c18bf0 100644 --- a/examples/ocPostprob.R +++ b/examples/ocPostprob.R @@ -6,7 +6,7 @@ # 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) + sim = 50000, wiggle = TRUE, randomdist = NULL, nnF = c(10, 20, 30) ) res$oc @@ -14,7 +14,7 @@ res$oc # 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) + sim = 50000, wiggle = TRUE, randomdist = c(-1, 3), nnF = c(10, 20, 30) ) res$oc @@ -22,7 +22,7 @@ res$oc # 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) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) ) res$oc @@ -30,7 +30,7 @@ res$oc # 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) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10) ) res$oc @@ -38,7 +38,7 @@ res$oc # 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) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10) ) res$oc diff --git a/examples/plotOc.R b/examples/plotOc.R index 35a75cfd..930ca464 100644 --- a/examples/plotOc.R +++ b/examples/plotOc.R @@ -1,6 +1,9 @@ # get operating character result from oc.postprob -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 = 10000) +res1 <- ocPostprob( + 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 = 50000 +) res1$oc plotOc(res1) diff --git a/man/plotOc.Rd b/man/plotOc.Rd index 67bef454..b13839d5 100644 --- a/man/plotOc.Rd +++ b/man/plotOc.Rd @@ -19,7 +19,7 @@ etc. and displays a bar plot of the operating characteristics \examples{ # get operating character result from oc.postprob -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 = 10000) +res1 <- ocPostprob(nn = 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) res1$oc plotOc(res1) diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index e0faae0d..2bcd07fb 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -18,13 +18,13 @@ test_that("h_get_distance gives an error with non sorted argument", { # 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)) + results <- h_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", { +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)) + results <- h_get_looks(dist = dist, nnE = c(10, 20, 30), nnF = c(10, 20, 30)) expect_equal(results$nnrE, results$nnrF) }) From 971264fc1203a4be0b434a519427073c173ecae4 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 12 Oct 2023 09:16:35 +0200 Subject: [PATCH 76/91] Update R/ocPostprob.R Co-authored-by: Daniel Sabanes Bove --- R/ocPostprob.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index 30a5ef2d..12b02dab 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -39,8 +39,8 @@ h_get_distance <- function(nn) { #' 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 #' From ff8aa37b38606718d0e2b8059dac82a9b5684e5c Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 12 Oct 2023 09:17:02 +0200 Subject: [PATCH 77/91] 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 12b02dab..04e4d9e8 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -81,7 +81,7 @@ h_get_looks <- function(dist, nnE, nnF) { #' 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. #' From 6f3a9994707cd4b1ed8fd2d0e2a85a0a0a92b107 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 12 Oct 2023 09:17:10 +0200 Subject: [PATCH 78/91] 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 04e4d9e8..96aa27f4 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -73,7 +73,7 @@ h_get_looks <- function(dist, nnE, nnF) { #' @typed p1 : number #' 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 From 8990c36f2b86527b2347eff31439d51d51f9fc51 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 12 Oct 2023 09:17:23 +0200 Subject: [PATCH 79/91] 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 96aa27f4..92bdf9ab 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -83,7 +83,7 @@ h_get_looks <- function(dist, nnE, nnF) { #' @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. +#' look size is an indicated interim, Futility or Efficacy or both. #' #' @keywords internal #' From 89230101a3d36977ff88d52116d20de6010e71fe Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 12 Oct 2023 09:17:34 +0200 Subject: [PATCH 80/91] Update R/postprob.R Co-authored-by: Daniel Sabanes Bove --- R/postprob.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/postprob.R b/R/postprob.R index 22cf7c38..35f444a3 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -62,7 +62,7 @@ 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 betamixPost is missing, then we would use the default parE + # If betamixPost is missing, then we would use the default parE. if (is.vector(parE)) { # Here there is only one component in the parE vector. assert_true(identical(length(parE), 2L)) From 3820c91b6557c555ea144b7de121213e2c9eef28 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 12 Oct 2023 09:17:42 +0200 Subject: [PATCH 81/91] Update R/postprob.R Co-authored-by: Daniel Sabanes Bove --- R/postprob.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/postprob.R b/R/postprob.R index 35f444a3..c9283de0 100644 --- a/R/postprob.R +++ b/R/postprob.R @@ -70,7 +70,7 @@ postprob <- function(x, n, p, parE = c(1, 1), weights, betamixPost, log.p = FALS parE <- t(parE) } - # If prior weights of the beta mixture are not supplied, weights are given + # If prior weights of the beta mixture are not supplied, weights are given. if (missing(weights)) { weights <- rep(1, nrow(parE)) } From ec14b6de307bb2c711af72ae038d1d1481d5b12c Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 12 Oct 2023 09:17:49 +0200 Subject: [PATCH 82/91] Update tests/testthat/test-ocPostprob.R Co-authored-by: Daniel Sabanes Bove --- tests/testthat/test-ocPostprob.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index 2bcd07fb..84bc96be 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -1,4 +1,4 @@ -# h_get_distance (helper function) ---- +# h_get_distance ---- test_that("h_get_distance gives an error with one element numeric", { expect_equal(h_get_distance(10), integer(0)) }) From 0c5202e558ec537855c329ede05a6cba85625067 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 12 Oct 2023 10:23:25 +0200 Subject: [PATCH 83/91] clean --- tests/testthat/test-ocPostprob.R | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index 84bc96be..d26d1f8a 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -15,7 +15,7 @@ test_that("h_get_distance gives an error with non sorted argument", { expect_error(h_get_distance(c(30, 20, 10))) }) -# h_get_looks (helper function) ---- +# h_get_looks ---- test_that("h_get_looks gives correct results if input is identical", { dist <- c(0, 5) results <- h_get_looks(dist = dist, nnE = c(10, 20, 30), nnF = c(10, 20, 30)) @@ -28,15 +28,13 @@ test_that("h_get_looks gives correct results if input is identical", { expect_equal(results$nnrE, results$nnrF) }) -# 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. +# h_get_decision ---- test_that("get_decision will give GO decision in favourable conditions", { tmp <- h_get_decision( nnr = c(10, 20, 30), truep = 0.5, + # Go criteria is P_E(p > p1) > tU, where P_E(truep > 0.30) > 0.8 + # Stop criteria is P_E(p < p0) > tL, where P_E(truep > 0.20) > 0.5 p0 = 0.2, p1 = 0.5, tL = 0.2, From f94c6e49c7509438bcf2a23c7ec01fb459ab366d 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, 12 Oct 2023 13:00:11 +0000 Subject: [PATCH 84/91] [skip actions] Roxygen Man Pages Auto Update --- man/h_get_decision.Rd | 4 ++-- man/h_get_looks.Rd | 6 ++++-- man/ocPostprob.Rd | 12 ++++++------ man/plotOc.Rd | 5 ++++- 4 files changed, 16 insertions(+), 11 deletions(-) diff --git a/man/h_get_decision.Rd b/man/h_get_decision.Rd index 713955d0..634965b8 100644 --- a/man/h_get_decision.Rd +++ b/man/h_get_decision.Rd @@ -25,14 +25,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.} -\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. } diff --git a/man/h_get_looks.Rd b/man/h_get_looks.Rd index da45d6e5..303add1f 100644 --- a/man/h_get_looks.Rd +++ b/man/h_get_looks.Rd @@ -18,8 +18,10 @@ specify in \code{nnF}.} } \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. +\itemize{ +\item \code{nnrE} is the result for Efficacy looks with random distance added. +\item \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}. diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index 123d1aa6..e4cd908a 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -28,7 +28,7 @@ specify in \code{nnF}.} \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}.} @@ -101,7 +101,7 @@ As default, \code{nnF} is set to the identical looks of \code{nnE}, and if \code # 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) + sim = 50000, wiggle = TRUE, randomdist = NULL, nnF = c(10, 20, 30) ) res$oc @@ -109,7 +109,7 @@ res$oc # 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) + sim = 50000, wiggle = TRUE, randomdist = c(-1, 3), nnF = c(10, 20, 30) ) res$oc @@ -117,7 +117,7 @@ res$oc # 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) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) ) res$oc @@ -125,7 +125,7 @@ res$oc # 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) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10) ) res$oc @@ -133,7 +133,7 @@ res$oc # 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) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10) ) res$oc diff --git a/man/plotOc.Rd b/man/plotOc.Rd index b13839d5..16389213 100644 --- a/man/plotOc.Rd +++ b/man/plotOc.Rd @@ -19,7 +19,10 @@ etc. and displays a bar plot of the operating characteristics \examples{ # get operating character result from oc.postprob -res1 <- ocPostprob(nn = 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) +res1 <- ocPostprob( + 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 = 50000 +) res1$oc plotOc(res1) From cb5d150fe5c72140c0f5294b03a119add4cd22b9 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 12 Oct 2023 16:23:28 +0200 Subject: [PATCH 85/91] clean --- NAMESPACE | 3 +- R/plotOc.R | 2 +- R/postprob.R | 79 ++++++++++++++----------- examples/postprobBeta.R | 10 ++++ man/h_get_decision.Rd | 4 +- man/h_get_looks.Rd | 6 +- man/ocPostprob.Rd | 12 ++-- man/plotOc.Rd | 5 +- man/postprob.Rd | 28 ++++----- man/{postprobOld.Rd => postprobBeta.Rd} | 16 ++--- tests/testthat/test-ocPostprob.R | 27 +++++---- tests/testthat/test-postprob.R | 1 - 12 files changed, 107 insertions(+), 86 deletions(-) create mode 100644 examples/postprobBeta.R rename man/{postprobOld.Rd => postprobBeta.Rd} (74%) 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/plotOc.R b/R/plotOc.R index 2e5c7caf..c4765cdd 100644 --- a/R/plotOc.R +++ b/R/plotOc.R @@ -13,7 +13,7 @@ #' @keywords graphics plotOc <- function(z) { ## plot function for oc.predprob or oc.postprob, or the dist versions of them - graphics::barplot(table(z$Decision, z$SampleSize) / z$params$ns, beside = TRUE) + graphics::barplot(table(z$Decision, z$SampleSize) / z$params$sim, beside = TRUE) ## get the parameter parDat <- lapply(z$params, deparse) diff --git a/R/postprob.R b/R/postprob.R index c9283de0..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/examples/postprobBeta.R b/examples/postprobBeta.R new file mode 100644 index 00000000..996ab7ee --- /dev/null +++ b/examples/postprobBeta.R @@ -0,0 +1,10 @@ +# 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/h_get_decision.Rd b/man/h_get_decision.Rd index 713955d0..634965b8 100644 --- a/man/h_get_decision.Rd +++ b/man/h_get_decision.Rd @@ -25,14 +25,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.} -\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. } diff --git a/man/h_get_looks.Rd b/man/h_get_looks.Rd index da45d6e5..303add1f 100644 --- a/man/h_get_looks.Rd +++ b/man/h_get_looks.Rd @@ -18,8 +18,10 @@ specify in \code{nnF}.} } \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. +\itemize{ +\item \code{nnrE} is the result for Efficacy looks with random distance added. +\item \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}. diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index 123d1aa6..e4cd908a 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -28,7 +28,7 @@ specify in \code{nnF}.} \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}.} @@ -101,7 +101,7 @@ As default, \code{nnF} is set to the identical looks of \code{nnE}, and if \code # 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) + sim = 50000, wiggle = TRUE, randomdist = NULL, nnF = c(10, 20, 30) ) res$oc @@ -109,7 +109,7 @@ res$oc # 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) + sim = 50000, wiggle = TRUE, randomdist = c(-1, 3), nnF = c(10, 20, 30) ) res$oc @@ -117,7 +117,7 @@ res$oc # 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) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) ) res$oc @@ -125,7 +125,7 @@ res$oc # 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) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10) ) res$oc @@ -133,7 +133,7 @@ res$oc # 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) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10) ) res$oc diff --git a/man/plotOc.Rd b/man/plotOc.Rd index b13839d5..16389213 100644 --- a/man/plotOc.Rd +++ b/man/plotOc.Rd @@ -19,7 +19,10 @@ etc. and displays a bar plot of the operating characteristics \examples{ # get operating character result from oc.postprob -res1 <- ocPostprob(nn = 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) +res1 <- ocPostprob( + 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 = 50000 +) res1$oc plotOc(res1) 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/postprobOld.Rd b/man/postprobBeta.Rd similarity index 74% rename from man/postprobOld.Rd rename to man/postprobBeta.Rd index e935456f..58795e3a 100644 --- a/man/postprobOld.Rd +++ b/man/postprobBeta.Rd @@ -1,21 +1,21 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/postprob.R -\name{postprobOld} -\alias{postprobOld} +\name{postprobBeta} +\alias{postprobBeta} \title{Posterior Probability of Efficacy Given Beta Prior} \usage{ -postprobOld(x, n, p, a = 1, b = 1) +postprobBeta(x, n, p, a = 1, b = 1) } \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 set to compute posterior probability.} -\item{a}{first parameter of the beta prior (successes)} +\item{a}{(\code{matrix}):\cr first parameter \code{alpha} of the beta prior (successes).} -\item{b}{second parameter of the beta prior (failures)} +\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. diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index d26d1f8a..3c32c304 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -48,8 +48,8 @@ test_that("get_decision will give GO decision in favourable conditions", { # h_get_oc ---- test_that("the probability results of get_oc are less than 1", { oc <- h_get_oc( - all_sizes = sample(c(11, 14, 20), 10000, replace = TRUE), - decision = sample(c(NA, TRUE, FALSE), 10000, replace = TRUE), + all_sizes = sample(c(11, 14, 20), size = 10000, replace = TRUE), + decision = sample(c(NA, TRUE, FALSE), size = 10000, replace = TRUE), nnrE = c(11, 14, 20), nnrF = c(11, 14, 20) ) @@ -57,13 +57,14 @@ test_that("the probability results of get_oc are less than 1", { }) test_that("the ExpectedN is within range based on vector of looks", { + all_sizes <- sample(c(11, 14, 20), size = 10000, replace = TRUE) oc <- h_get_oc( - all_sizes = sample(c(11, 14, 20), 10000, replace = TRUE), - decision = sample(c(NA, TRUE, FALSE), 10000, replace = TRUE), + all_sizes = all_sizes, + decision = sample(c(NA, TRUE, FALSE), size = 10000, replace = TRUE), nnrE = c(11, 14, 20), nnrF = c(11, 14, 20) ) - expect_number(oc$ExpectedN, lower = min(all_sizes), upper = max(all_sizes)) + expect_number(oc$ExpectedN, lower = min(all_sizes), upper = max(all_sizes)) # TODO }) # ocPostprob ---- @@ -85,28 +86,28 @@ test_that("the PrFutility increases with increase futility looks", { ) res_fut$oc$PrFutility - res_no_fut <- ocPostprob( + res_one_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 = 5000, wiggle = FALSE, randomdist = NULL, nnF = c(10) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10) ) - res_no_fut$oc$PrFutility - expect_true(res_fut$oc$PrFutility > res_no_fut$oc$PrFutility) + res_one_fut$oc$PrFutility + expect_true(res_fut$oc$PrFutility > res_one_fut$oc$PrFutility) }) -test_that("the PrFfficacy increases with increase Efficacy looks", { +test_that("the PrEfficacy 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 = 5000, wiggle = FALSE, randomdist = NULL, nnF = c(30) + sim = 50000, 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 = 5000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) ) res_more_eff$oc$PrEfficacy - expect_true(res_more_eff$oc$PrEfficacy > res_more_eff$oc$PrEfficacy) + expect_true(res_more_eff$oc$PrEfficacy > res_eff$oc$PrEfficacy) }) # ocPostprob --- diff --git a/tests/testthat/test-postprob.R b/tests/testthat/test-postprob.R index 13e1e54f..e9381886 100644 --- a/tests/testthat/test-postprob.R +++ b/tests/testthat/test-postprob.R @@ -11,7 +11,6 @@ test_that("postprobBeta gives incrementally higher values with increase x suppor 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 From 5c332e425a92f71a2fc23cd013b4b9adaf22a650 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 12 Oct 2023 16:34:57 +0200 Subject: [PATCH 86/91] clean --- tests/testthat/test-ocPostprob.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index 3c32c304..4a5c8e67 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -64,7 +64,7 @@ test_that("the ExpectedN is within range based on vector of looks", { nnrE = c(11, 14, 20), nnrF = c(11, 14, 20) ) - expect_number(oc$ExpectedN, lower = min(all_sizes), upper = max(all_sizes)) # TODO + expect_number(oc$ExpectedN, lower = min(all_sizes), upper = max(all_sizes)) }) # ocPostprob ---- From 6d0b9525a13a8459fd7eda1ff44e9b1f41a22e82 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Thu, 12 Oct 2023 16:57:22 +0200 Subject: [PATCH 87/91] clean --- R/ocPostprob.R | 4 ++-- man/h_get_decision.Rd | 2 +- tests/testthat/test-ocPostprob.R | 17 ++++++++++------- 3 files changed, 13 insertions(+), 10 deletions(-) diff --git a/R/ocPostprob.R b/R/ocPostprob.R index 92bdf9ab..5384c77c 100644 --- a/R/ocPostprob.R +++ b/R/ocPostprob.R @@ -63,9 +63,9 @@ h_get_looks <- function(dist, nnE, nnF) { #' #' @inheritParams h_get_looks #' @typed nnr : numeric -#' union of `nnE`and `nnF`. +#' 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 diff --git a/man/h_get_decision.Rd b/man/h_get_decision.Rd index 634965b8..623bd861 100644 --- a/man/h_get_decision.Rd +++ b/man/h_get_decision.Rd @@ -9,7 +9,7 @@ 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).} diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index 4a5c8e67..569af1dd 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -111,19 +111,17 @@ test_that("the PrEfficacy increases with increase Efficacy looks", { }) # 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. test_that("ocPostprob gives results that are within range to stats::pbinom", { set.seed(1989) + # Go criteria is P_E(truep >= 0.45) > 0.70 + # Stop criteria is P_E(truep <= 0.45) > 0.90 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 ) + # 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. expect_equal(res1$oc$PrEfficacy, 0.56226) p.go <- 1 - pbinom(q = 20 - 1, size = 40, prob = 0.5) expect_true(abs(p.go - res1$oc$PrEfficacy) < 1e-3) @@ -131,10 +129,15 @@ test_that("ocPostprob gives results that are within range to stats::pbinom", { test_that("ocPostprob gives results that are within range to stats::pbinom", { set.seed(1989) + # Go criteria is P_E(truep >= 0.45) > 0.70 + # Stop criteria is P_E(truep <= 0.45) > 0.90 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 ) + # 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. expect_equal(res1$oc$PrFutility, 0.01998) p.stop <- pbinom(q = 13, size = 40, prob = 0.5) p.stop From 096b8bb21f35a397620a9a5364c9a4e1dfc527bc Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 13 Oct 2023 08:07:20 +0200 Subject: [PATCH 88/91] Update tests/testthat/test-ocPostprob.R Co-authored-by: Daniel Sabanes Bove --- tests/testthat/test-ocPostprob.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index 569af1dd..35489fb1 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -88,7 +88,7 @@ test_that("the PrFutility increases with increase futility looks", { res_fut$oc$PrFutility res_one_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 = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = 10 ) res_one_fut$oc$PrFutility expect_true(res_fut$oc$PrFutility > res_one_fut$oc$PrFutility) From 993dad433c6a8a71adbb9f5ad1e77727ffbe4138 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 13 Oct 2023 08:09:34 +0200 Subject: [PATCH 89/91] clean --- examples/ocPostprob.R | 4 ++-- tests/testthat/test-ocPostprob.R | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/examples/ocPostprob.R b/examples/ocPostprob.R index 14c18bf0..23074841 100644 --- a/examples/ocPostprob.R +++ b/examples/ocPostprob.R @@ -30,7 +30,7 @@ res$oc # 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 = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = 10 ) res$oc @@ -38,7 +38,7 @@ res$oc # 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 = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = 10 ) res$oc diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index 35489fb1..c944dff5 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -98,7 +98,7 @@ test_that("the PrEfficacy 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 = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(30) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = 30 ) res_eff$oc$PrEfficacy From ee111a6e221d0e8301c42a3d2447cfe261e8894d 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: Fri, 13 Oct 2023 06:12:38 +0000 Subject: [PATCH 90/91] [skip actions] Roxygen Man Pages Auto Update --- man/ocPostprob.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/ocPostprob.Rd b/man/ocPostprob.Rd index e4cd908a..92d6a9f4 100644 --- a/man/ocPostprob.Rd +++ b/man/ocPostprob.Rd @@ -125,7 +125,7 @@ res$oc # 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 = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = 10 ) res$oc @@ -133,7 +133,7 @@ res$oc # 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 = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10) + sim = 50000, wiggle = FALSE, randomdist = NULL, nnF = 10 ) res$oc From 9c1ada1f87f16c1544ca3c77198c7fe58b9cd6d1 Mon Sep 17 00:00:00 2001 From: Audrey Yeo Date: Fri, 13 Oct 2023 10:34:10 +0200 Subject: [PATCH 91/91] clean --- tests/testthat/test-ocPostprob.R | 44 +++++++++++--------------------- 1 file changed, 15 insertions(+), 29 deletions(-) diff --git a/tests/testthat/test-ocPostprob.R b/tests/testthat/test-ocPostprob.R index c944dff5..d9b14c85 100644 --- a/tests/testthat/test-ocPostprob.R +++ b/tests/testthat/test-ocPostprob.R @@ -70,42 +70,42 @@ test_that("the ExpectedN is within range based on vector of looks", { # ocPostprob ---- test_that("the sum of Eff, Fut, Gray zone probabiliy is 1", { set.seed(1989) - res1 <- ocPostprob( + expect_warning(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 - ) + parE = c(1, 1), sim = 10000 + ), "Advise to use sim >= 50000 to achieve convergence") results <- sum(res1$oc[5:7]) expect_equal(results, 1) }) test_that("the PrFutility increases with increase futility looks", { set.seed(1989) - res_fut <- ocPostprob( + expect_warning(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 = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) - ) + sim = 10000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) + ), "Advise to use sim >= 50000 to achieve convergence") res_fut$oc$PrFutility - res_one_fut <- ocPostprob( + expect_warning(res_one_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 = 50000, wiggle = FALSE, randomdist = NULL, nnF = 10 - ) + sim = 10000, wiggle = FALSE, randomdist = NULL, nnF = 10 + ), "Advise to use sim >= 50000 to achieve convergence") res_one_fut$oc$PrFutility expect_true(res_fut$oc$PrFutility > res_one_fut$oc$PrFutility) }) test_that("the PrEfficacy increases with increase Efficacy looks", { set.seed(1989) - res_eff <- ocPostprob( + expect_warning(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 = 50000, wiggle = FALSE, randomdist = NULL, nnF = 30 - ) + sim = 10000, wiggle = FALSE, randomdist = NULL, nnF = 30 + ), "Advise to use sim >= 50000 to achieve convergence") res_eff$oc$PrEfficacy - res_more_eff <- ocPostprob( + expect_warning(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 = 50000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) - ) + sim = 10000, wiggle = FALSE, randomdist = NULL, nnF = c(10, 20, 30) + ), "Advise to use sim >= 50000 to achieve convergence") res_more_eff$oc$PrEfficacy expect_true(res_more_eff$oc$PrEfficacy > res_eff$oc$PrEfficacy) }) @@ -121,25 +121,11 @@ test_that("ocPostprob gives results that are within range to stats::pbinom", { ) # 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. expect_equal(res1$oc$PrEfficacy, 0.56226) p.go <- 1 - pbinom(q = 20 - 1, size = 40, prob = 0.5) expect_true(abs(p.go - res1$oc$PrEfficacy) < 1e-3) -}) - -test_that("ocPostprob gives results that are within range to stats::pbinom", { - set.seed(1989) - # Go criteria is P_E(truep >= 0.45) > 0.70 - # Stop criteria is P_E(truep <= 0.45) > 0.90 - 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 - ) - # 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. expect_equal(res1$oc$PrFutility, 0.01998) p.stop <- pbinom(q = 13, size = 40, prob = 0.5) - p.stop expect_true(abs(p.stop - res1$oc$PrFutility) < 1e-2) })