带有随机森林的图像分类(光栅堆栈)(包裹护林员)

Question

我正在使用R包护林员对随机森林进行拟合以对光栅图像进行分类.预测函数产生错误,此后我提供了一个可重现的例子.

library(raster)
library(nnet)
library(ranger)
data(iris)

# put iris data into raster
r<-list()
for(i in 1:4){
  r[[i]]<-raster(nrows=10, ncols=15)
  r[[i]][]<-iris[,i]
}
r<-stack(r)
names(r)<-names(iris)[1:4]

# multinom (an example that works)
nn.model <- multinom(Species ~ ., data=iris, trace=F)
nn.pred<-predict(r,nn.model)

# ranger (doesn't work)
ranger.model<-ranger(Species ~ ., data=iris)   
ranger.pred<-predict(r,ranger.model)

给出的错误是

v [cells,]中的错误< - predv:矩阵上的下标数量不正确

虽然我的真实数据的错误是

p [-naind,]中的错误< - predv:要替换的项目数不是替换长度的倍数

我唯一想到的是,ranger.prediction对象包含了除感兴趣的预测之外的几个元素.无论如何,如何使用游侠在光栅堆栈上进行预测？

Answer 1

编辑，2021-07-15

有一个关于使用的问题clusterR，我找到了一种比我最初建议的更直接的方法。新代码与原始代码执行相同的操作，但方式更简单，并提供并行处理选项：

# First train the ranger model

ranger.model <- ranger(Species ~ .
                       , data = iris
                       , probability = TRUE  # This argument is needed for se
                       , keep.inbag = TRUE   # So is this one
                       )


# Create prediction function for clusterR

f_se <- function(model, ...) predict(model, ...)$se


# Predict se using clusterR
  
beginCluster(2)

map_se <- clusterR(r
                   , predict
                   , args = list(ranger.model
                                 , type = 'se'  # Remember to include this argument
                                 , fun = f_se
                                 )
                   )

endCluster()

原答案，2018-05-31

您可以通过在 caret 包的 train 函数中训练模型来从栅格堆栈上的 Ranger 模型运行预测：

library(caret)
ranger.model <- train(Species ~ ., data = iris, method = "ranger")  
ranger.pred <- predict(r, ranger.model)

但是，如果您想预测标准误差，这将不起作用，因为训练对象的预测函数不接受type = 'se'. 我通过使用本文档为此目的构建一个函数来解决这个问题：

https://cran.r-project.org/web/packages/raster/vignettes/functions.pdf

# Function to predict standard errors on a raster
predfun <- function(x, model, type, filename)
{
  out <- raster(x)
  bs <- blockSize(out)
  out <- writeStart(out, filename, overwrite = TRUE)
  for (i in 1:bs$n) {
    v <- getValues(x, row = bs$row[i], nrows = bs$nrows[i])
    nas <- apply(v, 1, function(x) sum(is.na(x)))
    p <- numeric(length = nrow(v))
    p[nas > 0] <- NA
    p[nas == 0] <- predict(object = model,
                           v[nas == 0,],
                           type = 'se')$se
    out <- writeValues(out, p, bs$row[i])
  }
  out <- writeStop(out)
  return(out)
}

# New ranger model 
ranger.model <- ranger(Species ~ .
                       , data = iris
                       , probability = TRUE
                       , keep.inbag  = TRUE
                       )
# Run predictions
se <- predfun(r
              , model = ranger.model
              , type  = "se"
              , filename = paste0(getwd(), "/se.tif")
              )