如何在R

Question

我正在尝试使用this文章中的方法，使用R软件降低气候条件的规模。我快到了，但是我缺少几个步骤

所需的包装和数据

对于此示例，我将一些数据上传到archive.org网站以加载所需的程序包，此示例中使用的数据使用以下代码：

library(raster)
library(rgdal)

download.file("https://archive.org/download/Downscaling/BatPatagonia.rds", "Bat.rds")
download.file("https://archive.org/download/Downscaling/TempMinPatNow.rds", "Tmin.rds")

BatPatagonia <- readRDS("Bat.rds")
TempMinPatNow <- readRDS("Tmin.rds")

BatPatagonia是一个栅格文件，具有从GEBCO数据集中提取并转换后的测深图和该区域的海拔高度，而TempMinPatNow是从worldclim中提取的同一地区一月份的最低温度。下面显示了数据集的图：

这个问题的目标

为了缩小上一次冰川期以来的过去数据，我需要对海平面与过去相同的情况模拟当前的气候。为此，我使用了GEBCO数据，并弄清了沿海地区的多少。根据上面引用的文章中的方法，这是要执行的前三个步骤：

1. 为海拔20米以上的土地创建DEM
2. 在移动的窗口中计算多元线性回归
3. 将系数外推到海洋

第3点是我一直在努力做的事情，我将展示我如何完成前2点，并展示我一直在寻找解决第3点的方法

1。为海拔20米的土地创建DEM

为此，我拍摄了 BatPatagonia 栅格，并使用以下代码用NA值替换了20米以下的所有值：

Elev20 <- BatPatagonia

values(Elev20) <- ifelse(values(Elev20) <= 20, NA, values(Elev20))

生成的栅格如下图所示

2。在移动的窗口中计算多元线性回归

根据2591页的手稿，下一步是在移动窗口中使用以下公式对20米以上的海拔高度进行多元线性回归：

我们已经有高程数据，但是我们还需要用于纬度和经度的栅格，为此，我们使用以下代码，首先创建纬度和经度栅格：

Latitud <- BatPatagonia
Longitud <- BatPatagonia

data_matrix <- raster::xyFromCell(BatPatagonia, 1:ncell(BatPatagonia))

values(Latitud) <- data_matrix[, 2]
values(Longitud) <- data_matrix[, 1]

我们将其乘以海拔超过20米的区域的栅格蒙版，以便仅获得所需的值：

Elev20Mask <- BatPatagonia

values(Elev20Mask) <- ifelse(values(Elev20Mask) <= 20, NA, 1)

Longitud <- Elev20Mask*Longitud

Latitud <- Elev20Mask*Latitud

现在，我将使用响应变量和预测变量构建堆栈：

Preds <- stack(Elev20, Longitud, Latitud, TempMinPatNow)

names(Preds) <- c("Elev", "Longitud", "Latitud", "Tmin")

结果堆栈如下图所示：

如论文所述，移动窗口应为25 x 25单元格，总共625个单元格，但是他们指出，如果移动窗口的数据少于170个单元格，则不应执行回归，并且最多应包含624个像元，以确保我们仅对靠近海岸的区域建模。带有移动窗口的多次回归的结果应该是具有局部截距的堆栈，以及上面显示的公式中每个Beta的局部估计。我发现了如何使用getValuesFocal函数使用以下代码来实现此目的（此循环需要一段时间）：

# First we establish the 25 by 25 window

w <- c(25, 25)

# Then we create the empty layers for the resulting stack

intercept <- Preds[[1]]
intercept[] <- NA

elevationEst <- intercept

latitudeEst <- intercept

longitudeEst <- intercept

现在我们开始代码：

