Глобальная легенда, использующая grid.arrange (gridExtra) и графики на основе решетки

Question

Я создаю четыре графика с использованием xyplot (решетки) и далее объединяю их с grid.arrange (gridExtra).

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

# Load packages 
require(lattice) 
require(gridExtra) 

# Generate some values 
x1<-rnorm(100,10,4) 
x2<-rnorm(100,10,4) 
x3<-rnorm(100,10,4) 
x4<-rnorm(100,10,4) 
y<-rnorm(100,10,1) 
cond<-rbinom(100,1,0.5) 
groups<-sample(c(0:10),100,replace=TRUE) 
dataa<-data.frame(y,x1,x2,x3,x4,cond,groups) 

# ploting function 
plott<-function(x){ 
xyplot(y~x|cond,groups=groups, 
     col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))), 
     pch = 1:length(levels(as.factor(groups))), 
     key = list(space="top", 
        text = list(as.character(levels(as.factor(groups)))), 
        points = TRUE, lines = TRUE, columns = 3, 
        pch = 1:length(levels(as.factor(groups))), 
        col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))), 
        cex=1)) 
} 
plot1<-plott(x=x1) 
plot2<-plott(x=x2) 
plot3<-plott(x=x3) 
plot4<-plott(x=x4) 


grid.arrange(plot1,plot2,plot2,plot4,ncol=2) 

В аналогичной должности, я видел, что она может быть выполнена с использованием, например, ggplot2 here и here, но есть ли способ включить глобальную общую легенду, используя gridExtra, и график на основе решетки, например. графика XY?

спасибо.

Answer 1

Мне удалось создать нечто более близкое к тому, что я впервые представил. Для этого я включаю дополнительный графический элемент, и я использую параметр layout_matrix в grid.arrange, чтобы минимизировать его эффект. Таким образом, я сохраняю легенду и почти исключаю сюжет.

# Load packages 
require(lattice) 
require(gridExtra) 

# Generate some values 
x1<-rnorm(100,10,4) 
x2<-rnorm(100,10,4) 
x3<-rnorm(100,10,4) 
x4<-rnorm(100,10,4) 
y<-rnorm(100,10,1) 
cond<-rbinom(100,1,0.5) 
groups<-sample(c(0:10),100,replace=TRUE) 
dataa<-data.frame(y,x1,x2,x3,x4,cond,groups) 

# ploting function 
plottNolegend<-function(x){ 
    xyplot(y~x|cond,groups=groups, 
     col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))), 
     pch = 1:length(levels(as.factor(groups))) 
) 
} 
plott<-function(x){ 
    xyplot(y~x|cond,groups=groups, 
     col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))), 
     pch = 1:length(levels(as.factor(groups))), 
     key = list(space="top", 
        text = list(as.character(levels(as.factor(groups)))), 
        points = TRUE, lines = TRUE, columns = 3, 
        pch = 1:length(levels(as.factor(groups))), 
        col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))), 
        cex=1)) 
} 
plot1<-plottNolegend(x=x1) 
plot2<-plottNolegend(x=x2) 
plot3<-plottNolegend(x=x3) 
plot4<-plottNolegend(x=x4) 
legend<-plott(x=x4) 



lay <- rbind(c(1,2), 
      c(1,2), 
      c(3,4), 
      c(3,4), 
      c(5,5)) 


grid.arrange(plot1,plot2,plot2,plot4,legend, layout_matrix = lay) 

Обновлено: Ответ был гораздо проще, чем я ожидал. Спасибо за вашу помощь.

# Load packages 
require(lattice) 
require(gridExtra) 
require(grid) 

# Generate some values 
x1<-rnorm(100,10,4) 
x2<-rnorm(100,10,4) 
x3<-rnorm(100,10,4) 
x4<-rnorm(100,10,4) 
y<-rnorm(100,10,1) 
cond<-rbinom(100,1,0.5) 
groups<-sample(c(0:10),100,replace=TRUE) 
dataa<-data.frame(y,x1,x2,x3,x4,cond,groups) 

# ploting function 
plott<-function(x){ 
    xyplot(y~x|cond,groups=groups, 
     col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))), 
     pch = 1:length(levels(as.factor(groups))), 
     key = NULL) 
} 
plot1<-plott(x=x1) 
plot2<-plott(x=x2) 
plot3<-plott(x=x3) 
plot4<-plott(x=x4) 


grid.arrange(plot1,plot2,plot2,plot4,ncol=2) 

KeyA<-list(space="top", 
    text = list(as.character(levels(as.factor(groups)))), 
    points = TRUE, lines = TRUE, columns = 11, 
    pch = 1:length(levels(as.factor(groups))), 
    col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))), 
    cex=1) 



draw.key(KeyA, draw = TRUE, vp = 
      viewport(.50, .99)) 

Answer 2

Одним из возможных решений является использование ggplot, намекнул here.

my.cols <- 1:3 

my.grid.layout <- rbind(c(1,2), 
         c(3,3)) 

g_legend<-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) 
    } 

legend.plot <- ggplot(iris, aes(x=Petal.Length, y=Sepal.Width,colour=Species)) + 
            geom_line(size=1) + # legend should show lines, not points or rects ... 
            theme(legend.position="right", legend.background = element_rect(colour = "black"), 
             legend.key = element_rect(fill = "white")) + # position, box and background colour of legend 
            scale_color_manual(values=my.cols, name = "Categories") + # manually insert colours as used in corresponding xyplot 
            guides(colour = guide_legend(reverse=T)) # inverts order of colours in legend 

mylegend <- g_legend(legend.plot) 
plot1 <- xyplot(Sepal.Width ~ Petal.Length, groups = Species, data = iris, type = 'l', 
       par.settings = simpleTheme(col=my.cols)) 
plot2 <- xyplot(Sepal.Length ~ Petal.Length, groups = Species, data = iris, type = 'l', 
       par.settings = simpleTheme(col=my.cols)) 


grid.arrange(plot1,plot2,mylegend,layout_matrix=my.grid.layout,    
     top=textGrob(gp=gpar(col='black',fontsize=20),"Some useless example")) 

Answer 3

Я думаю, что лучшим решением является использование c.trellis из latticeExtra:

library(latticeExtra) 
c(plot1, plot2, plot3, plot4)