R/mb.rank-class.R

In MBNMAtime: Run Time-Course Model-Based Network Meta-Analysis (MBNMA) Models

##############################################
#### Functions for class("mb.rank") ####
##############################################


#' Plot histograms of rankings from MBNMA models
#' @param x An object of class `"mb.rank"` generated by `rank.mbnma()`
#' @param treat.labs A vector of treatment labels in the same order as treatment codes.
#' Easiest to use treatment labels stored by `mb.network()`
#' @param ... Arguments to be sent to `ggplot2::ggplot()`
#'
#' @return A histogram that shows rankings for each treatment/agent/prediction.
#' The object returned is an object of class `c("gg", "ggplot")`.
#'
#' @examples
#' \donttest{
#' # Create an mb.network object from a dataset
#' painnet <- mb.network(osteopain)
#'
#' # Run an MBNMA model with an Emax time-course
#' emax <- mb.run(painnet,
#'   fun=temax(pool.emax="rel", method.emax="common",
#'     pool.et50="abs", method.et50="random"),
#'   positive.scale=TRUE)
#'
#' # Calculate treatment rankings for AUC and emax
#' ranks <- rank(emax,
#'   param=c("auc"),
#'   int.range=c(0,15), n.iter=500)
#'
#' # Plot histograms for ranking by AUC
#' plot(ranks)
#' }
#'
#' @export
plot.mb.rank <- function(x, treat.labs=NULL, ...) {
  # ... are commands to be sent to geom_histogram

  # Run checks
  argcheck <- checkmate::makeAssertCollection()
  checkmate::assertClass(x, "mb.rank", add=argcheck)
  checkmate::assertCharacter(treat.labs, null.ok=TRUE, add=argcheck)
  checkmate::reportAssertions(argcheck)

  # Declare global variables
  ranks <- NULL

  # output <- list()
  #
  # if (is.null(params)) {
  #   params <- names(x)
  # }

  if (is.null(treat.labs)) {
    treat.labs <- as.character(colnames(x$rank.matrix))
  } else if (!is.null(treat.labs)) {
    if (length(treat.labs)!=ncol(x$rank.matrix)) {
      stop("`treat.labs` must be the same length as the number of treatments that have been ranked in `x`")
    }
  }

  rank.mat <- x$rank.matrix
  treats <- c(1:ncol(rank.mat))

  ranks.param <- vector()
  treat <- vector()
  for (i in seq_along(treats)) {
    treat <- append(treat, rep(treats[i], nrow(rank.mat)))
    ranks.param <- append(ranks.param, rank.mat[,i])
  }
  df <- data.frame("ranks"=ranks.param, "treat"=treat)

  df$treat <- factor(df$treat, labels=treat.labs)

  g <- ggplot2::ggplot(df, ggplot2::aes(x=ranks), ...) +
    ggplot2::geom_bar() +
    ggplot2::xlab("Rank (1 = best)") +
    ggplot2::ylab("MCMC iterations") +
    ggplot2::facet_wrap(~treat) +
    ggplot2::ggtitle(x$param) +
    theme_mbnma()

  graphics::plot(g)

  return(invisible(g))

  # for (param in seq_along(params)) {
  #
  #   rank.mat <- x[[params[param]]]$rank.matrix
  #   #treats <- colnames(rank.mat)
  #   treats <- c(1:ncol(rank.mat))
  #
  #   ranks.param <- vector()
  #   treat <- vector()
  #   for (i in seq_along(treats)) {
  #     treat <- append(treat, rep(treats[i], nrow(rank.mat)))
  #     ranks.param <- append(ranks.param, rank.mat[,i])
  #   }
  #   df <- data.frame("ranks"=ranks.param, "treat"=treat)
  #
  #   df$treat <- factor(df$treat, labels=treat.labs)
  #
  #   g <- ggplot2::ggplot(df, ggplot2::aes(x=ranks), ...) +
  #     ggplot2::geom_bar() +
  #     ggplot2::xlab("Rank (1 = best)") +
  #     ggplot2::ylab("MCMC iterations") +
  #     ggplot2::facet_wrap(~treat) +
  #     ggplot2::ggtitle(params[param]) +
  #     theme_mbnma()
  #
  #   graphics::plot(g)
  #
  #   output[[params[param]]] <- g
  # }
#
#   return(invisible(output))
}



#' Prints a summary of rankings for each parameter
#'
#' @inheritParams plot.mb.rank
#' @param ... further arguments passed to or from other methods
#'
#' @return Prints summary details of treatment rankings to the console
#'
#' @export
print.mb.rank <- function(x, ...) {

  output <- crayon::bold("\n========================================\nTreatment rankings\n========================================")
  cat(output, "\n\n")

  head <- crayon::bold(crayon::underline(paste0(x$param, " ranking")))

  sumtab <- x$summary
  sumtab <- sumtab[,c(1,2,6,4,8)]

  cat(head)

  print(knitr::kable(sumtab, col.names = c("Treatment", "Mean", "Median", "2.5%", "97.5%"), digits = 2))
  cat("\n\n")
}