循环数据帧的R函数

Question

如果这是重复或有点令人困惑，我深表歉意 - 我已经搜索了所有 SO，但似乎无法找到我想要完成的任务。我没有广泛使用函数/循环，尤其是从头开始编写，所以我不确定错误是来自函数（可能）还是来自数据的构造。基本流程如下：

虚拟数据集 - 分组、类型、比率、年、月

我正在通过与此位分组的数据集上运行 lm 公式：

coef_models <- test_coef %>% group_by(Grouping) %>% do(model = lm(rate ~ years + months, data = .))

上面的结果给了我变量的截距和系数 - 我接下来要完成（并且失败）的是对于所有负估计系数，将该分量从等式中删除并仅使用正系数重新运行 lm 。因此，例如一组状态，如果年系数为负，我想在公式中运行 lm(rate ~ months, data = . with。

为了到达那里，我使用 plyr/broom 获取结果并将它们放入数据框中：

#removed lines with negative coefficients
library(dplyr)
library(broom)
coef_output_test <- as.data.frame(coef_models %>% tidy(model))
coef_output_test$Grouping <- as.character(coef_output_test$Grouping)
#drop these coefficients and rerun
coef_output_test_rerun <- coef_output_test[!(coef_output_test$estimate >= 0),]

从这里开始，我正在尝试重新运行有问题的分组，而没有初始运行中的负变量。因为变量会有所不同，有些实例会退出几年，有些会几个月，我需要通过正确的列才能使用。我想这就是我要挂断电话的地方：

lm_test_rerun_out <- data.frame(grouping=character()
                            , '(intercept)'=double()
                            , term=character()
                            , estimate=double()
                            , stringsAsFactors=FALSE)    
lm_test_rerun <- function(r) {    
y = coef_output_test_rerun$Grouping
x = coef_output_test_rerun$term
for (i in 2:nrow(coef_output_test_rerun)){
    lm_test_rerun_out <- test_coef %>% group_by(Grouping["y"]) %>% do(model = lm(rate ~ x, data = .))
  }
}
lm_test_rerun(coef_output_test_rerun)

我收到此错误：

variable lengths differ (found for 'x')

函数的输出应该是这样的虚拟输出：

Grouping, Term, (intercept), Estimate
Sports, Years, 0.56, 0.0430
States, Months, 0.67, 0.340

我肯定不会流利地使用 R，而且我确信可以更有效地完成上述工作的部分，但函数的输出应该是使用的分组和 x 变量，以及截距和估计对于每个。最终，我将采用该输出并附加回原始的“coef_models” - 但我现在无法超越这部分。

编辑：样本 test_coef 集

        Grouping    Drilldown   Years   Months  Rate
    Sports  Basketball  10  23  0.42
    Sports  Soccer  13  18  0.75
    Sports  Football    9   5   0.83
    Sports  Golf    13  17  0.59
    States  CA  13  20  0.85
    States  TX  14  9   0.43
    States  AK  14  10  0.63
    States  AR  10  5   0.60
    States  ID  18  2   0.22
Countries   US  8   19  0.89
Countries   CA  9   19  0.86
Countries   UK  2   15  0.64
Countries   MX  21  15  0.19
Countries   AR  8   11  0.62

Answer 1

考虑使用by 的基本 R 解决方案，该解决方案将数据帧按一个或多个因子切片，以便任何扩展方法在每个分组子集上运行。具体来说，下面将通过检查系数矩阵有条件地重新运行lm模型，并最终返回一个具有所需值的数据框：

数据

txt <- '        Grouping    Drilldown   Years   Months  Rate
    Sports  Basketball  10  23  0.42
    Sports  Soccer  13  18  0.75
    Sports  Football    9   5   0.83
    Sports  Golf    13  17  0.59
    States  CA  13  20  0.85
    States  TX  14  9   0.43
    States  AK  14  10  0.63
    States  AR  10  5   0.60
    States  ID  18  2   0.22
Countries   US  8   19  0.89
Countries   CA  9   19  0.86
Countries   UK  2   15  0.64
Countries   MX  21  15  0.19
Countries   AR  8   11  0.62'

test_coef <- read.table(text=txt, header=TRUE)

代码

df_list <- by(test_coef, test_coef$Grouping, function(df){
  # FIRST MODEL
  res <- summary(lm(Rate ~ Years + Months, data = df))$coefficients

  # CONDITIONALLY DEFINE FORMULA
  f <- NULL
  if ((res["Years",1]) < 0 & (res["Months",1]) > 0) f <- Rate ~ Months
  if ((res["Years",1]) > 0 & (res["Months",1]) < 0) f <- Rate ~ Years 

  # CONDITIONALLY RERUN MODEL
  if (!is.null(f)) res <- summary(lm(f, data = df))$coefficients

  # ITERATE THROUGH LENGTH OF res MATRIX SKIPPING FIRST ROW
  tmp_list <- lapply(seq(length(res[-1,1])), function(i)
    data.frame(Group = as.character(df$Grouping[[1]]), 
               Term = row.names(res)[i+1],
               Intercept = res[1,1],
               Estimate = res[i+1,1])
  )

  # RETURN DATAFRAME OF 1 OR MORE ROWS
  return(do.call(rbind, tmp_list))
})

final_df <- do.call(rbind, unname(df_list))
final_df

#       Group   Term  Intercept    Estimate
# 1 Countries Months -0.0512500  0.04375000
# 2    Sports  Years  0.6894118 -0.00372549
# 3    States Months  0.2754176  0.02941113

请注意：移除第一个负系数并重新运行新模型可能会使之前为正的其他组件变为负值。