التنبؤ.م() مع عامل غير معروف مستوى في اختبار البيانات

StackOverflow https://stackoverflow.com/questions/4285214

سؤال

أنا تركيب نموذج عامل البيانات والتنبؤ.إذا كان newdata في predict.lm() يحتوي على عامل واحد المستوى الذي هو غير معروف إلى نموذج ، كل من predict.lm() فشل بإرجاع خطأ.

هل هناك طريقة جيدة أن يكون predict.lm() عودة التنبؤ لأولئك مستويات عامل نموذج يعرف ونا غير معروف مستويات عامل, بدلا من مجرد خطأ ؟

رمز المثال:

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)

أود آخر الأمر إلى عودة ثلاثة "الحقيقي" التنبؤات المقابلة مستويات عامل "ألف" و "ب" و "ج" ، NA المقابلة المجهول المستوى "د".

هل كانت مفيدة؟

المحلول

تم ترتيب الوظيفة وتوسيعها Morgenball. يتم تنفيذه أيضًا في Sperrorest حاليا.

ميزات إضافية

  • يسقط مستويات العوامل غير المستخدمة بدلاً من مجرد تعيين القيم المفقودة إلى NA.
  • تصدر رسالة إلى المستخدم تم إسقاط مستويات العوامل
  • يتحقق لوجود متغيرات العوامل في test_data وإرجاع البيانات الأصلية. الإطار إذا كانت غير موجودة
  • لا يعمل فقط 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))

أثناء محاولة تحسين هذه الوظيفة ، صادفت حقيقة أن أساليب التعلم SL مثل lm, glm إلخ. تحتاج إلى نفس المستويات في القطار والاختبار أثناء طرق التعلم ML (svm, randomForest) فشل إذا تمت إزالة المستويات. هذه الطرق تحتاج إلى جميع المستويات في القطار والاختبار.

من الصعب للغاية تحقيق الحل العام لأن كل نموذج مجهز لديه طريقة مختلفة لتخزين مكون مستوى العوامل (fit$xlevels إلى عن على lm و fit$contrasts إلى عن على glmmPQL). على الأقل يبدو أنه متسق عبر lm النماذج ذات الصلة.

نصائح أخرى

يجب عليك إزالة المستويات الإضافية قبل أي حساب ، مثل:

> 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 هذا (0،1) ... و D إنه مرة أخرى (0،0)! لذلك فإن نموذجك يفترض ذلك A و D هي نفس المستوى إذا كان سيسقط بسذاجة المتغير الوهمي الأخير.

في جزء نظري أكثر: من الممكن إنشاء نموذج دون الحصول على جميع المستويات. الآن ، كما حاولت أن أشرح من قبل ، هذا النموذج هو فقط صالح للمستويات التي استخدمتها عند بناء النموذج. إذا صادفت مستويات جديدة ، فيجب عليك إنشاء نموذج جديد لتضمين المعلومات الإضافية. إذا لم تفعل ذلك ، فإن الشيء الوحيد الذي يمكنك القيام به هو حذف المستويات الإضافية من مجموعة البيانات. ولكن بعد ذلك تفقد جميع المعلومات الموجودة فيها ، لذلك لا تعتبر الممارسة الجيدة عمومًا.

إذا كنت ترغب في التعامل مع المستويات المفقودة في بياناتك بعد إنشاء نموذج LM الخاص بك ولكن قبل الاتصال بالتنبؤ (بالنظر إلى أننا لا نعرف بالضبط ما هي المستويات المفقودة مسبقًا) هنا هي الوظيفة التي قمت بإنشائها لضبط جميع المستويات وليس في نموذج إلى NA - سوف يعطي التنبؤ أيضًا NA ويمكنك بعد ذلك استخدام طريقة بديلة للتنبؤ بهذه القيم.

هدف سيكون إخراج LM الخاص بك من LM (... ، البيانات = 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

}

يبدو أنك قد مثل الآثار العشوائية.انظر إلى ما يشبه glmer (lme4 حزمة).مع بايزي نموذج ستحصل على آثار هذا النهج 0 عندما يكون هناك القليل من المعلومات لاستخدامها عند تقدير لهم.تحذير على الرغم من أن عليك أن تفعل التنبؤ نفسك, بدلا من استخدام التنبؤ().

بدلا من ذلك, يمكنك ببساطة جعل متغيرات وهمية عن المستويات التي تريد تضمينها في النموذج ، على سبيل المثالمتغير 0/1 يوم الاثنين ، واحد يوم الثلاثاء ، واحد يوم الأربعاء ، إلخ.الأحد سيتم حذفها من النموذج إذا كان يحتوي على جميع 0.ولكن وجود 1 في الأحد عمود في بيانات أخرى لن تفشل في التنبؤ الخطوة.وسوف نفترض فقط أن الأحد لديه تأثير متوسط الأيام الأخرى (التي قد تكون أو قد لا يكون صحيحا).

واحدة من افتراضات الانحدارات الخطية/اللوجستية هو القليل أو معدوم متعدد الخطية ؛ لذلك إذا كانت متغيرات التنبؤ مستقلة بشكل مثالي عن بعضها البعض ، فإن النموذج لا يحتاج إلى رؤية جميع مستويات العوامل الممكنة. مستوى العامل الجديد (D) هو مؤشر جديد ، ويمكن ضبطه على NA دون التأثير على قدرة التنبؤ بالعوامل المتبقية A ، B ، C. هذا هو السبب في أن النموذج يجب أن يكون قادرًا على عمل تنبؤات. لكن إضافة المستوى الجديد D يلقي المخطط المتوقع. هذه هي القضية برمتها. تعيين NA إصلاح ذلك.

ال lme4 سوف تتعامل الحزمة مع مستويات جديدة إذا قمت بتعيين العلامة allow.new.levels=TRUE عند الاتصال predict.

مثال: إذا كان عامل يوم الأسبوع في متغير 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 الممتاز و ستان البنية الاساسية.

يتمثل حل سريع ودني لاختبار الانقسام ، في إعادة تشفير قيم نادرة كـ "غيرها". هنا تنفيذ:

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

مرخصة بموجب: CC-BY-SA مع الإسناد
لا تنتمي إلى StackOverflow
scroll top