球面上地理数据的插值

4

我有一个数据集,其中包含每个地理位置的纬度/经度坐标和相应的0/1值(4到200个以上数据点)。现在,我想通过插值来填补空洞,并根据插值结果在地球表面上添加颜色。我的主要问题是如何“围绕地球”进行插值,因为目前我是在平面上进行插值,这显然行不通。

我的数据

set.seed(41)
n <- 5
s <- rbind(data.frame(lon = rnorm(n, 0, 180),
                      lat = rnorm(n, 90, 180),
                      value = 0),
           data.frame(lon = rnorm(n, 180, 180),
                      lat = rnorm(n, 90, 180),
                      value = 1))
s$lon <- s$lon %% 360 -180
s$lat <- s$lat %% 180 -90
s_old <- s

可视化数据点

library(sp)  
library(rgdal)
library(scales)
library(raster)
library(dplyr)

par(mfrow=c(2,1), mar=c(0,0,0,0))
grd <- expand.grid(lon = seq(-180,180, by = 20), 
                   lat = seq(-90, 90, by=10))
coordinates(grd) <- ~lon + lat
gridded(grd) <- TRUE
plot(grd, add=F, col=grey(.8))

coordinates(s) = ~lon + lat
points(s, col=s$value + 2, pch=16, cex=.6)

在此输入图片描述

平面内的二元插值

目前,使用akima包直接在经纬度坐标上进行二元样条插值。虽然该方法有效,但未考虑到经纬度坐标位于球体上的事实。

nx <- 361
ny <- 181
xo <- seq(-180, 179, len=nx)
yo <- seq(-90, 89, len=ny)
xy <- as.data.frame(coordinates(s))
int <- akima:::interp(x = xy$lon, y = xy$lat, z = s$value, 
                      extrap = T, 
                      xo = xo, yo = yo, 
                      nx = nx, ny=100, 
                      linear = F)
z <- int$z
# correct for out of range interpolations values
z[z < 0] <- 0
z[z > 1] <- 1

grd <- expand.grid(lon = seq(-180,180, by = 20), 
                   lat = seq(-90, 90, by=10))
coordinates(grd) <- ~lon + lat
gridded(grd) <- TRUE
plot(grd, add=F, col=grey(.8))

## create raster image
r <- raster(nrows=ny, ncols=nx, crs='+proj=longlat',
            xmn=-180, xmx=180, ymn=-90, ymx=90)
values(r) <- as.vector(z)  

# tweaking of color breaks
colors <- alpha(colorRampPalette(c("red", "yellow", "green"))(21), .4)
br <- seq(0.3, 0.7, len=20)
image(xo, yo, z, add = T, col = colors, breaks=c(-.1, br, 1.1))
points(s, col=s$value + 2, pch=16, cex=.6)

enter image description here

显然,这对于球体是不起作用的,因为左侧与右侧不匹配。在球体上,插值应该是无缝的。

enter image description here

我可以使用哪些方法在 R 中对球面进行插值?

1个回答

4
你可以自己计算点和网格之间的距离,然后使用自己的插值方法。例如,在你的数据示例中,下面是一个反距离插值。

生成数据

library(sp)
library(rgdal)

# Data
set.seed(41)
n <- 5
s <- rbind(data.frame(lon = rnorm(n, 0, 180),
                      lat = rnorm(n, 90, 180),
                      value = 0),
           data.frame(lon = rnorm(n, 180, 180),
                      lat = rnorm(n, 90, 180),
                      value = 1))
s$lon <- s$lon %% 360 -180
s$lat <- s$lat %% 180 -90
s_old <- s

创建栅格以进行网格插值

## create raster image
r <- raster(nrows=ny, ncols=nx, crs='+proj=longlat',
            xmn=-180, xmx=180, ymn=-90, ymx=90)

计算点与栅格之间的距离

库中的spDists函数在坐标未被投影时使用大圆距离。这意味着计算两点之间的距离是最短的。

# Distance between points and raster
s.r.dists <- spDists(x = coordinates(s), y = coordinates(r), longlat = TRUE)

使用反距离插值在球面上进行插值

在这里,我建议使用经典的反距离插值方法,采用2次幂(idp=2)。如果您想要其他次幂或者线性插值,或者只想利用有限数量的邻居进行插值,您可以自己修改计算方式。

# Inverse distance interpolation using distances
# pred = 1/dist^idp
idp <- 2
inv.w <- (1/(s.r.dists^idp))
z <- (t(inv.w) %*% matrix(s$value)) / apply(inv.w, 2, sum)

r.pred <- r
values(r.pred) <- z

然后绘制结果

# tweaking of color breaks
colors <- alpha(colorRampPalette(c("red", "yellow", "green"))(21), .4)
br <- seq(0.3, 0.7, len=20)
plot(r.pred, col = colors, breaks=c(-.1, br, 1.1), legend=F)
points(s, col=s$value + 2, pch=16, cex=.6)

Inverse distance interpolation on surface of a sphere (ipd=2)


一个问题:我该如何做到插值不会赋予单个点太大的权重,例如在一个绿色点周围有很多红点的情况下,该绿色点的插值值不应该是绿色的,而应该是红色或只是略带绿色,以显示该区域是红色的。请参见http://imgur.com/a/89CqF? - Mark Heckmann
1
在这种情况下,这将不是插值。使用插值时,距离很重要,因此当dist = 0时,预测几乎等于数据。您可以减少“idp”权重,但您想要的更多是模型而不是插值。我可以通过gam或glm将您带到我的其他答案:https://dev59.com/FKDia4cB1Zd3GeqPBlCw#43064436 然而,这并不能解决球面插值的问题。也许您可以将坐标从南北变换为立体投影,并在其上尝试模型?然后重新投影... - Sébastien Rochette

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接