R语言 使用ggplot2的舍入全局栅格Map

vq8itlhq  于 2023-02-17  发布在  其他
关注(0)|答案(2)|浏览(150)

我想做一个全球光栅Map在圆形(波多野投影)。我有光栅从ERA5数据是在GCS坐标系。
我应用了以下代码:

library(raster) 
library(ggplot2) 
library(viridis) 
library(tidyterra) 
library(terra) 
setwd("C:/Users/usman/Desktop/a") 
r= raster("SH.tif") 
p = projectRaster(r, crs = "+proj=hatano",method = "bilinear")
g = graticule(60, 45, "+proj=hatano") 
plot(g, background="azure", mar=c(.2,.2,.2,4), lab.cex=0.5, col="light gray") 
myplot = plot(p, add=TRUE, axes=FALSE, plg=list(shrink=.8), col=viridis(25)) 
ggsave("tile_plot2.png", plot=myplot, height=4, width=6.5, dpi=150)`

我的输出是

不过,我想要这个

部分代码和参考图像取自以下线程R ggplot plotting map raster with rounded shape - How to remove data outside projected area?
此外,当我试图保存使用一个空白文件生成.

sqserrrh

sqserrrh1#

下面是一个可重现的示例

library(terra)
library(geodata)
library(viridis)

tavg <- worldclim_global("tavg", 10, ".")
tavg <- mean(tavg)
tavg <- project(tavg, "+proj=hatano", mask=TRUE)

g <- graticule(60, 45, "+proj=hatano")

plot(g, background="azure", mar=c(.2,.2,.2,4), lab.cex=0.5, col="light gray")
plot(tavg, add=TRUE, axes=FALSE, plg=list(shrink=.8), col=viridis(25))

如果您想将其保存为png文件,可以执行以下操作

png("test.png", 1000, 450, pointsize=24)
plot(g, background="azure", mar=c(.2,.2,.2,4), lab.cex=0.5, col="light gray")
plot(tavg, add=TRUE, axes=FALSE, plg=list(shrink=.8), col=viridis(25))
dev.off()

需要记住的一件事是,您需要调整画布的大小,以匹配您正在制作的Map的大小。
您的问题和代码不是很清楚,您提到了ggplot2,但您没有使用它,如何使用ggplot2执行上述操作请参见original post
在应使用terra::project的位置使用raster::projectRaster。创建经纬网但未使用。

jljoyd4f

jljoyd4f2#

我对此的看法是,由于某种原因,ggplot2在标记+proj=hatano的轴时工作得特别糟糕(世界Map的ggplot2轴标记特别混乱,请参见this question),所以我需要手动将它们放置在经纬网的起点(使用lwgeom::st_startpoint()计算:

library(terra)
library(tidyterra)
library(ggplot2)
library(geodata)
# For graticules, etc
library(sf)

r <- worldclim_global("tavg", 10, ".") |>
  mean() |>
  # Crop
  project("+proj=hatano", mask = TRUE)

# Discretize for better plotting after projection
g <- st_graticule(ndiscr = 500) |> st_transform(st_crs(r))
border <- st_graticule() |>
  st_bbox() |>
  st_as_sfc() |>
  st_transform(3857) |>
  st_segmentize(500000) |>
  st_transform(st_crs(r)) |>
  st_cast("POLYGON")

# Get label placement,
# This is the hardest part
library(dplyr)
labels_x_init <- g %>%
  filter(type == "N") %>%
  mutate(lab = paste0(degree, "°"))

labels_x <- st_as_sf(st_drop_geometry(labels_x_init), lwgeom::st_startpoint(labels_x_init))

labels_y_init <- g %>%
  filter(type == "E") %>%
  mutate(lab = paste0(degree, "°"))

labels_y <- st_as_sf(st_drop_geometry(labels_y_init), lwgeom::st_startpoint(labels_y_init))

# Plot
ggplot() +
  geom_sf(data = border, fill = "azure", color = "lightgray", linewidth = 1) +
  geom_sf(data = g, color = "lightgray") +
  geom_spatraster(data = r) +
  scale_fill_whitebox_c(palette = "viridi") +
  geom_sf_text(data = labels_x, aes(label = lab), nudge_x = -1000000, size = 3) +
  geom_sf_text(data = labels_y, aes(label = lab), nudge_y = -1000000, size = 3) +
  theme_void() +
  labs(x = "", y = "", fill = "Temp")

相关问题