Hi All,
I have pulled the following function (fplot) from the internet, and
unfortunately I do not see an author to whom I can give credit. It used grid
graphics and relies mostly on package rmeta by Thomas Lumley. I am trying to
make the font smaller in my labeltext, but don’t see any references to font size
in the code. Digitize changes the number size on the x-axis, but don’t see a
corresponding way of making the labeling size smaller.
Using R 3.0.2
Any suggestions appreciated.
Gerard Smits
fplot=function (labeltext, mean, lower, upper, align = NULL, is.summary = FALSE,
clip = c(-Inf, Inf), xlab = "", zero = 1, graphwidth =
unit(3,"inches"),
col = meta.colors(), xlog = FALSE, xticks = NULL,
xlow=0, xhigh, digitsize, boxsize,
...)
{
require("grid") || stop("`grid' package not found")
require("rmeta") || stop("`rmeta' package not
found")
drawNormalCI <- function(LL, OR, UL, size)
{
size = 0.75 * size
clipupper <- convertX(unit(UL, "native"), "npc",
valueOnly = TRUE) > 1
cliplower <- convertX(unit(LL, "native"), "npc",
valueOnly = TRUE) < 0
box <- convertX(unit(OR, "native"), "npc",
valueOnly = TRUE)
clipbox <- box < 0 || box > 1
if (clipupper || cliplower)
{
ends <- "both"
lims <- unit(c(0, 1), c("npc", "npc"))
if (!clipupper) {
ends <- "first"
lims <- unit(c(0, UL), c("npc",
"native"))
}
if (!cliplower) {
ends <- "last"
lims <- unit(c(LL, 1), c("native",
"npc"))
}
grid.lines(x = lims, y = 0.5, arrow = arrow(ends = ends,
length = unit(0.05, "inches")), gp = gpar(col =
col$lines))
if (!clipbox)
grid.rect(x = unit(OR, "native"), width = unit(size,
"snpc"), height = unit(size, "snpc"), gp =
gpar(fill = col$box,
col = col$box))
}
else {
grid.lines(x = unit(c(LL, UL), "native"), y = 0.5,
gp = gpar(col = col$lines))
grid.rect(x = unit(OR, "native"), width = unit(size,
"snpc"), height = unit(size, "snpc"), gp =
gpar(fill = col$box,
col = col$box))
if ((convertX(unit(OR, "native") + unit(0.5 * size,
"lines"), "native", valueOnly = TRUE) >
UL) &&
(convertX(unit(OR, "native") - unit(0.5 * size,
"lines"), "native", valueOnly = TRUE) <
LL))
grid.lines(x = unit(c(LL, UL), "native"), y = 0.5,
gp = gpar(col = col$lines))
}
}
drawSummaryCI <- function(LL, OR, UL, size) {
grid.polygon(x = unit(c(LL, OR, UL, OR), "native"), y =
unit(0.5 +
c(0, 0.5 * size, 0, -0.5 * size), "npc"), gp = gpar(fill =
col$summary,
col = col$summary))
}
plot.new()
widthcolumn <- !apply(is.na(labeltext), 1, any)
nc <- NCOL(labeltext)
labels <- vector("list", nc)
if (is.null(align))
align <- c("l", rep("r", nc - 1))
else align <- rep(align, length = nc)
nr <- NROW(labeltext)
is.summary <- rep(is.summary, length = nr)
for (j in 1:nc) {
labels[[j]] <- vector("list", nr)
for (i in 1:nr) {
if (is.na(labeltext[i, j]))
next
x <- switch(align[j], l = 0, r = 1, c = 0.5)
just <- switch(align[j], l = "left", r =
"right", c = "center")
labels[[j]][[i]] <- textGrob(labeltext[i, j], x = x,
just = just, gp = gpar(fontface = if (is.summary[i])
"bold"
else "plain", col = rep(col$text, length = nr)[i]))
}
}
colgap <- unit(3, "mm")
colwidths <- unit.c(max(unit(rep(1, sum(widthcolumn)),
"grobwidth",
labels[[1]][widthcolumn])), colgap)
if (nc > 1) {
for (i in 2:nc) colwidths <- unit.c(colwidths, max(unit(rep(1,
sum(widthcolumn)), "grobwidth",
labels[[i]][widthcolumn])),
colgap)
}
colwidths <- unit.c(colwidths, graphwidth)
pushViewport(viewport(layout = grid.layout(nr + 1, nc * 2 +
1, widths = colwidths, heights = unit(c(rep(1, nr), 0.5),
"lines"))))
cwidth <- (upper - lower)
#xrange <- c(max(min(lower, na.rm = TRUE), clip[1]), min(max(upper, na.rm
= TRUE), clip[2]))
xrange <- c(xlow,xhigh)
info <- 1/cwidth
info <- info/max(info[!is.summary], na.rm = TRUE)
info[is.summary] <- 1
if (!is.null(boxsize))
info <- rep(boxsize, length = length(info))
for (j in 1:nc) {
for (i in 1:nr) {
if (!is.null(labels[[j]][[i]])) {
pushViewport(viewport(layout.pos.row = i, layout.pos.col = 2 *
j - 1))
grid.draw(labels[[j]][[i]])
popViewport()
}
}
}
pushViewport(viewport(layout.pos.col = 2 * nc + 1, xscale = xrange))
grid.lines(x = unit(zero, "native"), y = 0:1, gp = gpar(col =
col$zero))
if (xlog) {
if (is.null(xticks)) {
ticks <- pretty(exp(xrange))
ticks <- ticks[ticks > 0]
}
else {
ticks <- xticks
}
if (length(ticks)) {
if (min(lower, na.rm = TRUE) < clip[1])
ticks <- c(exp(clip[1]), ticks)
if (max(upper, na.rm = TRUE) > clip[2])
ticks <- c(ticks, exp(clip[2]))
xax <- xaxisGrob(gp = gpar(cex = digitsize, col = col$axes),
at = log(ticks), name = "xax")
xax1 <- editGrob(xax, gPath("labels"), label =
format(ticks, digits = 2))
grid.draw(xax1)
}
}
else {
if (is.null(xticks)) {
grid.xaxis(gp = gpar(cex = digitsize, col = col$axes))
}
else if (length(xticks)) {
grid.xaxis(at = xticks, gp = gpar(cex = 0.6, col = col$axes))
}
}
grid.text(xlab, y = unit(-2, "lines"), gp = gpar(col = col$axes))
popViewport()
for (i in 1:nr) {
if (is.na(mean[i]))
next
pushViewport(viewport(layout.pos.row = i, layout.pos.col = 2 *
nc + 1, xscale = xrange))
if (is.summary[i])
drawSummaryCI(lower[i], mean[i], upper[i], info[i])
else drawNormalCI(lower[i], mean[i], upper[i], info[i])
popViewport()
}
popViewport()
}
# my code starts here:
labletext<-cbind(c("",
"All Available Eyes (n=194)",
"",
"Month 12 Visit Timing (p=0.8312*)",
" Before Window (n=12)",
" In Window (n=146)",
" After Window (n=36)",
"",
"Major Protocol Deviation (p=0.5189*)",
" None (n=149)",
" Present (n=45)",
"",
"Protocol Approved Device (p=0.5131*)",
" Yes (n=62)",
" No (n=132)",
"",
"ITT Imputations",
" Multiple Imputation (n=210)",
" LOCF (n=210)",
" Worst Case (n=210)"
),
c("",
" 0.0309 [-0.0488 0.1106]",
"","",
"","","","","",
"","","","","",
"","","","","",
"",""))
m <- c(NA, 0.0309, NA, NA, 0.1591, 0.0286, 0.0153, NA, NA, 0.0529,
-0.0441, NA, NA, 0.0364, 0.0455, NA, NA, 0.0123, -0.0667, -0.1429)
l <- c(NA, -0.0488, NA, NA, -0.0524, -0.0548, -0.1372, NA, NA, -0.0251,
-0.2106, NA, NA, -0.0529, -0.0605, NA, NA, -0.0670, -0.2333, -0.2576)
u <- c(NA, 0.1106, NA, NA, 0.3706, 0.1120, 0.1678, NA, NA, 0.1309,
0.1224, NA, NA, 0.1257, 0.1515, NA, NA, 0.0916, 0.1000, -0.0282)
fplot(labletext, m, l ,u, zero=0, is.summary=c(rep(FALSE,3)), clip=c(0,8),
xlog=FALSE,
xlow=-0.5, xhigh=+0.5, xlab=“\nVariable Tested", digitsize=0.9,
graphwidth = unit(3,"inches"),
boxsize=.6,
col=meta.colors(box="blue",line="blue",
summary="red"))
grid.text("Forest Plot of xxx\nwith Point Estimate and 95% CI", x =
.5, y = .9, gp=gpar(fontsize=15))
grid.text("* Test of heterogeneity of subgroups using General Estimating
Equation model.", x = .38, y = .07, gp=gpar(fontsize=10))
[[alternative HTML version deleted]]
On Jan 19, 2014, at 1:13 PM, Gerard Smits wrote:> Hi All, > > I have pulled the following function (fplot) from the internet, and unfortunately I do not see an author to whom I can give credit. It used grid graphics and relies mostly on package rmeta by Thomas Lumley. I am trying to make the font smaller in my labeltext, but don?t see any references to font size in the code. Digitize changes the number size on the x-axis, but don?t see a corresponding way of making the labeling size smaller. >Wouldn't it just be needed to specify grid parameters (as exemplified several other places in that code) in the code where 'labels' are created? ... labels[[j]][[i]] <- textGrob(labeltext[i, j], x = x, just = just, gp = gpar(fontsize=8, fontface = if (is.summary[i]) "bold" else "plain", col = rep(col$text, length = nr)[i])) ... Seems to succeed (once the errant and quite strange double comma character '?' is removed and replaced with a proper double quote.) If you are doing this on a word processor, then you should convert to a programming text editor. -- David.> Using R 3.0.2 > > Any suggestions appreciated. > > Gerard Smits > > fplot=function (labeltext, mean, lower, upper, align = NULL, is.summary = FALSE, > clip = c(-Inf, Inf), xlab = "", zero = 1, graphwidth = unit(3,"inches"), > col = meta.colors(), xlog = FALSE, xticks = NULL, > xlow=0, xhigh, digitsize, boxsize, > ...) > > { > require("grid") || stop("`grid' package not found") > require("rmeta") || stop("`rmeta' package not found") > > > drawNormalCI <- function(LL, OR, UL, size) > { > > size = 0.75 * size > clipupper <- convertX(unit(UL, "native"), "npc", valueOnly = TRUE) > 1 > cliplower <- convertX(unit(LL, "native"), "npc", valueOnly = TRUE) < 0 > box <- convertX(unit(OR, "native"), "npc", valueOnly = TRUE) > clipbox <- box < 0 || box > 1 > > if (clipupper || cliplower) > { > ends <- "both" > lims <- unit(c(0, 1), c("npc", "npc")) > if (!clipupper) { > ends <- "first" > lims <- unit(c(0, UL), c("npc", "native")) > } > if (!cliplower) { > ends <- "last" > lims <- unit(c(LL, 1), c("native", "npc")) > } > grid.lines(x = lims, y = 0.5, arrow = arrow(ends = ends, > length = unit(0.05, "inches")), gp = gpar(col = col$lines)) > > if (!clipbox) > grid.rect(x = unit(OR, "native"), width = unit(size, > "snpc"), height = unit(size, "snpc"), gp = gpar(fill = col$box, > col = col$box)) > } > else { > grid.lines(x = unit(c(LL, UL), "native"), y = 0.5, > gp = gpar(col = col$lines)) > grid.rect(x = unit(OR, "native"), width = unit(size, > "snpc"), height = unit(size, "snpc"), gp = gpar(fill = col$box, > col = col$box)) > if ((convertX(unit(OR, "native") + unit(0.5 * size, > "lines"), "native", valueOnly = TRUE) > UL) && > (convertX(unit(OR, "native") - unit(0.5 * size, > "lines"), "native", valueOnly = TRUE) < LL)) > grid.lines(x = unit(c(LL, UL), "native"), y = 0.5, > gp = gpar(col = col$lines)) > } > > } > > drawSummaryCI <- function(LL, OR, UL, size) { > grid.polygon(x = unit(c(LL, OR, UL, OR), "native"), y = unit(0.5 + > c(0, 0.5 * size, 0, -0.5 * size), "npc"), gp = gpar(fill = col$summary, > col = col$summary)) > } > > plot.new() > widthcolumn <- !apply(is.na(labeltext), 1, any) > nc <- NCOL(labeltext) > labels <- vector("list", nc) > if (is.null(align)) > align <- c("l", rep("r", nc - 1)) > else align <- rep(align, length = nc) > nr <- NROW(labeltext) > is.summary <- rep(is.summary, length = nr) > for (j in 1:nc) { > labels[[j]] <- vector("list", nr) > for (i in 1:nr) { > if (is.na(labeltext[i, j])) > next > x <- switch(align[j], l = 0, r = 1, c = 0.5) > just <- switch(align[j], l = "left", r = "right", c = "center") > labels[[j]][[i]] <- textGrob(labeltext[i, j], x = x, > just = just, gp = gpar(fontface = if (is.summary[i]) "bold" > else "plain", col = rep(col$text, length = nr)[i])) > } > } > colgap <- unit(3, "mm") > colwidths <- unit.c(max(unit(rep(1, sum(widthcolumn)), "grobwidth", > labels[[1]][widthcolumn])), colgap) > if (nc > 1) { > for (i in 2:nc) colwidths <- unit.c(colwidths, max(unit(rep(1, > sum(widthcolumn)), "grobwidth", labels[[i]][widthcolumn])), > colgap) > } > colwidths <- unit.c(colwidths, graphwidth) > pushViewport(viewport(layout = grid.layout(nr + 1, nc * 2 + > 1, widths = colwidths, heights = unit(c(rep(1, nr), 0.5), > "lines")))) > cwidth <- (upper - lower) > > #xrange <- c(max(min(lower, na.rm = TRUE), clip[1]), min(max(upper, na.rm = TRUE), clip[2])) > xrange <- c(xlow,xhigh) > > info <- 1/cwidth > info <- info/max(info[!is.summary], na.rm = TRUE) > info[is.summary] <- 1 > > if (!is.null(boxsize)) > info <- rep(boxsize, length = length(info)) > > for (j in 1:nc) { > for (i in 1:nr) { > if (!is.null(labels[[j]][[i]])) { > pushViewport(viewport(layout.pos.row = i, layout.pos.col = 2 * > j - 1)) > grid.draw(labels[[j]][[i]]) > popViewport() > } > } > } > > pushViewport(viewport(layout.pos.col = 2 * nc + 1, xscale = xrange)) > grid.lines(x = unit(zero, "native"), y = 0:1, gp = gpar(col = col$zero)) > if (xlog) { > if (is.null(xticks)) { > ticks <- pretty(exp(xrange)) > ticks <- ticks[ticks > 0] > } > else { > ticks <- xticks > } > if (length(ticks)) { > if (min(lower, na.rm = TRUE) < clip[1]) > ticks <- c(exp(clip[1]), ticks) > if (max(upper, na.rm = TRUE) > clip[2]) > ticks <- c(ticks, exp(clip[2])) > xax <- xaxisGrob(gp = gpar(cex = digitsize, col = col$axes), > at = log(ticks), name = "xax") > xax1 <- editGrob(xax, gPath("labels"), label = format(ticks, digits = 2)) > grid.draw(xax1) > } > } > else { > if (is.null(xticks)) { > grid.xaxis(gp = gpar(cex = digitsize, col = col$axes)) > } > else if (length(xticks)) { > grid.xaxis(at = xticks, gp = gpar(cex = 0.6, col = col$axes)) > } > } > > grid.text(xlab, y = unit(-2, "lines"), gp = gpar(col = col$axes)) > popViewport() > for (i in 1:nr) { > if (is.na(mean[i])) > next > pushViewport(viewport(layout.pos.row = i, layout.pos.col = 2 * > nc + 1, xscale = xrange)) > if (is.summary[i]) > drawSummaryCI(lower[i], mean[i], upper[i], info[i]) > else drawNormalCI(lower[i], mean[i], upper[i], info[i]) > popViewport() > } > popViewport() > } > > > > # my code starts here: > > > labletext<-cbind(c("", > "All Available Eyes (n=194)", > "", > "Month 12 Visit Timing (p=0.8312*)", > " Before Window (n=12)", > " In Window (n=146)", > " After Window (n=36)", > "", > "Major Protocol Deviation (p=0.5189*)", > " None (n=149)", > " Present (n=45)", > "", > "Protocol Approved Device (p=0.5131*)", > " Yes (n=62)", > " No (n=132)", > "", > "ITT Imputations", > " Multiple Imputation (n=210)", > " LOCF (n=210)", > " Worst Case (n=210)" > ), > > c("", > " 0.0309 [-0.0488 0.1106]", > "","", > "","","","","", > "","","","","", > "","","","","", > "","")) > > > m <- c(NA, 0.0309, NA, NA, 0.1591, 0.0286, 0.0153, NA, NA, 0.0529, -0.0441, NA, NA, 0.0364, 0.0455, NA, NA, 0.0123, -0.0667, -0.1429) > l <- c(NA, -0.0488, NA, NA, -0.0524, -0.0548, -0.1372, NA, NA, -0.0251, -0.2106, NA, NA, -0.0529, -0.0605, NA, NA, -0.0670, -0.2333, -0.2576) > u <- c(NA, 0.1106, NA, NA, 0.3706, 0.1120, 0.1678, NA, NA, 0.1309, 0.1224, NA, NA, 0.1257, 0.1515, NA, NA, 0.0916, 0.1000, -0.0282) > > > fplot(labletext, m, l ,u, zero=0, is.summary=c(rep(FALSE,3)), clip=c(0,8), xlog=FALSE, > xlow=-0.5, xhigh=+0.5, xlab=?\nVariable Tested", digitsize=0.9, graphwidth = unit(3,"inches"), > boxsize=.6, > col=meta.colors(box="blue",line="blue", summary="red")) > > grid.text("Forest Plot of xxx\nwith Point Estimate and 95% CI", x = .5, y = .9, gp=gpar(fontsize=15)) > grid.text("* Test of heterogeneity of subgroups using General Estimating Equation model.", x = .38, y = .07, gp=gpar(fontsize=10)) > > > [[alternative HTML version deleted]] > > ______________________________________________ > R-help at r-project.org mailing list > https://stat.ethz.ch/mailman/listinfo/r-help > PLEASE do read the posting guide http://www.R-project.org/posting-guide.html > and provide commented, minimal, self-contained, reproducible code.David Winsemius Alameda, CA, USA
At 21:13 19/01/2014, Gerard Smits wrote:>Hi All, > >I have pulled the following function (fplot) from the internet, and >unfortunately I do not see an author to whom I can give credit. It >used grid graphics and relies mostly on package rmeta by Thomas Lumley.Dear Gerard Unless you are particularly wedded to using rmeta and/or grid graphics you could always try one of the other packages from CRAN which provide customisable forest plots like metafor or meta. Incidentally I am not sure whether the upper case F in your subject line is deliberate but the story that the plots are named after an Oxford cancer researcher named Forest is believed to be apocryphal and it is their supposed resemblance to a collection of trees which is the source. And, no, they do not remind me of trees either ...> I am trying to make the font smaller in my labeltext, but don't > see any references to font size in the code. Digitize changes the > number size on the x-axis, but don't see a corresponding way of > making the labeling size smaller. > >Using R 3.0.2 > >Any suggestions appreciated. > >Gerard Smits > >fplot=function (labeltext, mean, lower, upper, align = NULL, >is.summary = FALSE, > clip = c(-Inf, Inf), xlab = "", zero = 1, graphwidth = unit(3,"inches"), > col = meta.colors(), xlog = FALSE, xticks = NULL, > xlow=0, xhigh, digitsize, boxsize, > ...) > >{ > require("grid") || stop("`grid' package not found") > require("rmeta") || stop("`rmeta' package not found") > > > drawNormalCI <- function(LL, OR, UL, size) > { > > size = 0.75 * size > clipupper <- convertX(unit(UL, "native"), "npc", valueOnly > = TRUE) > 1 > cliplower <- convertX(unit(LL, "native"), "npc", valueOnly > = TRUE) < 0 > box <- convertX(unit(OR, "native"), "npc", valueOnly = TRUE) > clipbox <- box < 0 || box > 1 > > if (clipupper || cliplower) > { > ends <- "both" > lims <- unit(c(0, 1), c("npc", "npc")) > if (!clipupper) { > ends <- "first" > lims <- unit(c(0, UL), c("npc", "native")) > } > if (!cliplower) { > ends <- "last" > lims <- unit(c(LL, 1), c("native", "npc")) > } > grid.lines(x = lims, y = 0.5, arrow = arrow(ends = ends, > length = unit(0.05, "inches")), gp = gpar(col = col$lines)) > > if (!clipbox) > grid.rect(x = unit(OR, "native"), width = unit(size, > "snpc"), height = unit(size, "snpc"), gp = > gpar(fill = col$box, > col = col$box)) > } > else { > grid.lines(x = unit(c(LL, UL), "native"), y = 0.5, > gp = gpar(col = col$lines)) > grid.rect(x = unit(OR, "native"), width = unit(size, > "snpc"), height = unit(size, "snpc"), gp = > gpar(fill = col$box, > col = col$box)) > if ((convertX(unit(OR, "native") + unit(0.5 * size, > "lines"), "native", valueOnly = TRUE) > UL) && > (convertX(unit(OR, "native") - unit(0.5 * size, > "lines"), "native", valueOnly = TRUE) < LL)) > grid.lines(x = unit(c(LL, UL), "native"), y = 0.5, > gp = gpar(col = col$lines)) > } > > } > > drawSummaryCI <- function(LL, OR, UL, size) { > grid.polygon(x = unit(c(LL, OR, UL, OR), "native"), y = unit(0.5 + > c(0, 0.5 * size, 0, -0.5 * size), "npc"), gp = > gpar(fill = col$summary, > col = col$summary)) > } > > plot.new() > widthcolumn <- !apply(is.na(labeltext), 1, any) > nc <- NCOL(labeltext) > labels <- vector("list", nc) > if (is.null(align)) > align <- c("l", rep("r", nc - 1)) > else align <- rep(align, length = nc) > nr <- NROW(labeltext) > is.summary <- rep(is.summary, length = nr) > for (j in 1:nc) { > labels[[j]] <- vector("list", nr) > for (i in 1:nr) { > if (is.na(labeltext[i, j])) > next > x <- switch(align[j], l = 0, r = 1, c = 0.5) > just <- switch(align[j], l = "left", r = "right", c = "center") > labels[[j]][[i]] <- textGrob(labeltext[i, j], x = x, > just = just, gp = gpar(fontface = if (is.summary[i]) "bold" > else "plain", col = rep(col$text, length = nr)[i])) > } > } > colgap <- unit(3, "mm") > colwidths <- unit.c(max(unit(rep(1, sum(widthcolumn)), "grobwidth", > labels[[1]][widthcolumn])), colgap) > if (nc > 1) { > for (i in 2:nc) colwidths <- unit.c(colwidths, max(unit(rep(1, > sum(widthcolumn)), "grobwidth", labels[[i]][widthcolumn])), > colgap) > } > colwidths <- unit.c(colwidths, graphwidth) > pushViewport(viewport(layout = grid.layout(nr + 1, nc * 2 + > 1, widths = colwidths, heights = unit(c(rep(1, nr), 0.5), > "lines")))) > cwidth <- (upper - lower) > > #xrange <- c(max(min(lower, na.rm = TRUE), clip[1]), > min(max(upper, na.rm = TRUE), clip[2])) > xrange <- c(xlow,xhigh) > > info <- 1/cwidth > info <- info/max(info[!is.summary], na.rm = TRUE) > info[is.summary] <- 1 > > if (!is.null(boxsize)) > info <- rep(boxsize, length = length(info)) > > for (j in 1:nc) { > for (i in 1:nr) { > if (!is.null(labels[[j]][[i]])) { > pushViewport(viewport(layout.pos.row = i, > layout.pos.col = 2 * > j - 1)) > grid.draw(labels[[j]][[i]]) > popViewport() > } > } > } > > pushViewport(viewport(layout.pos.col = 2 * nc + 1, xscale = xrange)) > grid.lines(x = unit(zero, "native"), y = 0:1, gp = gpar(col = col$zero)) > if (xlog) { > if (is.null(xticks)) { > ticks <- pretty(exp(xrange)) > ticks <- ticks[ticks > 0] > } > else { > ticks <- xticks > } > if (length(ticks)) { > if (min(lower, na.rm = TRUE) < clip[1]) > ticks <- c(exp(clip[1]), ticks) > if (max(upper, na.rm = TRUE) > clip[2]) > ticks <- c(ticks, exp(clip[2])) > xax <- xaxisGrob(gp = gpar(cex = digitsize, col = col$axes), > at = log(ticks), name = "xax") > xax1 <- editGrob(xax, gPath("labels"), label = > format(ticks, digits = 2)) > grid.draw(xax1) > } > } > else { > if (is.null(xticks)) { > grid.xaxis(gp = gpar(cex = digitsize, col = col$axes)) > } > else if (length(xticks)) { > grid.xaxis(at = xticks, gp = gpar(cex = 0.6, col = col$axes)) > } > } > > grid.text(xlab, y = unit(-2, "lines"), gp = gpar(col = col$axes)) > popViewport() > for (i in 1:nr) { > if (is.na(mean[i])) > next > pushViewport(viewport(layout.pos.row = i, layout.pos.col = 2 * > nc + 1, xscale = xrange)) > if (is.summary[i]) > drawSummaryCI(lower[i], mean[i], upper[i], info[i]) > else drawNormalCI(lower[i], mean[i], upper[i], info[i]) > popViewport() > } > popViewport() >} > > > ># my code starts here: > > >labletext<-cbind(c("", > "All Available Eyes (n=194)", > "", > "Month 12 Visit Timing (p=0.8312*)", > " Before Window (n=12)", > " In Window (n=146)", > " After Window (n=36)", > "", > "Major Protocol Deviation (p=0.5189*)", > " None (n=149)", > " Present (n=45)", > "", > "Protocol Approved Device (p=0.5131*)", > " Yes (n=62)", > " No (n=132)", > "", > "ITT Imputations", > " Multiple Imputation (n=210)", > " LOCF (n=210)", > " Worst Case (n=210)" > ), > > c("", > " 0.0309 [-0.0488 0.1106]", > "","", > "","","","","", > "","","","","", > "","","","","", > "","")) > > >m <- c(NA, 0.0309, NA, NA, 0.1591, 0.0286, 0.0153, NA, >NA, 0.0529, -0.0441, NA, NA, 0.0364, 0.0455, NA, >NA, 0.0123, -0.0667, -0.1429) >l <- c(NA, -0.0488, NA, NA, -0.0524, -0.0548, -0.1372, NA, NA, >-0.0251, -0.2106, NA, NA, -0.0529, -0.0605, NA, NA, >-0.0670, -0.2333, -0.2576) >u <- c(NA, 0.1106, NA, NA, 0.3706, 0.1120, 0.1678, NA, >NA, 0.1309, 0.1224, NA, NA, 0.1257, 0.1515, NA, >NA, 0.0916, 0.1000, -0.0282) > > >fplot(labletext, m, l ,u, zero=0, is.summary=c(rep(FALSE,3)), >clip=c(0,8), xlog=FALSE, > xlow=-0.5, xhigh=+0.5, xlab="\nVariable Tested", > digitsize=0.9, graphwidth = unit(3,"inches"), > boxsize=.6, > col=meta.colors(box="blue",line="blue", summary="red")) > >grid.text("Forest Plot of xxx\nwith Point Estimate and 95% CI", x = >.5, y = .9, gp=gpar(fontsize=15)) >grid.text("* Test of heterogeneity of subgroups using General >Estimating Equation model.", x = .38, y = .07, gp=gpar(fontsize=10)) > > > [[alternative HTML version deleted]]Michael Dewey info at aghmed.fsnet.co.uk http://www.aghmed.fsnet.co.uk/home.html