Часто я хочу выполнить кросс-проверку в наборе данных, который содержит некоторые фактор-переменные, и после запуска некоторое время процедура перекрестной проверки не выполняется с ошибкой: factor x has new levels Y
.
Например, используя пакет boot:
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) классы могут не отображаться как в учебных, так и в тестовых данных.
Есть два решения, которые spring:
- Сначала создайте подмножество данных, сначала выбрав один случайный образец каждого
factor level
, начиная с самого редкого класса (по частоте), а затем жадно удовлетворяя следующий редкий класс и так далее. Затем с помощьюcreateDataPartition
на остальной части набора данных и слияния результатов для создания нового набора данных поезда, который содержит всеlevels
. - Использование
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
)
}