ggplot2: Sử dụng gtable để di chuyển các nhãn dải lên đầu bảng cho facet_grid

Question

Tôi đang tạo hình ảnh bằng cách sử dụng facet_grid để tạo thành một biến phân loại trên trục y. Tôi quyết định không sử dụng facet_wrap vì tôi cần space = 'free' và labeller = label_parsed. Nhãn của tôi dài và tôi có một chú giải ở bên phải vì vậy tôi muốn di chuyển các nhãn từ bên phải của bảng điều khiển lên đầu bảng điều khiển.

Dưới đây là ví dụ để hiển thị nơi tôi bị kẹt.

library(ggplot2) 
library(gtable) 

mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() + 
    facet_grid(manufacturer ~ ., scales = 'free', space = 'free') + 
    theme_minimal() + 
    theme(panel.margin = unit(0.5, 'lines'), strip.text.y = element_text(angle = 0)) 

Bây giờ tôi muốn di chuyển văn bản dải từ bên phải của mỗi bảng để phía trên cùng của mỗi bảng. Tôi có thể lưu trữ các grobs cho nhãn dải và loại bỏ chúng khỏi những âm mưu:

grob <- ggplotGrob(mt) 
strips.y <- gtable_filter(grob, 'strip-right') 
grob2 <- grob[,-5] 

Nhưng bây giờ tôi bị mắc kẹt khi nói đến rbind -ing các grobs trở lại để các nhãn đi đến phía trên cùng của tấm.

Một giải pháp khác có thể là sử dụng facet_wrap và sau đó kích thước lại các ô as discussed in another question, nhưng trong trường hợp đó, tôi sẽ phải thay đổi nhãn theo cách thủ công trên các mặt vì không có labeller = label_parsed cho facet_wrap.

Tôi muốn đánh giá cao các đề xuất về một trong hai cách tiếp cận!

Cảm ơn bạn đã đọc,

Tom

Answer 1

này có cách tiếp cận đầu tiên của bạn. Nó chèn một hàng phía trên mỗi tấm, lấy các dải tròn (bên phải), và chèn chúng vào các hàng mới.

library(ggplot2) 
library(gtable) 
library(grid) 

mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() + 
    facet_grid(manufacturer ~ ., scales = 'free', space = 'free') + 
    theme(panel.margin = unit(0.5, 'lines'), 
     strip.text.y = element_text(angle = 0)) 

# Get the gtable 
gt <- ggplotGrob(mt) 

# Get the position of the panels in the layout 
panels <-c(subset(gt$layout, name=="panel", se=t:r)) 

# Add a row above each panel 
for(i in rev(panels$t-1)) gt = gtable_add_rows(gt, unit(.5, "lines"), i) 

# Get the positions of the panels and the strips in the revised layout 
panels <-c(subset(gt$layout, name=="panel", se=t:r)) 
strips <- c(subset(gt$layout, name=="strip-right", se=t:r)) 

# Get the strip grobs 
stripText = gtable_filter(gt, "strip-right") 

# Insert the strip grobs into the new rows 
for(i in 1:length(strips$t)) gt = gtable_add_grob(gt, stripText$grobs[[i]], t=panels$t[i]-1, l=4, r=4) 

# Remove the old strips 
gt = gt[,-5] 

# For this plot - adjust the heights of the strips and the empty row above the strips 
for(i in panels$t) { 
    gt$heights[i-1] = list(unit(0.8, "lines")) 
    gt$heights[i-2] = list(unit(0.2, "lines")) 
    } 

# Draw it 
grid.newpage() 
grid.draw(gt) 

OR, bạn có thể đạt được cách tiếp cận thứ hai sử dụng một facet_wrap_labeller chức năng available from here.

library(ggplot2) 
library(gtable) 

mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() + 
    facet_wrap(~ manufacturer, scales = "free_y", ncol = 1) + 
    theme(panel.margin = unit(0.2, 'lines')) 


facet_wrap_labeller <- function(gg.plot, labels=NULL) { 
    require(gridExtra) 

    g <- ggplotGrob(gg.plot) 
    gg <- g$grobs  
    strips <- grep("strip_t", names(gg)) 

    for(ii in seq_along(labels)) { 
    modgrob <- getGrob(gg[[strips[ii]]], "strip.text", 
         grep=TRUE, global=TRUE) 
    gg[[strips[ii]]]$children[[modgrob$name]] <- editGrob(modgrob,label=labels[ii]) 
    } 

    g$grobs <- gg 
    class(g) = c("arrange", "ggplot",class(g)) 
    return(g) 
} 

## Number of y breaks in each panel 
g <- ggplot_build(mt) 
N <- sapply(lapply(g$panel$ranges, "[[", "y.major"), length) 

# Some arbitrary strip texts 
StripTexts = expression(gamma[1], sqrt(gamma[2]), C, `A really incredibly very very very long label`, gamma[5], alpha[1], alpha[2], `Land Rover`, alpha[1], beta[2], gamma^2, delta^2, epsilon[2], zeta[3], eta[4]) 

# Apply the facet_wrap_labeller function 
gt = facet_wrap_labeller(mt, StripTexts) 

# Get the position of the panels in the layout 
panels <- gt$layout$t[grepl("panel", gt$layout$name)] 

# Replace the default panel heights with relative heights 
gt$heights[panels] <- lapply(N, unit, "null") 

# Draw it 
gt 

Answer 2

tôi đã phải vật lộn với một vấn đề tương tự nhưng đặt các nhãn ở phía dưới. Tôi đã sử dụng một sự thích ứng mã của câu trả lời này. Và thời gian gần đây phát hiện ra rằng

ggplot2 ver.2.2.1.0 (http://docs.ggplot2.org/current/facet_grid.html)

~facet_grid(.~variable,switch='x')

tùy chọn mà đã làm việc thật đẹp đối với tôi.