R/convert-.r

In pimeta: Prediction Intervals for Random-Effects Meta-Analysis

#' Converting binary data
#' 
#' Converting binary outcome data to the effect size estimates
#' and the within studies standard errors vector
#' 
#' @details This function implements methods for logarithmic
#' odds ratio, logarithmic relative risk, and risk difference
#' described in Hartung & Knapp (2001).
#' 
#' @name convert_bin
#' @rdname convert_bin
#' @param m1 the number of successes in treatment group 1
#' @param n1 the number of patients in treatment group 1
#' @param m2 the number of successes in treatment group 2
#' @param n2 the number of patients in treatment group 2
#' @param type the outcome measure for binary outcome data (default = "logOR").
#' \itemize{
#' \item \code{logOR}: logarithmic odds ratio,
#'                     which is defined by \eqn{=\log \frac{(m1+0.5)(n2-m2+0.5)}{(n1-m1+0.5)(m2+0.5)}}.
#' \item \code{logRR}: logarithmic relative risk,
#'                     which is defined by \eqn{=\log \frac{(m1+0.5)(n2+0.5)}{(n1+0.5)(m2+0.5)}}.
#' \item \code{RD}:    risk difference,
#'                     which is defined by \eqn{=\frac{m1}{n1}-\frac{m2}{n2}}.
#' }
#' @return
#' \itemize{
#' \item \code{y}: the effect size estimates vector.
#' \item \code{se}: the within studies standard errors vector.
#' }
#' @references
#' Hartung, J., and Knapp, G. (2001).
#' A refined method for the meta-analysis of controlled clinical trials
#' with binary outcome.
#' \emph{Stat Med.}
#' \strong{20}(24): 3875-3889.
#' \url{https://doi.org/10.1002/sim.1009}
#' @examples
#' m1 <- c(15,12,29,42,14,44,14,29,10,17,38,19,21)
#' n1 <- c(16,16,34,56,22,54,17,58,14,26,44,29,38)
#' m2 <- c( 9, 1,18,31, 6,17, 7,23, 3, 6,12,22,19)
#' n2 <- c(16,16,34,56,22,55,15,58,15,27,45,30,38)
#' dat <- pimeta::convert_bin(m1, n1, m2, n2, type = "logOR")
#' \donttest{pimeta::pima(dat$y, dat$se)}
#' @export
convert_bin <- function(m1, n1, m2, n2, type = c("logOR", "logRR", "RD")) {

  # initial check
  lstt <- c("logOR", "logRR", "RD")
  type <- match.arg(type)
  
  util_check_nonneg(m1)
  util_check_nonneg(n1)
  util_check_nonneg(m2)
  util_check_nonneg(n2)
  
  if (length(m1) != length(n1) || length(n1) != length(m2) || length(m2) != length(n2)) {
    stop("'m1', 'n1', 'm2', and 'n2' should have the same length.")
  } else if (!is.element(type, lstt)) {
    stop("Unknown 'type' specified.")
  }
  
  res <- NULL
  if (type == "logOR") {
    res$y <- log((m1 + 0.5)*(n2 - m2 + 0.5)/(n1 - m1 + 0.5)/(m2 + 0.5))
    res$se <- sqrt(1.0/(m1 + 0.5) + 1.0/(n1 - m1 + 0.5) + 1.0/(m2 + 0.5) + 1.0/(n2 - m2 + 0.5))
  } else if (type == "logRR") {
    res$y <- log((m1 + 0.5)*(n2 + 0.5)/(n1 + 0.5)/(m2 + 0.5))
    res$se <- sqrt(1.0/(m1 + 0.5) - 1.0/(n1 + 0.5) + 1.0/(m2 + 0.5) - 1.0/(n2 + 0.5))
  } else if (type == "RD") {
    res$y <- m1/n1 - m2/n2
    res$se <- sqrt(
      ((m1 + 0.0625)/(n1 + 0.125))*((n1 - m1 + 0.0625)/(n1 + 0.125))/n1 +
        ((m2 + 0.0625)/(n2 + 0.125))*((n2 - m2 + 0.0625)/(n2 + 0.125))/n2
    )
  }
  
  res <- data.frame(res)
  
  return(res)
  
}