Вменяйте постоянную и создайте пустышку-пустышку

Question

Обычной стратегией для работы с отсутствующими предикторами в регрессии является создание фиктивной переменной и заполнение константы.

Например:

lm(Y ~ X1 + replace(X2, is.na(X2), 0) + is.na(X2), df)

Есть ли лучший способ реализацииthis?

Особенно, если бы у меня были X3, X4 и т. д., в которых также отсутствовали значения, это было бы очень утомительно, и я бы в итоге получил следующую неуклюжую формулу:

Y ~ X1 + replace(X2, is.na(X2), 0) + is.na(X2) + 
         replace(X3, is.na(X3), 0) + is.na(X3) + 
         replace(X4, is.na(X4), 0) + is.na(X4)

Это такжебыло бы неплохо иметь возможность рассчитать среднее значение столбца вместо нуля.

Данные:

df <- structure(list(Y = c(3.83, 22.73, 13.85, 14.09, 20.55, 18.51, 
17.76, 9.42, 15.88, 27.81), X1 = 1:10, X2 = c(2L, NA, NA, 4L, 
8L, 7L, 6L, 1L, 3L, 9L)), .Names = c("Y", "X1", "X2"), row.names = c(NA, 
-10L), class = "data.frame")

Answer 1

Я укусил пулю и спустился по этой конкретной кроличьей норе, опубликовав сообщение, чтобы поделиться своими выводами.

Обработка NA в R выполняется с помощью na.action функций, которые предоставляются model.frame внутренне при использованиифункция моделирования, такая как lm.

Мы можем определить нашу собственную, которая заменяет столбец, содержащий NA, матрицей, содержащей исходный вектор, со средним значением, заменяющим NA, и фиктивной переменной, указывающей, что произошло.У нас может быть data.frame универсальный вызов рекурсивно более простой реализации:

na.dummy <- function(object, ...) {
  UseMethod("na.dummy", object)
}

na.dummy.numeric <- function(object, ..., m=mean(object, na.rm=TRUE)) {
  i <- is.na(object)

  structure(cbind(replace(object, i, m), `NA`=i*1), 
            class='na.dummy', m=m)
}

na.dummy.data.frame <- function(object, ...) {

  w <- vapply(object, anyNA, TRUE)
  cm <- rep(NA, length(object))


  for(j in which(w)) {
    object[[j]] <- na.dummy(object[[j]])
    cm[j] <- attr(object[[j]], 'm')


  }


  structure(object, 
            na.action=structure(cm, class='dummy'))
}

Удивительно, но это в основном работает.Однако, когда вы пытаетесь predict() на новых данных, система ломается.Ниже приведена функция, которая редактирует метаданные модели для правильной настройки фрейма модели для прогнозирования:

fix_predvars <- function(object){


  pv <- attr(terms(object), "predvars")

  cm <- na.action(object)


  for(j in seq_along(cm)) {
    if(is.na(cm[j])) next

    newpv <- quote(na.dummy())
    newpv[[2]] <- pv[[j+1]]
    newpv[["m"]] <- cm[j]
    pv[[j+1]] <- newpv

  }
  attr(object$terms, 'predvars') <- pv

  object
}



makepredictcall.na.dummy <- function(var, call){
  if (as.character(call)[1L] != "na.dummy")
    return(call)
  call["m"] <- attr(var, "m")
  call
}

predict.na.dummy <- function(object, newx, ...)
{
  if(missing(newx))
    return(object)
  na.dummy(newx, m=attr(object, "m"))
}

Это пример фактического подбора модели, а затем ее использования для создания прогноза в случае отсутствияданные:

> (m <- lm(Y~X1+X2, df, na.action = na.dummy))

Call:
lm(formula = Y ~ X1 + X2, data = df, na.action = na.dummy)

Coefficients:
(Intercept)           X1           X2         X2NA  
     0.2313       0.9715       1.9356       5.9521  

> m2 <- fix_predvars(m)
> predict(m2, newdata = data.frame(X1=2,X2=NA_real_))
       1 
17.80423

Answer 2

Одним из подходов может быть использование функции для вменения и создания фиктивных переменных, возможно, что-то вроде этого:

impvars <-  function(dat) {
  # Detect and impute
  imp <- sapply(dat, function(x) {
    if (any(is.na(x))) {
      cbind(replace(x, is.na(x), mean(x, na.rm = TRUE)), is.na(x))
    }
    else {
      x
    }
  })

  rdf <- data.frame(do.call(cbind, imp))

  # Name the columns
  midx <- sapply(dat, function(x) any(is.na(x)))
  vnames <- names(dat)
  for (i in rev(seq_along(midx))) {
    if (midx[i])
      vnames <-
        append(vnames, paste0(vnames[i], "_dum"), after = i)
  }
  names(rdf) <- vnames

  return(rdf)

}

lm(Y ~ ., data = impvars(df))

Call:
lm(formula = Y ~ ., data = impvars(df))

Coefficients:
(Intercept)           X1       X1_dum           X2       X2_dum  
     0.3167       0.9622      -0.2523       2.0030       5.5531 

Данные:

df <- structure(list(Y = c(3.83, 22.73, 13.85, 14.09, 20.55, 18.51, 
                           17.76, 9.42, 15.88, 27.81), X1 = c(1:5, NA, NA, 8:10), X2 = c(2L, NA, NA, 4L, 
                                                                         8L, 7L, 6L, 1L, 3L, 9L)), .Names = c("Y", "X1", "X2"), row.names = c(NA, 
                                                                                                                                              -10L), class = "data.frame")