web-dev-qa-db-fra.com

predict.lm () avec un facteur inconnu dans les données de test

J'adapte un modèle pour factoriser les données et les prédire. Si newdata dans predict.lm() contient un seul niveau de facteur inconnu du modèle, all of predict.lm() échoue et renvoie une erreur.

Existe-t-il un bon moyen que predict.lm() renvoie une prédiction pour les niveaux de facteurs connus du modèle et NA pour les niveaux de facteurs inconnus, au lieu d'une simple erreur?

Exemple de code:

foo <- data.frame(response=rnorm(3),predictor=as.factor(c("A","B","C")))
model <- lm(response~predictor,foo)
foo.new <- data.frame(predictor=as.factor(c("A","B","C","D")))
predict(model,newdata=foo.new)

Je voudrais que la toute dernière commande renvoie trois prédictions "réelles" correspondant aux niveaux de facteur "A", "B" et "C" et un NA correspondant au niveau inconnu "D".

rregressionlinear-regressionlm
32
Stephan Kolassa

Rangé et étendu la fonction par MorgenBall . Il est également implémenté dans sperrorest now.

Caractéristiques supplémentaires

  • supprime les niveaux de facteur inutilisés plutôt que de simplement définir les valeurs manquantes sur NA. 
  • envoie un message à l'utilisateur indiquant que les niveaux de facteurs ont été supprimés
  • vérifie l'existence de variables de facteur dans test_data et renvoie le nom de fichier original data.frame s'il n'est pas présent
  • fonctionne non seulement pour lm, glm et aussi pour glmmPQL

Remarque: La fonction illustrée ici peut changer (améliorer) avec le temps. 

#' @title remove_missing_levels
#' @description Accounts for missing factor levels present only in test data
#' but not in train data by setting values to NA
#'
#' @import magrittr
#' @importFrom gdata unmatrix
#' @importFrom stringr str_split
#'
#' @param fit fitted model on training data
#'
#' @param test_data data to make predictions for
#'
#' @return data.frame with matching factor levels to fitted model
#'
#' @keywords internal
#'
#' @export
remove_missing_levels <- function(fit, test_data) {

  # https://stackoverflow.com/a/39495480/4185785

  # drop empty factor levels in test data
  test_data %>%
    droplevels() %>%
    as.data.frame() -> test_data

  # 'fit' object structure of 'lm' and 'glmmPQL' is different so we need to
  # account for it
  if (any(class(fit) == "glmmPQL")) {
    # Obtain factor predictors in the model and their levels
    factors <- (gsub("[-^0-9]|as.factor|\\(|\\)", "",
                     names(unlist(fit$contrasts))))
    # do nothing if no factors are present
    if (length(factors) == 0) {
      return(test_data)
    }

    map(fit$contrasts, function(x) names(unmatrix(x))) %>%
      unlist() -> factor_levels
    factor_levels %>% str_split(":", simplify = TRUE) %>%
      extract(, 1) -> factor_levels

    model_factors <- as.data.frame(cbind(factors, factor_levels))
  } else {
    # Obtain factor predictors in the model and their levels
    factors <- (gsub("[-^0-9]|as.factor|\\(|\\)", "",
                     names(unlist(fit$xlevels))))
    # do nothing if no factors are present
    if (length(factors) == 0) {
      return(test_data)
    }

    factor_levels <- unname(unlist(fit$xlevels))
    model_factors <- as.data.frame(cbind(factors, factor_levels))
  }

  # Select column names in test data that are factor predictors in
  # trained model

  predictors <- names(test_data[names(test_data) %in% factors])

  # For each factor predictor in your data, if the level is not in the model,
  # set the value to NA

  for (i in 1:length(predictors)) {
    found <- test_data[, predictors[i]] %in% model_factors[
      model_factors$factors == predictors[i], ]$factor_levels
    if (any(!found)) {
      # track which variable
      var <- predictors[i]
      # set to NA
      test_data[!found, predictors[i]] <- NA
      # drop empty factor levels in test data
      test_data %>%
        droplevels() -> test_data
      # issue warning to console
      message(sprintf(paste0("Setting missing levels in '%s', only present",
                             " in test data but missing in train data,",
                             " to 'NA'."),
                      var))
    }
  }
  return(test_data)
}

Nous pouvons appliquer cette fonction à l'exemple de la question comme suit:

predict(model,newdata=remove_missing_levels (fit=model, test_data=foo.new))

