使用具有多个色标的 ggplot2 映射栅格数据

Question

问题 1：我正在使用 ggplot2 包。我想映射两个不同的栅格变量，一个是全球水体（变量 1），另一个是全球土地（变量 2）。我需要为它们中的每一个提供两种不同的色标。据我所知，当您使用 ggplot2 时，只接受一种色标。我有两个调色板，“jet.colors”和“YlOrBr”，我想将它们中的每一个分配给一个变量。 These figures show spatial coverage of the two variables using solid colors and just one color palette(jet.colors)。我想将 jet.colors 分配给变量 1 和 YlOrBr 到变量 2。提供了代码和数据。问题 2：在我的项目中，variable1 和 variable2 都有 3 个维度，这个维度意味着时间（第 3 个维度的大小是 50）。我想绘制 50 张地图。我有兴趣为所有地图的每个变量设置一个色标。色标的最大值和最小值定义为 max(variable1[,3,],na.rm=TRUE) 和 min(variable1[,3,],na.rm=TRUE) 和 max(variable2[,3, ],na.rm=TRUE) 和 min(variable2[,3,],na.rm=TRUE) 分别用于 Variable1 和 Variable2。为了为每个变量获得一个色标，在根据原始数据（已解释）获得两个变量的最大值和最小值之后，我重新调整了 variable1[,3,] 和 variable3[,3,] 的比例。我会很感激你的帮助。

jet.colors <- colorRampPalette(c("#00007F", "blue", "#007FFF", "cyan", 
"#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000"))
YlOrBr <- c("#FFFFD4", "#FED98E", "#FE9929", "#D95F0E", "#993404")
Variable1 <- read.table("Variable1.txt",header = TRUE, sep = "\t");
Variable2  <- read.table("Variable2.txt",header = TRUE, sep = "\t");

Variable1=as.data.frame(Variable1)
Variable2=as.data.frame(Variable2)

librray(ggplot2)
map.world <- map_data("world")
gg <- ggplot()
gg <- gg + geom_raster(data=  Variable1, aes(  Variable1$V2,   
Variable1$V1,fill=  Variable1$V3 ))
gg <- gg + geom_raster(data=  Variable2, aes(  Variable2$V2,   
Variable2$V1,fill=  Variable2$V3 ))
gg <- gg  +scale_fill_gradientn(colours=jet.colors(7))
gg <- gg + geom_map(dat=map.world, map = map.world, aes(map_id=region), 
fill="NA", color="black",size=0.4)
gg <- gg + expand_limits(x = map.world$long, y = map.world$lat)
gg <- gg + theme(panel.grid=element_blank(), panel.border=element_blank())
gg <- gg + theme(axis.ticks=element_blank(), axis.text=element_blank())
gg <- gg + theme(legend.position="right",plot.title = element_text(size = 10, 
face = "bold"))
gg <- gg 
+theme(axis.title.x=element_blank())+theme(axis.title.y=element_blank())
gg <- gg+ coord_equal() 
gg 

You can get the data here

Answer 1

我通过将填充映射到非重叠区域来绕过ggplot 中的这个限制：

library(ggplot2)
library(scales)
library(gridExtra)
library(grid)

jet.colors <- colorRampPalette(c("#00007F", "blue", "#007FFF", "cyan", "#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000"))
YlOrBr <- c("#FFFFD4", "#FED98E", "#FE9929", "#D95F0E", "#993404")
Variable1 <- read.table("Variable1.txt",header = TRUE, sep = "\t");
Variable2  <- read.table("Variable2.txt",header = TRUE, sep = "\t");

Variable1=as.data.frame(Variable1)
Variable2=as.data.frame(Variable2)
Variable1$V3_rescale = rescale(Variable1$V3)
Variable2$V3_rescale = rescale(Variable2$V3)+100 # Map to non-overlapping range


map.world <- map_data("world")
gg <- ggplot() + 
  geom_raster(data= Variable1, aes(V2,V1,fill=V3_rescale)) +
  geom_raster(data=Variable2, aes(V2,V1,fill=V3_rescale)) + 
  scale_fill_gradientn(
    colours=c(jet.colors(7),YlOrBr),
    values = rescale(
      c(rescale(seq(from = min(Variable1$V3), # range for Variable 1
                    to = max(Variable1$V3),
                    length.out=7)),
        rescale(seq(from = min(Variable2$V3), # range for Variable 2
                    to = max(Variable2$V3),
                    length.out = length(YlOrBr)))+100)))

gg <- gg + geom_map(dat=map.world, map = map.world, aes(map_id=region), 
                    fill="NA", color="black",size=0.4)
gg <- gg + expand_limits(x = map.world$long, y = map.world$lat)
gg <- gg + theme(panel.grid=element_blank(), panel.border=element_blank())
gg <- gg + theme(axis.ticks=element_blank(), axis.text=element_blank())
gg <- gg + theme(legend.position="right",plot.title = element_text(size = 10, 
                                                                   face = "bold"))
gg <- gg +theme(axis.title.x=element_blank())+theme(axis.title.y=element_blank())
gg <- gg + coord_equal() + theme(legend.position = "none") # remove legend

为了添加图例，我修改了这篇帖子Inserting a table under the legend in a ggplot2 histogram的答案：

# Make plot with only Variable 1 to extract legend
Variable1_plot <- ggplot() + 
  geom_raster(data= Variable1, aes(V2,V1,fill=V3)) + 
  scale_fill_gradientn(colours = jet.colors(7)) + 
  guides(fill=guide_legend(title="Variable1"))

# Make plot with only Variable 2 to extract legend
Variable2_plot <- ggplot() + 
  geom_raster(data= Variable2, aes(V2,V1,fill=V3)) + 
  scale_fill_gradientn(colours = YlOrBr) + 
  guides(fill=guide_legend(title="Variable2"))

#Extract Legend
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_Variable1 <- g_legend(Variable1_plot)
legend_Variable2 <- g_legend(Variable2_plot)

grid.newpage()
vp1 <- viewport(width = 0.75, height = 1, x = 0.375, y = .5)
vpleg <- viewport(width = 0.25, height = 0.5, x = 0.85, y = 0.75)
subvp <- viewport(width = 0.3, height = 0.3, x = 0.85, y = 0.25)
print(gg, vp = vp1)
upViewport(0)
pushViewport(vpleg)
grid.draw(legend_Variable2)
#Make the new viewport active and draw
upViewport(0)
pushViewport(subvp)
grid.draw(legend_Variable1)