web-dev-qa-db-ja.com

テストデータに未知の因子レベルがあるpredict.lm（）

モデルを因子データに適合させて予測しています。 predict.lm()のnewdataに、モデルにとって未知の単一因子レベルが含まれている場合、allof predict.lm()は失敗し、エラーを返します。

エラーだけでなく、predict.lm()がモデルが知っている因子レベルの予測と未知の因子レベルのNAを返すための良い方法はありますか？

コード例：

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)

最後のコマンドで、因子レベル「A」、「B」、「C」に対応する3つの「実際の」予測と、不明なレベル「D」に対応するNAを返すようにしたいと思います。

rregressionlinear-regressionlm
33
Stephan Kolassa

MorgenBall で関数を整頓し、拡張しました。 sperrorest にも実装されています。

追加機能

  • 欠落している値をNAに設定するだけでなく、未使用の因子レベルを削除します。
  • 因子水準が下がったというメッセージをユーザーに発行します
  • test_data内の因子変数の存在をチェックし、存在しない場合は元のdata.frameを返します
  • lm、glmだけでなく、glmmPQLでも機能します

注：ここに示す機能は、時間の経過とともに変化（改善）する可能性があります。

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

この関数を質問の例に次のように適用できます。

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

この機能を改善しようとしているときに、lm、glmなどのSL学習メソッドはトレーニングとテストで同じレベルを必要とするのに対し、ML学習メソッド（svm、randomForest）がレベルを削除すると失敗するという事実に遭遇しました。これらのメソッドには、トレーニングとテストのすべてのレベルが必要です。

フィットされたモデルごとに因子レベルコンポーネントの格納方法が異なるため、一般的なソリューションを実現するのは非常に困難です（lmの場合はfit$xlevels、glmmPQLの場合はfit$contrasts）。少なくとも、lm関連モデル全体で一貫しているようです。

6
pat-s

次のように、計算の前に余分なレベルを削除する必要があります。

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

これは、より一般的な方法であり、元のデータで発生しないすべてのレベルをNAに設定します。 Hadleyがコメントで述べたように、これをpredict()関数に含めることを選択できたかもしれませんが、彼らはそうしませんでした

計算自体を見れば、なぜそれをしなければならないのかは明らかです。内部的には、予測は次のように計算されます。

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

下部には両方のモデル行列があります。 _foo.new_の列には追加の列があるため、マトリックス計算を使用できなくなっています。新しいデータセットを使用してモデル化する場合、追加のレベル用の追加のダミー変数を備えた別のモデルも取得します。

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

モデルマトリックスから最後の列を削除することもできません。削除しても、他の両方のレベルが影響を受けるためです。レベルAのコードは（0,0）になります。 Bの場合、これは（1,0）で、Cの場合、この（0,1）...であり、Dの場合も、（0,0）です。したがって、モデルは、最後のダミー変数を単純に削除する場合、AとDが同じレベルであると想定します。

より理論的な部分では、すべてのレベルがなくてもモデルを構築できます。さて、前に説明したように、そのモデルはonlyモデルの作成時に使用したレベルに対して有効です。新しいレベルに出会った場合、追加の情報を含めるために新しいモデルを構築する必要があります。それを行わない場合は、データセットから余分なレベルを削除するしかありません。しかし、基本的にはそこに含まれていたすべての情報が失われるため、一般的には良い習慣とは見なされません。

29
Joris Meys

Lmモデルを作成した後、predictを呼び出す前に、データの欠落レベルを処理する場合（事前にどのレベルが欠落している可能性があるか正確にわからない場合）は、ここにないすべてのレベルを設定するために作成した関数ですNAにモデル化-予測もNAを与え、別の方法を使用してこれらの値を予測できます。

objectはlm（...、data = trainData）からのlm出力になります

dataは、予測を作成するデータフレームになります

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

線形/ロジスティック回帰の仮定の1つは、多重共線性がほとんどまたはまったくないことです。そのため、予測変数が理想的には互いに独立している場合、モデルは考えられるさまざまな因子レベルをすべて見る必要はありません。新しい因子レベル（D）は新しい予測子であり、残りの因子A、B、Cの予測能力に影響を与えることなくNAに設定できます。これが、モデルが予測を実行できるようにする必要がある理由です。ただし、新しいレベルDを追加すると、予期したスキーマが失われます。それが全体の問題です。 NAを設定すると修正されます。

2
Kingz

ランダム効果が好きかもしれませんね。 glmer（lme4パッケージ）のようなものを調べます。ベイジアンモデルでは、それらを推定するときに使用する情報がほとんどない場合、効果は0に近づきます。ただし、predict（）を使用するのではなく、自分で予測を行う必要があることに注意してください。

または、モデルに含めるレベルのダミー変数を作成することもできます。月曜日を表す変数0/1、火曜日を表す変数、水曜日を表す変数など。日曜日がすべて0の場合、モデルから自動的に削除されます。ただし、他のデータの日曜日の列に1があっても、予測ステップは失敗しません。それは、日曜日が他の日の平均である効果を持っていると仮定するだけです（それは正しいかもしれないし、そうでないかもしれません）。

2
tiffany

predictを呼び出すときにフラグ_lme4_を設定すると、_allow.new.levels=TRUE_パッケージは新しいレベルを処理します。

例：曜日係数が変数dowにあり、カテゴリカルな結果が_b_fail_の場合、次のように実行できます。

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)

これは、変量効果ロジスティック回帰の例です。もちろん、通常の回帰...またはほとんどのGLMモデルを実行できます。ベイジアンの道をさらに進みたい場合は、Gelman＆Hillの優れた本と Stan インフラストラクチャをご覧ください。

1
Lantern Rouge

分割テストの迅速で汚れたソリューションは、まれな値を「その他」として再コード化することです。ここに実装があります：

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

たとえば、data.tableの場合、呼び出しは次のようになります。

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

ここで、xcolsはcolnames(dt)のサブセットです。

0
dzeltzer