离散颜色比例的栅格地图，用于负值和正值R。

Question

离散颜色比例的栅格地图，用于负值和正值R。

5

我有两个数据框，我想将它们映射。这些数据框具有相同的xy坐标，并且我需要一个单一的colorbar，其中包含可见的离散颜色比例尺，用于两个dfs，就像这里显示的那样。我希望颜色键中的颜色与自定义断点匹配。非常感谢提供一个更通用的解决方案，可以应用于此示例之外。

我需要的是RcolorBrewer软件包中的RdYIBu调色板。

我的代码到目前为止：

library(rasterVis)
ras1 <- raster(nrow=10,ncol=10) 
set.seed(1) 
ras1[] <- rchisq(df=10,n=10*10) 
ras2=ras1*(-1)/2 
s <- stack(ras1,ras2) 
Uniques <- cellStats(s,stat=unique) 
Uniques.max <- max(Uniques)
Uniques.min <- min(Uniques)
my.at <- round(seq(ceiling(Uniques.max), floor(Uniques.min), length.out= 10),0)
myColorkey <- list(at=my.at, labels=list(at=my.at)) 
levelplot(s, at=my.at, colorkey=myColorkey,par.settings=RdBuTheme())

如何将色键中的值设置为与上面示例地图上显示的值相匹配的值？请注意，色键中的颜色数量应与地图上显示的颜色数量相同。

非常感谢您的帮助。您的建议将帮助我开发许多类似的地图。

谢谢。

- code123

你尝试过这个吗？：http://oscarperpinan.github.io/rastervis/FAQ.html#sec-1 - Oscar Perpiñán

@OscarPerpiñán 来自常见问题解答中的代码片段

ras1 <- raster(nrow=10,ncol=10) set.seed(1) ras1[] <- rchisq(df=10,n=10*10) ras2=ras1*(-1)/2 s <- stack(ras1,ras2) Uniques <- cellStats(s,stat=unique) Uniques.max <- max(Uniques),Uniques.min <- min(Uniques) my.at <- round(seq(ceiling(Uniques.max), floor(Uniques.min), length.out= 10),0); myColorkey <- list(at=my.at, labels=list(at=my.at))                       levelplot(s, at=my.at, colorkey=myColorkey,par.settings=RdBuTheme())

但是你会发现，与我展示的示例地图上标注的不同，0并不在正确的位置上。我该怎么解决这个问题呢？非常感谢。 - code123

在注释中，您可以使用分号（;）在语句之间，以便您的代码可以运行。 - Robert Hijmans

@RobertH 感谢您的有用编辑。这个问题的一些答案可以在这里找到[https://dev59.com/5ZHea4cB1Zd3GeqPlSe5]。 - code123

ggplot2 更适合这个需求（使用 facet_wrap 或 facet_grid），感兴趣吗？ - shekeine

@Shekeine 我肯定有兴趣。请帮忙提供你的解决方案。谢谢。 - code123

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- shekeine · Accepted Answer

以下内容将帮助你开始。借助ggplot2文档和众多在线示例，您应该能够轻松调整美学效果，使其完全符合您的要求，毫无困难。干杯。

#Order breaks from lowest to highest
  my_at <- sort(my_at)

#Get desired core colours from brewer
  cols0 <- brewer.pal(n=length(my_at), name="RdYlBu")

#Derive desired break/legend colours from gradient of selected brewer palette
  cols1 <- colorRampPalette(cols0, space="rgb")(length(my_at))

#Convert raster to dataframe
  df <- as.data.frame(s, xy=T)
  names(df) <- c("x", "y", "Epoch1", "Epoch2")

#Melt n-band raster to long format
  dfm <- melt(df, id.vars=c("x", "y"), variable.name="epoch", value.name="value")

#Construct continuous raster plot without legend
  #Note usage of argument `values` in `scale_fill_gradientn` -
  #-since your legend breaks are not equi-spaced!!!
  #Also note usage of coord_equal()
  a  <- ggplot(data=dfm, aes(x=x, y=y)) + geom_raster(aes(fill=value)) + coord_equal()+
        facet_wrap(facets=~epoch, ncol=1) + theme_bw() + 

        scale_x_continuous(expand=c(0,0))+
        scale_y_continuous(expand=c(0,0))+
        scale_fill_gradientn(colours=cols1,
                             values=rescale(my_at),
                             limits=range(dfm$value),
                             breaks=my_at) +
        theme(legend.position="none", panel.grid=element_blank())

#Make dummy plot discrete legend whose colour breaks go along `cols1`
  df_leg <- data.frame(x=1:length(my_at), y=length(my_at):1, value=my_at)
  gg_leg <- ggplot(data=df_leg, aes(x=x, y=y)) + geom_raster(aes(fill=factor(value))) +
            scale_fill_manual(breaks=my_at, values=cols1,
                              guide=guide_legend(title="",
                                                 label.position="bottom")) +
            theme(legend.position="bottom")

#Extract discrete legend from dummy plot
  tmp <- ggplot_gtable(ggplot_build(gg_leg))
  leg <- which(sapply(tmp$grobs, function(x) x$name)=="guide-box")
  legend <- tmp$grobs[[leg]]

#Combine continuous plot of your rasters with the discrete legend
  grid.arrange(a, legend, ncol=1, heights=c(4, 0.8))