Я пытаюсь воспроизвести следующий график [базовый R] с помощью ggplot2
Я справился с большей частью этого, но что в настоящее время меня сбивает с толку, так это размещение отрезков линии, которые присоединяются к краевому участку коврика справа от участка с соответствующей меткой. Ярлыки были нарисованы (на втором рисунке ниже) через anotation_custom()
, и я использовал трюк @baptiste по отключению отсечения, чтобы можно было рисовать в поле графика.
Несмотря на множество попыток, я не могу разместить segmentGrobs()
в желаемых местах устройства так, чтобы они соединяли правильную метку и метку коврика.
Воспроизводимый пример:
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)
Если у вас не установлен веганский, я добавляю dput
укрепленного объекта в конце вопроса и fortify()
метод, если вы хотите запустить пример, и fortify()
для удобного построения графиков с ggplot()
. Я также включаю довольно длинную функцию myPlt()
, которая иллюстрирует то, что я работал до сих пор, и которую можно использовать в примере набора данных, если у вас есть загруженные пакеты и вы можете создать mod
.
Я пробовал довольно много вариантов, но сейчас я, кажется, теряюсь в темноте, правильно размещая отрезки линии.
Я ищу не решение конкретной проблемы построения меток / сегментов для примера набора данных, а общее решение, которое я могу использовать для программного размещения сегментов и меток, поскольку это сформирует основу метода autoplot()
для объектов class(mod)
. У меня есть надписи, только не отрезки линий. Итак, к вопросам:
- Как используются аргументы
xmin
,xmax
,ymin
,ymax
, когда я хочу разместить сегмент grob, содержащий строку, идущую от координат данныхx0
,y0
доx1
,y1
? - Можно задать другой вопрос: как использовать
annotation_custom()
для рисования сегментов вне области графика между известными координатами данных отx0
,y0
доx1
,y1
?
Я был бы рад получить ответы, в которых просто был какой-либо старый график в области графика, но показано, как добавить отрезки линии между известными координатами на поле графика.
Я не склонен к использованию annotation_custom()
, поэтому, если доступно лучшее решение, я бы тоже подумал об этом. Я действительно хочу избегать наличия меток в области графика; Я думаю, что смогу добиться этого, используя annotate()
и расширив пределы оси X в шкале с помощью аргумента expand
.
Метод fortify()
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
}
dput()
Это результат 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")
Что я пробовал:
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)
}
Рисунок основан на том, что я пробовал в myPlt()
Это насколько я сделал это с myPlt()
сверху. Обратите внимание на маленькие горизонтальные отметки, проведенные через метки - это должны быть угловые отрезки линии на первом рисунке выше.
annotation_custom
и отключение обрезки - хороший способ. Рассматривали ли вы вместо этого такого рода примеры? - person baptiste   schedule 05.07.2013annotation_custom()
. Предположим, я хочу разместить линейный сегмент в области графика, соединяющий две известные координаты. Я знаю, как это сделать сannotate
, но не сannotation_custom()
. Я не понимаю разницы. - person Gavin Simpson   schedule 05.07.2013