En essayant d'améliorer cette fonction, je suis tombé sur le fait que les méthodes d'apprentissage SL telles que lm, glm etc. ont besoin des mêmes niveaux d'apprentissage et de test tandis que les méthodes d'apprentissage ML (svm, randomForest) échouent si les niveaux sont supprimés. Ces méthodes nécessitent tous les niveaux en train et test. 

Une solution générale est assez difficile à obtenir car chaque modèle ajusté dispose d'une manière différente de stocker son composant de niveau de facteur (fit$xlevels pour lm et fit$contrasts pour glmmPQL). Au moins, il semble être cohérent dans tous les modèles liés à lm. 

6
pat-s

Vous devez supprimer les niveaux supplémentaires avant tout calcul, comme:

> id <- which(!(foo.new$predictor %in% levels(foo$predictor)))
> foo.new$predictor[id] <- NA
> predict(model,newdata=foo.new)
         1          2          3          4 
-0.1676941 -0.6454521  0.4524391         NA

Il s’agit d’une manière plus générale de procéder. Elle définira tous les niveaux qui ne figurent pas dans les données originales à NA. Comme Hadley l’a mentionné dans les commentaires, ils auraient pu choisir d’inclure cela dans la fonction predict(), mais ils ne l’ont pas fait.

Pourquoi vous devez faire cela devient évident si vous regardez le calcul lui-même. En interne, les prévisions sont calculées comme suit:

model.matrix(~predictor,data=foo) %*% coef(model)
        [,1]
1 -0.1676941
2 -0.6454521
3  0.4524391

Au bas, vous avez les deux matrices de modèle. Vous voyez que celui pour foo.new a une colonne supplémentaire, vous ne pouvez donc plus utiliser le calcul matriciel. Si vous utilisiez le nouvel ensemble de données pour modéliser, vous obtiendriez également un modèle différent, à savoir un modèle avec une variable factice supplémentaire pour le niveau supplémentaire.

> model.matrix(~predictor,data=foo)
  (Intercept) predictorB predictorC
1           1          0          0
2           1          1          0
3           1          0          1
attr(,"assign")
[1] 0 1 1
attr(,"contrasts")
attr(,"contrasts")$predictor
[1] "contr.treatment"

> model.matrix(~predictor,data=foo.new)
  (Intercept) predictorB predictorC predictorD
1           1          0          0          0
2           1          1          0          0
3           1          0          1          0
4           1          0          0          1
attr(,"assign")
[1] 0 1 1 1
attr(,"contrasts")
attr(,"contrasts")$predictor
[1] "contr.treatment"

Vous ne pouvez pas non plus simplement supprimer la dernière colonne de la matrice du modèle, car même si vous le faites, les deux autres niveaux sont toujours influencés. Le code pour le niveau A serait (0,0). Pour B c'est (1,0), pour C ceci (0,1) ... et pour D c'est encore (0,0)! Votre modèle suppose donc que A et D ont le même niveau si elle supprime naïvement la dernière variable muette.

Sur une partie plus théorique: Il est possible de construire un modèle sans avoir tous les niveaux. Maintenant, comme j'ai essayé de l'expliquer précédemment, ce modèle est seulement valide pour les niveaux que vous avez utilisés lors de la construction du modèle. Si vous rencontrez de nouveaux niveaux, vous devez créer un nouveau modèle pour inclure les informations supplémentaires. Si vous ne le faites pas, la seule chose à faire est de supprimer les niveaux supplémentaires du jeu de données. Mais vous perdez en gros toutes les informations qu’il contient, ce qui n’est généralement pas considéré comme une bonne pratique.

29
Joris Meys

Si vous souhaitez traiter les niveaux manquants dans vos données après la création de votre modèle lm mais avant d'appeler Predict (étant donné que nous ne savons pas exactement quels niveaux peuvent être manquants auparavant), voici la fonction que j'ai créée pour définir tous les niveaux model to NA - la prédiction donnera également NA et vous pourrez alors utiliser une autre méthode pour prédire ces valeurs.

objet sera votre sortie lm de lm (..., data = trainData)

data sera le bloc de données pour lequel vous voulez créer des prédictions

