问题
I am trying to reproduce the following [base R] plot with ggplot2
I have managed most of this, but what is currently baffling me is the placement of the line segments that join the marginal rug plot on the right of the plot with the respective label. The labels have been draw (in the second figure below) via anotation_custom() and I have used @baptiste's trick of turning off clipping to allow drawing in the plot margin.
Despite many attempts I am unable to place segmentGrobs() at the desired locations in the device such that they join the correct rug tick and label.
A reproducible example is
y <- data.frame(matrix(runif(30*10), ncol = 10))
names(y) <- paste0("spp", 1:10)
treat <- gl(3, 10)
time <- factor(rep(1:10, 3))
require(vegan); require(grid); require(reshape2); require(ggplot2)
mod <- prc(y, treat, time)
If you don't have vegan installed, I append a dput of the fortified object at the end of the Question and a fortify() method should you wish to run the example and fortify() for handy plotting with ggplot(). I also include a somewhat lengthy function, myPlt(), that illustrates what I have working so far, which can be used on the example data set if you have the packages loaded and can create mod.
I have tried quite a few options but I seem to be flailing in the dark now on getting the line segments placed correctly.
I am not looking for a solution to the specific issue of plotting the labels/segments for the example data set, but a generic solution that I can use to place segments and labels programatically as this will form the basis of an autoplot() method for objects of class(mod). I have the labels worked out OK, just not the line segments. So to the questions:
- How are the
xmin,xmax,ymin,ymaxarguments used when I want to place a segment grob containing a line running from data coordx0,y0tox1,y1? - Perhaps asked a different way, how do you use
annotation_custom()to draw segments outside the plot region between known data coordsx0,y0tox1,y1?
I would be happy to receive Answers that simply had any old plot in the plot region but showed how to add line segments between known coordinates in the margin of the plot.
I'm not wedded to the use of annotation_custom() so if a better solution is available I'd consider that too. I do want to avoid having the labels in the plot region though; I think I can achieve that by using annotate() and extending the x-axis limits in the scale via the expand argument.
The fortify() method
fortify.prc <- function(model, data, scaling = 3, axis = 1,
...) {
s <- summary(model, scaling = scaling, axis = axis)
b <- t(coef(s))
rs <- rownames(b)
cs <- colnames(b)
res <- melt(b)
names(res) <- c("Time", "Treatment", "Response")
n <- length(s$sp)
sampLab <- paste(res$Treatment, res$Time, sep = "-")
res <- rbind(res, cbind(Time = rep(NA, n),
Treatment = rep(NA, n),
Response = s$sp))
res$Score <- factor(c(rep("Sample", prod(dim(b))),
rep("Species", n)))
res$Label <- c(sampLab, names(s$sp))
res
}
The dput()
This is the output from fortify.prc(mod):
structure(list(Time = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2,
3, 4, 5, 6, 7, 8, 9, 10, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA), Treatment = c(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3,
3, 3, 3, 3, 3, 3, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), Response = c(0.775222658013234,
-0.0374860102875694, 0.100620532505619, 0.17475403767196, -0.736181209242918,
1.18581913245908, -0.235457236665258, -0.494834646295896, -0.22096700738071,
-0.00852429328460645, 0.102286976108412, -0.116035743892094,
0.01054849999509, 0.429857364190398, -0.29619258318138, 0.394303081010858,
-0.456401545475929, 0.391960511587087, -0.218177702859661, -0.174814586471715,
0.424769871360028, -0.0771395073436865, 0.698662414019584, 0.695676522106077,
-0.31659375422071, -0.584947748238806, -0.523065304477453, -0.19259357510277,
-0.0786143714402391, -0.313283220381509), Score = structure(c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Sample",
"Species"), class = "factor"), Label = c("2-1", "2-2", "2-3",
"2-4", "2-5", "2-6", "2-7", "2-8", "2-9", "2-10", "3-1", "3-2",
"3-3", "3-4", "3-5", "3-6", "3-7", "3-8", "3-9", "3-10", "spp1",
"spp2", "spp3", "spp4", "spp5", "spp6", "spp7", "spp8", "spp9",
"spp10")), .Names = c("Time", "Treatment", "Response", "Score",
"Label"), row.names = c("1", "2", "3", "4", "5", "6", "7", "8",
"9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19",
"20", "spp1", "spp2", "spp3", "spp4", "spp5", "spp6", "spp7",
"spp8", "spp9", "spp10"), class = "data.frame")
What I've tried:
myPlt <- function(x, air = 1.1) {
## fortify PRC model
fx <- fortify(x)
## samples and species scores
sampScr <- fx[fx$Score == "Sample", ]
sppScr <- fx[fx$Score != "Sample", ]
ord <- order(sppScr$Response)
sppScr <- sppScr[ord, ]
## base plot
plt <- ggplot(data = sampScr,
aes(x = Time, y = Response,
colour = Treatment, group = Treatment),
subset = Score == "Sample")
plt <- plt + geom_line() + # add lines
geom_rug(sides = "r", data = sppScr) ## add rug
## species labels
sppLab <- sppScr[, "Label"]
## label grobs
tg <- lapply(sppLab, textGrob, just = "left")
## label grob widths
wd <- sapply(tg, function(x) convertWidth(grobWidth(x), "cm",
valueOnly = TRUE))
mwd <- max(wd) ## largest label
## add some space to the margin, move legend etc
plt <- plt +
theme(plot.margin = unit(c(0, mwd + 1, 0, 0), "cm"),
legend.position = "top",
legend.direction = "horizontal",
legend.key.width = unit(0.1, "npc"))
## annotate locations
## - Xloc = new x coord for label
## - Xloc2 = location at edge of plot region where rug ticks met plot box
Xloc <- max(fx$Time, na.rm = TRUE) +
(2 * (0.04 * diff(range(fx$Time, na.rm = TRUE))))
Xloc2 <- max(fx$Time, na.rm = TRUE) +
(0.04 * diff(range(fx$Time, na.rm = TRUE)))
## Yloc - where to position the labels in y coordinates
yran <- max(sampScr$Response, na.rm = TRUE) -
min(sampScr$Response, na.rm = TRUE)
## This is taken from vegan:::linestack
## attempting to space the labels out in the y-axis direction
ht <- 2 * (air * (sapply(sppLab,
function(x) convertHeight(stringHeight(x),
"npc", valueOnly = TRUE)) *
yran))
n <- length(sppLab)
pos <- numeric(n)
mid <- (n + 1) %/% 2
pos[mid] <- sppScr$Response[mid]
if (n > 1) {
for (i in (mid + 1):n) {
pos[i] <- max(sppScr$Response[i], pos[i - 1] + ht[i])
}
}
if (n > 2) {
for (i in (mid - 1):1) {
pos[i] <- min(sppScr$Response[i], pos[i + 1] - ht[i])
}
}
## pos now contains the y-axis locations for the labels, spread out
## Loop over label and add textGrob and segmentsGrob for each one
for (i in seq_along(wd)) {
plt <- plt + annotation_custom(tg[[i]],
xmin = Xloc,
xmax = Xloc,
ymin = pos[i],
ymax = pos[i])
seg <- segmentsGrob(Xloc2, pos[i], Xloc, pos[i])
## here is problem - what to use for ymin, ymax, xmin, xmax??
plt <- plt + annotation_custom(seg,
## xmin = Xloc2,
## xmax = Xloc,
## ymin = pos[i],
## ymax = pos[i])
xmin = Xloc2,
xmax = Xloc,
ymin = min(pos[i], sppScr$Response[i]),
ymax = max(pos[i], sppScr$Response[i]))
}
## Build the plot
p2 <- ggplot_gtable(ggplot_build(plt))
## turn off clipping
p2$layout$clip[p2$layout$name=="panel"] <- "off"
## draw plot
grid.draw(p2)
}
Figure based on what I have tried in myPlt()
This is as far as I have made it with myPlt() from above. Note the small horizontal ticks drawn through the labels - these should be the angled line segments in the first figure above.
回答1:
Maybe this can illustrate annotation_custom,
myGrob <- grobTree(rectGrob(gp=gpar(fill="red", alpha=0.5)),
segmentsGrob(x0=0, x1=1, y0=0, y1=1, default.units="npc"))
myGrob2 <- grobTree(rectGrob(gp=gpar(fill="blue", alpha=0.5)),
segmentsGrob(x0=0, x1=1, y0=0, y1=1, default.units="npc"))
p <- qplot(1:10, 1:10) + theme(plot.margin=unit(c(0, 3, 0, 0), "cm")) +
annotation_custom(myGrob, xmin=5, xmax=6, ymin=3.5, ymax=5.5) +
annotate("segment", x=5, xend=6, y=3, yend=5, colour="red") +
annotation_custom(myGrob2, xmin=8, xmax=12, ymin=3.5, ymax=5.5)
p
g <- ggplotGrob(p)
g$layout$clip[g$layout$name=="panel"] <- "off"
grid.draw(g)
There's a weird bug apparently, whereby if I reuse myGrob instead of myGrob2, it ignores the placement coordinates the second time and stacks it up with the first layer. This function is really buggy.
回答2:
Here's how I would approach this,
library(gtable)
library(ggplot2)
library(plyr)
set.seed(1)
d <- data.frame(x=rep(1:10, 5),
y=rnorm(50),
g = gl(5,10))
# example plot
p <- ggplot(d, aes(x,y,colour=g)) +
geom_line() +
scale_x_continuous(expand=c(0,0))+
theme(legend.position="top",
plot.margin=unit(c(1,0,0,0),"line"))
# dummy data for the legend plot
# built with the same y axis (same limits, same expand factor)
d2 <- ddply(d, "g", summarise, x=0, y=y[length(y)])
d2$lab <- paste0("line #", seq_len(nrow(d2)))
plegend <- ggplot(d, aes(x,y, colour=g)) +
geom_blank() +
geom_segment(data=d2, aes(x=2, xend=0, y=y, yend=y),
arrow=arrow(length=unit(2,"mm"), type="closed")) +
geom_text(data=d2, aes(x=2.5,label=lab), hjust=0) +
scale_x_continuous(expand=c(0,0)) +
guides(colour="none")+
theme_minimal() + theme(line=element_blank(),
text=element_blank(),
panel.background=element_rect(fill="grey95", linetype=2))
# extract the panel only, we don't need the rest
gl <- gtable_filter(ggplotGrob(plegend), "panel")
# add a cell next to the main plot panel, and insert gl there
g <- ggplotGrob(p)
index <- subset(g$layout, name == "panel")
g <- gtable_add_cols(g, unit(1, "strwidth", "line # 1") + unit(1, "cm"))
g <- gtable_add_grob(g, gl, t = index$t, l=ncol(g),
b=index$b, r=ncol(g))
grid.newpage()
grid.draw(g)
It should be straight-forward to adapt the "legend" plot with specific tags and locations (left as an exercise for the interested reader).
来源：https://stackoverflow.com/questions/17492230/how-to-place-grobs-with-annotation-custom-at-precise-areas-of-the-plot-region