使用 grid.arrange (gridExtra) 和基于点阵的图的全局图例

Global legend using grid.arrange (gridExtra) and lattice based plots

我正在使用 xyplot (lattice) 生成四个图,并将它们与 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)

在类似的 post 中,我看到它可以使用 ggplot2 来执行,例如here and 但有没有一种方法可以使用 gridExtra 和基于格子的图来包含全局通用图例,例如坐标图?

谢谢。

我设法制作出更接近我最初想象的东西。为此,我包含了一个额外的图形元素,并且我在 grid.arrange 中使用 layout_matrix 选项来最小化其影响。这样我就保留了传说,几乎排除了情节。

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

一个可能的解决方案是使用 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"))

我认为更好的解决方案是使用 c.trellis from latticeExtra:

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