Căn chỉnh nhiều biểu đồ ggplot có và không có chú thích

Question

Tôi đang cố gắng sử dụng ggplot để vẽ biểu đồ so sánh giá trị tuyệt đối của hai biến và cũng hiển thị tỷ lệ giữa chúng. Vì tỷ lệ này là đơn vị và các giá trị không phải là, tôi không thể hiển thị chúng trên cùng trục y, vì vậy tôi muốn ngăn xếp theo chiều dọc dưới dạng hai biểu đồ riêng biệt với các trục x được căn chỉnh.

Đây là những gì tôi đã có cho đến nay:

library(ggplot2) 
library(dplyr) 
library(gridExtra) 

# Prepare some sample data. 
results <- data.frame(index=(1:20)) 
results$control <- 50 * results$index 
results$value <- results$index * 50 + 2.5*results$index^2 - results$index^3/8 
results$ratio <- results$value/results$control 

# Plot absolute values 
plot_values <- ggplot(results, aes(x=index)) + 
    geom_point(aes(y=value, color="value")) + 
    geom_point(aes(y=control, color="control")) 

# Plot ratios between values 
plot_ratios <- ggplot(results, aes(x=index, y=ratio)) + 
    geom_point() 

# Arrange the two plots above each other 
grid.arrange(plot_values, plot_ratios, ncol=1, nrow=2) 

Vấn đề lớn là truyền thuyết về quyền của cốt truyện đầu tiên làm cho nó một kích thước khác nhau. Một vấn đề nhỏ là tôi không muốn hiển thị tên trục x và đánh dấu trên ô trên cùng, để tránh lộn xộn và làm cho nó rõ ràng rằng họ chia sẻ cùng một trục.

tôi đã xem xét câu hỏi này và câu trả lời của mình:

Align plot areas in ggplot

Thật không may, không phải câu trả lời có hoạt động tốt đối với tôi. Faceting có vẻ không phù hợp, vì tôi muốn có vảy y hoàn toàn khác nhau cho hai đồ thị của tôi. Thao tác với các tham số được trả về bởi ggplot_gtable có vẻ hứa hẹn hơn, nhưng tôi không biết làm thế nào để có được xung quanh thực tế là hai đồ thị có số lượng ô khác nhau. Naively sao chép mã đó dường như không thay đổi kích thước biểu đồ kết quả cho trường hợp của tôi.

Đây là một câu hỏi tương tự:

The perils of aligning plots in ggplot

Câu hỏi bản thân dường như cho thấy một lựa chọn tốt, nhưng rbind.gtable phàn nàn nếu các bảng có số lượng khác nhau của cột, đó là trường hợp ở đây do sự huyền thoại. Có lẽ có một cách để xếp vào một cột trống trong bảng thứ hai? Hoặc một cách để ngăn chặn truyền thuyết trong đồ thị đầu tiên và sau đó thêm nó vào đồ thị kết hợp?

Answer 1

