Часто я хочу выполнить перекрестную проверку для набора данных, который содержит некоторые факторные переменные, и после некоторого запуска подпрограмма перекрестной проверки завершается с ошибкой: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) классы могут не отображаться как в данных обучения, так и в тестовых данных.

На ум приходят два решения:

Сначала создайте подмножество данных, выбрав одну случайную выборку каждогоfactor level сначала, начиная с самого редкого класса (по частоте), а затем жадно удовлетворяя следующий редкий класс и так далее. Затем с помощьюcreateDataPartition на остальной части набора данных и слияния, что приводит к созданию новогопоезд набор данных, который содержит всеlevels.С помощьюcreateDataPartitions и и делает выборку отклонения.

$24ботинок25$

В идеале я хотел бы решение, котороепросто работает для создания разделов и неудачрано если нет возможности создать такие разделы.

Есть фундаментальная теоретическая причина, почему пакеты не предлагают это? Они предлагают это, а я просто не смог их заметить из-за слепого пятна? Есть ли лучший способ сделать эту стратифицированную выборку?

Пожалуйста, оставьте комментарий, если я должен задать этот вопрос на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
        )
}