r - 在不规则网格上绘制气候数据的正确方法

Question

我已经将这个问题作为在不规则网格问题上绘制数据的有效方法的一部分，但一般反馈是将原始问题拆分为更易于管理的块。因此，这个新问题。

我使用在不规则二维网格上组织的卫星数据，其维度是扫描线（沿轨道维度，即 Y 轴）和地面像素（跨轨道维度，即 X 轴）。每个中心像素的经纬度信息存储在辅助坐标变量中，以及四个角坐标对（经纬度坐标在 WGS84 参考椭球上给出）。

让我们构建一个玩具数据集，包含一个 12x10 的潜在不规则网格和相关的表面温度测量值。

library(pracma) # for the meshgrid function
library(ggplot2)

num_sl <- 12 # number of scanlines
num_gp <- 10 # number of ground pixels
l <- meshgrid(seq(from=-20, to=20, length.out = num_gp), 
              seq(from=30, to=60, length.out = num_sl))

lon <- l[[1]] + l[[2]]/10
lat <- l[[2]] + l[[1]]/10

data <- matrix(seq(from = 30, to = 0, length.out = num_sl*num_gp), 
               byrow = TRUE, nrow = num_sl, ncol = num_gp) +
  matrix(runif(num_gp*num_sl)*6, nrow = num_sl, ncol = num_gp)

df <- data.frame(lat=as.vector(lat), lon=as.vector(lon), temp=as.vector(data))

lon和数据包含我正在使用的原始产品中提供的lat中心像素坐标，存储为二维矩阵，其轴是 ground_pixel（X 轴）和扫描线（Y 轴）。data相同尺寸的矩阵包含我的测量值。然后我将这三个矩阵展平并将它们存储在数据框中。

我想在地图上绘制地面像素（作为四边形），并相应地填充温度测量值。

使用瓷砖我得到：

ggplot(df, aes(y=lat, x=lon, fill=temp)) + 
  geom_tile(width=2, height=2) +
  geom_point(size=.1) +
  borders('world', colour='gray50', size=.2) + 
  coord_quickmap(xlim=range(lon), ylim=range(lat)) +
  scale_fill_distiller(palette='Spectral') +
  theme_minimal()

但这不是我所追求的。我可以玩width并height让瓷砖相互“接触”，但当然这甚至不会接近我想要的目标，即在地图上绘制实际投影的地面像素。
例如，Python 的 xarray 可以根据像素中心坐标自动推断像素边界：

问题

有没有办法在 R 中实现相同的结果，即：从像素中心自动推断像素边界，并将像素绘制为地图上的填充多边形？也许使用sf包？

我可以在这个问题的答案中看到它已经完成，但我对使用的答案sf有点不清楚，因为它处理不同的投影和潜在的规则网格，而在我的情况下，我想我不必重新 -投影我的数据，此外，我的数据不在常规网格上。

如果这是不可能的，我想我可以在我的产品中使用像素边界信息，但如果这个问题被证明不容易解决，那么这可能是另一个问题的主题。

Answer 1

这是执行此操作的一种方法。可能有一些更简单的东西，但这有效。

首先，我将使用 raster 包来操作坐标。我在这里创建的栅格是“非常规”的，因为它们包含的值是位置数据。但是使用栅格而不是矩阵可以访问一些有用的函数，例如extend和，最有用的是，resample我将使用它的双线性插值函数来查找顶点

library(raster)
latr = raster(lat)
lonr = raster(lon)

find.vertices = function(m){
  r = raster(m)
  vertices = raster(matrix(nrow = dim(r)[1]+1, ncol = dim(r)[2]+1))
  x = extend(r, c(1,1))
  x[1,] = 2*x[2,] - x[3,]
  x[dim(x)[1],] = 2*x[dim(x)[1]-1,] - x[dim(x)[1]-2,]
  x[,1] = 2*x[,2] - x[,3]
  x[,dim(x)[2]] = 2*x[,dim(x)[2]-1] - x[,dim(x)[2]-2,]
  extent(vertices) = extent(r) + res(r)
  vertices = resample(x, vertices)
}

latv = find.vertices(lat)
lonv = find.vertices(lon)
df2 = data.frame(xc = lonv[], yc = latv[])

让我们绘制这些顶点以检查我们是否在轨道上：

ggplot(df, aes(y=lat, x=lon, fill=temp)) + 
  geom_tile(width=2, height=2) +
  geom_point(size=.1) +
  geom_point(aes(xc, yc), data=df2, inherit.aes =F) +
  borders('world', colour='gray50', size=.2) + 
  coord_quickmap(xlim=range(lon), ylim=range(lat)) +
  scale_fill_distiller(palette='Spectral') +
  theme_minimal()

现在我们Polygon从这些顶点 创建一些

nx = NCOL(latv)
ny = NROW(lonv)
polys = list()
for (i in 1:length(data)) {
  x = col(data)[i]
  y = row(data)[i]
  polys[[i]] = Polygon(cbind(
      lonv[c((x-1)*ny + y, (x-1)*ny + y + 1, x*ny + y + 1, x*ny + y, (x-1)*ny + y)], 
      latv[c((x-1)*ny + y, (x-1)*ny + y + 1, x*ny + y + 1, x*ny + y, (x-1)*ny + y)]
    ))
}

