Assume the code below (as given in Viechtbauer, 2010):
library(metafor)
data("dat.bcg", package = "metafor")
dat <- escalc(measure = "RR", ai = tpos, bi = tneg, ci = cpos, di = cneg, data = dat.bcg, append = TRUE)
res <- rma(ai = tpos, bi = tneg, ci = cpos, di = cneg, data = dat, measure = "RR")
forest(res, slab = paste(dat$author, dat$year, sep = ", "), xlim = c(-16, 6), at = log(c(0.05, 0.25, 1, 4)), atransf = exp, ilab = cbind(dat$tpos, dat$tneg, dat$cpos, dat$cneg), ilab.xpos = c(-9.5, -8, -6, -4.5), cex = 0.75)
op <- par(cex = 0.75, font = 2)
text(c(-9.5, -8, -6, -4.5), 15, c("TB+", "TB-", "TB+", "TB-"))
text(c(-8.75, -5.25), 16, c("Vaccinated", "Control"))
text(-16, 15, "Author(s) and Year", pos = 4)
text(6, 15, "Relative Risk [95% CI]", pos = 2)
par(op)
This gives a forest graph as below:
So how can I change the format of confidence intervals in the graph? Is it possible to replace brackets with parentheses and use "to" instead of ","? How about using "-" or long hypen instead of ","? This should change i.e. [0.13, 1.26] to (0.13 to 1.26) or (0.13 – 1.26)
You need to do some hacking of the code for forest.rma. Several steps:
After displaying the current version of the code by typing the function name:
forest.rma # Copy the name and the code and paste into the console
# Add an assignment operator `<-`
# leave off the bytecode and environment notations at the bottom
Or you can do this in an editor, which would probably be the preferred method since you might then want to save this code to a .Rprofile file.
1) Add parameters to the argument list:
forest.rma <-
function (x, annotate = TRUE, addfit = TRUE, addcred = FALSE,
showweights = FALSE, xlim, alim, clim, ylim, at, steps = 5,
level = x$level, digits = 2, refline = 0, xlab, slab, mlab,
ilab, ilab.xpos, ilab.pos, order, transf, atransf, targs,
rows, efac = 1, pch = 15, psize, col, border, lty, cex, cex.lab,
cex.axis, annosep = " , ", bkt=c("[", "]"), ...)
{ # ....not showing all the _long_ function body
# Scroll down to almost the bottom of the function body
2) Find and change arguments to the annotext cbind-assignment. There are several places where annotext might get constructed, but only one of them matches your "format target". Find the one that looks like this:
# annotext <- cbind(annotext[, 1], " [ ", annotext[,
# 2], " , ", annotext[, 3], " ]")
Change to this:
annotext <- cbind(annotext[, 1], bkt[1], annotext[,
2], annosep, annotext[, 3], bkt[2] )
# hit enter to get the modification to hold in your workspace
3) Now assign the correct environment to the function so it can play well with its siblings:
environment(forest.rma) <- environment(forest.default)
# if you forget this step you see this error:
Error in forest.rma(res, slab = paste(dat$author, dat$year, sep = ", "), :
could not find function ".setlab"
And call it with the new arguments of your choosing:
png(); forest(res, slab = paste(dat$author, dat$year, sep = ", "), xlim = c(-16, 6), at = log(c(0.05, 0.25, 1, 4)), atransf = exp, ilab = cbind(dat$tpos, dat$tneg, dat$cpos, dat$cneg), ilab.xpos = c(-9.5, -8, -6, -4.5), cex = 0.75, annosep=" to ", bkt = c( "(", ")" ) )
op <- par(cex = 0.75, font = 2)
text(c(-9.5, -8, -6, -4.5), 15, c("TB+", "TB-", "TB+", "TB-"))
text(c(-8.75, -5.25), 16, c("Vaccinated", "Control"))
text(-16, 15, "Author(s) and Year", pos = 4)
text(6, 15, "Relative Risk [95% CI]", pos = 2)
dev.off()
Here is a solution that does not require changing the code of the forest.rma() function. I use annotate=FALSE so that the function does not annotate the forest plot and instead add those annotations myself.
library(metafor)
data("dat.bcg", package = "metafor")
dat <- escalc(measure = "RR", ai = tpos, bi = tneg, ci = cpos, di = cneg, data = dat.bcg, append = TRUE)
res <- rma(ai = tpos, bi = tneg, ci = cpos, di = cneg, data = dat, measure = "RR")
### note the use of annotate=FALSE in forest()
forest(res, slab = paste(dat$author, dat$year, sep = ", "), xlim = c(-16, 6),
at = log(c(0.05, 0.25, 1, 4)), atransf = exp,
ilab = cbind(dat$tpos, dat$tneg, dat$cpos, dat$cneg), ilab.xpos = c(-9.5, -8, -6, -4.5),
cex = 0.75, annotate=FALSE)
op <- par(cex = 0.75, font = 2)
text(c(-9.5, -8, -6, -4.5), 15, c("TB+", "TB-", "TB+", "TB-"))
text(c(-8.75, -5.25), 16, c("Vaccinated", "Control"))
text(-16, 15, "Author(s) and Year", pos = 4)
text(6, 15, "Relative Risk [95% CI]", pos = 2)
### add annotations manually
tmp <- summary(dat, transf=exp)[,c("yi","ci.lb","ci.ub")] ### for the individual studies
tmp <- rbind(tmp, with(predict(res, transf=exp), c(pred, ci.lb, ci.ub))) ### add model estimate and CI bounds
sav <- apply(tmp, 2, formatC, format="f", digits=2)
annotext <- apply(sav, 1, function(x) {paste0(x[1], " (", x[2], " to ", x[3], ")")})
text(6, c(res$k:1, -1), annotext, pos=2, font=1)
par(op)
Related
I am trying to create a forestplot, using forestplotter function, am able to get a beautiful graph, but am not able to see the entire graph, the column widths in few of the columns are so big, even if the string size is less, making the width of the entire graph, so big to see, can someone help me with this and also is it possible to align the datahrame contents uniformly centre aligned......Please help me with this
The code and relevant data are
###Required packages###
library(grid)
library(forestploter)
library(rmeta)
library(gridExtra)
#Data entered#
df <- data.frame(Study=c("A","B","C","D","Summary"),
nA = c(24,187,36,26,273),
median_A = c(4.9,5.69,8.866995074,8.5,NA),
Q1A =c(3,2.86,4.495073892,2,NA),
Q3A =c(8.5,9.78,14.96305419,32,NA),
nP = c(23,193,36,26,278),
median_P = c(7.2,6.79,8.990147783,12.5,NA),
Q1P =c(3.4,3.59,4.002463054,2,NA),
Q3P =c(10.9,10.12,12.06896552,43,NA),
W = c("10.6%","80.8%","8.0%","0.70%",NA),
E=c(-2.3,-1.1,-0.123152709,-4,-1.16881587),
UL=c(1.161473203,0.156288294,3.881699516,10.02689306,-0.039791047),
LL=c(-5.761473203,-2.356288294,-4.128004935,-18.02689306,-2.297840692))
#Calculate SE for box size#
df$SE <- (df$UL-df$E)/1.96
#Column for Confidence intervals for Drug A and Placebo, with 2 significant digit#
df$IQRA <- sprintf("%.2f (%.2f to %.2f)",df$median_A,df$Q1A, df$Q3A)
df$IQRP <- sprintf("%.2f (%.2f to %.2f)",df$median_P,df$Q1P, df$Q3P)
#Column for Confidence intervals for NET EFFECT, with 2 significant digit#
df$MD <- sprintf("%.2f (%.2f to %.2f)", df$E, df$LL, df$UL)
#Create a column with space for forest plot#
df$" "<- paste(rep(" ", 16), collapse = " ")
##Forest plot theme##
#To be modified as needed#
ftn <-forest_theme(
base_size = 16,
base_family = "serif",
ci_pch = 15,
ci_col = "black",
ci_lty = 1,
ci_lwd = 1,
ci_Theight = 0.25,
legend_name = " ",
legend_position = "right",legend_value = "",
xaxis_lwd = 1,
xaxis_cex = 0.7,
refline_lwd = 1,
refline_lty = "dashed",
refline_col = "red",
summary_fill = "blue",
summary_col = "blue",
footnote_cex = 0.4,
footnote_fontface = "plain",
footnote_col = "black",
title_just = c("center"),
title_cex = 1.1,
title_fontface = "bold",
title_col = "black",
show.rownames = FALSE)
##Table in Order for Forest plot##
#First get Column names#
colnames(df)
df2 <-df[,c(1,2,15,6,16,18,17)]
#Make NA cells empty
df2[5,3] <-c(" ")
df2[5,5] <-c(" ")
##Forestplot##
plot<-forest(df2,
est = df$E,
lower = df$LL,
upper = df$UL,
sizes = (df$SE/10),
ci_column = 6,
ref_line = 0,
arrow_lab = c("Drug A Better", "Placebo Better"),
xlim = c(-7, 6),
is_summary = c(FALSE,FALSE,FALSE,FALSE,TRUE),
xlog = FALSE,
ticks_digits = 0,ticks_at = c(-6,0,6),
theme = ftn)
##Show plot
print(plot, autofit = FALSE)
I have 5 variables which want to plot and export in one pdf. However, I have some trouble wiht the for-loop I am running,
parC <-list(unit = 100,labelx = "Time",labely = "Time",cols = "black",
pcex = .01, pch = 1,las = 1,
labax = seq(0,nrow(RP),100),
labay = seq(0,nrow(RP),100))
pdf("filename.pdf", onefile=TRUE)
for (i in RP_values){ # the values that are plotted
for (j in name) { # name is a list of names, so that the title changes dynamically
plotting(i, parC, j)
}
}
dev.off()
RP_values = list of values that is plotted
name = list of names to dynamically change the plotting title
plotting = an adjusted version from the plotRP() function of the crqa package. Here I added a main title to the plot.
The code for the plotting() function:
plotting <- function(RP, par, x){
if (exists("par") == FALSE){ # we use some defaults
## default values
unit = 2; labelx = "Time"; labely = "Time"
cols = "black"; pcex = .3; pch = 1; las = 0;
labax = seq(0, nrow(RP), unit); labay = seq(0, nrow(RP), unit);
} else { # we load the values that we desire
for (v in 1:length(par)) assign(names(par)[v], par[[v]])
}
xdim = nrow(RP)
ydim = ncol(RP)
RP = matrix(as.numeric(RP), nrow = xdim, ncol = ydim) # transform it for plotting
ind = which(RP == 1, arr.ind = T)
tstamp = seq(0, xdim, unit)
par(mar = c(5,5, 1, 3), font.axis = 2, cex.axis = 1,
font.lab = 2, cex.lab = 1.2)
plot(tstamp, tstamp, type = "n", xlab = "", ylab = "", xaxt = "n", yaxt = "n", main = x)
matpoints(ind[,1], ind[,2], cex = pcex, col = cols, pch = pch)
mtext(labelx, at = mean(tstamp), side = 1, line = 2.2, cex = 1.2, font = 2)
mtext(labely, at = mean(tstamp), side = 2, line = 2.2, cex = 1.2, font = 2)
# if (is.numeric(labax)){ ## it means there is some default
# mtext(labax, at = seq(1, nrow(RP), nrow(RP)/10), side = 1, line = .5, cex = 1, font = 2)
# mtext(labay, at = seq(1, nrow(RP), nrow(RP)/10), side = 2, line = .5, cex = 1, font = 2)
# } else{
mtext(labax, at = tstamp, side = 1, line = .5, cex = .8, font = 2, las = las)
mtext(labay, at = tstamp, side = 2, line = .5, cex = .8, font = 2, las = las)
# }
}
My problem is instead of 5 plots I get 25, where each plot appears 5 times, but with a different title. If I do not include the "j" part everything works fine, but of course do not have any main title for each plot.
I appreciate any help.
Best,
Johnson
From your description and comments, it appears you need an elementwise loop and not a nested loop. Consider retrieving all pairwise combinations of names and RP_values with expand.grid and iterate through them with mapply. Also, since parC depends on nrows of corresponding RP, have parC defined inside function for only two parameters (with more informative names like title instead of x):
plotting <- function(RP, title) {
parC <- list(unit=100, labelx="Time", labely="Time",
cols="black", pcex=.01, pch=1, las=1,
labax=seq(0, nrow(RP), 100),
labay=seq(0, nrow(RP), 100))
...
plot(tstamp, tstamp, type="n", xlab="", ylab="",
xaxt="n", yaxt="n", main=title)
...
}
params <- expand.grid(RP_values=RP_values, name=name)
out <- mapply(plotting, RP=params$RP_values, title=params$name)
Please consider the following sample polar plot:
library(plotrix)
testlen <- c(rnorm(36)*2 + 5)
testpos <- seq(0, 350, by = 10)
polar.plot(testlen, testpos, main = "Test Polar Plot",
lwd = 3, line.col = 4, rp.type = "s")
I would like to add lines at angles 30 and 330 as well as 150 and 210 (from the center to the outside). I experimented with the line function but could not get it to work.
The calculations for exact placement are a bit goofy but using your test data
set.seed(15)
testlen<-c(rnorm(36)*2+5)
testpos<-seq(0,350,by=10)
polar.plot(testlen,testpos,main="Test Polar Plot",
lwd=3,line.col=4,rp.type="s")
You can add lines at 20,150,210,300 with
add.line <- c(30,330, 150,210)/360*2*pi
maxlength <- max(pretty(range(testlen)))-min(testlen)
segments(0, 0, cos(add.line) * maxlength, sin(add.line) * maxlength,
col = "red")
And that makes the following plot
You can just use the rp.type = "r" argument and add = TRUE. So, something like
library(plotrix)
set.seed(1)
testlen <- c(rnorm(36)*2 + 5)
testpos <- seq(0,350, by = 10)
polar.plot(testlen, testpos, main = "Test Polar Plot",
lwd = 3, line.col = 4, rp.type = "s")
followed by
pos <- c(30, 330, 150, 210)
len <- c(10, 10, 10, 10)
polar.plot(lengths = len, polar.pos = pos,
radial.lim = c(0, 15),
lwd = 2, line.col = 2, rp.type = "r", add = TRUE)
yields your desired output.
TukeyHSD function prints a title "alpha% family-wise confidence level", which is wrapped inside title function. Therefore, using main = "" approach to remove the title gives an error message:
x <- rnorm(20,5,6)
y <- factor(c(rep("d", 5), rep("i",5), rep("t",5), rep("l",5)))
z <- aov(x ~ y)
plot(TukeyHSD(z), main = "")
Error in plot.default(c(xi[, "lwr"], xi[, "upr"]), rep.int(yvals, 2), :
formal argument "main" matched by multiple actual arguments
Joris Meys suggests placing main = "" into the plot.TukeyHSD function. However, if I try to manually edit the function, I get an error message too:
tukey.edit <- function (x, ...)
{
for (i in seq_along(x)) {
xi <- x[[i]][, -4, drop = FALSE]
yvals <- nrow(xi):1
dev.hold()
on.exit(dev.flush())
plot(c(xi[, "lwr"], xi[, "upr"]), rep.int(yvals, 2),
type = "n", axes = FALSE, xlab = "", ylab = "", main = "", # changed main = NULL to main = ""
...)
axis(1, ...)
axis(2, at = nrow(xi):1, labels = dimnames(xi)[[1L]],
srt = 0, ...)
abline(h = yvals, lty = 1, lwd = 0.5, col = "lightgray")
abline(v = 0, lty = 2, lwd = 0.5, ...)
segments(xi[, "lwr"], yvals, xi[, "upr"], yvals, ...)
segments(as.vector(xi), rep.int(yvals - 0.1, 3), as.vector(xi),
rep.int(yvals + 0.1, 3), ...)
title(xlab = paste("Differences in mean levels of",
names(x)[i])) # removed main from here
box()
}
}
tukey.edit(z)
Error in x[[i]][, -4, drop = FALSE] : incorrect number of dimensions
What did I do wrong and how to remove the title in the plot?
Eh, this is a little bit embarrassing. I did not use TukeyHSD inside the plotting function. This works:
tukey.edit(TukeyHSD(z))
I decided it was important for R users to be able to play hangman and made an R hangman game. The problem is I don't do many plots for general release and so I don't know how to provide the user with a plot that works independent of platform or gui.
Here's where you can download the complete package that contains large word bank:
library(devtools); install_github("hangman", "trinker")
The function that plots looks like this (I made the word bank go away for reproducibility):
hangman <- function() {
#x1 <- DICTIONARY[sample(1:nrow(DICTIONARY), 1), 1]
x1 <- "trapped"
x <- unlist(strsplit(x1, NULL))
len <- length(x)
x2 <- rep("_", len)
chance <- 0
win1 <- 0
win <- win1/len
wrong <- character()
right <- character()
print(x2, quote = FALSE)
hang.plot <- function(){ #plotting function
plot.new()
mtext("HANGMAN", col = "blue", cex=2)
mtext(paste(x2, collapse = " "), side = 1, cex=1.5)
mtext("wrong", side = 3, cex=1.5,
adj = 0, padj = 5, col = "red")
text(.015, .8, paste(wrong, collapse = "\n"), offset=.3,
cex=1.5, adj=c(0,1))
mtext("correct", side = 3, cex=1.5,
adj = 1, padj = 5, col = "red")
text(.96, .8, paste(right, collapse = "\n"), offset=.3,
cex=1.5, adj=c(0,1))
segments(.365, .77, .365, .83, lwd=2)
segments(.365, .83, .625, .83, lwd=2)
segments(.625, .83, .625, .25, lwd=2)
segments(.57, .25, .675, .25, lwd=2)
parts <- seq_len(length(wrong))
if (identical(wrong, character(0))) {
parts <- 0
}
if (1 %in% parts) {
mtext("O", side = 1, cex=4, adj = .365, padj = -7.2)
mtext("o o", side = 1, cex=1, adj = .3725, padj = -28.2)
mtext("<", side = 1, cex=1, adj = .373, padj = -27.6)
mtext("__", side = 1, cex=1, adj = .373, padj = -27.2)
}
if (2 %in% parts) {
mtext("I", side = 1, cex=4, adj = .375, padj = -6.25)
mtext("I", side = 1, cex=4, adj = .375, padj = -5.5)
mtext("I", side = 1, cex=4, adj = .375, padj = -4.75)
}
if (3 %in% parts) {
segments(.37, .57, .45, .63, lwd=7)
}
if (4 %in% parts) {
segments(.37, .57, .29, .63, lwd=7)
}
if (5 %in% parts) {
segments(.37, .426, .43, .3, lwd=7)
mtext("__", side = 1, cex = 1, adj = .373,
padj = -27.2, col = "white")
mtext("O", side = 1, cex = 1.25, adj = .373, padj = -21.5,
col="red")
}
if (6 %in% parts) {
segments(.37, .426, .31, .3, lwd = 7)
mtext("o o", side = 1, cex = 1, adj = .3725,
padj = -28.2, col="white")
mtext("x x", side = 1, cex=1, adj = .3725, padj = -28.2)
mtext("You Lose", side = 1, cex=8, padj = -3,
col = "darkgreen")
mtext(paste(x2, collapse = " "), side = 1, cex=1.6, col="white")
mtext(paste(x2, collapse = " "), side = 1, cex=1.5, col="white")
mtext(paste(x2, collapse = " "), side = 1, adj = .51, cex=1.6,
col="white")
mtext(paste(x, collapse = " "), side = 1, cex=1.5)
}
if (win1 == len) {
mtext("WINNER!", side = 1, cex=8, padj = -3,
col = "green")
mtext("WINNER!", side = 1, cex=8, adj = .1, padj = -3.1,
col = "darkgreen")
}
} #end of hang.plot
guess <- function(){#start of guess function
cat("\n","Choose a letter:","\n")
y <- scan(n=1,what = character(0),quiet=T)
if (y %in% c(right, wrong)) {
stop(paste0("You've already guessed ", y))
}
if (!y %in% letters) {
stop(paste0(y, " is not a letter"))
}
if (y %in% x) {
right <<- c(right, y)
win1 <<- sum(win1, sum(x %in% y))
win <<- win1/len
message(paste0("Correct!","\n"))
} else {
wrong <<- c(wrong, y)
chance <<- length(wrong)
message(paste0("The word does not contain ", y, "\n"))
}
x2[x %in% right] <<- x[x %in% right]
print(x2, quote = FALSE)
hang.plot()
}#end of guess function
hang.plot()
while(all(win1 != len & chance < 6)){
try(guess())
}
if (win == 1) {
outcome <- "\nCongratulations! You Win!\n"
} else {
outcome <- paste("\nSorry. You loose. The word is:", x1, "\n")
}
cat(outcome)
}
This looks great on RGUI (in windows) where I created it but the plot is misconfigured in RStudio. How can I make the code plot everything in a way that lines up/looks good independent of gui/platform (my friend bryangoodrich suggested grid as a possibility)?
Try to use text() instead of mtext(). All coordinate must be reconsider. Not tested.
To follow on Alan's answer, if you insist on drawing the head as the letter "O", then you'll need to calculate the height of the character, and use text instead of mtext. For example, this works in both rgui and in RStudio (on Windows) to attach the head to the first segment
plot.new()
segments(0.365, 0.77, 0.365, 0.83, lwd = 2)
text(0.365,0.77-strheight("O", cex=4)/2,"O", cex=4)
Resizing doesn't work, but you get the idea.