Как настроить модель в CARET для выполнения двухэтапной модели классификации PLS-[Classifer]?

Если вы хотите, чтобы эти типы моделей соответствовали caret, вам нужно будет использовать последнюю версию на CRAN. Последнее обновление было создано для того, чтобы люди могли использовать нестандартные модели по своему усмотрению.

Мой подход, описанный ниже, заключается в том, чтобы объединить PLS и другую модель (я использовал случайный лес в приведенном ниже примере) и настроить их одновременно. Таким образом, для каждой складки используется 2D-сетка из ncomp и mtry.

«Хитрость» заключается в том, чтобы привязать загрузки PLS к объекту случайного леса, чтобы их можно было использовать во время прогнозирования. Вот код, определяющий модель (только классификация):

 modelInfo <- list(label = "PLS-RF",
              library = c("pls", "randomForest"),
              type = "Classification",
              parameters = data.frame(parameter = c('ncomp', 'mtry'),
                                      class = c("numeric", 'numeric'),
                                      label = c('#Components', 
                                                '#Randomly Selected Predictors')),
              grid = function(x, y, len = NULL) {
                grid <- expand.grid(ncomp = seq(1, min(ncol(x) - 1, len), by = 1),
                            mtry = 1:len)
                grid <- subset(grid, mtry <= ncomp)
                },
              loop = NULL,
              fit = function(x, y, wts, param, lev, last, classProbs, ...) { 
                     ## First fit the pls model, generate the training set scores,
                     ## then attach what is needed to the random forest object to 
                     ## be used later
                     pre <- plsda(x, y, ncomp = param$ncomp)
                     scores <- pls:::predict.mvr(pre, x, type = "scores")
                     mod <- randomForest(scores, y, mtry = param$mtry, ...)
                     mod$projection <- pre$projection
                     mod
                   },
                   predict = function(modelFit, newdata, submodels = NULL) {       
                     scores <- as.matrix(newdata)  %*% modelFit$projection
                     predict(modelFit, scores)
                   },
                   prob = NULL,
                   varImp = NULL,
                   predictors = function(x, ...) rownames(x$projection),
                   levels = function(x) x$obsLevels,
                   sort = function(x) x[order(x[,1]),])

и вот вызов train:

 library(ChemometricsWithR)
 data(prostate)

 set.seed(1)
 inTrain <- createDataPartition(prostate.type, p = .90)
 trainX <-prostate[inTrain[[1]], ]
 trainY <- prostate.type[inTrain[[1]]]
 testX <-prostate[-inTrain[[1]], ]
 testY <- prostate.type[-inTrain[[1]]]

 ## These will take a while for these data
 set.seed(2)
 plsrf <- train(trainX, trainY, method = modelInfo,
                preProc = c("center", "scale"),
                tuneLength = 10,
                trControl = trainControl(method = "repeatedcv",
                                         repeats = 5))

 ## How does random forest do on its own?
 set.seed(2)
 rfOnly <- train(trainX, trainY, method = "rf",
                tuneLength = 10,
                trControl = trainControl(method = "repeatedcv",
                                         repeats = 5))

Ради интереса я получил:

 > getTrainPerf(plsrf)
   TrainAccuracy TrainKappa method
 1     0.7940423    0.65879 custom
 > getTrainPerf(rfOnly)
   TrainAccuracy TrainKappa method
 1     0.7794082  0.6205322     rf

а также

 > postResample(predict(plsrf, testX), testY)
  Accuracy     Kappa 
 0.7741935 0.6226087 
 > postResample(predict(rfOnly, testX), testY)
  Accuracy     Kappa 
 0.9032258 0.8353982 

Максимум

Основываясь на ценных комментариях Макса, я почувствовал необходимость иметь рефери IRIS, который известен своей классификацией, и, что более важно, результат Species имеет более двух классов, что было бы хорошим набором данных для проверки Пользовательская модель PLS-LDA в каретке:

data(iris)
names(iris)
head(iris)
dim(iris) # 150x5
set.seed(1)
inTrain <- createDataPartition(y = iris$Species,
                               ## the outcome data are needed
                               p = .75,
                               ## The percentage of data in the
                               ## training set
                               list = FALSE)
## The format of the results
## The output is a set of integers for the rows of Iris
## that belong in the training set.
training <- iris[ inTrain,] # 114
testing <- iris[-inTrain,] # 36

ctrl <- trainControl(method = "repeatedcv",
                     repeats = 5,
                     classProbs = TRUE)
set.seed(2)
plsFitIris <- train(Species ~ .,
                   data = training,
                   method = "pls",
                   tuneLength = 4,
                   trControl = ctrl,
                   preProc = c("center", "scale"))
plsFitIris
plot(plsFitIris)


set.seed(2)
plsldaFitIris <- train(Species ~ .,
                      data = training,
                      method = modelInfo,
                      tuneLength = 4,
                      trControl = ctrl,
                      preProc = c("center", "scale"))

plsldaFitIris
plot(plsldaFitIris)  

Теперь сравниваем две модели:

getTrainPerf(plsFitIris)
  TrainAccuracy TrainKappa method
1     0.8574242  0.7852462    pls
getTrainPerf(plsldaFitIris)
  TrainAccuracy TrainKappa method
1      0.975303  0.9628179 custom
postResample(predict(plsFitIris, testing), testing$Species)
Accuracy    Kappa 
   0.750    0.625 
postResample(predict(plsldaFitIris, testing), testing$Species)
 Accuracy     Kappa 