将列表Polygon转换为SpatialPolygonsDataFrame

Polys = sapply(1:length(polys), function(i) Polygons(polys[i], i))
SPolys = sapply(1:length(polys), function(i) SpatialPolygons(Polys[i], i))
SPolys = do.call(bind, SPolys)
SPolysdf = SpatialPolygonsDataFrame(SPolys, data.frame(data=as.vector(data)))

要在 ggplot 中绘制此对象，我们需要转换为常规的data.frame. 传统上，大多数人都使用fortify过这个。但是 ggplot 文档警告说这可能会被弃用，并建议使用 broom 包。我对扫帚不太熟悉，但我决定像这样遵循这个建议：

library(broom)
ggSPolysdf = tidy(SPolysdf)
ggSPolysdf = cbind(ggSPolysdf, data = rep(as.vector(data), each=5))

最后我们可以绘制：

ggplot(df, aes(y=lat, x=lon, fill=temp)) + 
  geom_polygon(aes(long,lat,fill=data, group = id), data=ggSPolysdf) +
  borders('world', colour='gray50', size=.2) + 
  coord_quickmap(xlim=range(lon), ylim=range(lat)) +
  scale_fill_distiller(palette='Spectral') +
  theme_minimal()

Answer 2

下面的解决方案基本上使用了来自@dww 的答案，并进行了一些似乎是获取数据所必需的更改（至少在我的平台上）。这些变化首先与定义上图中“倾斜像素”的多边形的定义有关；其次，关于如何将多边形压缩成数据框的问题。对于第二个问题，sf使用了 @SymbolixAU 建议的包。

library(raster)
latr = raster(lat)
lonr = raster(lon)

find.vertices = function(m){
 r = raster(m)
 vertices = raster(matrix(nrow = dim(r)[1]+1, ncol = dim(r)[2]+1))
 x = extend(r, c(1,1))
 x[1,] = 2*x[2,] - x[3,]
 x[dim(x)[1],] = 2*x[dim(x)[1]-1,] - x[dim(x)[1]-2,]
 x[,1] = 2*x[,2] - x[,3]
 x[,dim(x)[2]] = 2*x[,dim(x)[2]-1] - x[,dim(x)[2]-2,]
 extent(vertices) = extent(r) + res(r)
 vertices = resample(x, vertices)
}

latv = find.vertices(lat)
lonv = find.vertices(lon)
df2 = data.frame(xc = lonv[], yc = latv[])

让我们绘制这些顶点以检查我们是否在轨道上：

ggplot(df, aes(y=lat, x=lon, fill=temp)) + 
  geom_tile(width=2, height=2) +
  geom_point(size=.1) +
  geom_point(aes(xc, yc), data=df2, inherit.aes=F) +
  borders('world', colour='gray50', size=.2) + 
  coord_quickmap(xlim=range(lon), ylim=range(lat)) +
  scale_fill_distiller(palette='Spectral') +
  theme_minimal()

现在我们从这些顶点创建多边形：

nx = NCOL(latv)

polys = list()
for (i in 1:length(data)) {
  x = col(data)[i]
  y = row(data)[i]

  polys[[i]] = Polygon(cbind(
      lonv[c((y-1)*nx + x, (y-1)*nx + x + 1, y*nx + x + 1, y*nx + x, (y-1)*nx + x)], 
      latv[c((y-1)*nx + x, (y-1)*nx + x + 1, y*nx + x + 1, y*nx + x, (y-1)*nx + x)]
    ))
}

将多边形列表转换为 SpatialPolygonsDataFrame：

Polys = sapply(1:length(polys), function(i) Polygons(polys[i], i))
SPolys = sapply(1:length(polys), function(i) SpatialPolygons(Polys[i], i))
SPolys = do.call(bind, SPolys)
SPolysdf = SpatialPolygonsDataFrame(SPolys, data.frame(data=as.vector(data)))

使用fortify转换为数据框将通过以下两行完成：（警告：如@dww所述，ggplot2文档不推荐此解决方案。）

ggSPolysdf_0 = fortify(SPolysdf)
ggSPolysdf = cbind(ggSPolysdf_0, data = rep(as.vector(data), each=5))

另一种方法是使用sf包。在下面的代码中，该命令st_coordinates扮演了fortifyin的角色ggplot2。请注意，使用本方法，变量的名称在转换中丢失，需要手动恢复：

library(sf)
sfSPolys = st_as_sf(SPolysdf)
coord_xy_SPolys = st_coordinates(sfSPolys)
coord_xyz_SPolys = cbind(coord_xy_SPolys, data = rep(as.vector(data), each=5))
ggSPolysdf = as.data.frame(coord_xyz_SPolys)
colnames(ggSPolysdf) <- c("long", "lat", "piece", "id", "data")

最后我们可以绘制：

ggplot(df, aes(y=lat, x=lon, fill=temp)) + 
  geom_polygon(mapping=aes(long,lat,fill=data, group=id), data=ggSPolysdf) +
  borders('world', colour='gray50', size=.2) + 
  coord_quickmap(xlim=range(lon), ylim=range(lat)) +
  scale_fill_distiller(palette='Spectral') +
  theme_minimal()