Ответ 1
Были проблемы с вашими командами gtable_add_cols() и gtable_add_grob(). Я добавил комментарии ниже.
Обновлено до ggplot2 v2.2.0
library(ggplot2)
library(gtable)
library(grid)
library(data.table)
library(scales)
diamonds$cut <- sample(letters[1:4], nrow(diamonds), replace = TRUE)
dt.diamonds <- as.data.table(diamonds)
d1 <- dt.diamonds[,list(revenue = sum(price),
stones = length(price)),
by=c("clarity", "cut")]
setkey(d1, clarity, cut)
# The facet_wrap plots
p1 <- ggplot(d1, aes(x = clarity, y = revenue, fill = cut)) +
geom_bar(stat = "identity") +
labs(x = "clarity", y = "revenue") +
facet_wrap( ~ cut, nrow = 2) +
scale_y_continuous(labels = dollar, expand = c(0, 0)) +
theme(axis.text.x = element_text(angle = 90, hjust = 1),
axis.text.y = element_text(colour = "#4B92DB"),
legend.position = "bottom")
p2 <- ggplot(d1, aes(x = clarity, y = stones, colour = "red")) +
geom_point(size = 4) +
labs(x = "", y = "number of stones") + expand_limits(y = 0) +
scale_y_continuous(labels = comma, expand = c(0, 0)) +
scale_colour_manual(name = '', values = c("red", "green"),
labels =c("Number of Stones")) +
facet_wrap( ~ cut, nrow = 2) +
theme(axis.text.y = element_text(colour = "red")) +
theme(panel.background = element_rect(fill = NA),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_rect(fill = NA, colour = "grey50"),
legend.position = "bottom")
# Get the ggplot grobs
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
# Grab the panels from g2 and overlay them onto the panels of g1
pp <- c(subset(g1$layout, grepl("panel", g1$layout$name), select = t:r))
g <- gtable_add_grob(g1, g2$grobs[grepl("panel", g1$layout$name)],
pp$t, pp$l, pp$b, pp$l)
# Function to invert labels
hinvert_title_grob <- function(grob){
widths <- grob$widths
grob$widths[1] <- widths[3]
grob$widths[3] <- widths[1]
grob$vp[[1]]$layout$widths[1] <- widths[3]
grob$vp[[1]]$layout$widths[3] <- widths[1]
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$x <- unit(1, "npc") - grob$children[[1]]$x
grob
}
# Get the y label from g2, and invert it
index <- which(g2$layout$name == "ylab-l")
ylab <- g2$grobs[[index]] # Extract that grob
ylab <- hinvert_title_grob(ylab)
# Put the y label into g, to the right of the right-most panel
# Note: Only one column and one y label
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos = max(pp$r))
g <-gtable_add_grob(g,ylab, t = min(pp$t), l = max(pp$r)+1,
b = max(pp$b), r = max(pp$r)+1,
clip = "off", name = "ylab-r")
# Get the y axis from g2, reverse the tick marks and the tick mark labels,
# and invert the tick mark labels
index <- which(g2$layout$name == "axis-l-1-1") # Which grob
yaxis <- g2$grobs[[index]] # Extract the grob
ticks <- yaxis$children[[2]]
ticks$widths <- rev(ticks$widths)
ticks$grobs <- rev(ticks$grobs)
plot_theme <- function(p) {
plyr::defaults(p$theme, theme_get())
}
tml <- plot_theme(p1)$axis.ticks.length # Tick mark length
ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") + tml
ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]])
yaxis$children[[2]] <- ticks
# Put the y axis into g, to the right of the right-most panel
# Note: Only one column, but two y axes - one for each row of the facet_wrap plot
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos = max(pp$r))
nrows = length(unique(pp$t)) # Number of rows
g <- gtable_add_grob(g, rep(list(yaxis), nrows),
t = unique(pp$t), l = max(pp$r)+1,
b = unique(pp$b), r = max(pp$r)+1,
clip = "off", name = paste0("axis-r-", 1:nrows))
# Get the legends
leg1 <- g1$grobs[[which(g1$layout$name == "guide-box")]]
leg2 <- g2$grobs[[which(g2$layout$name == "guide-box")]]
# Combine the legends
g$grobs[[which(g$layout$name == "guide-box")]] <-
gtable:::cbind_gtable(leg1, leg2, "first")
grid.newpage()
grid.draw(g)
SO не является учебным сайтом, и это может вызвать ярость других пользователей SO, но комментариев слишком много.
Нарисуйте граф только с одной панелью (т.е. без фасетирования),
library(ggplot2)
p <- ggplot(mtcars, aes(x = mpg, y = disp)) + geom_point()
Получите ggplot grob.
g <- ggplotGrob(p)
Исследуйте гроб участка:
1) gtable_show_layout() дает диаграмму графика gtable. Большим пространством посередине является расположение панели сюжета. Столбцы слева и внизу панели содержат оси y и x. И есть граница, окружающая весь сюжет. Индексы дают расположение каждой ячейки в массиве. Обратите внимание, например, что панель расположена в третьей строке четвертого столбца.
gtable_show_layout(g)
2) Блок данных макета. g$layout возвращает фрейм данных, который содержит имена грыз, содержащиеся в графике, вместе с их местоположениями в пределах gtable: t, l, b и r (для верхнего, левого, правого и нижнего). Обратите внимание, например, что панель расположена при t = 3, l = 4, b = 3, r = 4. Это то же самое расположение панели, которое было получено выше из диаграммы.
g$layout
3) Диаграмма макета пытается дать высоты и ширину строк и столбцов, но они имеют тенденцию перекрываться. Вместо этого используйте g$widths и g$heights. 1null ширина и высота - ширина и высота панели. Обратите внимание, что 1null - это 3-я высота и 4-я ширина - 3 и 4.
Теперь нарисуем грань facet_wrap и график facet_grid.
p1 <- ggplot(mtcars, aes(x = mpg, y = disp)) + geom_point() +
facet_wrap(~ carb, nrow = 1)
p2 <- ggplot(mtcars, aes(x = mpg, y = disp)) + geom_point() +
facet_grid(. ~ carb)
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
Два сюжета выглядят одинаково, но их таблицы пригодности отличаются. Кроме того, имена компонентов grobs отличаются.
Часто бывает удобно получить подмножество фрейма данных макета, содержащего индексы (т.е. t, l, b и r) гномов общего типа; скажем, все панели.
pp1 <- subset(g1$layout, grepl("panel", g1$layout$name), select = t:r)
pp2 <- subset(g2$layout, grepl("panel", g2$layout$name), select = t:r)
Обратите внимание, например, что все панели находятся в строке 4 (pp1$t, pp2$t). pp1$r относится к столбцам, которые содержат панели сюжетов. pp1$r + 1 относится к столбцам справа от панелей, max(pp1$r) относится к самой правой колонке, содержащей панель. max(pp1$r) + 1 относится к столбцу справа от правой колонки, содержащей панель.
и т.д.
Наконец, нарисуйте график facet_wrap с более чем одной строкой.
p3 <- ggplot(mtcars, aes(x = mpg, y = disp)) + geom_point() +
facet_wrap(~ carb, nrow = 2)
g3 <- ggplotGrob(p3)
Исследуйте сюжет, как и раньше, но также подмножите рамку данных макета, чтобы содержать индексы панелей.
pp3 <- subset(g3$layout, grepl("panel", g3$layout$name), select = t:r)
Как и следовало ожидать, pp3 сообщает, что панели сюжетов расположены в трех столбцах (4, 7 и 10) и двух строках (4 и 8).
Эти индексы используются при добавлении строк или столбцов в gtable и при добавлении grobs к gtable. Проверьте эти команды с помощью ?gtable_add_rows и gtable_add_grob.
Кроме того, узнайте несколько grid, особенно о том, как построить grobs и использовать единицы (некоторые ресурсы указаны в теге r-grid здесь, на SO.