循环数据框的R函数

时间:2018-03-23 19:23:25

标签: r function loops

如果这是重复或有点令人困惑,我道歉 - 我已经搜索了所有这些但似乎无法应用找到我想要完成的事情。我还没有广泛使用函数/循环,特别是从头开始编写,因此我不确定错误是来自函数(可能)还是来自数据结构。基本流程如下:

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

我通过使用此位分组来运行数据集上的lm公式:

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

上面的结果给出了变量的截距和系数 -  我试图完成下一步(并且失败)的是所有负估计的系数,将该分量从该等式中删除,并仅用正系数重新运行lm。所以例如一组状态,如果年份系数为负,我想运行lm(速率〜月,数据=。在公式中。

为了实现目标,通过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变量,以及每个人的拦截和估计。最终,我将把这个输出并追溯到最初的&#39; coef_models&#39; - 但我暂时无法超越这部分。

编辑:示例test_coef set

        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

1 个答案:

答案 0 :(得分: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

请注意:删除第一个负数系数并重新运行新模型可以使其他组件在之前为正数时呈现负数。