随机森林（ranger软件包）进行图像分类（栅格堆栈）

Question

随机森林（ranger软件包）进行图像分类（栅格堆栈）

9

我正在使用R包ranger拟合随机森林来对栅格图像进行分类。预测函数出现错误，下面提供一个可重现的示例。

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 对象包含多个与预测相关之外的元素。无论如何，如何使用 ranger 在栅格堆栈上进行预测？

- Hugo

如果你在ranger软件包的github存储库中打开一个问题，我认为你可以得到你的问题的答案。 - lampros

{btsdaf} - m-dz

4个回答

4

稍微调整一下：

pacman::p_load(raster, nnet, 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)  # predict(object, newdata, type = c("raw","class"), ...)

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

as.data.frame(as.matrix(r))可以实现！

免责声明：我没有检查输出的正确性，所以这可能根本不会产生任何结果，但是...

identical(iris$Species, ranger.pred$predictions)

- m-dz

谢谢 @m-dz 的回答，但是输出（即ranger.pred）不像应该是一个栅格。实际上，我正在使用这种方法：（1）将栅格转换为数据框，（2）对数据框的条目进行分类，然后（3）再次转换为栅格。不过，我担心这种方法在处理大型栅格时可能行不通？ - Hugo

很遗憾，我不知道这里的答案，但是predict.ranger肯定不能将栅格作为输入...也许情况不会那么糟糕？ - m-dz

2

如果有帮助的话，我使用randomForest而不是ranger也可以正常工作。

library(randomForest)
rf.model<-randomForest(Species ~ ., data=iris)   
rf.pred<-predict(r,rf.model)

- Antonios

1

谢谢@Antonis，但是ranger函数通过参数case.weights接受案例权重，这正是我感兴趣的。randomForest不支持。这就是为什么我使用ranger的原因。 - Hugo

1

这里可以找到另一个解决方案： https://github.com/imbs-hl/ranger/issues/319

如上所述，使用ranger随机森林模型的raster::predict()将无法工作，因为raster包不支持ranger。

用户mnwright提供了一种解决方法。您只需要在代码中添加一些内容即可使其正常工作：

ranger.pred<-predict(r,ranger.model, fun = function(model, ...) predict(model, ...)$predictions)

对我有用，现在对象 ranger.pred 应该是一个栅格图像。

- anplaceb

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- ABMoeller · Accepted Answer

编辑，2021年7月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()

您可以通过在caret包的train函数中训练ranger模型来对栅格数据进行预测：

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

然而，如果你想预测标准误差，这种方法就行不通了，因为train对象的预测函数不接受"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")
              )