Как управлять координатами t, b, l, r с помощью gtable() для правильной маркировки меток и меток вторичной оси оси.

Question

Я использую facet_wrap и также смогу построить вторичную ось y. Однако ярлыки не рисуются вблизи оси, а они расположены очень далеко. Я понимаю, что все это разрешится, если я пойму, как манипулировать системой координат гейблей (t, b, l, r). Может кто-нибудь объяснить, как и что они на самом деле изображают - t: r = c (4,8,4,4) означает что.

Существует много ссылок на вторичный yaxis с ggplot, однако, когда nrow/ncol больше 1, они терпят неудачу. Поэтому, пожалуйста, научите меня основам геометрии сетки и управлению расположением грызунов.

Изменить: Код

this is the final code written by me : 

library(ggplot2) 
library(gtable) 
library(grid) 
library(data.table) 
library(scales) 

# Data 
diamonds$cut <- sample(letters[1:13], 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) + 
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) + 
    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 
xx <- ggplot_build(p1) 
g1 <- ggplot_gtable(xx) 

yy <- ggplot_build(p2) 
g2 <- ggplot_gtable(yy) 

nrow = length(unique(xx$panel$layout$ROW)) 
ncol = length(unique(xx$panel$layout$COL)) 
npanel = length(xx$panel$layout$PANEL) 

pp <- c(subset(g1$layout, grepl("panel", g1$layout$name), se = t:r)) 
g <- gtable_add_grob(g1, g2$grobs[grepl("panel", g1$layout$name)], 
        pp$t, pp$l, pp$b, pp$l) 

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 
} 

j = 1 
k = 0 

for(i in 1:npanel){ 
    if ((i %% ncol == 0) || (i == npanel)){ 
    k = k + 1 
    index <- which(g2$layout$name == "axis_l-1") # Which grob 
    yaxis <- g2$grobs[[index]]     # Extract the grob 
    ticks <- yaxis$children[[2]] 
    ticks$widths <- rev(ticks$widths) 
    ticks$grobs <- rev(ticks$grobs) 
    ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") 
    ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]]) 
    yaxis$children[[2]] <- ticks 
    if (k == 1)#to ensure just once d secondary axisis printed 
     g <- gtable_add_cols(g,g2$widths[g2$layout[index,]$l], 
       max(pp$r[j:i])) 
     g <- gtable_add_grob(g,yaxis,max(pp$t[j:i]),max(pp$r[j:i])+1, 
       max(pp$b[j:i]) 
        , max(pp$r[j:i]) + 1, clip = "off", name = "2ndaxis") 
    j = i + 1 
    } 
} 

# inserts the label for 2nd y-axis 
loc_1st_yaxis_label <- c(subset(g$layout, grepl("ylab", g$layout$name), se 
         = t:r)) 
loc_2nd_yaxis_max_r <- c(subset(g$layout, grepl("2ndaxis", g$layout$name), 
         se = t:r)) 
zz <- max(loc_2nd_yaxis_max_r$r)+1 
loc_1st_yaxis_label$l <- zz 
loc_1st_yaxis_label$r <- zz 

index <- which(g2$layout$name == "ylab") 
ylab <- g2$grobs[[index]]    # Extract that grob 
ylab <- hinvert_title_grob(ylab) 
ylab$children[[1]]$rot <- ylab$children[[1]]$rot + 180 
g <- gtable_add_grob(g, ylab, loc_1st_yaxis_label$t, loc_1st_yaxis_label$l 
        , loc_1st_yaxis_label$b, loc_1st_yaxis_label$r 
        , clip = "off", name = "2ndylab") 
grid.draw(g) 

@Sandy здесь код и its output

Беда только в том, что в последней строке вторичные метки у-оси внутри panels.I пытались решить это, но не в состоянии

Answer 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, но есть слишком много для комментария.

рисовать график с одним участком панели только (то есть, нет facetting),

library(ggplot2) 

p <- ggplot(mtcars, aes(x = mpg, y = disp)) + geom_point() 

Получить ggplot Grob.

g <- ggplotGrob(p) 

Исследуйте участок Grob:
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.