Hi All, I have been able to modify the x-axis to start at zero by adding xlow and xhigh parameters; that was pretty simple. I have been unable to find the location of the code that would turn off the information weighting of the box size (I have smaller randomized trials getting less weight than a much larger non-randomized trial). The function is forestplot() from rmeta.
Thanks for any help. Gerard Slightly modified working function with data and a call follows: 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, ...) { 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 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() } tabletext<-cbind(c("","Randomized Trials"," Study 1", " Study 2", " Combined", "", "Study 3 ", " Comorbid"," Non-Comorbid",""), c("","","","","","","","","","")) m <- c(NA, NA, 2.32 , 2.55 , 2.41 , NA, NA, 2.04 , 1.62 , NA) l <- c(NA, NA, 1.1746, 1.1495, 1.4377, NA, NA, 1.609, 1.339, NA) u <- c(NA, NA, 4.5919, 5.6364, 4.0490, NA, NA, 2.592, 1.952, NA) fplot(tabletext, m, l ,u, zero=1, is.summary=c(rep(FALSE,3)), clip=c(0,8), xlog=FALSE, xlow=0, xhigh=6, xlab="Odds Ratio",digitsize=0.9,graphwidth = unit(4,"inches"), col=meta.colors(box="black",line="black", summary="black")) [[alternative HTML version deleted]] ______________________________________________ R-help@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.