web-dev-qa-db-ja.com

lfeパッケージからfelmのメソッドを予測する

predictモデルのfelm動作を取得するためのすてきなクリーンな方法はありますか？

library(lfe)
model1 <- lm(data = iris, Sepal.Length ~ Sepal.Width + Species)
predict(model1, newdata = data.frame(Sepal.Width = 3, Species = "virginica"))
# Works

model2 <- felm(data = iris, Sepal.Length ~ Sepal.Width | Species)
predict(model2, newdata = data.frame(Sepal.Width = 3, Species = "virginica"))
# Does not work
rpredictlfe
20
kennyB

回避策として、felm、getfe、およびdemeanlistを次のように組み合わせることができます。

library(lfe)

lm.model <- lm(data=demeanlist(iris[, 1:2], list(iris$Species)), Sepal.Length ~ Sepal.Width)
fe <- getfe(felm(data = iris, Sepal.Length ~ Sepal.Width | Species))
predict(lm.model, newdata = data.frame(Sepal.Width = 3)) + fe$effect[fe$idx=="virginica"]

demeanlistを使用して変数を中央に配置し、次にlmを使用して中央に配置された変数を使用してSepal.Widthの係数を推定し、lmオブジェクトを取得するという考え方です。 predictを実行できます。次に、felm + getfeを実行して固定効果の条件付き平均を取得し、それをpredictの出力に追加します。

12
pbaylis

これはあなたが探している答えではないかもしれませんが、作成者は、適合したlfeモデルを使用して外部データを予測するために、felmパッケージに機能を追加しなかったようです。主な焦点は、グループの固定効果の分析にあるようです。ただし、パッケージのドキュメントには次のことが記載されていることに注意してください。

このオブジェクトは「lm」オブジェクトに似ており、lm用に設計された後処理メソッドが機能する場合があります。ただし、これを成功させるには、オブジェクトを強制する必要がある場合があります。

したがって、いくつかの追加のfelm機能を取得するために、lmオブジェクトをlmオブジェクトに強制することが可能である可能性があります（必要な計算を実行するために必要なすべての情報がオブジェクトに存在する場合）。

Lfeパッケージは非常に大きなデータセットで実行することを目的としており、メモリを節約するための努力が払われました。これの直接の結果として、felmオブジェクトは、lmオブジェクトとは対照的に、qr分解を使用/含みません。残念ながら、lmpredictプロシージャは、予測を計算するためにこの情報に依存しています。したがって、felmオブジェクトを強制し、predictメソッドを実行すると失敗します。

> model2 <- felm(data = iris, Sepal.Length ~ Sepal.Width | Species)
> class(model2) <- c("lm","felm") # coerce to lm object
> predict(model2, newdata = data.frame(Sepal.Width = 3, Species = "virginica"))
Error in qr.lm(object) : lm object does not have a proper 'qr' component.
 Rank zero or should not have used lm(.., qr=FALSE).

予測を実行するために本当にこのパッケージを使用する必要がある場合は、felmオブジェクトで利用可能な情報を使用して、この機能の独自の簡略化バージョンを作成できます。たとえば、OLS回帰係数はmodel2$coefficientsから入手できます。

5
Jellen Vermeir

pbaylis からの答えを拡張するために、複数の固定効果を可能にするためにうまく拡張する少し長蛇の関数を作成しました。 felmモデルで使用されている元のデータセットを手動で入力する必要があることに注意してください。この関数は、予測のベクトルと、予測と固定効果を列として含むnew_dataに基づくデータフレームの2つの項目を含むリストを返します。

predict_felm <- function(model, data, new_data) {

  require(dplyr)

  # Get the names of all the variables
  y <- model$lhs
  x <- rownames(model$beta)
  fe <- names(model$fe)

  # Demean according to fixed effects
  data_demeaned <- demeanlist(data[c(y, x)],
                             as.list(data[fe]),
                             na.rm = T)

  # Create formula for LM and run prediction
  lm_formula <- as.formula(
    paste(y, "~", paste(x, collapse = "+"))
  )

  lm_model <- lm(lm_formula, data = data_demeaned)
  lm_predict <- predict(lm_model,
                        newdata = new_data)

  # Collect coefficients for fe
  fe_coeffs <- getfe(model) %>% 
    select(fixed_effect = effect, fe_type = fe, idx)

  # For each fixed effect, merge estimated fixed effect back into new_data
  new_data_merge <- new_data
  for (i in fe) {

    fe_i <- fe_coeffs %>% filter(fe_type == i)

    by_cols <- c("idx")
    names(by_cols) <- i

    new_data_merge <- left_join(new_data_merge, fe_i, by = by_cols) %>%
      select(-matches("^idx"))

  }

  if (length(lm_predict) != nrow(new_data_merge)) stop("unmatching number of rows")

  # Sum all the fixed effects
  all_fixed_effects <- base::rowSums(select(new_data_merge, matches("^fixed_effect")))

  # Create dataframe with predictions
  new_data_predict <- new_data_merge %>% 
    mutate(lm_predict = lm_predict, 
           felm_predict = all_fixed_effects + lm_predict)

  return(list(predict = new_data_predict$felm_predict,
              data = new_data_predict))

}

model2 <- felm(data = iris, Sepal.Length ~ Sepal.Width | Species)
predict_felm(model = model2, data = iris, new_data = data.frame(Sepal.Width = 3, Species = "virginica"))
# Returns prediction and data frame
2
dmbwebb

これは、予測でグループ効果を無視し、新しいXを予測していて、信頼区間のみが必要な場合に機能するはずです。最初にclustervcv属性を検索し、次にrobustvcv、次にvcvを検索します。

predict.felm <- function(object, newdata, se.fit = FALSE,
                         interval = "none",
                         level = 0.95){
  if(missing(newdata)){
    stop("predict.felm requires newdata and predicts for all group effects = 0.")
  }

  tt <- terms(object)
  Terms <- delete.response(tt)
  attr(Terms, "intercept") <- 0

  m.mat <- model.matrix(Terms, data = newdata)
  m.coef <- as.numeric(object$coef)
  fit <- as.vector(m.mat %*% object$coef)
  fit <- data.frame(fit = fit)

  if(se.fit | interval != "none"){
    if(!is.null(object$clustervcv)){
      vcov_mat <- object$clustervcv
    } else if (!is.null(object$robustvcv)) {
      vcov_mat <- object$robustvcv
    } else if (!is.null(object$vcv)){
      vcov_mat <- object$vcv
    } else {
      stop("No vcv attached to felm object.")
    }
    se.fit_mat <- sqrt(diag(m.mat %*% vcov_mat %*% t(m.mat)))
  }
  if(interval == "confidence"){
    t_val <- qt((1 - level) / 2 + level, df = object$df.residual)
    fit$lwr <- fit$fit - t_val * se.fit_mat
    fit$upr <- fit$fit + t_val * se.fit_mat
  } else if (interval == "prediction"){
    stop("interval = \"prediction\" not yet implemented")
  }
  if(se.fit){
    return(list(fit=fit, se.fit=se.fit_mat))
  } else {
    return(fit)
  }
}
2
kennyB