Nothing
#' 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)
}
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.