for (rl in 1:nrow(Preds)) {
  v <- getValuesFocal(Preds[[1:4]], row = rl, nrows = 1, ngb = w, array = FALSE)
  int <- rep(NA, nrow(v[[1]]))
  x1 <- rep(NA, nrow(v[[1]]))
  x2 <- rep(NA, nrow(v[[1]]))
  x3 <- rep(NA, nrow(v[[1]]))
  x4 <- rep(NA, nrow(v[[1]]))
  for (i in 1:nrow(v[[1]])) {
    xy <- na.omit(data.frame(x1 = v[[1]][i, ], x2 = v[[2]][i, ], x3 = v[[3]][i, 
                                                                         ], y = v[[4]][i, ]))

    if (nrow(xy) > 170 & nrow(xy) <= 624) {
      coefs <- coefficients(lm(as.numeric(xy$y) ~ as.numeric(xy$x1) + 
                             as.numeric(xy$x2) + as.numeric(xy$x3)))
      int[i] <- coefs[1]
      x1[i] <- coefs[2]
      x2[i] <- coefs[3]
      x3[i] <- coefs[4]
    } else {
      int[i] <- NA
      x1[i] <- NA
      x2[i] <- NA
      x3[i] <- NA
    }
  }

  intercept[rl, ] <- int
  elevationEst[rl, ] <- x1
  longitudeEst[rl, ] <- x2
  latitudeEst[rl, ] <- x3

  message(paste(rl, "of", nrow(Preds), "ready"))
}

Coeffs <- stack(intercept, elevationEst, latitudeEst, longitudeEst, (intercept + Preds$Elev * elevationEst + Preds$Longitud * longitudeEst + Preds$Latitud *latitudeEst), Preds$Tmin)

names(Coeffs) <- c("intercept", "elevationEst", "longitudeEst", "latitudeEst", "fitted", "Observed")

此循环的结果是coeffs堆栈，如下所示：

这是我被困住的地方：

将系数外推到海洋

现在的目标是将Coeffs堆栈的前4个栅格（截距，elevationEst，longitudeEst和latitudeEst）外推到海岸应根据最后一个冰浅最大值（浅120米）的位置

MaxGlacier <- BatPatagonia

values(MaxGlacier) <- ifelse(values(MaxGlacier) < -120, NA,1)

预计的海岸线如下图所示：

作者将系数投影到海岸的方式是通过使用NCAR中NCL语言的poisson_grid_fill解泊松方程来填补空白。但我想保持简单，并尝试使用相同的语言来做所有事情。我还在python中找到了类似的功能。

我对任何运行良好的推断过程都会感到满意，我并没有将搜索限制在该算法上。

我发现了几个可以填补空白的r软件包，例如Gapfill软件包，甚至还找到了一个review of methods可以填补空白，但是其中大多数用于插值，并且主要用于基于NDVI的层填充间隙的其他层。

关于如何向前推进的任何想法？

谢谢

Answer 1

让我回想起几十年前的物理本科时代，我们使用拉普拉斯松弛法来解决这类泊松方程问题。我不确定，但是我想这可能也是poisson_grid_fill的工作方式。这个过程很简单。弛豫是一个迭代过程，其中我们计算除形成边界条件的那些单元格以外的每个单元格作为水平或垂直相邻单元格的平均值，然后重复进行直到结果达到稳定解为止。

在您的情况下，您已经具有值的单元格提供了边界条件，我们可以遍历其他单元格。诸如此类（此处显示截距系数-您可以用相同的方式进行其他操作）：

gaps = which(is.na(intercept)[])
intercept.ext = intercept
w=matrix(c(0,0.25,0,0.25,0,0.25,0,0.25,0), nc=3, nr=3)
max.it = 1000
for (i in 1:max.it) intercept.ext[gaps] = focal(intercept.ext, w=w, na.rm=TRUE)[gaps]
intercept.ext = mask(intercept.ext, MaxGlacier)

修改

函数中嵌入了相同的过程，以演示如何使用while循环，直到达到所需的公差（或超过最大迭代次数）为止。请注意，此功能只是为了说明原理，并未针对速度进行优化。

gap.fill = function(r, max.it = 1e4, tol = 1e-2, verbose=FALSE) {
  gaps = which(is.na(r)[])
  r.filled = r
  w = matrix(c(0,0.25,0,0.25,0,0.25,0,0.25,0), nc=3, nr=3)
  i = 0
  while(i < max.it) {
    i = i + 1
    new.vals = focal(r.filled, w=w, na.rm=TRUE)[gaps]
    max.residual = suppressWarnings(max(abs(r.filled[gaps] - new.vals), na.rm = TRUE))
    if (verbose) print(paste('Iteration', i, ': residual = ', max.residual))
    r.filled[gaps] = new.vals
    if (is.finite(max.residual) & max.residual <= tol) break
  }
  return(r.filled)
}

intercept.ext = gap.fill(intercept)
intercept.ext = mask(intercept.ext, MaxGlacier)
plot(stack(intercept, intercept.ext))