随机森林、随机森林SRC或cforest中单个树的变量重要性？

Question

我正在尝试在R中找到一种方法，用于计算随机森林或条件随机森林中单棵树的变量重要性。

一个很好的起点是使用rpart:::importance命令，它可以计算用于rpart树的变量重要性的度量：

> library(rpart) 
> rp <- rpart(Kyphosis ~ Age + Number + Start, data = kyphosis)
> rpart:::importance(rp)
   Start      Age   Number 
8.198442 3.101801 1.521863

randomForest::getTree命令是从randomForest对象中提取树结构的标准工具，但它返回一个data.frame：

library(randomForest)
rf <- randomForest(Kyphosis ~ Age + Number + Start, data = kyphosis)
tree1 <- getTree(rf, k=1, labelVar=TRUE)
str(tree1)

'data.frame':   29 obs. of  6 variables:
$ left daughter : num  2 4 6 8 10 12 0 0 14 16 ...
$ right daughter: num  3 5 7 9 11 13 0 0 15 17 ...
$ split var     : Factor w/ 3 levels "Age","Number",..: 2 3 1 2 3 3 NA NA 3 1 ...
$ split point   : num  5.5 8.5 78 3.5 14.5 7.5 0 0 3.5 75 ...
$ status        : num  1 1 1 1 1 1 -1 -1 1 1 ...
erce$ prediction    : chr  NA NA NA NA ...

一个解决方案是使用as.rpart命令将tree1强制转换为rpart对象。不幸的是，我不知道在任何R包中都有这个命令。

使用party包时，我发现了一个类似的问题。 varimp命令适用于cforest对象，而不适用于单棵树。

library(party) 
cf <- cforest(Kyphosis ~ Age + Number + Start, data = kyphosis) 
ct <- party:::prettytree(cf@ensemble[[1]], names(cf@data@get("input"))) 
tree2 <- new("BinaryTree") 
tree2@tree <- ct 
tree2@data <- cf@data 
tree2@responses <- cf@responses 
tree2@weights <- cf@initweights
varimp(tree2)

Error in varimp(tree2) : 
   no slot of name "initweights" for this object of class "BinaryTree"

非常感谢您的帮助。

- Marco Sandri

---

我相信你需要手动编写一个函数。请注意，tree1可能是data.frame类别，但它不是您通常的数据框。它为树提供分类规则。 - alexwhitworth

rpart:::importance和randomForest:::importance的代码都很容易获取。 - alexwhitworth

Answer 1

从@Alex的建议开始，我开始研究party:::varimp。该命令用于计算cforest的标准（平均减少准确率）和条件变量重要性（VI），并且可以轻松修改以计算森林中每棵单独树的VI。

set.seed(12345)
y <- cforest(score ~ ., data = readingSkills,
       control = cforest_unbiased(mtry = 2, ntree = 10))

varimp_ctrees <- function (object, mincriterion = 0, conditional = FALSE,
threshold = 0.2, nperm = 1, OOB = TRUE, pre1.0_0 = conditional) {
    response <- object@responses
    if (length(response@variables) == 1 && inherits(response@variables[[1]], 
        "Surv")) 
        return(varimpsurv(object, mincriterion, conditional, 
            threshold, nperm, OOB, pre1.0_0))
    input <- object@data@get("input")
    xnames <- colnames(input)
    inp <- initVariableFrame(input, trafo = NULL)
    y <- object@responses@variables[[1]]
    if (length(response@variables) != 1) 
        stop("cannot compute variable importance measure for multivariate response")
    if (conditional || pre1.0_0) {
        if (!all(complete.cases(inp@variables))) 
            stop("cannot compute variable importance measure with missing values")
    }
    CLASS <- all(response@is_nominal)
    ORDERED <- all(response@is_ordinal)
    if (CLASS) {
        error <- function(x, oob) mean((levels(y)[sapply(x, which.max)] != 
            y)[oob])
    } else {
        if (ORDERED) {
            error <- function(x, oob) mean((sapply(x, which.max) != 
                y)[oob])
        } else {
            error <- function(x, oob) mean((unlist(x) - y)[oob]^2)
        }
    }
    w <- object@initweights
    if (max(abs(w - 1)) > sqrt(.Machine$double.eps)) 
        warning(sQuote("varimp"), " with non-unity weights might give misleading results")
    perror <- matrix(0, nrow = nperm * length(object@ensemble), 
        ncol = length(xnames))
    colnames(perror) <- xnames
    for (b in 1:length(object@ensemble)) {
        tree <- object@ensemble[[b]]
        if (OOB) {
            oob <- object@weights[[b]] == 0
        } else {
            oob <- rep(TRUE, length(y))
        }
        p <- .Call("R_predict", tree, inp, mincriterion, -1L, 
            PACKAGE = "party")
        eoob <- error(p, oob)
        for (j in unique(party:::varIDs(tree))) {
            for (per in 1:nperm) {
                if (conditional || pre1.0_0) {
                  tmp <- inp
                  ccl <- create_cond_list(conditional, threshold, 
                    xnames[j], input)
                  if (is.null(ccl)) {
                    perm <- sample(which(oob))
                  }  else {
                    perm <- conditional_perm(ccl, xnames, input, 
                      tree, oob)
                  }
                  tmp@variables[[j]][which(oob)] <- tmp@variables[[j]][perm]
                  p <- .Call("R_predict", tree, tmp, mincriterion, 
                    -1L, PACKAGE = "party")
                } else {
                  p <- .Call("R_predict", tree, inp, mincriterion, 
                    as.integer(j), PACKAGE = "party")
                }
                perror[(per + (b - 1) * nperm), j] <- (error(p, 
                  oob) - eoob)
            }
        }
    }
    perror <- as.data.frame(perror)
    return(list(MeanDecreaseAccuracy = colMeans(perror), VIMcTrees=perror))
}

VIMcTrees 是一个矩阵，它的行数等于森林树的数量，每个解释变量都有一列。该矩阵的 (i,j) 元素是第 i 棵树中第 j 个变量的 VI。

varimp_ctrees(y)$VIMcTrees

   nativeSpeaker       age  shoeSize
1       4.853855  30.06969 52.271824
2      15.740311  70.55825  5.409772
3      17.022082 113.86020  0.000000
4      22.003119  19.62134 50.634286
5       6.070659  28.58817 47.049866
6      16.508634 105.50321  2.302387
7      11.487349  31.80002 46.147677
8      19.250631  27.78282 43.589832
9      19.669478  98.73722  0.483079
10     11.748669  85.95768  5.812538

- Marco Sandri