R/pos1S.R

In RBesT: R Bayesian Evidence Synthesis Tools

#' Probability of Success for a 1 Sample Design
#'
#' The `pos1S` function defines a 1 sample design (prior, sample
#' size, decision function) for the calculation of the frequency at
#' which the decision is evaluated to 1 when assuming a distribution
#' for the parameter. A function is returned which performs the
#' actual operating characteristics calculations.
#'
#' @template args-boundary1S
#'
#' @details The `pos1S` function defines a 1 sample design and
#' returns a function which calculates its probability of success.
#' The probability of success is the frequency with which the decision
#' function is evaluated to 1 under the assumption of a given true
#' distribution of the data implied by a distirbution of the parameter
#' \eqn{\theta}.
#'
#' Calling the `pos1S` function calculates the critical value
#' \eqn{y_c} and returns a function which can be used to evaluate the
#' PoS for different predictive distributions and is evaluated as
#'
#' \deqn{ \int F(y_c|\theta) p(\theta) d\theta, }
#'
#' where \eqn{F} is the distribution function of the sampling
#' distribution and \eqn{p(\theta)} specifies the assumed true
#' distribution of the parameter \eqn{\theta}. The distribution
#' \eqn{p(\theta)} is a mixture distribution and given as the
#' `mix` argument to the function.
#'
#' @return Returns a function that takes as single argument
#' `mix`, which is the mixture distribution of the control
#' parameter. Calling this function with a mixture distribution then
#' calculates the PoS.
#'
#' @family design1S
#'
#' @examples
#'
#' # non-inferiority example using normal approximation of log-hazard
#' # ratio, see ?decision1S for all details
#' s <- 2
#' flat_prior <- mixnorm(c(1, 0, 100), sigma = s)
#' nL <- 233
#' theta_ni <- 0.4
#' theta_a <- 0
#' alpha <- 0.05
#' beta <- 0.2
#' za <- qnorm(1 - alpha)
#' zb <- qnorm(1 - beta)
#' n1 <- round((s * (za + zb) / (theta_ni - theta_a))^2)
#' theta_c <- theta_ni - za * s / sqrt(n1)
#'
#' # assume we would like to conduct at an interim analysis
#' # of PoS after having observed 20 events with a HR of 0.8.
#' # We first need the posterior at the interim ...
#' post_ia <- postmix(flat_prior, m = log(0.8), n = 20)
#'
#' # dual criterion
#' decComb <- decision1S(c(1 - alpha, 0.5), c(theta_ni, theta_c), lower.tail = TRUE)
#'
#' # ... and we would like to know the PoS for a successful
#' # trial at the end when observing 10 more events
#' pos_ia <- pos1S(post_ia, 10, decComb)
#'
#' # our knowledge at the interim is just the posterior at
#' # interim such that the PoS is
#' pos_ia(post_ia)
#'
#' @export
pos1S <- function(prior, n, decision, ...) UseMethod("pos1S")
#' @export
pos1S.default <- function(prior, n, decision, ...) "Unknown density"

#' @templateVar fun pos1S
#' @template design1S-binomial
#' @export
pos1S.betaMix <- function(prior, n, decision, ...) {
  crit <- decision1S_boundary(prior, n, decision)
  lower.tail <- attr(decision, "lower.tail")

  design_fun <- function(mix) {
    pred_dtheta <- preddist(mix, n = n)
    pmix(pred_dtheta, crit, lower.tail = lower.tail)
  }
  design_fun
}

#' @templateVar fun pos1S
#' @template design1S-normal
#' @export
pos1S.normMix <- function(prior, n, decision, sigma, eps = 1e-6, ...) {
  ## distributions of the means of the data generating distributions
  ## for now we assume that the underlying standard deviation
  ## matches the respective reference scales
  if (missing(sigma)) {
    sigma <- RBesT::sigma(prior)
    message("Using default prior reference scale ", sigma)
  }
  assert_number(sigma, lower = 0)

  sigma(prior) <- sigma

  crit <- decision1S_boundary(prior, n, decision, sigma, eps)

  ## check where the decision is 1, i.e. left or right
  lower.tail <- attr(decision, "lower.tail")

  design_fun <- function(mix) {
    pred_dtheta_mean <- preddist(mix, n = n, sigma = sigma)
    pmix(pred_dtheta_mean, crit, lower.tail = lower.tail)
  }
  design_fun
}

#' @templateVar fun pos1S
#' @template design1S-poisson
#' @export
pos1S.gammaMix <- function(prior, n, decision, eps = 1e-6, ...) {
  crit <- decision1S_boundary(prior, n, decision, eps)
  lower.tail <- attr(decision, "lower.tail")

  design_fun <- function(mix) {
    assert_that(likelihood(prior) == "poisson")
    pred_dtheta_sum <- preddist(mix, n = n)
    pmix(pred_dtheta_sum, crit, lower.tail = lower.tail)
  }
  design_fun
}