R/summary.crossnma.R

In htx-r/crossnma: Cross-Design & Cross-Format Network Meta-Analysis and Regression

#' Summary function for crossnma object
#'
#' @description
#' This function creates posterior summary statistics for the fitted
#' cross network meta-analysis / meta-regression model
#'
#' @param object An object generated by the \code{\link{crossnma}}.
#' @param quantiles A numeric vector of probabilities to present
#'   posterior summaries. The default value is c(0.025, 0.5, 0.975)
#'   for the 95\% credible interval and the median.
#' @param backtransf A logical value indicating whether to
#'   exponentiate the parameters of relative treatment effect and
#'   covariate effect.
#' @param exp Deprecated argument (replaced by \code{backtransf}).
#' @param \dots Additional arguments to be passed to summary()
#'   function
#' @return \code{crossnma.summary} returns a matrix containing the
#'   following summary statistics (in columns) for each estimated
#'   parameter:
#' @return \code{Mean} the mean of the posterior distribution
#' @return \code{SD} the standard deviation of the posterior
#'   distribution
#' @return \code{2.5\%} (default) the 2.5\% quantile of the posterior
#'   distribution (the lower bound of the 95\% credible interval)
#' @return \code{50\%} (default) the median of the posterior
#'   distribution
#' @return \code{97.5\%} (default) the 97.5\% quantile of the
#'   posterior distribution (the upper bound of the 95\% credible
#'   interval)
#' @return \code{Rhat} Gelman-Rubin statistic. The further the value
#'   of Rhat from 1, the worse the mixing of chains and so the
#'   convergence.
#' @return \code{n.eff} An estimate of the effective sample size. The
#'   smaller the value of n.eff the greater the uncertainty associated
#'   with the corresponding parameter.
#'
#' @author Tasnim Hamza \email{hamza.a.tasnim@@gmail.com}, Guido
#'   Schwarzer \email{guido.schwarzer@uniklinik-freiburg.de}
#'
#' @seealso \code{\link{print.summary.crossnma}}
#'
#' @examples
#' \dontrun{
#' # We conduct a network meta-analysis assuming a random-effects
#' # model.
#' # The data comes from randomized-controlled trials and
#' # non-randomized studies (combined naively)
#' head(ipddata) # participant-level data
#' stddata # study-level data
#'
#' # Create a JAGS model
#' mod <- crossnma.model(treat, id, relapse, n, design,
#'   prt.data = ipddata, std.data = stddata,
#'   reference = "A", trt.effect = "random", method.bias = "naive")
#'
#' # Fit JAGS model
#' set.seed(1909)
#' fit <- crossnma(mod)
#'
#' # Display the output
#' summary(fit)
#' }
#'
#' @method summary crossnma
#' @export

summary.crossnma <- function(object,
                             quantiles = object$model$quantiles,
                             backtransf = object$model$backtransf,
                             exp = backtransf,
                             ...) {

  chkclass(object, "crossnma")
  ##
  chklevel(quantiles)
  ##
  missing.backtransf <- missing(backtransf)
  backtransf <-
    deprecated2(backtransf, missing.backtransf, exp, missing(exp))
  chklogical(backtransf)
  if (backtransf & object$model$sm %in% c("MD", "SMD")) {
    if (!missing.backtransf)
      warning("No back transformation of results for (standardised) ",
              "mean differences (argument 'backtransf').")
    backtransf <- FALSE
  }
  ##
  exp <- backtransf
  ref <- object$model$reference
  
  sum.fit <- summary(object$samples, quantiles = quantiles, ...)
  ## mean and sd
  mat <- sum.fit$statistics[, c("Mean", "SD")]
  ## add quantiles
  mat <- cbind(mat, sum.fit$quantiles)
  ##
  if (backtransf) {
    sel <- !(startsWith(rownames(mat), "tau") |
             startsWith(rownames(mat), "SUCRA"))
    mat[row.names(mat)[sel], colnames(mat) != "SD"] <-
      exp(mat[row.names(mat)[sel], colnames(mat) != "SD"])
  }
  
  ## Add Rhat
  ##
  Rhat <- round(rhat(object$samples)$psrf[, "Point est."], 3)
  mat <- cbind(mat, Rhat)

  ## Add number of effective sample size
  ##
  n.eff <- round(effectiveSize(object$samples))
  mat <- cbind(mat, n.eff)
  
  ## Attach treatment names to basic parameters (d's)
  ##
  row.names(mat)[startsWith(rownames(mat), "d")] <-
    paste("d", as.character(object$model$trt.key$trt.ini), sep = ".")
  ##
  mat[row.names(mat) %in% paste("d", ref, sep = "."), ] <- NA

  ## Attach treatment names to SUCRA values (SUCRA's)
  ##
  row.names(mat)[startsWith(rownames(mat), "SUCRA")] <-
    paste("SUCRA", as.character(object$model$trt.key$trt.ini), sep = ".")

  ## Reorder entries in results matrix
  ##
  sel.d <- startsWith(rownames(mat), "d.")
  sel.tau <- startsWith(rownames(mat), "tau")
  sel.sucra <- startsWith(rownames(mat), "SUCRA")
  ##
  mat <- rbind(mat[sel.d, , drop = FALSE],
               mat[!(sel.d | sel.tau | sel.sucra), , drop = FALSE],
               mat[sel.tau, , drop = FALSE],
               mat[sel.sucra, , drop = FALSE])
  
  class(mat) <- c("summary.crossnma", class(mat))
  attr(mat, "backtransf") <- backtransf
  attr(mat, "exp") <- exp
  ##
  attr(mat, "object") <- object
  ##
  mat
}