Использование arrGrob для добавления подзаголовка в качестве легенды

Question

Я пытаюсь объединить два графика, где один основной сюжет, а другой - подзаголовок, который я хотел бы разместить в области легенды основной сюжет.

Этот код производит этот сюжет:

gLegend <- function(a.gplot){ 
    tmp <- ggplot_gtable(ggplot_build(a.gplot)) 
    leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") 
    legend <- tmp$grobs[[leg]] 
    return(legend) 
} 

set.seed(1) 
main.df <- data.frame(group=rep(LETTERS[1:4],3), 
        y=rnorm(12),x=c(rep(1,4),rep(2,4),rep(3,4)),col=rep(c("gray","blue","red","magenta"),3)) 
main.df$group <- factor(main.df$group,levels=LETTERS[1:4]) 
sub.df <- data.frame(group=c("B","C","D"),x=1:3,effect=runif(3,0,1),col=c("blue","red","magenta")) 
sub.df$group <- factor(sub.df$group,levels=LETTERS[2:4]) 

main.plot <- ggplot(main.df,aes(x=x,y=y,color=factor(group)))+geom_point(size=3)+facet_wrap(~group,ncol=4)+scale_fill_manual(values=c("gray","blue","red","magenta"),labels=c("A","B","C","D"),name="group")+scale_colour_manual(values=c("gray","blue","red","magenta"),labels=c("A","B","C","D"),name="group")+scale_x_continuous(breaks=unique(main.df$x)) 
sub.plot <- ggplot(sub.df,aes(x=x,y=effect,color=factor(group)))+geom_point(size=2)+scale_fill_manual(values=c("blue","red","magenta"),labels=c("B","C","D"),name="group",guide=FALSE)+scale_colour_manual(values=c("blue","red","magenta"),labels=c("B","C","D"),name="group",guide=FALSE)+labs(x="group",y="effect")+ggtitle("effect summary")+scale_x_continuous(breaks=unique(sub.df$x),labels=c("B","C","D")) 

sub.plot.grob <- ggplotGrob(sub.plot) 
combined.plot <- arrangeGrob(main.plot+theme(legend.position="none"),widths=c(0.75,0.25),arrangeGrob(20,sub.plot.grob),ncol=2) 

То, что я хотел бы сделать, это избавиться от легенды основного сюжета.

Если добавить к guide=FALSEscale_fill_manualscale_colour_manualgLegend бросает ошибку:

Error in tmp$grobs[[leg]] : 
    attempt to select less than one element in get1index 

Очевидно, потому что он не может нормально "guide-box"

Любая идея, как решить эту проблему?

Answer 1

Здесь решение с использованием grid пакет, если вы хотите пустое пространство, в котором текущая легенда:

library(grid) 

set.seed(1) 
main.df <- data.frame(group=rep(LETTERS[1:4],3), 
        y = rnorm(12), 
        x = c(rep(1,4), rep(2,4), rep(3,4)), 
        col = rep(c("gray", "blue", "red", "magenta"), 3)) 
main.df$group <- factor(main.df$group,levels=LETTERS[1:4]) 

sub.df <- data.frame(group=c("B", "C", "D"), 
       x = 1:3, 
       effect = runif(3, 0, 1), 
       col = c("blue", "red", "magenta")) 
sub.df$group <- factor(sub.df$group, levels=LETTERS[2:4]) 

main.plot <- ggplot(main.df, aes(x = x,y = y, color = factor(group))) + 
geom_point(size = 3) + facet_wrap(~group, ncol = 4) + 
scale_fill_manual(values = c("gray", "blue", "red", "magenta"), 
labels = c("A", "B", "C", "D"),name = "group") + 
scale_colour_manual(values = c("gray", "blue", "red", "magenta"), 
labels = c("A", "B", "C", "D"), name = "group") + 
scale_x_continuous(breaks = unique(main.df$x)) + guides(color = F) 

sub.plot <- ggplot(sub.df, aes(x = x, y = effect, color = factor(group))) + 
geom_point(size = 2) + 
scale_fill_manual(values = c("blue", "red", "magenta"), 
labels = c("B", "C", "D"), name= "group" ,guide = FALSE) + 
scale_colour_manual(values = c("blue", "red", "magenta"), 
labels = c("B", "C", "D"), name = "group", guide=FALSE) + 
labs(x = "group", y = "effect") + 
ggtitle("effect summary") + 
scale_x_continuous(breaks = unique(sub.df$x), labels = c("B", "C", "D")) 


blank = grid.rect(gp = gpar(col = "white")) 

sub.plot.grob <- arrangeGrob(blank, sub.plot, ncol = 1) 

combined.plot <- arrangeGrob(main.plot, sub.plot.grob, ncol=2, widths=c(0.75,0.25)) 

grid.arrange(combined.plot) 

Answer 2

Вот альтернативное решение с использованием cowplot

library(ggplot2) 
library(cowplot) 
theme_set(theme_bw()) #cowplot automatically sets theme_classic 

set.seed(1) 
main.df <- data.frame(group=rep(LETTERS[1:4],3), 
         y=rnorm(12),x=c(rep(1,4),rep(2,4),rep(3,4)),col=rep(c("gray","blue","red","magenta"),3)) 
main.df$group <- factor(main.df$group,levels=LETTERS[1:4]) 
sub.df <-  data.frame(group=c("B","C","D"),x=1:3,effect=runif(3,0,1),col=c("blue","red","magenta")) 
sub.df$group <- factor(sub.df$group,levels=LETTERS[2:4]) 

sub.plot <- ggplot(sub.df,aes(x=x,y=effect,color=factor(group)))+ 
    geom_point(size=2)+ 
    scale_fill_manual(values=c("blue","red","magenta"),labels=c("B","C","D"),name="group",guide=FALSE)+ 
    scale_colour_manual(values=c("blue","red","magenta"),labels=c("B","C","D"),name="group",guide=FALSE)+ 
    labs(x="group",y="effect")+ 
    ggtitle("effect summary")+ 
    scale_x_continuous(breaks=unique(sub.df$x),labels=c("B","C","D")) 


main.plot <- ggplot(main.df,aes(x=x,y=y,color=factor(group)))+ 
    geom_point(size=3)+facet_wrap(~group,ncol=4)+ 
    scale_fill_manual(values=c("gray","blue","red","magenta"),labels=c("A","B","C","D"),name="group")+ 
    scale_colour_manual(values=c("gray","blue","red","magenta"),labels=c("A","B","C","D"),name="group")+ 
    scale_x_continuous(breaks=unique(main.df$x)) + 
    theme(legend.position = "none") 

ggdraw() + 
    draw_plot(main.plot, x = 0, y = 0, width = 0.75, height = 1) + 
    draw_plot(sub.plot, 0.75, 0, .25, .5) 

Answer 3

попробуйте это,

grid.arrange(ggplot(), ggplot(), 
      layout_matrix=matrix(c(1,1,NA,2), 2), widths=c(1.5,1))