Global legend using grid.arrange (gridExtra) and l

问题:

I am producing four plots using xyplot (lattice) and further combine them with grid.arrange (gridExtra).

I would like to obtain a graph with a common global legend. The closest that I have reached is the following. They have to be in a matrix layout, otherwise an option would be to put them in a column and include only a legend for the top or bottom one.

# 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)

In a similar post, I have seen that it can be performed with the use of ggplot2 e.g. here and here but is there a way to include a global common legend using gridExtra and a lattice based plot e.g. xyplot?

Thank you.

回答1:

One possible solution is to use ggplot, hinted 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"))

回答2:

I managed to produce something more close to what I first imagined. For that I am including an extra graphical element and I am using the layout_matrix option in grid.arrange to minimize its effect. That way I am keeping the legend and almost exclude the plot.

# 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)

Updated: The answer was much simpler than I expected. Thank you all for your help.

    # 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))

回答3:

I think the better solution is to use c.trellis from latticeExtra:

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