使用partykit构建强制拆分分类树时遇下标越界错误求助

问题背景 #

我需要构建一棵分类树，要求首次拆分必须基于分类变量split.variable，预测目标为分类变量target。数据特征如下：

• 当split.variable=1时，target只能是1
• 当split.variable=0时，target可为0或1

数据交叉表：

> table(training_set$target, training_set$split.variable)
     0  1
  0 69  0
  1 59 56

当前实现与报错 #

我成功创建了tr1和tr2（tr3因数据无有效拆分报错，已忽略），代码如下：

tr1 <- ctree(target ~ split.variable,     data = training_set, maxdepth = 1) # 首次拆分基于split.variable
tr2 <- ctree(target ~ split.variable + ., data = training_set,  # 构建左分支模型
             subset = predict(tr1, type = "node") == 2)

fix_ids <- function(x, startid = 1L) {
  id <- startid - 1L
  new_node <- function(x) {
    id <<- id + 1L
    if(is.terminal(x)) return(partynode(id, info = info_node(x)))
    partynode(id,
              split = split_node(x),
              kids = lapply(kids_node(x), new_node),
              surrogates = surrogates_node(x),
              info = info_node(x))
  }
  
  return(new_node(x))   
}

no <- node_party(tr1)
no$kids <- list(
  fix_ids(node_party(tr2), startid = 2L)
  #, fix_ids(node_party(tr3), startid = 5L) # 因数据问题注释
)
# 节点结构可视化输出：
# [1] root
# |   [2] V2 <= 1
# |   |   [3] V15 <= -2.489 *
# |   |   [4] V15 > -2.489 *

mdf <- model.frame(target ~ split.variable + ., data = training_set)
tr <- party(no, 
            data = mdf,
            fitted = data.frame(
              "(fitted)" = fitted_node(no, data = mdf),
              "(response)" = model.response(mdf),
              check.names = FALSE),
            terms = terms(mdf), )

运行party(...)时出现以下错误：

Error in kids_node(node)[[i]] : subscript out of bounds

调用栈信息：

8: is.terminal(node)
7: fitted_node(kids_node(node)[[i]], data, vmatch, obs[indx], perm)
6: fitted_node(no, data = mdf)
5: data.frame(`(fitted)` = fitted_node(no, data = mdf), `(response)` = model.response(mdf), 
       check.names = FALSE)
4: party(no, data = mdf, fitted = data.frame(`(fitted)` = fitted_node(no, 
       data = mdf), `(response)` = model.response(mdf), check.names = FALSE), 
       terms = terms(mdf), )
3: .is.positive.intlike(x)
2: .traceback(x, max.lines = max.lines)
1: traceback(party(no, data = mdf, fitted = data.frame(`(fitted)` = fitted_node(no, 
       data = mdf), `(response)` = model.response(mdf), check.names = FALSE), 
       terms = terms(mdf), ))

求助需求 #

不确定该错误是否与缺失分支、mlr包依赖、数据特性有关，希望得到解决思路。

内容的提问来源于stack exchange，提问作者Nico