web-dev-qa-db-de.com

predict.lm () mit einem unbekannten Faktor in den Testdaten

Ich passe ein Modell an, um Daten zu faktorisieren und vorherzusagen. Wenn die Variable newdata in predict.lm() eine einzelne Faktorstufe enthält, die dem Modell nicht bekannt ist, schlägt all von predict.lm() fehl und gibt einen Fehler zurück.

Gibt es eine gute Möglichkeit, predict.lm() eine Vorhersage für die vom Modell bekannten Faktorstufen und für unbekannte Faktorstufen anstelle eines Fehlers zurückgeben zu lassen?

Beispielcode:

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)

Ich möchte, dass der letzte Befehl drei "echte" Vorhersagen zurückgibt, die den Faktorstufen "A", "B" und "C" entsprechen, und eine NA, die der unbekannten Stufe "D" entspricht.

32
Stephan Kolassa

Bereinigt und erweitert die Funktion um MorgenBall . Es ist auch in sperrorest now implementiert.

Zusatzfunktionen

  • reduziert nicht verwendete Faktorebenen, statt nur die fehlenden Werte auf NA zu setzen. 
  • gibt dem Benutzer eine Meldung aus, dass die Faktorstufen gelöscht wurden
  • prüft auf Vorhandensein von Faktorvariablen in test_data und gibt den ursprünglichen data.frame zurück, falls keine vorhanden sind
  • funktioniert nicht nur für lm, glm und auch für glmmPQL

Hinweis: Die hier gezeigte Funktion kann sich im Laufe der Zeit ändern (verbessern). 

#' @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)
}

Wir können diese Funktion wie folgt auf das Beispiel in der Frage anwenden:

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

Bei dem Versuch, diese Funktion zu verbessern, bin ich auf die Tatsache gestoßen, dass SL-Lernmethoden wie lm, glm usw. dieselben Ebenen in train & test benötigen, während ML-Lernmethoden (svm, randomForest) fehlschlagen, wenn die Ebenen entfernt werden. Diese Methoden benötigen alle Ebenen in Train & Test. 

Eine generelle Lösung ist ziemlich schwer zu erreichen, da jedes angepasste Modell eine andere Methode zum Speichern der Faktor-Komponente (fit$xlevels für lm und fit$contrasts für glmmPQL) hat. Zumindest scheint es über lm verwandte Modelle hinweg konsistent zu sein. 

6
pat-s

Sie müssen die zusätzlichen Ebenen vor jeder Berechnung entfernen, wie:

> 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 

Dies ist eine allgemeinere Methode, da alle Ebenen, die in den Originaldaten nicht vorkommen, auf NA gesetzt werden. Wie Hadley in den Kommentaren erwähnte, hätten sie sich entscheiden können, dies in die Funktion predict() aufzunehmen, was aber nicht der Fall war

Warum Sie das tun müssen, wird offensichtlich, wenn Sie die Berechnung selbst betrachten. Intern werden die Vorhersagen wie folgt berechnet:

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

Unten haben Sie beide Modellmatrizen. Sie sehen, dass die für foo.new eine zusätzliche Spalte hat, so dass Sie die Matrixberechnung nicht mehr verwenden können. Wenn Sie das neue Dataset zum Modellieren verwenden, erhalten Sie auch ein anderes Modell, das eine zusätzliche Dummy-Variable für die zusätzliche Ebene enthält.

> 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"

Sie können auch nicht einfach die letzte Spalte aus der Modellmatrix löschen, da selbst dann beide Ebenen beeinflusst werden. Der Code für die Ebene A lautet (0,0). Für B ist dies (1,0), für C dieses (0,1) ... und für D ist es wieder (0,0)! Ihr Modell würde also annehmen, dass A und D die gleiche Ebene haben, wenn die letzte Dummy-Variable auf naive Weise gelöscht werden würde.

