Extender modelos de 2 clases a problemas de múltiples clases

Este documento sobre Adaboost ofrece algunas sugerencias y códigos (página 17) para extender los modelos de 2 clases a problemas de clase K. Me gustaría generalizar este código, de modo que pueda conectar fácilmente diferentes modelos de 2 clases y comparar los resultados. Debido a que la mayoría de los modelos de clasificación tienen una interfaz de fórmula y un predictmétodo, algo de esto debería ser relativamente fácil. Desafortunadamente, no he encontrado una forma estándar de extraer las probabilidades de clase de los modelos de 2 clases, por lo que cada modelo requerirá un código personalizado.

Aquí hay una función que escribí para dividir un problema de clase K en problemas de clase 2 y devolver modelos K:

oneVsAll <- function(X,Y,FUN,...) {
    models <- lapply(unique(Y), function(x) {
        name <- as.character(x)
        .Target <- factor(ifelse(Y==name,name,'other'), levels=c(name, 'other'))
        dat <- data.frame(.Target, X)
        model <- FUN(.Target~., data=dat, ...)
        return(model)
    })
    names(models) <- unique(Y)
    info <- list(X=X, Y=Y, classes=unique(Y))
    out <- list(models=models, info=info)
    class(out) <- 'oneVsAll'
    return(out)
}

Aquí hay un método de predicción que escribí para iterar sobre cada modelo y hacer predicciones:

predict.oneVsAll <- function(object, newX=object$info$X, ...) {
    stopifnot(class(object)=='oneVsAll')
    lapply(object$models, function(x) {
        predict(x, newX, ...)
    })
}

Y finalmente, aquí hay una función para convertir normalizar una data.framede las probabilidades pronosticadas y clasificar los casos. Tenga en cuenta que depende de usted construir la columna K data.framede probabilidades de cada modelo, ya que no hay una forma unificada de extraer las probabilidades de clase de un modelo de 2 clases:

classify <- function(dat) {
    out <- dat/rowSums(dat)
    out$Class <- apply(dat, 1, function(x) names(dat)[which.max(x)])
    out
}

Aquí hay un ejemplo usando adaboost:

library(ada)
library(caret) 
X <- iris[,-5]
Y <- iris[,5]
myModels <- oneVsAll(X, Y, ada)
preds <- predict(myModels, X, type='probs')
preds <- data.frame(lapply(preds, function(x) x[,2])) #Make a data.frame of probs
preds <- classify(preds)
>confusionMatrix(preds$Class, Y)
Confusion Matrix and Statistics

            Reference
Prediction   setosa versicolor virginica
  setosa         50          0         0
  versicolor      0         47         2
  virginica       0          3        48

Aquí hay un ejemplo usando lda(sé que lda puede manejar múltiples clases, pero este es solo un ejemplo):

library(MASS)
myModels <- oneVsAll(X, Y, lda)
preds <- predict(myModels, X)
preds <- data.frame(lapply(preds, function(x) x[[2]][,1])) #Make a data.frame of probs
preds <- classify(preds)
>confusionMatrix(preds$Class, Y)
Confusion Matrix and Statistics

            Reference
Prediction   setosa versicolor virginica
  setosa         50          0         0
  versicolor      0         39         5
  virginica       0         11        45

Estas funciones deberían funcionar para cualquier modelo de 2 clases con una interfaz de fórmula y un predictmétodo. Tenga en cuenta que tiene que dividir manualmente los componentes X e Y, lo cual es un poco feo, pero escribir una interfaz de fórmula está más allá de mí en este momento.

¿Este enfoque tiene sentido para todos? ¿Hay alguna manera de mejorarlo o hay un paquete existente para resolver este problema?

Una forma de mejorar es utilizar el enfoque de "ponderar todos los pares", que supuestamente es mejor que "uno contra todos" mientras sigue siendo escalable.

En cuanto a los paquetes existentes, glmnetadmite logit multinomial (regularizado) que se puede utilizar como un clasificador de varias clases.