Nhiều tiêu đề trong facet_wrap (ggplot2)

Question

Tôi đang cố gắng thêm nhiều tiêu đề vào một ô sử dụng facet_wrap và ggplot2. Giả sử bạn có dữ liệu hàng quý trong hai năm và muốn so sánh đồ họa của dữ liệu hàng quý với hai tiêu đề chính chính; 2014 và 2015, cũng như các chức danh cho quý tương ứng.

tôi đã đến này đến nay:

data <- rnorm(10) 

A1 <- data.frame("Y"=data, "X"=1:10, "Q"=1, "year"=2014) 
A2 <- data.frame("Y"=data, "X"=1:10, "Q"=2, "year"=2014) 
A3 <- data.frame("Y"=data, "X"=1:10, "Q"=3, "year"=2014) 
A4 <- data.frame("Y"=data, "X"=1:10, "Q"=4, "year"=2014) 

N1 <- data.frame("Y"=data, "X"=1:10, "Q"=1, "year"=2015) 
N2 <- data.frame("Y"=data, "X"=1:10, "Q"=2, "year"=2015) 
N3 <- data.frame("Y"=data, "X"=1:10, "Q"=3, "year"=2015) 
N4 <- data.frame("Y"=data, "X"=1:10, "Q"=4, "year"=2015) 

A <- rbind(A1, A2, A3, A4) 
N <- rbind(N1, N2, N3, N4) 
tmp <- data.frame(rbind(A, N)) 

ggplot(data=tmp, aes(x=X, y=Y)) + geom_line() + facet_wrap(~year + Q, scales="free", ncol=4) 

mà mang lại cho tôi biểu đồ này:

Thay vào đó tôi muốn "2014" và "2015" được trong hai hộp màu xám riêng biệt trên mỗi phụ đồ thị. Điều đó có thể không?

Cảm ơn!

Answer 1

Bạn đánh bại tôi vào nó RHA, tôi đã viết gần một mã giống hệt với mã của bạn trước khi tôi thấy bài đăng của bạn. Nhưng dù sao, cảm ơn!

Tôi cũng muốn loại bỏ "2014" và "2015" từ các hộp màu xám (mà tôi không nêu trong bài viết đầu tiên của tôi), vì vậy tôi đã phải thực hiện một số thay đổi nhiều hơn nữa.

Với một số cảm hứng từ here, here, và here, tôi đã đưa ra như sau (thực sự xấu xí) mã:

data14 <- rnorm(10) 
data15 <- rnorm(10, mean = 500) 

A1 <- data.frame("Y"=data14, "X"=1:10, "Q"=1, "year"=2014) 
A2 <- data.frame("Y"=data14, "X"=1:10, "Q"=2, "year"=2014) 
A3 <- data.frame("Y"=data14, "X"=1:10, "Q"=3, "year"=2014) 
A4 <- data.frame("Y"=data14, "X"=1:10, "Q"=4, "year"=2014) 

N1 <- data.frame("Y"=data15, "X"=1:10, "Q"=1, "year"=2015) 
N2 <- data.frame("Y"=data15, "X"=1:10, "Q"=2, "year"=2015) 
N3 <- data.frame("Y"=data15, "X"=1:10, "Q"=3, "year"=2015) 
N4 <- data.frame("Y"=data15, "X"=1:10, "Q"=4, "year"=2015) 

A <- rbind(A1, A2, A3, A4) 
N <- rbind(N1, N2, N3, N4) 
tmp <- data.frame(rbind(A, N)) 

Sau đó, tôi đã thực hiện một chức năng đơn giản đặt tên các biến một cách chính xác

labFunc <- function(data, var1, var2, names) { 
    data$id <- NA 
    loop <- length(levels(factor(data[[var2]]))) 

    for (i in 1:loop) { 
    data[data[[var1]] == 2014 & data[[var2]] == levels(factor(data[[var2]]))[i], "id"] <- names[i] 
    data[data[[var1]] == 2015 & data[[var2]] == levels(factor(data[[var2]]))[i], "id"] <- paste(names[i], "") 
    } 

    first <- levels(factor(data$id))[seq(from=1, to = length(levels(factor(data$id))), by = 2)] 
    second <- levels(factor(data$id))[seq(from=2, to = length(levels(factor(data$id))), by = 2)] 

    data$id <- factor(data$id, levels=paste(c(first, second))) 
    return(data) 
} 

names <- c("Q1", "Q2", "Q3", "Q4") 
data <- labFunc(tmp, "year", "Q", names) 

