我有两个我想要映射的数据帧。 dfs具有相同的xy坐标,我需要一个单一颜色条,两个dfs都有一个可见的离散色标,就像这里显示的那样。我希望colorkey中的颜色与自定义的断点相匹配。可以在此示例之外应用的更通用的解决方案非常感谢
来自 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())
如何设置colorkey中的值以匹配地图上的值,如上面的示例地图所示?请注意,colorkey中的颜色数应与地图上显示的数字相同。
非常感谢你的帮助。您的建议将帮助我开发许多此类地图。
感谢。
答案 0 :(得分:4)
以下内容应该让你前进。使用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))