회귀분석 테스트 데이터에서 알 수없는 요인 수준의 predict.lm()




회귀분석 r (6)

나는 데이터를 팩터링하고 예측하는 모델에 적합하다. predict.lm()newdata 에 모델에서 알 수없는 단일 요인 수준이 포함되어 있으면 predict.lm()모두 실패하고 오류가 반환됩니다.

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"에 해당하는 세 가지 "실제"예측과 알 수없는 수준 "D"에 해당하는 NA 를 반환하고 싶습니다.


Linear / Logistic Regression의 가정 중 하나는 다중 공선 성이 거의 없거나 전혀 없습니다. 예측 변수가 이상적으로 서로 독립적이라면 모델은 가능한 다양한 요인 수준을 모두 볼 필요가 없습니다. 새로운 요인 수준 (D)은 새로운 예측 자이며 나머지 요인 A, B, C의 예측 능력에 영향을주지 않으면 서 NA로 설정할 수 있습니다. 이것이 모델이 여전히 예측을 할 수 있어야하는 이유입니다. 그러나 새로운 레벨 D를 추가하면 예상 스키마가 삭제됩니다. 그게 전부 문제 야. NA를 설정하면이를 수정합니다.


MorgenBall의 기능을 정리하고 확장했습니다. 그것은 또한 지금 sperrorest 에서 구현됩니다.

추가 기능

  • 누락 된 값을 NA 설정하는 것보다 사용되지 않은 요소 레벨을 떨어 뜨립니다.
  • 요소 수준이 떨어 졌다는 메시지를 사용자에게 보냅니다.
  • test_data 에 요소 변수가 존재하는지 확인하고, 존재하지 않으면 원래 data.frame을 반환합니다.
  • lm , glm 뿐만 아니라 glmmPQL 에서도 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://.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 )은 수준이 제거되면 실패합니다. 이 방법은 열차 및 시험의 모든 단계를 필요로합니다.

모든 적합한 모델은 요소 레벨 구성 요소를 저장하는 다른 방법 ( fit$xlevels 경우 lm fit$xlevelsfit$contrasts )을 사용하기 때문에 일반적인 솔루션을 만드는 것은 매우 어렵습니다. 최소한 그것은 관련 모델 전반에 걸쳐 일관성있는 것으로 보인다.


당신이 당신의 데이터 모델을 만든 후에 데이터를 놓치지 않고 예측을하기 전에 (사전에 누락 된 레벨을 정확히 알지 못한다면) 여기서 나는 모든 레벨을 모형을 NA로 옮긴다 - 예측은 또한 NA를 준다. 그리고 나서이 값을 예측하기 위해 대안적인 방법을 사용할 수있다.

object 는 lm (..., data = trainData)의 출력물이 될 것입니다.

데이터 는 예측을 만들려는 데이터 프레임이됩니다.

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

}

분할 테스트를위한 신속하고 더러운 솔루션은 드문 값을 "기타"로 코드화하는 것입니다. 다음은 구현입니다.

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

여기서 xcolscolnames(dt) 의 모든 하위 집합입니다.


다음과 같이 계산하기 전에 추가 레벨을 제거해야합니다.

> 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로 설정합니다. 해들리가 주석에서 언급했듯이, 이것을 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 this (0,1) ... 그리고 D 경우 다시 (0,0)입니다! 따라서 모델은 마지막 더미 변수를 순진하게 버리면 AD 가 같은 레벨이라고 가정합니다.

보다 이론적 인 부분 : 모든 단계를 거치지 않고도 모델을 만들 수 있습니다. 이제, 이전에 설명하려고 했으므로이 모델은 모델을 빌드 할 때 사용한 레벨 에서만 유효합니다. 새로운 수준을 발견하면 추가 정보를 포함하도록 새 모델을 만들어야합니다. 그렇게하지 않으면 데이터 세트에서 추가 레벨을 삭제할 수 있습니다. 하지만 기본적으로 정보에 포함 된 모든 정보를 잃어 버리기 때문에 일반적으로 좋은 방법으로 간주되지 않습니다.


lme4 호출 할 때 allow.new.levels=TRUE 플래그를 설정하면 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 모델을 수행 할 수 있습니다. Bayesian 경로를 따라 가려면 Gelman & Hill의 우수한 책과 Stan 인프라를 살펴보십시오.







lm