Tạo cốt truyện:

p <-ggplot(data, aes(y = Y, x = X)) + 
    geom_line() + 
    facet_wrap(~ id , ncol = 4, scales = "free") 

Và cuối cùng thêm các nhãn lớn

z <- ggplotGrob(p) 

# New strip at the top 
z <- gtable_add_rows(z, unit(1, "lines"), pos = 0) # New row added to top 
z <- gtable_add_rows(z, unit(1, "lines"), pos = 6) # New row added to top 

#z <- gtable_add_rows(z, unit(9, "lines"), pos = 0) # New row added to top 


# Check the layout 
gtable_show_layout(z) # New strip goes into row 2 
# New strip spans columns 4 to 8 

z <- gtable_add_grob(z, 
        list(rectGrob(gp = gpar(col = NA, fill = grey(0.8), size = .5)), 
          textGrob("2014", vjust = .27, 
            gp = gpar(cex = .75, fontface = 'bold', col = "black"))), 2, 4, 2, 14, name = c("a", "b")) 

z <- gtable_add_grob(z, 
        list(rectGrob(gp = gpar(col = NA, fill = grey(0.8), size = .5)), 
          textGrob("2015", vjust = .27, 
            gp = gpar(cex = .75, fontface = 'bold', col = "black"))), 7, 4, 7, 14, name = c("a", "b")) 



# Add small gap between strips - below row 2 
z <- gtable_add_rows(z, unit(2/10, "lines"), 2) 
z <- gtable_add_rows(z, unit(5/10, "lines"), 7) 

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

Đây là một chút phức tạp hơn so với tôi nghĩ, nhưng cảm ơn tất cả các bạn đã giúp đỡ!

Answer 2

Sử dụng mã here, theo đề nghị của Sandy Muspratt, tôi có thể đưa ra:

library(ggplot2) 
library(gtable) 

data <- rnorm(10) 

A1 <- data.frame("Y"=data, "X"=1:10, "Q"=1, "year"=2014) 
A2 <- data.frame("Y"=data, "X"=1:10, "Q"=2, "year"=2014) 
A3 <- data.frame("Y"=data, "X"=1:10, "Q"=3, "year"=2014) 
A4 <- data.frame("Y"=data, "X"=1:10, "Q"=4, "year"=2014) 

N1 <- data.frame("Y"=data, "X"=1:10, "Q"=1, "year"=2015) 
N2 <- data.frame("Y"=data, "X"=1:10, "Q"=2, "year"=2015) 
N3 <- data.frame("Y"=data, "X"=1:10, "Q"=3, "year"=2015) 
N4 <- data.frame("Y"=data, "X"=1:10, "Q"=4, "year"=2015) 

A <- rbind(A1, A2, A3, A4) 
N <- rbind(N1, N2, N3, N4) 
tmp <- data.frame(rbind(A, N)) 

p <- ggplot(data=tmp, aes(x=X, y=Y)) + geom_line() + facet_wrap(~year + Q, scales="free", ncol=4) 


z <- ggplotGrob(p) 

# New title strip at the top 
z <- gtable_add_rows(z, unit(1, "lines"), pos = 0) # New row added to top 

# Display the layout to select the place for the new strip 
gtable_show_layout(z) # New strip goes into row 2 
# New strip spans columns 4 to 13 

z <- gtable_add_grob(z, 
        list(rectGrob(gp = gpar(col = NA, fill = grey(0.8), size = .5)), 
          textGrob("2014", vjust = .27, 
            gp = gpar(cex = .75, fontface = 'bold', col = "black"))), 2, 4, 2, 13, name = c("a", "b")) 

# Add small gap between strips - below row 2 
z <- gtable_add_rows(z, unit(2/10, "line"), 2) 


# New title strip in the middle 
z <- gtable_add_rows(z, unit(1, "lines"), pos = 8) # New row added to top 
# Display the layout to select the place for the new strip 
gtable_show_layout(z) 
# New strip goes into row 9 
# New strip spans columns 4 to 13 

z <- gtable_add_grob(z, 
        list(rectGrob(gp = gpar(col = NA, fill = grey(0.8), size = .5)), 
          textGrob("2015", vjust = .27, 
            gp = gpar(cex = .75, fontface = 'bold', col = "black"))), 9, 4, 9, 13, name = c("a", "b")) 

# Add small gap between strips - below row 2 
z <- gtable_add_rows(z, unit(2/10, "line"), 9) 


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

Mà sẽ cung cấp cho bạn biểu đồ này: