R/SLB_weight.R

In BDIB: Bayesian Dynamic Information Borrowing for Longitudinal Data with Informative Dropout

#' Self-adapting mixture weight for longitudinal borrowing (SLB)
#'
#' Given posterior samples of the concurrent control parameter (under a
#' non-informative prior) and a historical point estimate, compute the SLB
#' weight via a kernel-density posterior probability ratio:
#' \deqn{
#' R = \frac{\pi(\theta = \theta_h \mid \mathcal{D}_C)}
#'          {\max\{ \pi(\theta = \theta_h + \delta \mid \mathcal{D}_C),
#'                  \pi(\theta = \theta_h - \delta \mid \mathcal{D}_C) \}}, \quad
#' w = \frac{R}{1 + R}.
#' }
#'
#' @param theta_cc_np_samples numeric vector. Posterior draws of the concurrent
#'   control parameter under a non-informative prior.
#' @param theta_h numeric scalar. Historical estimate.
#' @param delta positive numeric. Clinically significant difference (CSD).
#' @return numeric scalar in \eqn{[0,1]}.
#' @export
#' @examples
#' set.seed(1000)
#' # Suppose these are posterior theta samples from concurrent control (NP fit)
#' theta_cc_np_samples <- rnorm(2000, mean = -3.2, sd = 0.25)
#'
#' # Historical estimate of theta and clinical delta
#' theta_h   <- -3.2
#' delta  <- 0.5
#'
#' SLB_weight(theta_cc_np_samples, theta_h = theta_h, delta = delta)
SLB_weight <- function(theta_cc_np_samples, theta_h, delta) {
  stopifnot(is.numeric(theta_cc_np_samples), length(theta_cc_np_samples) > 20L)
  stopifnot(is.numeric(theta_h), length(theta_h) == 1L)
  stopifnot(is.numeric(delta), length(delta) == 1L, delta > 0)

  d0  <- gaussian_kde(theta_cc_np_samples, theta_h)
  d_m <- gaussian_kde(theta_cc_np_samples, theta_h - delta)
  d_p <- gaussian_kde(theta_cc_np_samples, theta_h + delta)

  den <- max(d_m, d_p)
  num <- d0

  R <- d0 / max(d_m, d_p)
  if (!is.finite(R) || R < 0) R <- 0
  w <- R / (1 + R)
  max(0, min(1, w))
}