missingLevelsToNA<-function(object,data){

  #Obtain factor predictors in the model and their levels ------------------

  factors<-(gsub("[-^0-9]|as.factor|\\(|\\)", "",names(unlist(object$xlevels))))
  factorLevels<-unname(unlist(object$xlevels))
  modelFactors<-as.data.frame(cbind(factors,factorLevels))


  #Select column names in your data that are factor predictors in your model -----

  predictors<-names(data[names(data) %in% factors])


  #For each factor predictor in your data if the level is not in the model set the value to NA --------------

  for (i in 1:length(predictors)){
    found<-data[,predictors[i]] %in% modelFactors[modelFactors$factors==predictors[i],]$factorLevels
    if (any(!found)) data[!found,predictors[i]]<-NA
  }

  data

}
5
Morgan Ball

On dirait que vous pourriez aimer les effets aléatoires. Regardez quelque chose comme glmer (paquet lme4). Avec un modèle bayésien, vous obtiendrez des effets qui approcheront 0 quand il y a peu d'informations à utiliser pour les estimer. Attention, cependant, vous devrez faire la prédiction vous-même, plutôt que d’utiliser Predict (). 

Vous pouvez également créer des variables nominales pour les niveaux que vous souhaitez inclure dans le modèle, par exemple. une variable 0/1 pour lundi, une pour mardi, une pour mercredi, etc. Dimanche sera automatiquement supprimé du modèle s'il contient tous les 0. Mais avoir un 1 dans la colonne dimanche dans les autres données n'échouera pas à l'étape de prédiction. Nous supposerons simplement que le dimanche a un effet moyen par rapport aux autres jours (ce qui peut être vrai ou non).

2
tiffany

Une des hypothèses des régressions linéaires/logistiques est de ne pas ou peu de multi-colinéarité; Par conséquent, si les variables prédictives sont idéalement indépendantes les unes des autres, le modèle n'a pas besoin de voir toute la variété possible de niveaux de facteurs. Un nouveau niveau de facteur (D) est un nouvel prédicteur et peut être défini sur NA sans affecter la capacité de prédiction des facteurs restants A, B et C. C'est pourquoi le modèle devrait toujours être capable de faire des prédictions. Mais l’ajout du nouveau niveau D jette le schéma attendu. C'est toute la question. Définir NA corrige cela.

1
Kingz

Le package lme4 gérera les nouveaux niveaux si vous définissez l'indicateur allow.new.levels=TRUE lors de l'appel de predict.

Exemple: si votre facteur jour de la semaine est dans une variable dow et un résultat catégorique b_fail, vous pouvez exécuter

M0 <- lmer(b_fail ~ x + (1 | dow), data=df.your.data, family=binomial(link='logit')) M0.preds <- predict(M0, df.new.data, allow.new.levels=TRUE)

Ceci est un exemple avec une régression logistique à effets aléatoires. Bien sûr, vous pouvez effectuer une régression régulière ... ou la plupart des modèles GLM. Si vous souhaitez poursuivre sur la voie bayésienne, consultez l'excellent livre de Gelman & Hill et l'infrastructure Stan .

1
Lantern Rouge

Une solution rapide pour les tests fractionnés consiste à recoder les valeurs rares en "autres". Voici une implémentation:

rare_to_other <- function(x, fault_factor = 1e6) {
  # dirty dealing with rare levels:
  # recode small cells as "other" before splitting to train/test,
  # assuring that lopsided split occurs with prob < 1/fault_factor
  # (N.b. not fully kosher, but useful for quick and dirty exploratory).

  if (is.factor(x) | is.character(x)) {
    min.cell.size = log(fault_factor, 2) + 1
    xfreq <- sort(table(x), dec = T)
    rare_levels <- names(which(xfreq < min.cell.size))
    if (length(rare_levels) == length(unique(x))) {
      warning("all levels are rare and recorded as other. make sure this is desirable")
    }
    if (length(rare_levels) > 0) {
      message("recoding rare levels")
      if (is.factor(x)) {
        altx <- as.character(x)
        altx[altx %in% rare_levels] <- "other"
        x <- as.factor(altx)
        return(x)
      } else {
        # is.character(x)
        x[x %in% rare_levels] <- "other"
        return(x)
      }
    } else {
      message("no rare levels encountered")
      return(x)
    }
  } else {
    message("x is neither a factor nor a character, doing nothing")
    return(x)
  }
}

Par exemple, avec data.table, l’appel ressemblerait à ceci: 

dt[, (xcols) := mclapply(.SD, rare_to_other), .SDcol = xcols] # recode rare levels as other

où xcols est un quelconque sous-ensemble de colnames(dt).

0
dzeltzer