Отказ от ответственности:
Это ужасный ответ, или, возможно, пакет caret имеет ужасную реализацию этой конкретной проблемы.В любом случае это кажется подходящим для открытия вопроса или пожелания на их github , если он еще не существует (либо желание более разнообразных predict функций, либо исправление именования, используемого в object$finalModel)
Проблема (возникшая во втором испытании) проистекает из того, как пакет caret внутренне обрабатывает различные процедуры подбора, в основном ограничивая функцию предсказания для целей очистки и стандартизации.
Проблема:
Проблема двоякая.
-
predict.train не допускает интервалы прогнозирования / доверительной вероятности finalModel, содержащийся в выходных данных train(...), содержит формулу, которая имеет необычный формат.
Кажется, две проблемы связаны с форматированием train и использованием в predict.train.Сосредоточившись сначала на последней проблеме, это становится очевидным, если взглянуть на выходные данные из
formula(m$finalModel)
#`.outcome ~ `poly(hp, 2)1` + `poly(hp, 2)2`)
. Очевидно, что некоторое форматирование выполняется во время работы train, поскольку ожидаемый результат будет mpg ~ poly(hp, 2), в то время как выход имеетрасширил RHS (и добавил кавычки / теги) и изменил LHS.Поэтому было бы неплохо либо исправить формулу, либо использовать формулу.
Анализ того, как пакет caret использует это в функции predict.train, показывает фрагмент кода ниже для * 1037.* input
predict.formula
#output
--more code
if (!is.null(newdata)) {
if (inherits(object, "train.formula")) {
newdata <- as.data.frame(newdata)
rn <- row.names(newdata)
Terms <- delete.response(object$terms)
m <- model.frame(Terms, newdata, na.action = na.action,
xlev = object$xlevels)
if (!is.null(cl <- attr(Terms, "dataClasses")))
.checkMFClasses(cl, m)
keep <- match(row.names(m), rn)
newdata <- model.matrix(Terms, m, contrasts = object$contrasts)
xint <- match("(Intercept)", colnames(newdata),
nomatch = 0)
if (xint > 0)
newdata <- newdata[, -xint, drop = FALSE]
}
}
--more code
out <- predictionFunction(method = object$modelInfo,
modelFit = object$finalModel, newdata = newdata,
preProc = object$preProcess)
Для менее опытных пользователей R мы в основном видим, что model.matrix создается с нуля без использования вывода formula(m$finalModel) (мы можем использовать это!), ипозже вызывается некоторая функция для прогнозирования на основе m$finalModel.Изучение predictionFunction из того же пакета показывает, что эта функция просто вызывает m$modelInfo$predict(m$finalModel, newdata) (для нашего примера)
И наконец, просмотр m$modelInfo$predict показывает приведенный ниже фрагмент кода
m$modelInfo$predict
#output
function(modelFit, newdata, submodels = NULL) {
if(!is.data.frame(newdata))
newdata <- as.data.frame(newdata)
predict(modelFit, newdata)
}
Примечаниечто modelFit = m$finalModel и newdata сделаны с выводом выше.Также Обратите внимание , что вызов predict не позволяет указать interval = "confidence", что является причиной первой проблемы.
Устранение проблемы (сортировка):
Существует множество способов решения этой проблемы.Одним из них является использование lm(...) вместо train(...).Другой способ - использовать внутреннюю часть функции для создания объекта данных, который соответствует странной спецификации модели, поэтому мы можем использовать predict(m$finalModel, newdata = newdata, interval = "confidence") так, как ожидается.
Я выбрал последнее.
caretNewdata <- caretTrainNewdata(m, mtcars)
preds <- predict(m$finalModel, caretNewdata, interval = "confidence")
head(preds, 3)
#output
fit lwr upr
Mazda RX4 22.03708 20.74297 23.33119
Mazda RX4 Wag 22.03708 20.74297 23.33119
Datsun 710 24.21108 22.77257 25.64960
Функция представлена ниже.для всезнайки я в основном извлек процесс строительства model.matrix из predict.train, predictionFunction и m$modelInfo$predict.Я не буду обещать, что эта функция работает для общего использования каждой модели caret, но это место для начала.
caretTrainNewdata Функция:
caretTrainNewdata <- function(object, newdata, na.action = na.omit){
if (!is.null(object$modelInfo$library))
for (i in object$modelInfo$library) do.call("requireNamespaceQuietStop",
list(package = i))
if (!is.null(newdata)) {
if (inherits(object, "train.formula")) {
newdata <- as.data.frame(newdata)
rn <- row.names(newdata)
Terms <- delete.response(object$terms)
m <- model.frame(Terms, newdata, na.action = na.action,
xlev = object$xlevels)
if (!is.null(cl <- attr(Terms, "dataClasses")))
.checkMFClasses(cl, m)
keep <- match(row.names(m), rn)
newdata <- model.matrix(Terms, m, contrasts = object$contrasts)
xint <- match("(Intercept)", colnames(newdata),
nomatch = 0)
if (xint > 0)
newdata <- newdata[, -xint, drop = FALSE]
}
}
else if (object$control$method != "oob") {
if (!is.null(object$trainingData)) {
if (object$method == "pam") {
newdata <- object$finalModel$xData
}
else {
newdata <- object$trainingData
newdata$.outcome <- NULL
if ("train.formula" %in% class(object) &&
any(unlist(lapply(newdata, is.factor)))) {
newdata <- model.matrix(~., data = newdata)[,
-1]
newdata <- as.data.frame(newdata)
}
}
}
else stop("please specify data via newdata")
} else
stop("please specify data data via newdata")
if ("xNames" %in% names(object$finalModel) & is.null(object$preProcess$method$pca) &
is.null(object$preProcess$method$ica))
newdata <- newdata[, colnames(newdata) %in% object$finalModel$xNames,
drop = FALSE]
if(!is.null(object$preProcess))
newdata <- predict(preProc, newdata)
if(!is.data.frame(newdata) &&
!is.null(object$modelInfo$predict) &&
any(grepl("as.data.frame", as.character(body(object$modelInfo$predict)))))
newdata <- as.data.frame(newdata)
newdata
}