R中有没有办法用两个轴绘制一个图例？答案

【问题标题】：Is there a way in R to plot a legend with two axes?R中有没有办法用两个轴绘制一个图例？
【发布时间】：2020-06-19 16:57:36
【问题描述】：

我想用两个轴绘制一个图例。具体来说，我结合了两个已分类的空间对象，第一个显示事件的强度，第二个显示该位置的事件概率。我想创建一个图例，显示组合栅格的像素在每个类别中的位置。我想创建的图例如下所示： Legend with two axes。

分类数据的正常图例是这样的：Original legend

这是我正在使用的数据类型的可重现示例：

library(raster)
library(rasterVis)

# setseed
set.seed(999)

# create raster (example of what would be the outcome of combining intensity and probability rasters)
plot.me<- raster(xmn=-110, xmx=-90, ymn=40, ymx=60, ncols=40, nrows=40)
val <- c(100:104, 200:204, 300:304, 400:404)
plot.me<- setValues(plot.me, sample(val,ncell(plot.me),replace=T))


######  Plotting

plot.me <- ratify(plot.me)
levelplot(plot.me,att="ID" ,
          col.regions=c("#beffff","#73dfff","#d0ff73","#55ff00",
                        "#73b2ff","#0070ff","#70a800","#267300",
                        "#f5f57a","#ffff00","#e8beff","#df73ff",
                        "#f5ca7a","#ffaa00","#e600a9","#a80084"))

Plot output from above

最简单的方法是创建绘图并稍后在图形编辑器中添加图例....但我确信必须有一种方法可以在 R 本身中执行此操作！我目前正在使用 rasterVis 包进行绘图，但如果 ggplot 或 base R 中有答案，这些同样受欢迎。

如果有一个可重复的中间步骤示例（即使用强度/概率栅格）更有用，请告诉我，我可以制作这些。

【问题讨论】：

我在 github 上见过的最接近的是 github.com/clauswilke/multiscales，但这不是你的例子。
使用rasterVis我产生了this image。如果这是您正在寻找的，请尝试可用的代码here（“双变量图例”部分）。
@OscarPerpiñán 我觉得你的例子最接近我所希望的（能够在地图上绘制图例）。我很难理解您的代码的一部分 - pList 步骤的目的是什么？这是使后续步骤正常运行所必需的，还是特定于您创建的地图？
@dee_2_dee 此步骤生成水平图列表，每个水平图对应一个类（参见上面的代码，在“分类数据”部分）。此列表折叠为带有Reduce 和+.trellis 的全局图。

标签： r ggplot2 legend spatial r-raster

【解决方案1】：

一种解决方案是制作两个图，并使用 grid.arrange 函数组合它们，例如 gridExtra 包

首先，我使用此帖子中发布的函数将您的 rasterLayer 转换为 tibble：Overlay raster layer on map in ggplot2 in R?

（PS：我修改了您的 val 对象，以便仅使 16 种不同的颜色与您提供的颜色模式匹配。在您的示例中，val 有 20 个不同的值）

val <- c(101:104, 201:204, 301:304, 401:404) # correction from OP's question to match 16 different values

library(raster)
gplot_data <- function(x, maxpixels = 50000)  {
  x <- raster::sampleRegular(x, maxpixels, asRaster = TRUE)
  coords <- raster::xyFromCell(x, seq_len(raster::ncell(x)))
  ## Extract values
  dat <- utils::stack(as.data.frame(raster::getValues(x))) 
  names(dat) <- c('value', 'variable')

  dat <- dplyr::as.tbl(data.frame(coords, dat))

  if (!is.null(levels(x))) {
    dat <- dplyr::left_join(dat, levels(x)[[1]], 
                            by = c("value" = "ID"))
  }
  dat
}

df <- gplot_data(plot.me)

然后，我使用geom_tile 创建第一个图，即热图：

library(ggplot2)
plot <- ggplot(df, aes(x = x, y = y, fill = as.factor(value)))+
  geom_tile(show.legend = FALSE)+
  coord_fixed(ratio = 20/20)+
  scale_fill_manual(values = c("#beffff","#73dfff","#d0ff73","#55ff00",
                               "#73b2ff","#0070ff","#70a800","#267300",
                               "#f5f57a","#ffff00","#e8beff","#df73ff",
                               "#f5ca7a","#ffaa00","#e600a9","#a80084"))+
  scale_y_continuous(name = "Latitude",labels = paste(c(40,45,50,55,60),"°N"))+
  scale_x_continuous(name = "Longitude",labels = paste(c(-110,-105,-100,-95,-90),"°W"))+
  theme_linedraw()+
  theme(panel.border = element_rect(size = 2),
        axis.text = element_text(size = 10),
        axis.title = element_text(size = 10),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank())

然后，我为图例创建一个单独的数据框：

library(tidyverse)
df_legend <- data.frame(value = unique(df$value))
df_legend <- df_legend %>% rowwise() %>% 
  mutate(Dim1 = unlist(strsplit(as.character(value),""))[1],
         Dim3 = unlist(strsplit(as.character(value),""))[3])

Source: local data frame [16 x 3]
Groups: <by row>

# A tibble: 16 x 3
   value Dim1  Dim3 
   <int> <chr> <chr>
 1   404 4     4    
 2   204 2     4    
 3   304 3     4    
 4   104 1     4    
 5   202 2     2    
 6   302 3     2    
 7   203 2     3    
 8   301 3     1    
 9   402 4     2    
10   401 4     1    
11   303 3     3    
12   102 1     2    
13   201 2     1    
14   103 1     3    
15   403 4     3    
16   101 1     1

现在，我为传说制作了情节：

legend <- ggplot(df_legend, aes(x = as.factor(Dim1), y = as.factor(Dim3), fill = as.factor(value)))+
  geom_tile(show.legend = FALSE, color = "black")+
  coord_fixed(ratio = 1)+
  scale_fill_manual(values = c("#beffff","#73dfff","#d0ff73","#55ff00",
                               "#73b2ff","#0070ff","#70a800","#267300",
                               "#f5f57a","#ffff00","#e8beff","#df73ff",
                               "#f5ca7a","#ffaa00","#e600a9","#a80084"))+
  theme_linedraw()+
  labs(x = "Dim1", y = "Dim3")+
  theme(panel.border = element_rect(size = 2),
        axis.text = element_text(size = 10),
        axis.title = element_text(size = 10))

最后，我将它们组合起来：

library(gridExtra)
grid.arrange(plot, legend, layout_matrix = rbind(c(1,1,2),c(1,1,3)))

它看起来像你想要得到的吗？

注意：您可能可以将光栅对象直接绘制到ggplot2 中，但我不确定确切的过程。此外，您可以使用grid.arrange 的布局，以使情节看起来完全符合您的要求

【讨论】：