R/plot_nma.R

In gunhanb/nmaINLA: Network Meta-Analysis using Integrated Nested Laplace Approximations

#' Plot a network plot
#'
#' Takes a \code{create_INLA_dat} output and plots a network graph.
#'
#' @param data A \code{create_INLA_dat} object.
#' @param s.id Variable holding the study IDs for each study. The default is "study".
#' @param t.id Variable holding the treatments for each study. The default is "treatment".
#' @param title A character string indicating plot title.
#' @param adjust.figsizex a positive number used to adjust the plot width. The default is 1.1.
#' @param adjust.figsizey a positive number used to adjust the plot height. The default is 1.1.
#' @source This function is taken from \code{nma.networkplot} function from \code{pcnetmeta} R package.
#' @author Lifeng Lin, Jing Zhang, and Haitao Chu
#' @seealso \code{pcnetmeta::nma.networkplot}
#' @export
plot_nma <-  function(s.id = "study", t.id = "treatment", data, title = "", adjust.figsizex = 1.1, adjust.figsizey = 1.1){
  alphabetic = TRUE
  weight.edge = TRUE
  adjust.thick = 5
  weight.node = TRUE
  adjust.node.size = 10
  node.col = "orange"
  edge.col = "black"
  text.cex = 1
  if(missing(s.id) | missing(t.id)){
    stop("both study id and treatment id must be specified.")
  }
  if(!missing(data)){
    s.id <- eval(substitute(s.id), data, parent.frame())
    t.id <- eval(substitute(t.id), data, parent.frame())
  }

  unique.sid <- unique(s.id)
  nstudy <- length(unique.sid)
  sid.ori <- s.id
  for(s in 1:nstudy){
    s.id[sid.ori == unique.sid[s]] <- s
  }

  unique.tid <- sort(unique(t.id))
  ntrt <- length(unique.tid)
  if(ntrt <= 2) stop("there are less than 3 treatments, no need for network plot.")
  trtname <- unique.tid
  trtname.order <- 1:ntrt

  if(length(trtname) != ntrt){
    stop("the length of trtname do not match the data.")
  }

  ## make treatment id to be 1 to ntrt
  tid.ori <- t.id
  for(t in 1:ntrt){
    t.id[tid.ori == unique.tid[t]] <- t
  }

  polar <- pi/2 - 2*pi/ntrt*(0:(ntrt - 1))
  x <- cos(polar)
  y <- sin(polar)
  graphics::plot(x, y, axes = FALSE, xlab="", ylab="", cex = 0.1,
       xlim = c(-adjust.figsizex, adjust.figsizex),
       ylim = c(-adjust.figsizey, adjust.figsizey),
       main = title)

  wt <- matrix(0, ntrt, ntrt)
  for(t1 in 2:ntrt){
    for(t2 in 1:(t1 - 1)){
      study.t1 <- s.id[t.id == t1]
      study.t2 <- s.id[t.id == t2]
      study.t1.t2 <- intersect(study.t1, study.t2)
      wt[t1, t2] <- length(study.t1.t2)
    }
  }
  wt <- c(wt)
  if(weight.edge == TRUE){
    wt.unique <- unique(wt[wt > 0])
    wtmin <- min(wt.unique)
    wtmax <- max(wt.unique)
    if(wtmin < wtmax){
      wt[wt > 0] <- round(1 + adjust.thick*(wt[wt > 0] - wtmin)/(wtmax - wtmin))
    }else{
      wt[wt > 0] <- 2
    }
  }else{
    wt[wt > 0] <- 2
  }
  wt <- matrix(wt, ntrt, ntrt)

  for(t1 in 2:ntrt){
    for(t2 in 1:(t1 - 1)){
      if(t1 != t2 & wt[t1, t2] > 0){
        graphics::lines(x = x[c(t1, t2)], y = y[c(t1, t2)],
              lwd = wt[t1, t2], col = edge.col)
      }
    }
  }
  if(weight.node){
    wt <- matrix(0, ntrt, ntrt)
    for(t1 in 2:ntrt){
      for(t2 in 1:(t1 - 1)){
        study.t1 <- s.id[t.id == t1]
        study.t2 <- s.id[t.id == t2]
        study.t1.t2 <- intersect(study.t1, study.t2)
        wt[t1, t2] <- length(study.t1.t2)
      }
    }
    wt <- wt + t(wt)
    wt <- colSums(wt)
    node.sizes <- 3 + (wt - min(wt))/(max(wt) - min(wt))*adjust.node.size
    graphics::points(x, y, pch = 20, cex = node.sizes, col = node.col)
  }else{
    graphics::points(x, y, pch = 20, cex = 3, col = node.col)
  }

  sides <- numeric(ntrt)
  eps <- 10^(-4)
  for(t in 1:ntrt){
    if((polar[t] <= pi/2 & polar[t] > pi/4) |
       (polar[t] < -5*pi/4 & polar[t] >= -3*pi/2)){
      sides[t] <- 3
    }
    if(polar[t] <= pi/4 & polar[t] >= -pi/4){
      sides[t] <- 4
    }
    if(polar[t] < -pi/4 & polar[t] > -3*pi/4){
      sides[t] <- 1
    }
    if(polar[t] <= -3*pi/4 & polar[t] >= -5*pi/4){
      sides[t] <- 2
    }
  }
  for(t in 1:ntrt){
    if(weight.node){
      graphics::text(x = x[t], y = y[t], labels = trtname[trtname.order[t]],
           cex = text.cex)
    }else{
      graphics::text(x = x[t], y = y[t], labels = trtname[trtname.order[t]],
           pos = sides[t], cex = text.cex)
    }
  }
}