Question

Je suis adaptation d'un modèle de données de facteur et la prévision. Si le newdata en predict.lm() contient un seul niveau de facteur qui est inconnu du modèle, tous de predict.lm() échoue et renvoie une erreur.

Y at-il un bon moyen d'avoir predict.lm() revenir une prédiction pour les niveaux de facteur le modèle Connaît et NA pour les niveaux de facteur inconnu, au lieu de seulement une 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 la dernière commande pour revenir trois prédictions « réelles » correspondant à des niveaux de facteur « A », « B » et « C » et un NA correspondant au niveau inconnu « D ».

Était-ce utile?

La solution

et étendu rangeait la fonction par MorgenBall . Il est également mis en œuvre dans sperrorest maintenant.

Autres caractéristiques

  • diminue les niveaux de facteur inutilisés plutôt que de fixer simplement les valeurs manquantes à NA.
  • émet un message à l'utilisateur que les niveaux de facteur ont été abandonnées
  • vérifie l'existence de variables de facteur dans test_data et retourne data.frame d'origine si non sont présents
  • fonctionne non seulement pour lm, et glm mais aussi pour glmmPQL

Note: La fonction affichée ici peut changer (améliorer) au fil du 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))

Tout en essayant d'améliorer cette fonction, je suis tombé sur le fait que les méthodes d'apprentissage SL comme lm, etc. glm besoin des mêmes niveaux dans le train et essai alors que les méthodes d'apprentissage ML (svm, randomForest) échoue si les niveaux sont supprimés. Ces méthodes ont besoin tous les niveaux dans le train et test.

Une solution générale est assez difficile à réaliser étant donné que chaque modèle ajusté a une façon différente de stocker leur composante de niveau de facteur (fit$xlevels pour lm et fit$contrasts pour glmmPQL). Au moins, il semble cohérent entre les modèles liés à la lm.

Autres conseils

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 

Ceci est une manière plus générale de le faire, il définira tous les niveaux qui ne se produisent pas dans les données d'origine à NA. Comme Hadley mentionné dans les commentaires, ils auraient pu choisir d'inclure dans la fonction predict(), mais ils n'ont pas

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

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

En bas, vous avez les deux matrices de modèle. Vous voyez que celui pour foo.new a une colonne supplémentaire, de sorte que vous ne pouvez pas utiliser le calcul de la matrice plus. Si vous utilisez le nouvel ensemble de données de modèle, vous obtenez également un modèle différent, étant un 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 simplement supprimer la dernière colonne de la matrice du modèle soit, parce que même si vous faites cela, sont encore influencés les deux autres niveaux. serait le code de A niveau (0,0). Pour ce B est (1,0), pour ce C (0,1) ... et pour D il est à nouveau (0,0)! Donc, votre modèle supposerait que A et D sont au même niveau si elle naïvement laisser tomber la dernière variable factice.

Sur une partie plus théorique: Il est possible de construire un modèle sans avoir tous les niveaux. Maintenant, comme je l'ai essayé d'expliquer avant, ce modèle est uniquement valable pour les niveaux que vous avez utilisé lors de la construction du modèle. Si vous tombez sur de nouveaux niveaux, vous devez construire un nouveau modèle pour inclure les informations supplémentaires. Si vous ne le faites pas, la seule chose que vous pouvez faire est de supprimer les niveaux supplémentaires de l'ensemble de données. Mais alors vous perdez essentiellement toutes les informations qui étaient contenues dans, donc il est généralement pas considérée comme une bonne pratique.

Si vous voulez traiter les niveaux manquants dans vos données après avoir créé votre modèle de film, mais avant d'appeler prédisons (étant donné que nous ne savons pas exactement quels niveaux pourraient être manquants au préalable) est fonction ici, je l'ai construit pour définir tous les niveaux pas dans le modèle à NA - la prévision sera alors également donner NA et vous pouvez alors utiliser une autre méthode pour prédire ces valeurs

.

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

données sera la trame de données que vous souhaitez créer des prédictions pour

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

}

Sons comme vous pourriez comme des effets aléatoires. Regardez dans quelque chose comme glmer (paquet lme4). Avec un modèle bayésien, vous obtiendrez des effets qui approche 0 quand il y a peu d'informations à utiliser lors de leur estimation. Avertissement, cependant, que vous aurez à faire vous-même prédiction, plutôt que d'utiliser prédire ().

Vous pouvez simplement faire des variables muettes pour les niveaux que vous souhaitez inclure dans le modèle, par exemple une variable 0/1 pour lundi, un mardi, un mercredi, etc. dimanche sera automatiquement supprimé du modèle si elle contient tous les 0. Mais avoir un 1 dans la colonne dimanche dans les autres données ne manquera pas l'étape de prédiction. Il va simplement supposer que dimanche a un effet de la moyenne des autres jours (qui peut ou ne peut pas être vrai).

L'une des hypothèses de Linear / logistique est à Regressions peu ou pas multicollinéarité; donc si les variables prédictives sont idéalement indépendants les uns des autres, le modèle n'a pas besoin de voir toute la variété possible des niveaux de facteur. Un nouveau niveau de facteur (D) est un nouveau prédicteur, et peut être réglé à NA sans affecter la capacité de prédiction des autres facteurs A, B, C. Voilà pourquoi le modèle doit encore être en mesure de faire des prévisions. Mais ajout du nouveau niveau D jette le schéma prévu. C'est toute la question. Réglage NA correctifs.

Le paquet lme4 traitera de nouveaux niveaux si vous définissez le allow.new.levels=TRUE de drapeau lors de l'appel predict.

Exemple: si votre jour de facteur de semaine est dans une dow variable et un b_fail final catégorique, 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 des effets aléatoires de régression logistique. Bien sûr, vous pouvez effectuer une régression régulière ... ou la plupart des modèles de GLM. Si vous voulez la tête plus loin sur le chemin bayésienne, regardez excellent livre et l'infrastructure du Stan Gelman & Hill.

Une solution rapide et sale pour split testing, est de recoder des valeurs rares comme « autres ». Voici une mise en œuvre:

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 serait quelque chose comme:

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

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

scroll top