Đây là giải pháp không yêu cầu sử dụng đồ họa lưới rõ ràng. Nó sử dụng các khía cạnh và ẩn mục nhập huyền thoại cho "tỷ lệ" (sử dụng kỹ thuật từ https://stackoverflow.com/a/21802022).

library(reshape2) 

results_long <- melt(results, id.vars="index") 
results_long$facet <- ifelse(results_long$variable=="ratio", "ratio", "values") 
results_long$facet <- factor(results_long$facet, levels=c("values", "ratio")) 

ggplot(results_long, aes(x=index, y=value, colour=variable)) + 
    geom_point() + 
    facet_grid(facet ~ ., scales="free_y") + 
    scale_colour_manual(breaks=c("control","value"), 
         values=c("#1B9E77", "#D95F02", "#7570B3")) + 
    theme(legend.justification=c(0,1), legend.position=c(0,1)) + 
    guides(colour=guide_legend(title=NULL)) + 
    theme(axis.title.y = element_blank()) 

Answer 2

khuyến khích bởi lời nhận xét Baptiste của, đây là những gì tôi đã làm cuối cùng:

library(ggplot2) 
library(dplyr) 
library(gridExtra) 

# Prepare some sample data. 
results <- data.frame(index=(1:20)) 
results$control <- 50 * results$index 
results$value <- results$index * 50 + 2.5*results$index^2 - results$index^3/8 
results$ratio <- results$value/results$control 

# Plot ratios between values 
plot_ratios <- ggplot(results, aes(x=index, y=ratio)) + 
    geom_point() 


# Plot absolute values 
remove_x_axis = 
    theme(
    axis.ticks.x = element_blank(), 
    axis.text.x = element_blank(), 
    axis.title.x = element_blank()) 

plot_values <- ggplot(results, aes(x=index)) + 
    geom_point(aes(y=value, color="value")) + 
    geom_point(aes(y=control, color="control")) + 
    remove_x_axis 

# Arrange the two plots above each other 
grob_ratios <- ggplotGrob(plot_ratios) 
grob_values <- ggplotGrob(plot_values) 
legend_column <- 5 
legend_width <- grob_values$widths[legend_column] 
grob_ratios <- gtable_add_cols(grob_ratios, legend_width, legend_column-1) 
grob_combined <- gtable:::rbind_gtable(grob_values, grob_ratios, "first") 
grob_combined <- gtable_add_rows(
    grob_combined,unit(-1.2,"cm"), pos=nrow(grob_values)) 
grid.draw(grob_combined) 

(Sau này tôi nhận ra rằng tôi thậm chí không cần phải giải nén chiều rộng chú thích, vì đối số size="first" cho rbind cho biết nó chỉ để có một ghi đè lên đối tượng khác.)

Nó cảm thấy một chút lộn xộn, nhưng nó là chính xác bố trí tôi đã hy vọng.

Answer 3

Một & giải pháp khá dễ dàng thay thế như sau:

# loading needed packages 
library(ggplot2) 
library(dplyr) 
library(tidyr) 

# Prepare some sample data 
results <- data.frame(index=(1:20)) 
results$control <- 50 * results$index 
results$value <- results$index * 50 + 2.5*results$index^2 - results$index^3/8 
results$ratio <- results$value/results$control 

# reshape into long format 
long <- results %>% 
    gather(variable, value, -index) %>% 
    mutate(facet = ifelse(variable=="ratio", "ratio", "values")) 
long$facet <- factor(long$facet, levels=c("values", "ratio")) 

# create the plot & remove facet labels with theme() elements 
ggplot(long, aes(x=index, y=value, colour=variable)) + 
    geom_point() + 
    facet_grid(facet ~ ., scales="free_y") + 
    scale_colour_manual(breaks=c("control","value"), values=c("green", "red", "blue")) + 
    theme(axis.title.y=element_blank(), strip.text=element_blank(), strip.background=element_blank()) 

mang đến cho:

Answer 4

Hãy thử điều này:

library(ggplot2) 
library(gtable) 
library(gridExtra) 

AlignPlots <- function(...) { 
    LegendWidth <- function(x) x$grobs[[8]]$grobs[[1]]$widths[[4]] 

    plots.grobs <- lapply(list(...), ggplotGrob) 

    max.widths <- do.call(unit.pmax, lapply(plots.grobs, "[[", "widths")) 
    plots.grobs.eq.widths <- lapply(plots.grobs, function(x) { 
    x$widths <- max.widths 
    x 
    }) 

    legends.widths <- lapply(plots.grobs, LegendWidth) 
    max.legends.width <- do.call(max, legends.widths) 
    plots.grobs.eq.widths.aligned <- lapply(plots.grobs.eq.widths, function(x) { 
    if (is.gtable(x$grobs[[8]])) { 
     x$grobs[[8]] <- gtable_add_cols(x$grobs[[8]], 
             unit(abs(diff(c(LegendWidth(x), 
                 max.legends.width))), 
              "mm")) 
    } 
    x 
    }) 

    plots.grobs.eq.widths.aligned 
} 

df <- data.frame(x = c(1:5, 1:5), 
       y = c(1:5, seq.int(5,1)), 
       type = factor(c(rep_len("t1", 5), rep_len("t2", 5)))) 

p1.1 <- ggplot(diamonds, aes(clarity, fill = cut)) + geom_bar() 
p1.2 <- ggplot(df, aes(x = x, y = y, colour = type)) + geom_line() 
plots1 <- AlignPlots(p1.1, p1.2) 
do.call(grid.arrange, plots1) 

p2.1 <- ggplot(diamonds, aes(clarity, fill = cut)) + geom_bar() 
p2.2 <- ggplot(df, aes(x = x, y = y)) + geom_line() 
plots2 <- AlignPlots(p2.1, p2.2) 
do.call(grid.arrange, plots2) 

Tạo này:

// Dựa trên nhiều câu trả lời của baptiste