Zu einem theoretischen Teil: Es ist möglich, ein Modell ohne alle Ebenen zu erstellen. Wie ich zuvor zu erklären versuchte, ist dieses Modell nur für die Ebenen gültig, die Sie beim Erstellen des Modells verwendet haben. Wenn Sie auf neue Ebenen stoßen, müssen Sie ein neues Modell erstellen, um die zusätzlichen Informationen aufzunehmen. Wenn Sie dies nicht tun, können Sie nur die zusätzlichen Ebenen aus dem Datensatz löschen. Aber dann verlieren Sie im Grunde alle Informationen, die darin enthalten waren, und werden daher im Allgemeinen nicht als bewährte Praxis betrachtet.

29
Joris Meys

Wenn Sie sich mit den fehlenden Ebenen in Ihren Daten befassen möchten, nachdem Sie Ihr Lm-Modell erstellt haben, jedoch vor dem Aufruf von "Predict" (da wir nicht genau wissen, welche Ebenen möglicherweise vorher fehlen), haben Sie hier die Funktion erstellt, mit der alle Ebenen festgelegt werden, die nicht in der Standardeinstellung liegen model to NA - Die Vorhersage gibt dann auch NA und Sie können dann eine alternative Methode verwenden, um diese Werte vorherzusagen.

object wird deine lm-Ausgabe von lm sein (..., data = trainData)

data ist der Datenrahmen, für den Sie Vorhersagen erstellen möchten

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

Hört sich an, als würden Sie zufällige Effekte mögen. Schau dir so etwas wie Glmer an (lme4 package). Mit einem Bayes'schen Modell erhalten Sie Effekte, die gegen 0 gehen, wenn für die Schätzung nur wenige Informationen benötigt werden. Es ist jedoch eine Warnung, dass Sie selbst Vorhersagen machen müssen, anstatt "Vorhersagen" () zu verwenden. 

Alternativ können Sie einfach Dummy-Variablen für die Ebenen erstellen, die Sie in das Modell aufnehmen möchten, z. eine variable 0/1 für Montag, eine für Dienstag, eine für Mittwoch usw. Der Sonntag wird automatisch aus dem Modell entfernt, wenn er alle 0 enthält. Aber eine 1 in der Sonntagsspalte in den anderen Daten wird den Vorhersageschritt nicht versagen. Es wird lediglich davon ausgegangen, dass der Sonntag an den anderen Tagen einen durchschnittlichen Effekt hat (der möglicherweise nicht stimmt).

2
tiffany

Eine der Annahmen von linearen/logistischen Regressionen ist zu wenig oder keine Multi-Kollinearität; Wenn also die Prädiktorvariablen idealerweise unabhängig voneinander sind, muss das Modell nicht alle möglichen Variationen der Faktorstufen sehen. Ein neuer Faktor (D) ist ein neuer Prädiktor und kann auf NA gesetzt werden, ohne die Vorhersagefähigkeit der übrigen Faktoren A, B, C zu beeinflussen. Daher sollte das Modell noch Vorhersagen treffen können. Die Hinzufügung der neuen Stufe D wirft jedoch das erwartete Schema ab. Das ist das ganze Problem. Das Festlegen von NA behebt das.

1
Kingz

Das lme4-Paket behandelt neue Ebenen, wenn Sie das Flag allow.new.levels=TRUE beim Aufruf von predict setzen.

Beispiel: Wenn Ihr Wochentagfaktor in einer Variablen dow und einem kategorialen Ergebnis b_fail enthalten ist, können Sie ausführen

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)

Dies ist ein Beispiel mit einer logistischen Regression mit zufälligen Effekten. Natürlich können Sie eine reguläre Regression durchführen ... oder die meisten GLM-Modelle. Wenn Sie den Bayesianischen Pfad weiter hinuntergehen möchten, sehen Sie sich das ausgezeichnete Buch von Gelman & Hill und die Infrastruktur von Stan an.

1
Lantern Rouge

Eine schnelle und schmutzige Lösung für Split-Tests ist das Umkodieren seltener Werte als "andere". Hier ist eine Implementierung:

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)
  }
}

Mit data.table würde der Aufruf beispielsweise so aussehen: 

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

dabei ist xcols eine beliebige Untermenge von colnames(dt).

0
dzeltzer