Pertanyaan predict.lm () dengan tingkat faktor yang tidak diketahui dalam data uji


Saya pas model untuk data faktor dan memprediksi. Jika itu newdata di predict.lm() mengandung satu tingkat faktor yang tidak diketahui oleh model, semua dari predict.lm() gagal dan mengembalikan kesalahan.

Apakah ada cara yang bagus untuk dimiliki predict.lm() mengembalikan prediksi untuk tingkat faktor yang diketahui model dan NA untuk tingkat faktor yang tidak diketahui, bukan hanya kesalahan?

Kode contoh:

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)

Saya ingin perintah terakhir untuk mengembalikan tiga prediksi "nyata" yang sesuai dengan level faktor "A", "B" dan "C" dan NA sesuai dengan level "D" yang tidak diketahui.


32
2017-11-26 12:15


asal


Jawaban:


Merapikan dan memperluas fungsi dengan MorgenBall. Ini juga diterapkan di sperrorest sekarang.

Fitur tambahan

  • menurunkan level faktor yang tidak digunakan daripada hanya menetapkan nilai yang hilang NA.
  • mengeluarkan pesan kepada pengguna bahwa level faktor telah dijatuhkan
  • memeriksa keberadaan variabel faktor dalam test_data dan mengembalikan data asli.frame jika tidak ada
  • bekerja tidak hanya untuk lm, glm dan tetapi juga untuk glmmPQL

Catatan: Fungsi yang ditampilkan di sini dapat berubah (tingkatkan) seiring waktu.

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

Kita dapat menerapkan fungsi ini ke contoh dalam pertanyaan sebagai berikut:

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

Ketika mencoba untuk meningkatkan fungsi ini, saya menemukan fakta bahwa metode pembelajaran SL seperti lm, glm dll. membutuhkan tingkat yang sama dalam melatih & menguji sementara metode pembelajaran ML (svm, randomForest) gagal jika level dihapus. Metode-metode ini membutuhkan semua level dalam latihan & tes.

Solusi umum cukup sulit untuk dicapai karena setiap model pas memiliki cara yang berbeda dalam menyimpan komponen level faktor mereka (fit$xlevels untuk lm dan fit$contrasts untuk glmmPQL). Setidaknya tampaknya konsisten lm model terkait.


6
2018-06-01 20:04



Anda harus menghapus tingkat tambahan sebelum perhitungan apa pun, seperti:

> 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 

Ini adalah cara yang lebih umum untuk melakukannya, itu akan mengatur semua level yang tidak terjadi pada data asli ke NA. Seperti yang disebutkan Hadley di komentar, mereka bisa memilih untuk memasukkan ini ke dalam predict() berfungsi, tetapi mereka tidak

Mengapa Anda harus melakukan itu menjadi jelas jika Anda melihat perhitungan itu sendiri. Secara internal, prediksi dihitung sebagai:

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

Di bagian bawah Anda memiliki kedua model matrik. Anda melihat bahwa untuk foo.new memiliki kolom ekstra, jadi Anda tidak dapat menggunakan penghitungan matriks lagi. Jika Anda akan menggunakan dataset baru untuk model, Anda juga akan mendapatkan model yang berbeda, menjadi satu dengan variabel boneka ekstra untuk tingkat tambahan.

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

Anda tidak bisa begitu saja menghapus kolom terakhir dari matriks model, karena meskipun Anda melakukannya, kedua tingkat lainnya masih terpengaruh. Kode untuk level A akan menjadi (0,0). Untuk B ini (1,0), untuk C ini (0,1) ... dan untuk D itu lagi (0,0)! Jadi model Anda akan menganggap itu A dan D adalah tingkat yang sama jika secara naif akan menjatuhkan variabel boneka terakhir.

