1

我有以下数据框：

input.df <- dplyr::data_frame(x = rnorm(4),
                              y = rnorm(4),
                              `z 1` = rnorm(4))

我想对每列与其他列进行多重回归，并从每个模型中提取 R 平方。这意味着我可以运行以下代码：

summary(lm(x ~ ., data = input.df))
summary(lm(y ~ ., data = input.df))
summary(lm(`z 1` ~ ., data = input.df))

并记下 R 平方。

我想自动执行此任务并有两列数据框，其中第一列是因变量，第二列是 R 平方。

这是我尝试过的：

n <- ncol(input.df)

replicate(n, input.df, simplify = F) %>%
  dplyr::bind_rows() %>%
  dplyr::mutate(group = rep(names(.), each = nrow(.) / n)) %>%
  dplyr::group_by(group) %>%
  dplyr::do({
    tgt.var <- .$group[1]

    # How do I get the formula to interpret . as all variables?
    lm(get(tgt.var) ~ ., data = .) %>%
      broom::glance() %>%
      dplyr::select(r.squared)

  })

我已经对我被卡住的部分发表了评论。我收到以下错误：

 Error in `contrasts<-`(`*tmp*`, value = contr.funs[1 + isOF[nn]]) :   contrasts can be applied only to factors with 2 or more levels
4

2 回答 2

2

我认为您构建数据框有点过于复杂了。不需要，replicate因为您在同一数据集上运行所有回归。你可以使用mapfrom purrr，想法是尝试类似的东西

library(purrr)
names(input.df) %>%
    map(~ lm(get(.) ~ ., data = input.df))

这运行没有错误，但没有给出预期的结果。原因是它get(.)作为新变量添加到数据集中，因此例如第一个回归x ~ x + y + `z 1`不是我们想要的。这可以通过lm如下更改公式轻松解决

names(input.df) %>%
    map(~ lm(formula(paste0('`', ., '` ~ .')), data = input.df))

（请注意，由于第三个变量的名称，需要包含转义反引号，否则就没有必要了）。这现在给出了预期的结果。如果您不想保留所有内容并想提取 r2 您可以这样做

names(input.df) %>%
    map(~ lm(formula(paste0('`', ., '` ~ .')), data = input.df)) %>%
    map(summary) %>%
    map_dbl('r.squared')
于 2017-04-18T14:44:35.427 回答
1

不确定如何直接解决您的问题。这是另一种方法来导出具有因变量的 data.frame 和 r.sq 用于单独的模型。

cond <- matrix(c(1,0,0,0,1,0,0,0,1), ncol=3)
colnames(cond)<- colnames(input.df)
cond

     x y z 1
[1,] 1 0   0
[2,] 0 1   0
[3,] 0 0   1

xy <- lapply(1:nrow(cond), function(v)
           list(y = colnames(cond)[which(cond[v,]==1)] %>% paste0("`", ., "`"), 
           x = colnames(cond)[which(cond[v,]==0)] %>% paste0("`", ., "`") %>% paste(., collapse="+")))


lm.form <- lapply(1:length(xy), function(v) paste(xy[[v]]$y, xy[[v]]$x, sep="~") %>% as.formula)

lm.mod <- lapply(lm.form, function(v)lm(v, data=input.df))

data.frame(pred = lapply(xy, function(v) v["x"]) %>% unlist,
           r.sq = lapply(lm.mod, function(v) summary(v)$r.sq)%>% unlist)

       pred      r.sq
1 `y`+`z 1` 0.5806704
2 `x`+`z 1` 0.8500431
3   `x`+`y` 0.8335421
于 2017-04-18T08:40:28.353 回答