0.9444444 0.9166667  

Итак, наконец, появилась ОЖИДАЕМАЯ разница и улучшение показателей. Таким образом, это поддержало бы идею Макса о том, что проблемы с двумя классами из-за вероятностного подхода Байеса к функции plsda приводят к одним и тем же результатам.

• Вам нужно обернуть резюме как PLS, так и LDA.
• Да, и plsr, и lda центрируют данные по-своему

• Я внимательно посмотрел на caret::preProcess (): в том виде, в каком он определен сейчас, вы не сможете использовать PLS в качестве метода предварительной обработки, потому что он контролируется, но caret::preProcess () использует только неконтролируемые методы (нет возможности передать зависимую переменную). Это, вероятно, затруднит исправление.

• Итак, внутри каркаса каретки вам нужно будет выбрать пользовательскую модель.

Если бы сценарий заключался в настройке модели типа PLS-LDA по коду, любезно предоставленному Максом (мейнтейнером CARET), то что-то в этом коде не так, но я не разобрался, потому что использовал Sonar данные одинаковые в caret виньетке и попытались воспроизвести результат один раз, используя method="pls", а другой раз, используя приведенную ниже пользовательскую модель для PLS-LDA, результаты были точно идентичными даже до последней цифры, которая была бессмысленный. Для бенчмаркинга нужен известный набор данных (я думаю, что набор данных с перекрестной проверкой PLS-LDA для радужной оболочки подойдет здесь, поскольку он известен этим типом анализа, и где-то должна быть его перекрестная проверка), все должны быть одинаковыми (set.seed(xxx) и номер повторения K-CV), за исключением рассматриваемого кода, чтобы правильно сравнивать и оценивать приведенный ниже код:

modelInfo <- list(label = "PLS-LDA",
                  library = c("pls", "MASS"),
                  type = "Classification",
                  parameters = data.frame(parameter = c("ncomp"),
                                          class = c("numeric"),
                                          label = c("#Components")),
                  grid = function(x, y, len = NULL) {
                    grid <- expand.grid(ncomp = seq(1, min(ncol(x) - 1, len), by = 1))
                  },
                  loop = NULL,
                  fit = function(x, y, wts, param, lev, last, classProbs, ...) { 
                    ## First fit the pls model, generate the training set scores,
                    ## then attach what is needed to the lda object to 
                    ## be used later
                    pre <- plsda(x, y, ncomp = param$ncomp)
                    scores <- pls:::predict.mvr(pre, x, type = "scores")
                    mod <- lda(scores, y, ...)
                    mod$projection <- pre$projection
                    mod
                  },
                  predict = function(modelFit, newdata, submodels = NULL) {       
                    scores <- as.matrix(newdata)  %*% modelFit$projection
                    predict(modelFit, scores)$class
                  },
                  prob = function(modelFit, newdata, submodels = NULL) {       
                    scores <- as.matrix(newdata)  %*% modelFit$projection
                    predict(modelFit, scores)$posterior
                  },
                  varImp = NULL,
                  predictors = function(x, ...) rownames(x$projection),
                  levels = function(x) x$obsLevels,
                  sort = function(x) x[order(x[,1]),])  

По запросу Зака ​​приведенный ниже код предназначен для method="pls" в знаке вставки, точно такой же конкретный пример в виде символа вставки на КРАН:

library(mlbench) # data set from here
data(Sonar)
dim(Sonar) # 208x60
set.seed(107)
inTrain <- createDataPartition(y = Sonar$Class,
                               ## the outcome data are needed
                               p = .75,
                               ## The percentage of data in the
                               ## training set
                               list = FALSE)
## The format of the results
## The output is a set of integers for the rows of Sonar
## that belong in the training set.
training <- Sonar[ inTrain,] #157
testing <- Sonar[-inTrain,] # 51

ctrl <- trainControl(method = "repeatedcv",
                     repeats = 3,
                     classProbs = TRUE,
                     summaryFunction = twoClassSummary)
set.seed(108)
plsFitSon <- train(Class ~ .,
                data = training,
                method = "pls",
                tuneLength = 15,
                trControl = ctrl,
                metric = "ROC",
                preProc = c("center", "scale"))
plsFitSon
plot(plsFitSon) # might be slightly difference than what in the vignette due to radnomness  

Теперь приведенный ниже код представляет собой пилотный запуск для классификации данных сонара с использованием пользовательской модели PLS-LDA, которая находится под вопросом. Ожидается, что будут получены любые числа, кроме идентичных тем, которые используют только PLS:

set.seed(108)
plsldaFitSon <- train(Class ~ .,
                   data = training,
                   method = modelInfo,
                   tuneLength = 15,
                   trControl = ctrl,
                   metric = "ROC",
                   preProc = c("center", "scale"))  

Теперь сравним результаты между двумя моделями:

getTrainPerf(plsFitSon)
   TrainROC TrainSens TrainSpec method
1 0.8741154 0.7638889 0.8452381    pls
getTrainPerf(plsldaFitSon)
   TrainROC TrainSens TrainSpec method
1 0.8741154 0.7638889 0.8452381 custom

postResample(predict(plsFitSon, testing), testing$Class)
Accuracy    Kappa 
0.745098 0.491954 
postResample(predict(plsldaFitSon, testing), testing$Class)
Accuracy    Kappa 
0.745098 0.491954 

Итак, результаты точно такие же, которых быть не может. Как бы не добавилась модель lda?