terra::predict() 直接应用于 spatraster

Question

我在 R 中创建了一个随机森林模型，并希望使用 terra 中的 Predict() 函数将其应用于 spatraster 对象。我可以将栅格转换为数据帧，而不是直接在 spatraster 上进行预测，但是我的实际数据集太大了。

可重现的示例：

library(terra)
library(ranger)

# Set seed for reproducibility
set.seed(123)

# Create raster
r <- rast(ncols=95, nrows=90, nlyrs=5,
          xmin=5.74166666666667, xmax=6.53333333333333,
          ymin=49.4416666666667, ymax=50.1916666666667,
          names=c("band1","band2","band3","band4","band5"),
          crs='GEOGCRS[\"WGS 84\",DATUM[\"World Geodetic System 1984\",
          ELLIPSOID[\"WGS 84\",6378137,298.257223563,LENGTHUNIT[\"metre\",1]]],
          PRIMEM[\"Greenwich\",0,ANGLEUNIT[\"degree\",0.0174532925199433]],
          CS[ellipsoidal,2],AXIS[\"geodetic latitude (Lat)\",north,ORDER[1],
          ANGLEUNIT[\"degree\",0.0174532925199433]],AXIS[\"geodetic longitude (Lon)\",
          east,ORDER[2],ANGLEUNIT[\"degree\",0.0174532925199433]],ID[\"EPSG\",4326]]')

# Fill the raster with random values
r$band1 <- runif(n = ncell(r))
r$band2 <- init(r, "cell")
r$band3 <- sample(c(1:10), ncell(r), replace = T)
r$band4 <- sample(c(1:10), ncell(r), replace = T)
r$band5 <- sample(c(1:10), ncell(r), replace = T)


# Generate random coordinates within the raster extent
num_coordinates <- 5
raster_extent <- ext(r)
random_coords <- cbind(runif(num_coordinates, min(raster_extent[1]), max(raster_extent[2])),
                       runif(num_coordinates, min(raster_extent[3]), max(raster_extent[4])))

# Extract raster values for each set of coordinates
extracted_values <- extract(r, random_coords)
extracted_values$response <- as.factor(sample(c(1,2), nrow(extracted_values), replace = T))

# Model
rf_model <- ranger(response ~., data = extracted_values, num.trees = 500)

# Prediction
prediction <- predict(r, rf_model,  na.rm = TRUE)$predictions

我的原始代码：

sentinel_data <- terra::extract(sentinel_raster, chosen_locations, ID = F) 
train_data <- data.frame(as.factor(habitat_points), sentinel_data)  `
train_data <- na.omit(train_data)
rf_model <- ranger(habitat_points ~ ., data = train_data, num.trees = 500, classification = TRUE)

predictions <- predict(sentinel_raster, rf_model,  na.rm = TRUE)$predictions
# Error in out[[i]] <- data.frame(value = 1:length(out[[i]]), label = out[[i]]) :    more elements supplied than there are to replace`

# Although:
names(sentinel_raster) == names(train_data)[-1]
#[1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 

我尝试了不同类型的模型（例如 randomForest 包）、不同的栅格和坐标集。更奇怪的是，我运行了执行类似任务并且曾经运行的旧脚本，它们都会产生相同的错误。也许与 terra 最近的更新有关？ 任何帮助将不胜感激。

Answer 1

ranger::predict 的输出是一个列表。这不是我们所期望的。

p <- predict(rf_model, r[1:2])
str(p)
#List of 5
# $ predictions              : Factor w/ 1 level "1": 1 1
# $ num.trees                : num 500
# $ num.independent.variables: num 5
# $ num.samples              : int 2
# $ treetype                 : chr "Classification"
# - attr(*, "class")= chr "ranger.prediction"

您需要通过提供自定义预测函数来解决这个问题。

pfun <- \(...) {
    predict(...)$predictions
}

p <- predict(r, rf_model,  fun=pfun, na.rm = TRUE)