R:对具有因子的数据集进行交叉验证

Question

通常,我想对包含一些因子变量的数据集运行交叉验证,并且在运行一段时间后,交叉验证例程失败并出现错误:factor x has new levels Y.

例如,使用包启动:

library(boot)
d <- data.frame(x=c('A', 'A', 'B', 'B', 'C', 'C'), y=c(1, 2, 3, 4, 5, 6))
m <- glm(y ~ x, data=d)
m.cv <- cv.glm(d, m, K=2) # Sometimes succeeds
m.cv <- cv.glm(d, m, K=2)
# Error in model.frame.default(Terms, newdata, na.action = na.action, xlev = object$xlevels) : 
#   factor x has new levels B

---

更新:这是一个玩具示例.同样的问题也出现在较大的数据集中,其中有几次出现级别,C但它们都不存在于训练分区中.

---

createDataPartition包caret中的函数函数对结果变量进行分层抽样并正确警告:

此外,对于'createDataPartition',非常小的类大小(<= 3),类可能不会出现在训练和测试数据中.

我想到两种解决方案:

1. 首先,通过factor level从最稀有的类(按频率)开始选择每个第一个的随机样本来创建数据的子集,然后贪婪地满足下一个稀有类等等.然后使用createDataPartition其余数据集并合并结果以创建包含所有数据集的新训练数据集levels.
2. 使用createDataPartitions和做拒绝采样.

到目前为止,由于数据大小的原因,选项2对我有用,但我不禁认为必须有一个比推出一个更好的解决方案.

理想情况下,我想要一个只适用于创建分区的解决方案,如果无法创建这样的分区,则需要提前失败.

是否有一个基本的理论上的原因,为什么包不提供这个？他们是否提供它而我因为盲点而无法发现它们？有没有更好的方法来进行这种分层抽样？

如果我应该在stats.stackoverflow.com上提出这个问题,请发表评论.

---

更新:

这就是我的手推出解决方案(2)的样子:

get.cv.idx <- function(train.data, folds, factor.cols = NA) {

    if (is.na(factor.cols)) {
        all.cols        <- colnames(train.data)
        factor.cols     <- all.cols[laply(llply(train.data[1, ], class), function (x) 'factor' %in% x)]
    }

    n                   <- nrow(train.data)
    test.n              <- floor(1 / folds * n)

    cond.met            <- FALSE
    n.tries             <- 0

    while (!cond.met) {
        n.tries         <- n.tries + 1
        test.idx        <- sample(nrow(train.data), test.n)
        train.idx       <- setdiff(1:nrow(train.data), test.idx)

        cond.met        <- TRUE

        for(factor.col in factor.cols) {
            train.levels <- train.data[ train.idx, factor.col ]
            test.levels  <- train.data[ test.idx , factor.col ]
            if (length(unique(train.levels)) < length(unique(test.levels))) {
                cat('Factor level: ', factor.col, ' violated constraint, retrying.\n')
                cond.met <- FALSE
            }
        }
    }

    cat('Done in ', n.tries, ' trie(s).\n')

    list( train.idx = train.idx
        , test.idx  = test.idx
        )
}

Answer 1

每个人都同意确保有一个最佳解决方案.但就个人而言,我只想try在cv.glm呼叫,直到它的工作原理使用while.

m.cv<- try(cv.glm(d, m, K=2)) #First try
class(m.cv) #Sometimes error, sometimes list
while ( inherits(m.cv, "try-error") ) {
m.cv<- try(cv.glm(d, m, K=2))
}
class(m.cv) #always list

我已经在data.fame中尝试了100,000行,它只需要几秒钟.

library(boot)
n <-100000
d <- data.frame(x=c(rep('A',n), rep('B', n), 'C', 'C'), y=1:(n*2+2))
m <- glm(y ~ x, data=d)

m.cv<- try(cv.glm(d, m, K=2))
class(m.cv) #Sometimes error, sometimes list
while ( inherits(m.cv, "try-error") ) {
m.cv<- try(cv.glm(d, m, K=2))
}
class(m.cv) #always list