Pada bagian yang lebih teoritis: Adalah mungkin untuk membangun model tanpa memiliki semua tingkatan. Sekarang, seperti yang saya coba jelaskan sebelumnya, model itu hanya valid untuk level yang Anda gunakan saat membuat model. Jika Anda menemukan level baru, Anda harus membuat model baru untuk memasukkan informasi tambahan. Jika Anda tidak melakukan itu, satu-satunya hal yang dapat Anda lakukan adalah menghapus tingkat tambahan dari kumpulan data. Tetapi pada dasarnya Anda kehilangan semua informasi yang terkandung di dalamnya, sehingga umumnya tidak dianggap praktik yang baik.


29
2017-11-26 12:38



Jika Anda ingin berurusan dengan tingkat yang hilang dalam data Anda setelah membuat model lm Anda tetapi sebelum menelepon memprediksi (mengingat kita tidak tahu persis tingkat apa yang mungkin hilang sebelumnya) di sini adalah fungsi yang telah saya buat untuk mengatur semua level yang tidak ada dalam model untuk NA - prediksi juga akan memberikan NA dan Anda kemudian dapat menggunakan metode alternatif untuk memprediksi nilai-nilai ini.

obyek akan menjadi output lm Anda dari lm (..., data = trainData)

data akan menjadi bingkai data yang Anda inginkan untuk membuat prediksi

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
2017-09-14 16:29



Kedengarannya seperti Anda mungkin menyukai efek acak. Lihatlah sesuatu seperti glmer (paket lme4). Dengan model Bayesian, Anda akan mendapatkan efek yang mendekati 0 ketika ada sedikit informasi untuk digunakan ketika memperkirakannya. Namun, peringatanlah, Anda harus melakukan prediksi sendiri, daripada menggunakan prediktif ().

Sebagai alternatif, Anda cukup membuat variabel dummy untuk level yang ingin Anda sertakan dalam model, mis. variabel 0/1 untuk hari Senin, satu untuk Selasa, satu untuk Rabu, dll. Minggu akan dihapus secara otomatis dari model jika berisi semua 0. Tetapi memiliki 1 di kolom hari Minggu di data lain tidak akan gagal dalam langkah prediksi. Itu hanya akan berasumsi bahwa Minggu memiliki efek yang rata-rata pada hari-hari lainnya (yang mungkin atau mungkin tidak benar).


2
2017-11-11 18:59



Salah satu asumsi Linear / Logistic Regressions adalah sedikit atau tidak ada multi-collinearity; jadi jika variabel prediktor idealnya independen satu sama lain, maka model tidak perlu melihat semua kemungkinan berbagai tingkat faktor. Tingkat faktor baru (D) adalah prediktor baru, dan dapat diatur ke NA tanpa mempengaruhi kemampuan memprediksi faktor-faktor yang tersisa A, B, C. Inilah sebabnya mengapa model harus tetap dapat membuat prediksi. Tetapi penambahan level baru D akan membuang skema yang diharapkan. Itulah masalahnya. Pengaturan NA memperbaiki itu.


1
2018-05-08 22:32



Itu lme4 paket akan menangani level baru jika Anda mengatur bendera allow.new.levels=TRUE saat menelepon predict.

Contoh: jika faktor hari minggu Anda dalam variabel dow dan hasil kategoris b_fail, Anda bisa berlari

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)

Ini adalah contoh dengan regresi logistik efek acak. Tentu saja, Anda dapat melakukan regresi reguler ... atau sebagian besar model GLM. Jika Anda ingin melangkah lebih jauh ke jalan Bayesian, lihat buku dan buku Gelman & Hill yang luar biasa Stan infrastruktur.


1
2018-06-30 00:26



Solusi cepat dan kotor untuk pengujian terpisah, adalah mengode ulang nilai langka sebagai "lainnya". Berikut ini penerapannya:

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

Misalnya, dengan data.tabel, panggilan akan menjadi sesuatu seperti:

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

dimana xcols adalah bagian dari colnames(dt).


0
2017-08-05 07:49